diff --git a/FSharp.Profiles.props b/FSharp.Profiles.props index 2e2edb73702190ce9df41ba9538ad7ccf1cc373d..f3e0bc12d364c2652ce99de409d3ffffe073239e 100644 --- a/FSharp.Profiles.props +++ b/FSharp.Profiles.props @@ -11,7 +11,6 @@ $(DefineConstants);NETSTANDARD - $(DefineConstants);NETSTANDARD1_6 $(DefineConstants);FX_NO_APP_DOMAINS $(DefineConstants);FX_NO_ARRAY_LONG_LENGTH $(DefineConstants);FX_NO_BEGINEND_READWRITE @@ -21,9 +20,7 @@ $(DefineConstants);FX_NO_CORHOST_SIGNER $(DefineConstants);FX_NO_EVENTWAITHANDLE_IDISPOSABLE $(DefineConstants);FX_NO_EXIT_CONTEXT_FLAGS - $(DefineConstants);FX_NO_HEAPTERMINATION $(DefineConstants);FX_NO_LINKEDRESOURCES - $(DefineConstants);FX_NO_LOADER_OPTIMIZATION $(DefineConstants);FX_NO_PARAMETERIZED_THREAD_START $(DefineConstants);FX_NO_PDB_READER $(DefineConstants);FX_NO_PDB_WRITER diff --git a/Makefile b/Makefile index e89dd8d335e29023dbebcd4c3402fb538f9b121a..10de364b677d90c67a0af6432e449ee8b8877b91 100644 --- a/Makefile +++ b/Makefile @@ -31,9 +31,9 @@ build: proto restore $(DotNetExe) build-server shutdown $(DotNetExe) build -c $(Configuration) -f netstandard1.6 src/fsharp/FSharp.Core/FSharp.Core.fsproj $(DotNetExe) build -c $(Configuration) -f netstandard2.0 src/fsharp/FSharp.Build/FSharp.Build.fsproj - $(DotNetExe) build -c $(Configuration) -f netstandard1.6 src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj + $(DotNetExe) build -c $(Configuration) -f netstandard2.0 src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj $(DotNetExe) build -c $(Configuration) -f netcoreapp2.1 src/fsharp/fsc/fsc.fsproj - $(DotNetExe) build -c $(Configuration) -f netstandard1.6 src/fsharp/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.fsproj + $(DotNetExe) build -c $(Configuration) -f netstandard2.0 src/fsharp/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.fsproj $(DotNetExe) build -c $(Configuration) -f netcoreapp2.1 src/fsharp/fsi/fsi.fsproj $(DotNetExe) build -c $(Configuration) -f netcoreapp2.0 tests/FSharp.Core.UnitTests/FSharp.Core.UnitTests.fsproj $(DotNetExe) build -c $(Configuration) -f netcoreapp2.0 tests/FSharp.Build.UnitTests/FSharp.Build.UnitTests.fsproj diff --git a/fcs/FSharp.Compiler.Service.ProjectCracker/ProjectCracker.fs b/fcs/FSharp.Compiler.Service.ProjectCracker/ProjectCracker.fs index eff81a3d24da89486e7903ab8e41fe822d60cb3b..d5be2c7565f919bf6a3c20b7eafbcc4cc8d9c917 100644 --- a/fcs/FSharp.Compiler.Service.ProjectCracker/ProjectCracker.fs +++ b/fcs/FSharp.Compiler.Service.ProjectCracker/ProjectCracker.fs @@ -1,6 +1,6 @@ namespace FSharp.Compiler.SourceCodeServices -#if !NETSTANDARD1_6 +#if !NETSTANDARD open System.Runtime.Serialization.Json open System.Runtime open System.Diagnostics @@ -60,7 +60,7 @@ type ProjectCracker = let enableLogging = defaultArg enableLogging true -#if NETSTANDARD1_6 +#if NETSTANDARD let arguments = [| yield projectFileName yield enableLogging.ToString() diff --git a/fcs/samples/FscExe/FscMain.fs b/fcs/samples/FscExe/FscMain.fs index 94e0a42ceb51ca1e1886bf7da4ece0e173a6eca2..26f26be63d10639117e66d24cc3fed6b11ec7d55 100644 --- a/fcs/samples/FscExe/FscMain.fs +++ b/fcs/samples/FscExe/FscMain.fs @@ -288,9 +288,7 @@ module Driver = for error in errors do eprintfn "%s" (error.ToString()) exitCode -#if !FX_NO_DEFAULT_DEPENDENCY_TYPE [] -#endif do () [] diff --git a/fsharp.proj b/fsharp.proj index a09acabb2c87d61bf07c33bcd5c1125f25e9ec4f..beb3636f9501598e70ac0b03a2391830f3e8f7a6 100644 --- a/fsharp.proj +++ b/fsharp.proj @@ -62,14 +62,14 @@ TargetFramework=net472 - TargetFramework=netstandard1.6 + TargetFramework=netstandard2.0 TargetFramework=net472 TargetFramework=net472 - TargetFramework=netstandard1.6 + TargetFramework=netstandard2.0 TargetFramework=net472 diff --git a/src/absil/il.fs b/src/absil/il.fs index b065b9ff87bd9a3588ccfbbe1332f70d738ff92a..012a2385925d35e604c18d226ce4444b24d382d4 100644 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -1908,7 +1908,7 @@ type ILTypeDefLayout = | Explicit of ILTypeDefLayoutInfo (* REVIEW: add field info here *) and ILTypeDefLayoutInfo = - { Size: int32 option; + { Size: int32 option Pack: uint16 option } [] @@ -2752,7 +2752,7 @@ let rescopeILTypeRef scoref (tref1:ILTypeRef) = else ILTypeRef.Create(scoref2, tref1.Enclosing, tref1.Name) // ORIGINAL IMPLEMENTATION (too many allocations -// { tspecTypeRef=rescopeILTypeRef scoref tref; +// { tspecTypeRef=rescopeILTypeRef scoref tref // tspecInst=rescopeILTypes scoref tinst } let rec rescopeILTypeSpec scoref (tspec1:ILTypeSpec) = let tref1 = tspec1.TypeRef @@ -3341,7 +3341,7 @@ let mkILDelegateMethods (access) (ilg: ILGlobals) (iltyp_AsyncCallback, iltyp_IA let mkCtorMethSpecForDelegate (ilg: ILGlobals) (ty:ILType, useUIntPtr) = let scoref = ty.TypeRef.Scope - mkILInstanceMethSpecInTy (ty, ".ctor", [rescopeILType scoref ilg.typ_Object; + mkILInstanceMethSpecInTy (ty, ".ctor", [rescopeILType scoref ilg.typ_Object rescopeILType scoref (if useUIntPtr then ilg.typ_UIntPtr else ilg.typ_IntPtr)], ILType.Void, emptyILGenericArgsList) diff --git a/src/absil/ilascii.fs b/src/absil/ilascii.fs index 41196df57a3906a2fa2d569d412b5bd847521eb6..cf8cef0a6315132bac416c270bc02a8cbc63902c 100644 --- a/src/absil/ilascii.fs +++ b/src/absil/ilascii.fs @@ -1,172 +1,155 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.AbstractIL.Internal.AsciiConstants +module internal FSharp.Compiler.AbstractIL.Internal.AsciiConstants -open Internal.Utilities open Internal.Utilities.Collections -open FSharp.Compiler.AbstractIL -open FSharp.Compiler.AbstractIL.Internal -open FSharp.Compiler.AbstractIL.Internal.Library -open FSharp.Compiler.AbstractIL.Extensions.ILX.Types -open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler.AbstractIL.IL // set to the proper value at CompileOps.fs (BuildFrameworkTcImports) +// Only reelvant when compiling FSharp.Core.dll let parseILGlobals = ref EcmaMscorlibILGlobals -// -------------------------------------------------------------------- -// Table of parsing and pretty printing data for instructions. -// - PP data is only used for instructions with no arguments -// -------------------------------------------------------------------- - -let noArgInstrs = - lazy [ - ["ldc";"i4";"0"], mkLdcInt32 0; - ["ldc";"i4";"1"], mkLdcInt32 1; - ["ldc";"i4";"2"], mkLdcInt32 2; - ["ldc";"i4";"3"], mkLdcInt32 3; - ["ldc";"i4";"4"], mkLdcInt32 4; - ["ldc";"i4";"5"], mkLdcInt32 5; - ["ldc";"i4";"6"], mkLdcInt32 6; - ["ldc";"i4";"7"], mkLdcInt32 7; - ["ldc";"i4";"8"], mkLdcInt32 8; - ["ldc";"i4";"M1"], mkLdcInt32 -1; - ["ldc";"i4";"m1"], mkLdcInt32 -1; - ["stloc";"0"], mkStloc (uint16 0); - ["stloc";"1"], mkStloc (uint16 1); - ["stloc";"2"], mkStloc (uint16 2); - ["stloc";"3"], mkStloc (uint16 3); - ["ldloc";"0"], mkLdloc (uint16 0); - ["ldloc";"1"], mkLdloc (uint16 1); - ["ldloc";"2"], mkLdloc (uint16 2); - ["ldloc";"3"], mkLdloc (uint16 3); - ["ldarg";"0"], (mkLdarg (uint16 ( 0))); - ["ldarg";"1"], (mkLdarg (uint16 ( 1))); - ["ldarg";"2"], (mkLdarg (uint16 ( 2))); - ["ldarg";"3"], (mkLdarg (uint16 ( 3))); - ["ret"], I_ret; - ["add"], AI_add; - ["add";"ovf"], AI_add_ovf; - ["add";"ovf";"un"], AI_add_ovf_un; - ["and"], AI_and; - ["div"], AI_div; - ["div";"un"], AI_div_un; - ["ceq"], AI_ceq; - ["cgt"], AI_cgt; - ["cgt";"un"], AI_cgt_un; - ["clt"], AI_clt; - ["clt";"un"], AI_clt_un; - ["conv";"i1"], AI_conv DT_I1; - ["conv";"i2"], AI_conv DT_I2; - ["conv";"i4"], AI_conv DT_I4; - ["conv";"i8"], AI_conv DT_I8; - ["conv";"i"], AI_conv DT_I; - ["conv";"r4"], AI_conv DT_R4; - ["conv";"r8"], AI_conv DT_R8; - ["conv";"u1"], AI_conv DT_U1; - ["conv";"u2"], AI_conv DT_U2; - ["conv";"u4"], AI_conv DT_U4; - ["conv";"u8"], AI_conv DT_U8; - ["conv";"u"], AI_conv DT_U; - ["conv";"r"; "un"], AI_conv DT_R; - ["conv";"ovf";"i1"], AI_conv_ovf DT_I1; - ["conv";"ovf";"i2"], AI_conv_ovf DT_I2; - ["conv";"ovf";"i4"], AI_conv_ovf DT_I4; - ["conv";"ovf";"i8"], AI_conv_ovf DT_I8; - ["conv";"ovf";"i"], AI_conv_ovf DT_I; - ["conv";"ovf";"u1"], AI_conv_ovf DT_U1; - ["conv";"ovf";"u2"], AI_conv_ovf DT_U2; - ["conv";"ovf";"u4"], AI_conv_ovf DT_U4; - ["conv";"ovf";"u8"], AI_conv_ovf DT_U8; - ["conv";"ovf";"u"], AI_conv_ovf DT_U; - ["conv";"ovf";"i1"; "un"], AI_conv_ovf_un DT_I1; - ["conv";"ovf";"i2"; "un"], AI_conv_ovf_un DT_I2; - ["conv";"ovf";"i4"; "un"], AI_conv_ovf_un DT_I4; - ["conv";"ovf";"i8"; "un"], AI_conv_ovf_un DT_I8; - ["conv";"ovf";"i"; "un"], AI_conv_ovf_un DT_I; - ["conv";"ovf";"u1"; "un"], AI_conv_ovf_un DT_U1; - ["conv";"ovf";"u2"; "un"], AI_conv_ovf_un DT_U2; - ["conv";"ovf";"u4"; "un"], AI_conv_ovf_un DT_U4; - ["conv";"ovf";"u8"; "un"], AI_conv_ovf_un DT_U8; - ["conv";"ovf";"u"; "un"], AI_conv_ovf_un DT_U; - ["stelem";"i1"], I_stelem DT_I1; - ["stelem";"i2"], I_stelem DT_I2; - ["stelem";"i4"], I_stelem DT_I4; - ["stelem";"i8"], I_stelem DT_I8; - ["stelem";"r4"], I_stelem DT_R4; - ["stelem";"r8"], I_stelem DT_R8; - ["stelem";"i"], I_stelem DT_I; - ["stelem";"u"], I_stelem DT_I; - ["stelem";"u8"], I_stelem DT_I8; - ["stelem";"ref"], I_stelem DT_REF; - ["ldelem";"i1"], I_ldelem DT_I1; - ["ldelem";"i2"], I_ldelem DT_I2; - ["ldelem";"i4"], I_ldelem DT_I4; - ["ldelem";"i8"], I_ldelem DT_I8; - ["ldelem";"u8"], I_ldelem DT_I8; - ["ldelem";"u1"], I_ldelem DT_U1; - ["ldelem";"u2"], I_ldelem DT_U2; - ["ldelem";"u4"], I_ldelem DT_U4; - ["ldelem";"r4"], I_ldelem DT_R4; - ["ldelem";"r8"], I_ldelem DT_R8; - ["ldelem";"u"], I_ldelem DT_I; // EQUIV - ["ldelem";"i"], I_ldelem DT_I; - ["ldelem";"ref"], I_ldelem DT_REF; - ["mul"], AI_mul ; - ["mul";"ovf"], AI_mul_ovf; - ["mul";"ovf";"un"], AI_mul_ovf_un; - ["rem"], AI_rem ; - ["rem";"un"], AI_rem_un ; - ["shl"], AI_shl ; - ["shr"], AI_shr ; - ["shr";"un"], AI_shr_un; - ["sub"], AI_sub ; - ["sub";"ovf"], AI_sub_ovf; - ["sub";"ovf";"un"], AI_sub_ovf_un; - ["xor"], AI_xor; - ["or"], AI_or; - ["neg"], AI_neg; - ["not"], AI_not; - ["ldnull"], AI_ldnull; - ["dup"], AI_dup; - ["pop"], AI_pop; - ["ckfinite"], AI_ckfinite; - ["nop"], AI_nop; - ["break"], I_break; - ["arglist"], I_arglist; - ["endfilter"], I_endfilter; - ["endfinally"], I_endfinally; - ["refanytype"], I_refanytype; - ["localloc"], I_localloc; - ["throw"], I_throw; - ["ldlen"], I_ldlen; - ["rethrow"], I_rethrow; - ];; - +/// Table of parsing and pretty printing data for instructions. +let noArgInstrs = + lazy [ + ["ldc";"i4";"0"], mkLdcInt32 0 + ["ldc";"i4";"1"], mkLdcInt32 1 + ["ldc";"i4";"2"], mkLdcInt32 2 + ["ldc";"i4";"3"], mkLdcInt32 3 + ["ldc";"i4";"4"], mkLdcInt32 4 + ["ldc";"i4";"5"], mkLdcInt32 5 + ["ldc";"i4";"6"], mkLdcInt32 6 + ["ldc";"i4";"7"], mkLdcInt32 7 + ["ldc";"i4";"8"], mkLdcInt32 8 + ["ldc";"i4";"M1"], mkLdcInt32 -1 + ["ldc";"i4";"m1"], mkLdcInt32 -1 + ["stloc";"0"], mkStloc (uint16 0) + ["stloc";"1"], mkStloc (uint16 1) + ["stloc";"2"], mkStloc (uint16 2) + ["stloc";"3"], mkStloc (uint16 3) + ["ldloc";"0"], mkLdloc (uint16 0) + ["ldloc";"1"], mkLdloc (uint16 1) + ["ldloc";"2"], mkLdloc (uint16 2) + ["ldloc";"3"], mkLdloc (uint16 3) + ["ldarg";"0"], mkLdarg (uint16 0) + ["ldarg";"1"], mkLdarg (uint16 1) + ["ldarg";"2"], mkLdarg (uint16 2) + ["ldarg";"3"], mkLdarg (uint16 3) + ["ret"], I_ret + ["add"], AI_add + ["add";"ovf"], AI_add_ovf + ["add";"ovf";"un"], AI_add_ovf_un + ["and"], AI_and + ["div"], AI_div + ["div";"un"], AI_div_un + ["ceq"], AI_ceq + ["cgt"], AI_cgt + ["cgt";"un"], AI_cgt_un + ["clt"], AI_clt + ["clt";"un"], AI_clt_un + ["conv";"i1"], AI_conv DT_I1 + ["conv";"i2"], AI_conv DT_I2 + ["conv";"i4"], AI_conv DT_I4 + ["conv";"i8"], AI_conv DT_I8 + ["conv";"i"], AI_conv DT_I + ["conv";"r4"], AI_conv DT_R4 + ["conv";"r8"], AI_conv DT_R8 + ["conv";"u1"], AI_conv DT_U1 + ["conv";"u2"], AI_conv DT_U2 + ["conv";"u4"], AI_conv DT_U4 + ["conv";"u8"], AI_conv DT_U8 + ["conv";"u"], AI_conv DT_U + ["conv";"r"; "un"], AI_conv DT_R + ["conv";"ovf";"i1"], AI_conv_ovf DT_I1 + ["conv";"ovf";"i2"], AI_conv_ovf DT_I2 + ["conv";"ovf";"i4"], AI_conv_ovf DT_I4 + ["conv";"ovf";"i8"], AI_conv_ovf DT_I8 + ["conv";"ovf";"i"], AI_conv_ovf DT_I + ["conv";"ovf";"u1"], AI_conv_ovf DT_U1 + ["conv";"ovf";"u2"], AI_conv_ovf DT_U2 + ["conv";"ovf";"u4"], AI_conv_ovf DT_U4 + ["conv";"ovf";"u8"], AI_conv_ovf DT_U8 + ["conv";"ovf";"u"], AI_conv_ovf DT_U + ["conv";"ovf";"i1"; "un"], AI_conv_ovf_un DT_I1 + ["conv";"ovf";"i2"; "un"], AI_conv_ovf_un DT_I2 + ["conv";"ovf";"i4"; "un"], AI_conv_ovf_un DT_I4 + ["conv";"ovf";"i8"; "un"], AI_conv_ovf_un DT_I8 + ["conv";"ovf";"i"; "un"], AI_conv_ovf_un DT_I + ["conv";"ovf";"u1"; "un"], AI_conv_ovf_un DT_U1 + ["conv";"ovf";"u2"; "un"], AI_conv_ovf_un DT_U2 + ["conv";"ovf";"u4"; "un"], AI_conv_ovf_un DT_U4 + ["conv";"ovf";"u8"; "un"], AI_conv_ovf_un DT_U8 + ["conv";"ovf";"u"; "un"], AI_conv_ovf_un DT_U + ["stelem";"i1"], I_stelem DT_I1 + ["stelem";"i2"], I_stelem DT_I2 + ["stelem";"i4"], I_stelem DT_I4 + ["stelem";"i8"], I_stelem DT_I8 + ["stelem";"r4"], I_stelem DT_R4 + ["stelem";"r8"], I_stelem DT_R8 + ["stelem";"i"], I_stelem DT_I + ["stelem";"u"], I_stelem DT_I + ["stelem";"u8"], I_stelem DT_I8 + ["stelem";"ref"], I_stelem DT_REF + ["ldelem";"i1"], I_ldelem DT_I1 + ["ldelem";"i2"], I_ldelem DT_I2 + ["ldelem";"i4"], I_ldelem DT_I4 + ["ldelem";"i8"], I_ldelem DT_I8 + ["ldelem";"u8"], I_ldelem DT_I8 + ["ldelem";"u1"], I_ldelem DT_U1 + ["ldelem";"u2"], I_ldelem DT_U2 + ["ldelem";"u4"], I_ldelem DT_U4 + ["ldelem";"r4"], I_ldelem DT_R4 + ["ldelem";"r8"], I_ldelem DT_R8 + ["ldelem";"u"], I_ldelem DT_I // EQUIV + ["ldelem";"i"], I_ldelem DT_I + ["ldelem";"ref"], I_ldelem DT_REF + ["mul"], AI_mul + ["mul";"ovf"], AI_mul_ovf + ["mul";"ovf";"un"], AI_mul_ovf_un + ["rem"], AI_rem + ["rem";"un"], AI_rem_un + ["shl"], AI_shl + ["shr"], AI_shr + ["shr";"un"], AI_shr_un + ["sub"], AI_sub + ["sub";"ovf"], AI_sub_ovf + ["sub";"ovf";"un"], AI_sub_ovf_un + ["xor"], AI_xor + ["or"], AI_or + ["neg"], AI_neg + ["not"], AI_not + ["ldnull"], AI_ldnull + ["dup"], AI_dup + ["pop"], AI_pop + ["ckfinite"], AI_ckfinite + ["nop"], AI_nop + ["break"], I_break + ["arglist"], I_arglist + ["endfilter"], I_endfilter + ["endfinally"], I_endfinally + ["refanytype"], I_refanytype + ["localloc"], I_localloc + ["throw"], I_throw + ["ldlen"], I_ldlen + ["rethrow"], I_rethrow + ] #if DEBUG -let wordsOfNoArgInstr, isNoArgInstr = - let t = - lazy +let wordsOfNoArgInstr, isNoArgInstr = + let t = + lazy (let t = HashMultiMap(300, HashIdentity.Structural) - noArgInstrs |> Lazy.force |> List.iter (fun (x, mk) -> t.Add(mk, x)) ; - t) - (fun s -> (Lazy.force t).[s]), + noArgInstrs |> Lazy.force |> List.iter (fun (x, mk) -> t.Add(mk, x)) + t) + (fun s -> (Lazy.force t).[s]), (fun s -> (Lazy.force t).ContainsKey s) #endif -// -------------------------------------------------------------------- -// 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))) -// -------------------------------------------------------------------- -// Parsing only... Tables of different types of instructions. -// First the different kinds of instructions. -// -------------------------------------------------------------------- - type NoArgInstr = (unit -> ILInstr) type Int32Instr = (int32 -> ILInstr) type Int32Int32Instr = (int32 * int32 -> ILInstr) @@ -180,96 +163,119 @@ type StringInstr = (string -> ILInstr) type TokenInstr = (ILToken -> ILInstr) type SwitchInstr = (ILCodeLabel list * ILCodeLabel -> ILInstr) -// -------------------------------------------------------------------- -// Now the generic code to make a table of instructions -// -------------------------------------------------------------------- - type InstrTable<'T> = (string list * 'T) list type LazyInstrTable<'T> = Lazy> -// -------------------------------------------------------------------- -// Now the tables of instructions -// -------------------------------------------------------------------- - -let NoArgInstrs = - 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 *) - (mk_stind (["stind";"i1"], DT_I1)); - (mk_stind (["stind";"u2"], DT_I2)); - (mk_stind (["stind";"i2"], DT_I2)); - (mk_stind (["stind";"u4"], DT_I4)); (* ILX EQUIVALENT *) - (mk_stind (["stind";"i4"], DT_I4)); - (mk_stind (["stind";"u8"], DT_I8)); (* ILX EQUIVALENT *) - (mk_stind (["stind";"i8"], DT_I8)); - (mk_stind (["stind";"r4"], DT_R4)); - (mk_stind (["stind";"r8"], DT_R8)); - (mk_stind (["stind";"ref"], DT_REF)); - (mk_ldind (["ldind";"i"], DT_I)); - (mk_ldind (["ldind";"i1"], DT_I1)); - (mk_ldind (["ldind";"i2"], DT_I2)); - (mk_ldind (["ldind";"i4"], DT_I4)); - (mk_ldind (["ldind";"i8"], DT_I8)); - (mk_ldind (["ldind";"u1"], DT_U1)); - (mk_ldind (["ldind";"u2"], DT_U2)); - (mk_ldind (["ldind";"u4"], DT_U4)); - (mk_ldind (["ldind";"u8"], DT_I8)); - (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))); - ] - ) : NoArgInstr InstrTable);; - -let Int64Instrs = - lazy ([ (["ldc";"i8"], (fun x ->(AI_ldc (DT_I8, ILConst.I8 x)))); ] : Int64Instr InstrTable) +/// Table of parsing and pretty printing data for instructions. +let NoArgInstrs : Lazy> = + lazy [ + for (nm, i) in noArgInstrs.Force() do + yield (nm, (fun () -> i)) + yield mk_stind (["stind";"u"], DT_I) + yield mk_stind (["stind";"i"], DT_I) + yield mk_stind (["stind";"u1"], DT_I1) + yield mk_stind (["stind";"i1"], DT_I1) + yield mk_stind (["stind";"u2"], DT_I2) + yield mk_stind (["stind";"i2"], DT_I2) + yield mk_stind (["stind";"u4"], DT_I4) + yield mk_stind (["stind";"i4"], DT_I4) + yield mk_stind (["stind";"u8"], DT_I8) + yield mk_stind (["stind";"i8"], DT_I8) + yield mk_stind (["stind";"r4"], DT_R4) + yield mk_stind (["stind";"r8"], DT_R8) + yield mk_stind (["stind";"ref"], DT_REF) + yield mk_ldind (["ldind";"i"], DT_I) + yield mk_ldind (["ldind";"i1"], DT_I1) + yield mk_ldind (["ldind";"i2"], DT_I2) + yield mk_ldind (["ldind";"i4"], DT_I4) + yield mk_ldind (["ldind";"i8"], DT_I8) + yield mk_ldind (["ldind";"u1"], DT_U1) + yield mk_ldind (["ldind";"u2"], DT_U2) + yield mk_ldind (["ldind";"u4"], DT_U4) + yield mk_ldind (["ldind";"u8"], DT_I8) + yield mk_ldind (["ldind";"r4"], DT_R4) + yield mk_ldind (["ldind";"r8"], DT_R8) + yield mk_ldind (["ldind";"ref"], DT_REF) + yield ["cpblk"], (fun () -> I_cpblk(Aligned, Nonvolatile)) + yield ["initblk"], (fun () -> I_initblk(Aligned, Nonvolatile)) + ] -let Int32Instrs = - lazy ([ (["ldc";"i4"], (fun x -> ((mkLdcInt32 x)))); - (["ldc";"i4";"s"], (fun x -> ((mkLdcInt32 x)))); ] : Int32Instr InstrTable) +/// Table of parsing and pretty printing data for instructions. +let Int64Instrs : Lazy> = + lazy [ + ["ldc";"i8"], (fun x -> AI_ldc (DT_I8, ILConst.I8 x)) + ] -let Int32Int32Instrs = - lazy ([ (["ldlen";"multi"], (fun (x, y) -> EI_ldlen_multi (x, y))); ] : Int32Int32Instr InstrTable) +/// Table of parsing and pretty printing data for instructions. +let Int32Instrs : Lazy> = + lazy [ + ["ldc";"i4"], mkLdcInt32 + ["ldc";"i4";"s"], mkLdcInt32 + ] -let DoubleInstrs = - lazy ([ (["ldc";"r4"], (fun x -> (AI_ldc (DT_R4, x)))); - (["ldc";"r8"], (fun x -> (AI_ldc (DT_R8, x)))); ] : DoubleInstr InstrTable) +/// Table of parsing and pretty printing data for instructions. +let Int32Int32Instrs : Lazy> = + lazy [ + ["ldlen";"multi"], EI_ldlen_multi + ] -let MethodSpecInstrs = - lazy ([ ( (["call"], (fun (mspec, y) -> I_call (Normalcall, mspec, y)))) ] : InstrTable) +/// Table of parsing and pretty printing data for instructions. +let DoubleInstrs : Lazy> = + lazy [ + ["ldc";"r4"], (fun x -> (AI_ldc (DT_R4, x))) + ["ldc";"r8"], (fun x -> (AI_ldc (DT_R8, x))) + ] -let StringInstrs = - lazy ([ (["ldstr"], (fun x -> I_ldstr x)); ] : InstrTable) +/// Table of parsing and pretty printing data for instructions. +let MethodSpecInstrs : Lazy> = + lazy [ + ["call"], (fun (mspec, y) -> I_call (Normalcall, mspec, y)) + ] -let TokenInstrs = - lazy ([ (["ldtoken"], (fun x -> I_ldtoken x)); ] : InstrTable) +/// Table of parsing and pretty printing data for instructions. +let StringInstrs : Lazy> = + lazy [ + ["ldstr"], I_ldstr + ] +/// Table of parsing and pretty printing data for instructions. +let TokenInstrs : Lazy> = + lazy [ + ["ldtoken"], I_ldtoken + ] -let TypeInstrs = - 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))); - (["castclass"], (fun x -> I_castclass x)); - (["ilzero"], (fun x -> EI_ilzero x)); - (["isinst"], (fun x -> I_isinst x)); - (["initobj";"any"], (fun x -> I_initobj x)); - (["unbox";"any"], (fun x -> I_unbox_any x)); ] : InstrTable) +/// Table of parsing and pretty printing data for instructions. +let TypeInstrs : Lazy> = + 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)) + ["castclass"], I_castclass + ["ilzero"], EI_ilzero + ["isinst"], I_isinst + ["initobj";"any"], I_initobj + ["unbox";"any"], I_unbox_any + ] -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) +/// Table of parsing and pretty printing data for instructions. +let IntTypeInstrs : Lazy> = + 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))) + ] -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))); - (["sizeof"], (fun x -> I_sizeof x)); - (["box"], (fun x -> I_box x)); - (["unbox"], (fun x -> I_unbox x)); ] : InstrTable) +/// Table of parsing and pretty printing data for instructions. +let ValueTypeInstrs : Lazy> = + lazy [ + ["cpobj"], I_cpobj + ["initobj"], I_initobj + ["ldobj"], (fun z -> I_ldobj (Aligned, Nonvolatile, z)) + ["stobj"], (fun z -> I_stobj (Aligned, Nonvolatile, z)) + ["sizeof"], I_sizeof + ["box"], I_box + ["unbox"], I_unbox + ] diff --git a/src/absil/illib.fs b/src/absil/illib.fs index 159975b4407b2559f1b7a3395de7c0c2933e587f..94bf28c6a93b41f300b4f166fce18ab8c8e45d33 100644 --- a/src/absil/illib.fs +++ b/src/absil/illib.fs @@ -38,7 +38,9 @@ let inline isSingleton l = | _ -> false let inline isNonNull x = not (isNull x) + let inline nonNull msg x = if isNull x then failwith ("null: " + msg) else x + let inline (===) x y = LanguagePrimitives.PhysicalEquality x y /// Per the docs the threshold for the Large Object Heap is 85000 bytes: https://docs.microsoft.com/en-us/dotnet/standard/garbage-collection/large-object-heap#how-an-object-ends-up-on-the-large-object-heap-and-how-gc-handles-them @@ -69,6 +71,7 @@ type InlineDelayInit<'T when 'T : not struct> = new (f: unit -> 'T) = {store = Unchecked.defaultof<'T>; func = Func<_>(f) } val mutable store : 'T val mutable func : Func<'T> + member x.Value = match x.func with | null -> x.store @@ -109,7 +112,7 @@ module Array = let mutable eq = true let mutable i = 0 while eq && i < len do - if not (inp.[i] === res.[i]) then eq <- false; + if not (inp.[i] === res.[i]) then eq <- false i <- i + 1 if eq then inp else res @@ -243,6 +246,7 @@ module Array = isSubArray suffix whole (whole.Length-suffix.Length) module Option = + let mapFold f s opt = match opt with | None -> None,s @@ -340,9 +344,6 @@ module List = | [] -> None | h :: t -> if f h then Some (h, List.rev acc @ t) else loop (h::acc) t loop [] inp - //tryRemove (fun x -> x = 2) [ 1;2;3] = Some (2, [1;3]) - //tryRemove (fun x -> x = 3) [ 1;2;3;4;5] = Some (3, [1;2;4;5]) - //tryRemove (fun x -> x = 3) [] = None let headAndTail l = match l with @@ -427,13 +428,21 @@ module List = let collect2 f xs ys = List.concat (List.map2 f xs ys) let toArraySquared xss = xss |> List.map List.toArray |> List.toArray + let iterSquared f xss = xss |> List.iter (List.iter f) + let collectSquared f xss = xss |> List.collect (List.collect f) + let mapSquared f xss = xss |> List.map (List.map f) + let mapFoldSquared f z xss = List.mapFold (List.mapFold f) z xss + let forallSquared f xss = xss |> List.forall (List.forall f) + let mapiSquared f xss = xss |> List.mapi (fun i xs -> xs |> List.mapi (fun j x -> f i j x)) + let existsSquared f xss = xss |> List.exists (fun xs -> xs |> List.exists (fun x -> f x)) + let mapiFoldSquared f z xss = mapFoldSquared f z (xss |> mapiSquared (fun i j x -> (i,j,x))) module ResizeArray = @@ -483,9 +492,13 @@ module ResizeArray = /// we need to stick these functions in this module rather than using the module functions for ValueOption /// that come after FSharp.Core 4.5.2. module ValueOptionInternal = + let inline ofOption x = match x with Some x -> ValueSome x | None -> ValueNone + let inline bind f x = match x with ValueSome x -> f x | ValueNone -> ValueNone + let inline isSome x = match x with ValueSome _ -> true | ValueNone -> false + let inline isNone x = match x with ValueSome _ -> false | ValueNone -> true type String with @@ -592,6 +605,7 @@ module Dictionary = [] type DictionaryExtensions() = + [] static member inline BagAdd(dic: Dictionary<'key, 'value list>, key: 'key, value: 'value) = match dic.TryGetValue key with @@ -775,7 +789,7 @@ module Cancellable = /// Implement try/finally for a cancellable computation let tryFinally e compensation = catch e |> bind (fun res -> - compensation(); + compensation() match res with Choice1Of2 r -> ret r | Choice2Of2 err -> raise err) /// Implement try/with for a cancellable computation @@ -800,14 +814,23 @@ module Cancellable = // } type CancellableBuilder() = + member x.Bind(e,k) = Cancellable.bind k e + member x.Return(v) = Cancellable.ret v + member x.ReturnFrom(v) = v + member x.Combine(e1,e2) = e1 |> Cancellable.bind (fun () -> e2) + member x.TryWith(e,handler) = Cancellable.tryWith e handler + member x.Using(resource,e) = Cancellable.tryFinally (e resource) (fun () -> (resource :> IDisposable).Dispose()) + member x.TryFinally(e,compensation) = Cancellable.tryFinally e compensation + member x.Delay(f) = Cancellable.delay f + member x.Zero() = Cancellable.ret () let cancellable = CancellableBuilder() @@ -845,7 +868,6 @@ module Eventually = else forceWhile ctok check (work ctok) let force ctok e = Option.get (forceWhile ctok (fun () -> true) e) - /// Keep running the computation bit by bit until a time limit is reached. /// The runner gets called each time the computation is restarted @@ -856,13 +878,13 @@ module Eventually = let rec runTimeShare ctok e = runner ctok (fun ctok -> sw.Reset() - sw.Start(); + sw.Start() let rec loop ctok ev2 = match ev2 with | Done _ -> ev2 | NotYetDone work -> if ct.IsCancellationRequested || sw.ElapsedMilliseconds > timeShareInMilliseconds then - sw.Stop(); + sw.Stop() NotYetDone(fun ctok -> runTimeShare ctok ev2) else loop ctok (work ctok) @@ -904,10 +926,11 @@ module Eventually = let tryFinally e compensation = catch (e) - |> bind (fun res -> compensation(); - match res with - | Result v -> Eventually.Done v - | Exception e -> raise e) + |> bind (fun res -> + compensation() + match res with + | Result v -> Eventually.Done v + | Exception e -> raise e) let tryWith e handler = catch e @@ -918,15 +941,22 @@ module Eventually = NotYetDone (fun ctok -> Done ctok) type EventuallyBuilder() = + member x.Bind(e,k) = Eventually.bind k e + member x.Return(v) = Eventually.Done v + member x.ReturnFrom(v) = v + member x.Combine(e1,e2) = e1 |> Eventually.bind (fun () -> e2) + member x.TryWith(e,handler) = Eventually.tryWith e handler + member x.TryFinally(e,compensation) = Eventually.tryFinally e compensation + member x.Delay(f) = Eventually.delay f - member x.Zero() = Eventually.Done () + member x.Zero() = Eventually.Done () let eventually = new EventuallyBuilder() @@ -938,10 +968,7 @@ let _ = eventually { try return (failwith "") with _ -> return 1 } let _ = eventually { use x = null in return 1 } *) -//--------------------------------------------------------------------------- -// generate unique stamps -//--------------------------------------------------------------------------- - +/// Generates unique stamps type UniqueStampGenerator<'T when 'T : equality>() = let encodeTab = new Dictionary<'T,int>(HashIdentity.Structural) let mutable nItems = 0 @@ -953,16 +980,16 @@ type UniqueStampGenerator<'T when 'T : equality>() = encodeTab.[str] <- idx nItems <- nItems + 1 idx + member this.Encode(str) = encode str + member this.Table = encodeTab.Keys -//--------------------------------------------------------------------------- -// memoize tables (all entries cached, never collected) -//--------------------------------------------------------------------------- - +/// memoize tables (all entries cached, never collected) type MemoizationTable<'T,'U>(compute: 'T -> 'U, keyComparer: IEqualityComparer<'T>, ?canMemoize) = let table = new Dictionary<'T,'U>(keyComparer) + member t.Apply(x) = if (match canMemoize with None -> true | Some f -> f x) then let mutable res = Unchecked.defaultof<'U> @@ -975,7 +1002,7 @@ type MemoizationTable<'T,'U>(compute: 'T -> 'U, keyComparer: IEqualityComparer<' if ok then res else let res = compute x - table.[x] <- res; + table.[x] <- res res) else compute x @@ -983,8 +1010,11 @@ type MemoizationTable<'T,'U>(compute: 'T -> 'U, keyComparer: IEqualityComparer<' exception UndefinedException type LazyWithContextFailure(exn:exn) = + static let undefined = new LazyWithContextFailure(UndefinedException) + member x.Exception = exn + static member Undefined = undefined /// Just like "Lazy" but EVERY forcer must provide an instance of "ctxt", e.g. to help track errors @@ -994,21 +1024,28 @@ type LazyWithContextFailure(exn:exn) = type LazyWithContext<'T,'ctxt> = { /// This field holds the result of a successful computation. It's initial value is Unchecked.defaultof mutable value : 'T + /// This field holds either the function to run or a LazyWithContextFailure object recording the exception raised /// from running the function. It is null if the thunk has been evaluated successfully. - mutable funcOrException: obj; + mutable funcOrException: obj + /// A helper to ensure we rethrow the "original" exception findOriginalException : exn -> exn } + static member Create(f: ('ctxt->'T), findOriginalException) : LazyWithContext<'T,'ctxt> = - { value = Unchecked.defaultof<'T>; - funcOrException = box f; + { value = Unchecked.defaultof<'T> + funcOrException = box f findOriginalException = findOriginalException } + static member NotLazy(x:'T) : LazyWithContext<'T,'ctxt> = { value = x funcOrException = null findOriginalException = id } + member x.IsDelayed = (match x.funcOrException with null -> false | :? LazyWithContextFailure -> false | _ -> true) + member x.IsForced = (match x.funcOrException with null -> true | _ -> false) + member x.Force(ctxt:'ctxt) = match x.funcOrException with | null -> x.value @@ -1030,21 +1067,16 @@ type LazyWithContext<'T,'ctxt> = x.funcOrException <- box(LazyWithContextFailure.Undefined) try let res = f ctxt - x.value <- res; - x.funcOrException <- null; + x.value <- res + x.funcOrException <- null res with e -> - x.funcOrException <- box(new LazyWithContextFailure(e)); + x.funcOrException <- box(new LazyWithContextFailure(e)) reraise() | _ -> failwith "unreachable" - - -// -------------------------------------------------------------------- -// Intern tables to save space. -// -------------------------------------------------------------------- - +/// Intern tables to save space. module Tables = let memoize f = let t = new Dictionary<_,_>(1000, HashIdentity.Structural) @@ -1055,7 +1087,6 @@ module Tables = else res <- f x; t.[x] <- res; res - /// Interface that defines methods for comparing objects using partial equality relation type IPartialEqualityComparer<'T> = inherit IEqualityComparer<'T> @@ -1063,14 +1094,13 @@ type IPartialEqualityComparer<'T> = abstract InEqualityRelation : 'T -> bool module IPartialEqualityComparer = + let On f (c: IPartialEqualityComparer<_>) = { new IPartialEqualityComparer<_> with member __.InEqualityRelation x = c.InEqualityRelation (f x) member __.Equals(x, y) = c.Equals(f x, f y) member __.GetHashCode x = c.GetHashCode(f x) } - - // Wrapper type for use by the 'partialDistinctBy' function [] type private WrapType<'T> = Wrap of 'T @@ -1090,27 +1120,37 @@ module IPartialEqualityComparer = if dict.ContainsKey(key) then false else (dict.[key] <- null; true) else true) - //------------------------------------------------------------------------- // Library: Name maps //------------------------------------------------------------------------ type NameMap<'T> = Map + type NameMultiMap<'T> = NameMap<'T list> + type MultiMap<'T,'U when 'T : comparison> = Map<'T,'U list> [] module NameMap = let empty = Map.empty + let range m = List.rev (Map.foldBack (fun _ x sofar -> x :: sofar) m []) + let foldBack f (m:NameMap<'T>) z = Map.foldBack f m z + let forall f m = Map.foldBack (fun x y sofar -> sofar && f x y) m true + let exists f m = Map.foldBack (fun x y sofar -> sofar || f x y) m false + let ofKeyedList f l = List.foldBack (fun x acc -> Map.add (f x) x acc) l Map.empty + let ofList l : NameMap<'T> = Map.ofList l + let ofSeq l : NameMap<'T> = Map.ofSeq l + let toList (l: NameMap<'T>) = Map.toList l + let layer (m1 : NameMap<'T>) m2 = Map.foldBack Map.add m1 m2 /// Not a very useful function - only called in one place - should be changed @@ -1165,49 +1205,76 @@ module NameMap = [] module NameMultiMap = + let existsInRange f (m: NameMultiMap<'T>) = NameMap.exists (fun _ l -> List.exists f l) m + let find v (m: NameMultiMap<'T>) = match m.TryGetValue v with true, r -> r | _ -> [] + let add v x (m: NameMultiMap<'T>) = NameMap.add v (x :: find v m) m + let range (m: NameMultiMap<'T>) = Map.foldBack (fun _ x sofar -> x @ sofar) m [] + let rangeReversingEachBucket (m: NameMultiMap<'T>) = Map.foldBack (fun _ x sofar -> List.rev x @ sofar) m [] let chooseRange f (m: NameMultiMap<'T>) = Map.foldBack (fun _ x sofar -> List.choose f x @ sofar) m [] + let map f (m: NameMultiMap<'T>) = NameMap.map (List.map f) m + let empty : NameMultiMap<'T> = Map.empty + let initBy f xs : NameMultiMap<'T> = xs |> Seq.groupBy f |> Seq.map (fun (k,v) -> (k,List.ofSeq v)) |> Map.ofSeq + let ofList (xs: (string * 'T) list) : NameMultiMap<'T> = xs |> Seq.groupBy fst |> Seq.map (fun (k,v) -> (k,List.ofSeq (Seq.map snd v))) |> Map.ofSeq [] module MultiMap = + let existsInRange f (m: MultiMap<_,_>) = Map.exists (fun _ l -> List.exists f l) m + let find v (m: MultiMap<_,_>) = match m.TryGetValue v with true, r -> r | _ -> [] + let add v x (m: MultiMap<_,_>) = Map.add v (x :: find v m) m + let range (m: MultiMap<_,_>) = Map.foldBack (fun _ x sofar -> x @ sofar) m [] + let empty : MultiMap<_,_> = Map.empty + let initBy f xs : MultiMap<_,_> = xs |> Seq.groupBy f |> Seq.map (fun (k,v) -> (k,List.ofSeq v)) |> Map.ofSeq type LayeredMap<'Key,'Value when 'Key : comparison> = Map<'Key,'Value> type Map<'Key,'Value when 'Key : comparison> with + static member Empty : Map<'Key,'Value> = Map.empty member x.Values = [ for (KeyValue(_,v)) in x -> v ] + member x.AddAndMarkAsCollapsible (kvs: _[]) = (x,kvs) ||> Array.fold (fun x (KeyValue(k,v)) -> x.Add(k,v)) + member x.LinearTryModifyThenLaterFlatten (key, f: 'Value option -> 'Value) = x.Add (key, f (x.TryFind key)) + member x.MarkAsCollapsible () = x /// Immutable map collection, with explicit flattening to a backing dictionary [] type LayeredMultiMap<'Key,'Value when 'Key : equality and 'Key : comparison>(contents : LayeredMap<'Key,'Value list>) = + member x.Add (k,v) = LayeredMultiMap(contents.Add(k,v :: x.[k])) + member x.Item with get k = match contents.TryGetValue k with true, l -> l | _ -> [] + member x.AddAndMarkAsCollapsible (kvs: _[]) = let x = (x,kvs) ||> Array.fold (fun x (KeyValue(k,v)) -> x.Add(k,v)) x.MarkAsCollapsible() + member x.MarkAsCollapsible() = LayeredMultiMap(contents.MarkAsCollapsible()) + member x.TryFind k = contents.TryFind k + member x.TryGetValue k = contents.TryGetValue k + member x.Values = contents.Values |> List.concat + static member Empty : LayeredMultiMap<'Key,'Value> = LayeredMultiMap LayeredMap.Empty [] @@ -1320,6 +1387,7 @@ module Shim = let mutable FileSystem = DefaultFileSystem() :> IFileSystem type File with + static member ReadBinaryChunk (fileName, start, len) = use stream = FileSystem.FileStreamReadShim fileName stream.Seek(int64 start, SeekOrigin.Begin) |> ignore diff --git a/src/absil/ilmorph.fs b/src/absil/ilmorph.fs index e0fe4cc749c286f90c33527f94d22ed343a894e5..1281007041a38733cda3e082f03868dd5aba333c 100644 --- a/src/absil/ilmorph.fs +++ b/src/absil/ilmorph.fs @@ -59,7 +59,7 @@ let rec ty_tref2tref f x = | ILType.FunctionPointer x -> ILType.FunctionPointer { x with - ArgTypes=List.map (ty_tref2tref f) x.ArgTypes; + ArgTypes=List.map (ty_tref2tref f) x.ArgTypes ReturnType=ty_tref2tref f x.ReturnType} | ILType.Byref t -> ILType.Byref (ty_tref2tref f t) | ILType.Boxed cr -> mkILBoxedType (tspec_tref2tref f cr) @@ -85,7 +85,7 @@ and tspec_scoref2scoref_tyvar2ty fs (x:ILTypeSpec) = ILTypeSpec.Create(morphILScopeRefsInILTypeRef (fst fs) x.TypeRef,tys_scoref2scoref_tyvar2ty fs x.GenericArgs) and callsig_scoref2scoref_tyvar2ty f x = { x with - ArgTypes=List.map (ty_scoref2scoref_tyvar2ty f) x.ArgTypes; + ArgTypes=List.map (ty_scoref2scoref_tyvar2ty f) x.ArgTypes ReturnType=ty_scoref2scoref_tyvar2ty f x.ReturnType} and tys_scoref2scoref_tyvar2ty f i = List.map (ty_scoref2scoref_tyvar2ty f) i and gparams_scoref2scoref_tyvar2ty f i = List.map (gparam_scoref2scoref_tyvar2ty f) i @@ -95,8 +95,8 @@ and morphILScopeRefsInILTypeRef fscope (x:ILTypeRef) = let callsig_ty2ty f (x: ILCallingSignature) = - { CallingConv=x.CallingConv; - ArgTypes=List.map f x.ArgTypes; + { CallingConv=x.CallingConv + ArgTypes=List.map f x.ArgTypes ReturnType=f x.ReturnType} let gparam_ty2ty f gf = {gf with Constraints = List.map f gf.Constraints} @@ -119,11 +119,11 @@ let mspec_ty2ty (((factualty : ILType -> ILType) , (fformalty: formal_scopeCtxt tys_ty2ty factualty x.GenericArgs) let fref_ty2ty (f: ILType -> ILType) x = - { x with DeclaringTypeRef = (f (mkILBoxedType (mkILNonGenericTySpec x.DeclaringTypeRef))).TypeRef; + { x with DeclaringTypeRef = (f (mkILBoxedType (mkILNonGenericTySpec x.DeclaringTypeRef))).TypeRef Type= f x.Type } let fspec_ty2ty ((factualty,(fformalty : formal_scopeCtxt -> ILType -> ILType))) x = - { FieldRef=fref_ty2ty (fformalty (Choice2Of2 x)) x.FieldRef; + { FieldRef=fref_ty2ty (fformalty (Choice2Of2 x)) x.FieldRef DeclaringType= factualty x.DeclaringType } let rec celem_ty2ty f celem = @@ -213,7 +213,7 @@ let locals_ty2ty f ls = List.map (local_ty2ty f) ls let ilmbody_instr2instr_ty2ty fs (il: ILMethodBody) = let (finstr,ftye) = fs - {il with Code=code_instr2instr_ty2ty (finstr,ftye) il.Code; + {il with Code=code_instr2instr_ty2ty (finstr,ftye) il.Code Locals = locals_ty2ty ftye il.Locals } let morphILMethodBody (filmbody) (x: ILLazyMethodBody) = @@ -240,7 +240,7 @@ let fdefs_ty2ty ilg f x = fdefs_fdef2fdef (fdef_ty2ty ilg f) x let mdefs_ty2ty_ilmbody2ilmbody ilg fs x = morphILMethodDefs (mdef_ty2ty_ilmbody2ilmbody ilg fs) x let mimpl_ty2ty f e = - { Overrides = ospec_ty2ty f e.Overrides; + { Overrides = ospec_ty2ty f e.Overrides OverrideBy = mspec_ty2ty (f,(fun _ -> f)) e.OverrideBy; } let edef_ty2ty ilg f (e: ILEventDef) = @@ -293,8 +293,8 @@ let morphILTypeInILModule_ilmbody2ilmbody_mdefs2mdefs ilg ((ftye: ILModuleDef -> let ftdefs = tdefs_ty2ty_ilmbody2ilmbody_mdefs2mdefs ilg [] (ftye m,fmdefs m) - { m with TypeDefs=ftdefs m.TypeDefs; - CustomAttrsStored= storeILCustomAttrs (cattrs_ty2ty ilg (ftye m None None) m.CustomAttrs); + { m with TypeDefs=ftdefs m.TypeDefs + CustomAttrsStored= storeILCustomAttrs (cattrs_ty2ty ilg (ftye m None None) m.CustomAttrs) Manifest=Option.map (manifest_ty2ty ilg (ftye m None None)) m.Manifest } let module_instr2instr_ty2ty ilg fs x = diff --git a/src/absil/ilprint.fs b/src/absil/ilprint.fs index c2d4e1d45d16b93d02985e3005dad40974d2c01d..f9f7fb7af19708c619a9165de6f5428725b3ef0a 100644 --- a/src/absil/ilprint.fs +++ b/src/absil/ilprint.fs @@ -31,7 +31,7 @@ let tyvar_generator = // depends on the gparams of the current scope. type ppenv = { ilGlobals: ILGlobals - ppenvClassFormals: int; + ppenvClassFormals: int ppenvMethodFormals: int } let ppenv_enter_method mgparams env = {env with ppenvMethodFormals=mgparams} @@ -49,53 +49,53 @@ let output_string (os: TextWriter) (s:string) = os.Write s let output_char (os: TextWriter) (c:char) = os.Write c let output_int os (i:int) = output_string os (string i) let output_hex_digit os i = - assert (i >= 0 && i < 16); + assert (i >= 0 && i < 16) if i > 9 then output_char os (char (int32 'A' + (i-10))) else output_char os (char (int32 '0' + i)) let output_qstring os s = - output_char os '"'; + output_char os '"' for i = 0 to String.length s - 1 do let c = String.get s i if (c >= '\000' && c <= '\031') || (c >= '\127' && c <= '\255') then let c' = int32 c - output_char os '\\'; - output_int os (c'/64); - output_int os ((c' % 64) / 8); + output_char os '\\' + output_int os (c'/64) + output_int os ((c' % 64) / 8) output_int os (c' % 8) else if (c = '"') then - (output_char os '\\'; output_char os '"') + output_char os '\\'; output_char os '"' else if (c = '\\') then - (output_char os '\\'; output_char os '\\') + output_char os '\\'; output_char os '\\' else output_char os c - done; + done output_char os '"' let output_sqstring os s = - output_char os '\''; + output_char os '\'' for i = 0 to String.length s - 1 do let c = s.[i] if (c >= '\000' && c <= '\031') || (c >= '\127' && c <= '\255') then let c' = int32 c - output_char os '\\'; - output_int os (c'/64); - output_int os ((c' % 64) / 8); + output_char os '\\' + output_int os (c'/64) + output_int os ((c' % 64) / 8) output_int os (c' % 8) else if (c = '\\') then - (output_char os '\\'; output_char os '\\') + output_char os '\\'; output_char os '\\' else if (c = '\'') then - (output_char os '\\'; output_char os '\'') + output_char os '\\'; output_char os '\'' else output_char os c - done; + done output_char os '\'' let output_seq sep f os (a:seq<_>) = use e = a.GetEnumerator() if e.MoveNext() then - f os e.Current; + f os e.Current while e.MoveNext() do - output_string os sep; + output_string os sep f os e.Current let output_array sep f os (a:_ []) = @@ -117,12 +117,12 @@ let output_lid os lid = output_seq "." output_string os lid let string_of_type_name (_,n) = n let output_byte os i = - output_hex_digit os (i / 16); + output_hex_digit os (i / 16) output_hex_digit os (i % 16) let output_bytes os (bytes:byte[]) = for i = 0 to bytes.Length - 1 do - output_byte os (Bytes.get bytes i); + output_byte os (Bytes.get bytes i) output_string os " " @@ -137,8 +137,8 @@ let output_u32 os (x:uint32) = output_string os (string (int64 x)) let output_i32 os (x:int32) = output_string os (string x) let output_u64 os (x:uint64) = output_string os (string (int64 x)) let output_i64 os (x:int64) = output_string os (string x) -let output_ieee32 os (x:float32) = (output_string os "float32 ("; output_string os (string (bits_of_float32 x)); output_string os ")") -let output_ieee64 os (x:float) = (output_string os "float64 ("; output_string os (string (bits_of_float x)); output_string os ")") +let output_ieee32 os (x:float32) = output_string os "float32 ("; output_string os (string (bits_of_float32 x)); output_string os ")" +let output_ieee64 os (x:float) = output_string os "float64 ("; output_string os (string (bits_of_float x)); output_string os ")" let rec goutput_scoref _env os = function | ILScopeRef.Local -> () @@ -148,7 +148,7 @@ let rec goutput_scoref _env os = function output_string os "[.module "; output_sqstring os mref.Name; output_string os "]" and goutput_type_name_ref env os (scoref,enc,n) = - goutput_scoref env os scoref; + goutput_scoref env os scoref output_seq "/" output_sqstring os (enc@[n]) and goutput_tref env os (x:ILTypeRef) = goutput_type_name_ref env os (x.Scope,x.Enclosing,x.Name) @@ -162,14 +162,14 @@ and goutput_typ env os ty = let cgparams = env.ppenvClassFormals let mgparams = env.ppenvMethodFormals if int tv < cgparams then - output_string os "!"; + output_string os "!" output_tyvar os tv elif int tv - cgparams < mgparams then - output_string os "!!"; - output_int os (int tv - cgparams); + output_string os "!!" + output_int os (int tv - cgparams) else - output_string os "!"; - output_tyvar os tv; + output_string os "!" + output_tyvar os tv output_int os (int tv) | ILType.Byref typ -> goutput_typ env os typ; output_string os "&" @@ -189,21 +189,21 @@ and goutput_typ env os ty = | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_Bool.TypeSpec.Name -> output_string os "bool" | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_Char.TypeSpec.Name -> output_string os "char" | ILType.Value tspec -> - output_string os "value class "; - goutput_tref env os tspec.TypeRef; - output_string os " "; + output_string os "value class " + goutput_tref env os tspec.TypeRef + output_string os " " goutput_gactuals env os tspec.GenericArgs | ILType.Void -> output_string os "void" | ILType.Array (bounds,ty) -> - goutput_typ env os ty; - output_string os "["; - output_arr_bounds os bounds; - output_string os "]"; + goutput_typ env os ty + output_string os "[" + output_arr_bounds os bounds + output_string os "]" | ILType.FunctionPointer csig -> - output_string os "method "; - goutput_typ env os csig.ReturnType; - output_string os " *("; - output_seq "," (goutput_typ env) os csig.ArgTypes; + output_string os "method " + goutput_typ env os csig.ReturnType + output_string os " *(" + output_seq "," (goutput_typ env) os csig.ArgTypes output_string os ")" | _ -> output_string os "NaT" @@ -229,10 +229,10 @@ and goutput_gactuals env os inst = and goutput_gactual env os ty = goutput_typ env os ty and goutput_tspec env os tspec = - output_string os "class "; - goutput_tref env os tspec.TypeRef; - output_string os " "; - goutput_gactuals env os tspec.GenericArgs; + output_string os "class " + goutput_tref env os tspec.TypeRef + output_string os " " + goutput_gactuals env os tspec.GenericArgs and output_arr_bounds os = function | bounds when bounds = ILArrayShape.SingleDimensional -> () @@ -243,11 +243,11 @@ and output_arr_bounds os = function | (None,Some sz) -> output_int os sz | (Some lower,None) -> - output_int os lower; + output_int os lower output_string os " ... " | (Some lower,Some d) -> - output_int os lower; - output_string os " ... "; + output_int os lower + output_string os " ... " output_int os d) os l @@ -288,7 +288,7 @@ and goutput_permission _env os p = and goutput_security_decls env os (ps: ILSecurityDecls) = output_seq " " (goutput_permission env) os ps.AsList and goutput_gparam env os (gf: ILGenericParameterDef) = - output_string os (tyvar_generator gf.Name); + output_string os (tyvar_generator gf.Name) output_parens (output_seq "," (goutput_typ env)) os gf.Constraints and goutput_gparams env os b = @@ -310,7 +310,7 @@ and output_callconv os (Callconv (hasthis,cc)) = (match hasthis with ILThisConvention.Instance -> "instance " | ILThisConvention.InstanceExplicit -> "explicit " - | ILThisConvention.Static -> "") ; + | ILThisConvention.Static -> "") output_bcc os cc and goutput_dlocref env os (dref:ILType) = @@ -323,40 +323,40 @@ and goutput_dlocref env os (dref:ILType) = | dref when dref.IsNominal && isTypeNameForGlobalFunctions dref.TypeRef.Name -> - goutput_scoref env os dref.TypeRef.Scope; + goutput_scoref env os dref.TypeRef.Scope output_string os "::" | ty ->goutput_typ_with_shortened_class_syntax env os ty; output_string os "::" and goutput_callsig env os (csig:ILCallingSignature) = - output_callconv os csig.CallingConv; - output_string os " "; - goutput_typ env os csig.ReturnType; + output_callconv os csig.CallingConv + output_string os " " + goutput_typ env os csig.ReturnType output_parens (output_seq "," (goutput_typ env)) os csig.ArgTypes and goutput_mref env os (mref:ILMethodRef) = - output_callconv os mref.CallingConv; - output_string os " "; - goutput_typ_with_shortened_class_syntax env os mref.ReturnType; - output_string os " "; + output_callconv os mref.CallingConv + output_string os " " + goutput_typ_with_shortened_class_syntax env os mref.ReturnType + output_string os " " // no quotes for ".ctor" let name = mref.Name - if name = ".ctor" || name = ".cctor" then output_string os name else output_id os name; + if name = ".ctor" || name = ".cctor" then output_string os name else output_id os name output_parens (output_seq "," (goutput_typ env)) os mref.ArgTypes and goutput_mspec env os (mspec:ILMethodSpec) = let fenv = ppenv_enter_method mspec.GenericArity (ppenv_enter_tdef (mkILFormalTypars mspec.DeclaringType.GenericArgs) env) - output_callconv os mspec.CallingConv; - output_string os " "; - goutput_typ fenv os mspec.FormalReturnType; - output_string os " "; - goutput_dlocref env os mspec.DeclaringType; - output_string os " "; + output_callconv os mspec.CallingConv + output_string os " " + goutput_typ fenv os mspec.FormalReturnType + output_string os " " + goutput_dlocref env os mspec.DeclaringType + output_string os " " let name = mspec.Name - if name = ".ctor" || name = ".cctor" then output_string os name else output_id os name; - goutput_gactuals env os mspec.GenericArgs; - output_parens (output_seq "," (goutput_typ fenv)) os mspec.FormalArgTypes; + if name = ".ctor" || name = ".cctor" then output_string os name else output_id os name + goutput_gactuals env os mspec.GenericArgs + output_parens (output_seq "," (goutput_typ fenv)) os mspec.FormalArgTypes and goutput_vararg_mspec env os (mspec, varargs) = match varargs with @@ -365,38 +365,38 @@ and goutput_vararg_mspec env os (mspec, varargs) = let fenv = ppenv_enter_method mspec.GenericArity (ppenv_enter_tdef (mkILFormalTypars mspec.DeclaringType.GenericArgs) env) - output_callconv os mspec.CallingConv; - output_string os " "; - goutput_typ fenv os mspec.FormalReturnType; - output_string os " "; - goutput_dlocref env os mspec.DeclaringType; + output_callconv os mspec.CallingConv + output_string os " " + goutput_typ fenv os mspec.FormalReturnType + output_string os " " + goutput_dlocref env os mspec.DeclaringType let name = mspec.Name if name = ".ctor" || name = ".cctor" then output_string os name else output_id os name - goutput_gactuals env os mspec.GenericArgs; - output_string os "("; - output_seq "," (goutput_typ fenv) os mspec.FormalArgTypes; - output_string os ",...,"; - output_seq "," (goutput_typ fenv) os varargs'; - output_string os ")"; + goutput_gactuals env os mspec.GenericArgs + output_string os "(" + output_seq "," (goutput_typ fenv) os mspec.FormalArgTypes + output_string os ",...," + output_seq "," (goutput_typ fenv) os varargs' + output_string os ")" and goutput_vararg_sig env os (csig:ILCallingSignature,varargs:ILVarArgs) = match varargs with | None -> goutput_callsig env os csig; () | Some varargs' -> - goutput_typ env os csig.ReturnType; - output_string os " ("; + goutput_typ env os csig.ReturnType + output_string os " (" let argtys = csig.ArgTypes if argtys.Length <> 0 then output_seq ", " (goutput_typ env) os argtys - output_string os ",...,"; - output_seq "," (goutput_typ env) os varargs'; - output_string os ")"; + output_string os ",...," + output_seq "," (goutput_typ env) os varargs' + output_string os ")" and goutput_fspec env os (x:ILFieldSpec) = let fenv = ppenv_enter_tdef (mkILFormalTypars x.DeclaringType.GenericArgs) env - goutput_typ fenv os x.FormalType; - output_string os " "; - goutput_dlocref env os x.DeclaringType; + goutput_typ fenv os x.FormalType + output_string os " " + goutput_dlocref env os x.DeclaringType output_id os x.Name let output_member_access os access = @@ -443,17 +443,17 @@ let output_at os b = let output_option f os = function None -> () | Some x -> f os x let goutput_alternative_ref env os (alt: IlxUnionAlternative) = - output_id os alt.Name; + output_id os alt.Name alt.FieldDefs |> output_parens (output_array "," (fun os fdef -> goutput_typ env os fdef.Type)) os let goutput_curef env os (IlxUnionRef(_,tref,alts,_,_)) = - output_string os " .classunion import "; - goutput_tref env os tref; + output_string os " .classunion import " + goutput_tref env os tref output_parens (output_array "," (goutput_alternative_ref env)) os alts let goutput_cuspec env os (IlxUnionSpec(IlxUnionRef(_,tref,_,_,_),i)) = - output_string os "class /* classunion */ "; - goutput_tref env os tref; + output_string os "class /* classunion */ " + goutput_tref env os tref goutput_gactuals env os i let output_basic_type os x = @@ -523,37 +523,37 @@ let output_after_tailcall os = function | _ -> () let rec goutput_apps env os = function | Apps_tyapp (actual,cs) -> - output_angled (goutput_gactual env) os actual; - output_string os " "; - output_angled (goutput_gparam env) os (mkILSimpleTypar "T") ; - output_string os " "; + output_angled (goutput_gactual env) os actual + output_string os " " + output_angled (goutput_gparam env) os (mkILSimpleTypar "T") + output_string os " " goutput_apps env os cs | Apps_app(ty,cs) -> - output_parens (goutput_typ env) os ty; - output_string os " "; + output_parens (goutput_typ env) os ty + output_string os " " goutput_apps env os cs | Apps_done ty -> - output_string os "--> "; + output_string os "--> " goutput_typ env os ty /// Print the short form of instructions let output_short_u16 os (x:uint16) = if int x < 256 then (output_string os ".s "; output_u16 os x) - else (output_string os " "; output_u16 os x) + else output_string os " "; output_u16 os x let output_short_i32 os i32 = if i32 < 256 && 0 >= i32 then (output_string os ".s "; output_i32 os i32) - else (output_string os " "; output_i32 os i32 ) + else output_string os " "; output_i32 os i32 let output_code_label os lab = output_string os (formatCodeLabel lab) let goutput_local env os (l: ILLocal) = - goutput_typ env os l.Type; + goutput_typ env os l.Type if l.IsPinned then output_string os " pinned" let goutput_param env os (l: ILParameter) = match l.Name with - None -> goutput_typ env os l.Type; + None -> goutput_typ env os l.Type | Some n -> goutput_typ env os l.Type; output_string os " "; output_sqstring os n let goutput_params env os ps = @@ -567,17 +567,17 @@ let goutput_freevars env os ps = let output_source os (s:ILSourceMarker) = if s.Document.File <> "" then - output_string os " .line "; - output_int os s.Line; + output_string os " .line " + output_int os s.Line if s.Column <> -1 then - output_string os " : "; - output_int os s.Column; - output_string os " /* - "; - output_int os s.EndLine; + output_string os " : " + output_int os s.Column + output_string os " /* - " + output_int os s.EndLine if s.Column <> -1 then - output_string os " : "; - output_int os s.EndColumn; - output_string os "*/ "; + output_string os " : " + output_int os s.EndColumn + output_string os "*/ " output_sqstring os s.Document.File @@ -599,21 +599,21 @@ let rec goutput_instr env os inst = | BI_blt_un -> "blt.un" | BI_bne_un -> "bne.un" | BI_brfalse -> "brfalse" - | BI_brtrue -> "brtrue"); - output_string os " "; + | BI_brtrue -> "brtrue") + output_string os " " output_code_label os tg1 - | I_br tg -> output_string os "/* br "; output_code_label os tg; output_string os "*/"; + | I_br tg -> output_string os "/* br "; output_code_label os tg; output_string os "*/" | I_leave tg -> output_string os "leave "; output_code_label os tg | I_call (tl,mspec,varargs) -> - output_tailness os tl; - output_string os "call "; - goutput_vararg_mspec env os (mspec,varargs); - output_after_tailcall os tl; + output_tailness os tl + output_string os "call " + goutput_vararg_mspec env os (mspec,varargs) + output_after_tailcall os tl | I_calli (tl,mref,varargs) -> - output_tailness os tl; - output_string os "calli "; - goutput_vararg_sig env os (mref,varargs); - output_after_tailcall os tl; + output_tailness os tl + output_string os "calli " + goutput_vararg_sig env os (mref,varargs) + output_after_tailcall os tl | I_ldarg u16 -> output_string os "ldarg"; output_short_u16 os u16 | I_ldarga u16 -> output_string os "ldarga "; output_u16 os u16 | (AI_ldc (dt, ILConst.I4 x)) -> @@ -627,98 +627,98 @@ let rec goutput_instr env os inst = | I_ldftn mspec -> output_string os "ldftn "; goutput_mspec env os mspec | I_ldvirtftn mspec -> output_string os "ldvirtftn "; goutput_mspec env os mspec | I_ldind (al,vol,dt) -> - output_alignment os al; - output_volatility os vol; - output_string os "ldind."; + output_alignment os al + output_volatility os vol + output_string os "ldind." output_basic_type os dt | I_cpblk (al,vol) -> - output_alignment os al; - output_volatility os vol; + output_alignment os al + output_volatility os vol output_string os "cpblk" | I_initblk (al,vol) -> - output_alignment os al; - output_volatility os vol; + output_alignment os al + output_volatility os vol output_string os "initblk" | I_ldloc u16 -> output_string os "ldloc"; output_short_u16 os u16 | I_ldloca u16 -> output_string os "ldloca "; output_u16 os u16 | I_starg u16 -> output_string os "starg "; output_u16 os u16 | I_stind (al,vol,dt) -> - output_alignment os al; - output_volatility os vol; - output_string os "stind."; + output_alignment os al + output_volatility os vol + output_string os "stind." output_basic_type os dt | I_stloc u16 -> output_string os "stloc"; output_short_u16 os u16 | I_switch l -> output_string os "switch "; output_parens (output_seq "," output_code_label) os l | I_callvirt (tl,mspec,varargs) -> - output_tailness os tl; - output_string os "callvirt "; - goutput_vararg_mspec env os (mspec,varargs); - output_after_tailcall os tl; + output_tailness os tl + output_string os "callvirt " + goutput_vararg_mspec env os (mspec,varargs) + output_after_tailcall os tl | I_callconstraint (tl,ty,mspec,varargs) -> - output_tailness os tl; - output_string os "constraint. "; - goutput_typ env os ty; - output_string os " callvirt "; - goutput_vararg_mspec env os (mspec,varargs); - output_after_tailcall os tl; + output_tailness os tl + output_string os "constraint. " + goutput_typ env os ty + output_string os " callvirt " + goutput_vararg_mspec env os (mspec,varargs) + output_after_tailcall os tl | I_castclass ty -> output_string os "castclass "; goutput_typ env os ty | I_isinst ty -> output_string os "isinst "; goutput_typ env os ty | I_ldfld (al,vol,fspec) -> - output_alignment os al; - output_volatility os vol; - output_string os "ldfld "; + output_alignment os al + output_volatility os vol + output_string os "ldfld " goutput_fspec env os fspec | I_ldflda fspec -> - output_string os "ldflda " ; + output_string os "ldflda " goutput_fspec env os fspec | I_ldsfld (vol,fspec) -> - output_volatility os vol; - output_string os "ldsfld "; + output_volatility os vol + output_string os "ldsfld " goutput_fspec env os fspec | I_ldsflda fspec -> - output_string os "ldsflda "; + output_string os "ldsflda " goutput_fspec env os fspec | I_stfld (al,vol,fspec) -> - output_alignment os al; - output_volatility os vol; - output_string os "stfld "; + output_alignment os al + output_volatility os vol + output_string os "stfld " goutput_fspec env os fspec | I_stsfld (vol,fspec) -> - output_volatility os vol; - output_string os "stsfld "; + output_volatility os vol + output_string os "stsfld " goutput_fspec env os fspec | I_ldtoken tok -> output_string os "ldtoken "; goutput_ldtoken_info env os tok | I_refanyval ty -> output_string os "refanyval "; goutput_typ env os ty | I_refanytype -> output_string os "refanytype" | I_mkrefany typ -> output_string os "mkrefany "; goutput_typ env os typ | I_ldstr s -> - output_string os "ldstr "; + output_string os "ldstr " output_string os s | I_newobj (mspec,varargs) -> // newobj: IL has a special rule that the CC is always implicitly "instance" and need // not be mentioned explicitly - output_string os "newobj "; + output_string os "newobj " goutput_vararg_mspec env os (mspec,varargs) | I_stelem dt -> output_string os "stelem."; output_basic_type os dt | I_ldelem dt -> output_string os "ldelem."; output_basic_type os dt | I_newarr (shape,typ) -> if shape = ILArrayShape.SingleDimensional then - output_string os "newarr "; + output_string os "newarr " goutput_typ_with_shortened_class_syntax env os typ else - output_string os "newobj void "; - goutput_dlocref env os (mkILArrTy(typ,shape)); - output_string os ".ctor"; + output_string os "newobj void " + goutput_dlocref env os (mkILArrTy(typ,shape)) + output_string os ".ctor" let rank = shape.Rank output_parens (output_array "," (goutput_typ env)) os (Array.create ( rank) EcmaMscorlibILGlobals.typ_Int32) | I_stelem_any (shape,dt) -> if shape = ILArrayShape.SingleDimensional then output_string os "stelem.any "; goutput_typ env os dt else - output_string os "call instance void "; - goutput_dlocref env os (mkILArrTy(dt,shape)); - output_string os "Set"; + output_string os "call instance void " + goutput_dlocref env os (mkILArrTy(dt,shape)) + output_string os "Set" let rank = shape.Rank let arr = Array.create (rank + 1) EcmaMscorlibILGlobals.typ_Int32 arr.[rank] <- dt @@ -727,23 +727,23 @@ let rec goutput_instr env os inst = if shape = ILArrayShape.SingleDimensional then output_string os "ldelem.any "; goutput_typ env os tok else - output_string os "call instance "; - goutput_typ env os tok; - output_string os " "; - goutput_dlocref env os (mkILArrTy(tok,shape)); - output_string os "Get"; + output_string os "call instance " + goutput_typ env os tok + output_string os " " + goutput_dlocref env os (mkILArrTy(tok,shape)) + output_string os "Get" let rank = shape.Rank output_parens (output_array "," (goutput_typ env)) os (Array.create ( rank) EcmaMscorlibILGlobals.typ_Int32) | I_ldelema (ro,_,shape,tok) -> - if ro = ReadonlyAddress then output_string os "readonly. "; + if ro = ReadonlyAddress then output_string os "readonly. " if shape = ILArrayShape.SingleDimensional then output_string os "ldelema "; goutput_typ env os tok else - output_string os "call instance "; - goutput_typ env os (ILType.Byref tok); - output_string os " "; - goutput_dlocref env os (mkILArrTy(tok,shape)); - output_string os "Address"; + output_string os "call instance " + goutput_typ env os (ILType.Byref tok) + output_string os " " + goutput_dlocref env os (mkILArrTy(tok,shape)) + output_string os "Address" let rank = shape.Rank output_parens (output_array "," (goutput_typ env)) os (Array.create ( rank) EcmaMscorlibILGlobals.typ_Int32) @@ -752,14 +752,14 @@ let rec goutput_instr env os inst = | I_unbox_any tok -> output_string os "unbox.any "; goutput_typ env os tok | I_initobj tok -> output_string os "initobj "; goutput_typ env os tok | I_ldobj (al,vol,tok) -> - output_alignment os al; - output_volatility os vol; - output_string os "ldobj "; + output_alignment os al + output_volatility os vol + output_string os "ldobj " goutput_typ env os tok | I_stobj (al,vol,tok) -> - output_alignment os al; - output_volatility os vol; - output_string os "stobj "; + output_alignment os al + output_volatility os vol + output_string os "stobj " goutput_typ env os tok | I_cpobj tok -> output_string os "cpobj "; goutput_typ env os tok | I_sizeof tok -> output_string os "sizeof "; goutput_typ env os tok @@ -770,12 +770,12 @@ let rec goutput_instr env os inst = let goutput_ilmbody env os (il: ILMethodBody) = - if il.IsZeroInit then output_string os " .zeroinit\n"; - output_string os " .maxstack "; - output_i32 os il.MaxStack; - output_string os "\n"; + if il.IsZeroInit then output_string os " .zeroinit\n" + output_string os " .maxstack " + output_i32 os il.MaxStack + output_string os "\n" if il.Locals.Length <> 0 then - output_string os " .locals("; + output_string os " .locals(" output_seq ",\n " (goutput_local env) os il.Locals output_string os ")\n" @@ -785,17 +785,17 @@ let goutput_mbody is_entrypoint env os (md: ILMethodDef) = elif md.ImplAttributes &&& MethodImplAttributes.IL <> enum 0 then output_string os "cil " else output_string os "runtime " - output_string os (if md.IsInternalCall then "internalcall " else " "); - output_string os (if md.IsManaged then "managed " else " "); - output_string os (if md.IsForwardRef then "forwardref " else " "); - output_string os " \n{ \n" ; - goutput_security_decls env os md.SecurityDecls; - goutput_custom_attrs env os md.CustomAttrs; + output_string os (if md.IsInternalCall then "internalcall " else " ") + output_string os (if md.IsManaged then "managed " else " ") + output_string os (if md.IsForwardRef then "forwardref " else " ") + output_string os " \n{ \n" + goutput_security_decls env os md.SecurityDecls + goutput_custom_attrs env os md.CustomAttrs match md.Body.Contents with | MethodBody.IL il -> goutput_ilmbody env os il | _ -> () - if is_entrypoint then output_string os " .entrypoint"; - output_string os "\n"; + if is_entrypoint then output_string os " .entrypoint" + output_string os "\n" output_string os "}\n" let goutput_mdef env os (md:ILMethodDef) = @@ -837,37 +837,37 @@ let goutput_mdef env os (md:ILMethodDef) = else "" let is_entrypoint = md.IsEntryPoint let menv = ppenv_enter_method (List.length md.GenericParams) env - output_string os " .method "; - if md.IsHideBySig then output_string os "hidebysig "; - if md.IsReqSecObj then output_string os "reqsecobj "; - if md.IsSpecialName then output_string os "specialname "; - if md.IsUnmanagedExport then output_string os "unmanagedexp "; - output_member_access os md.Access; - output_string os " "; - output_string os attrs; - output_string os " "; - output_callconv os md.CallingConv; - output_string os " "; - (goutput_typ menv) os md.Return.Type; - output_string os " "; - output_id os md.Name ; - output_string os " "; - (goutput_gparams env) os md.GenericParams; - output_string os " "; - (goutput_params menv) os md.Parameters; - output_string os " "; + output_string os " .method " + if md.IsHideBySig then output_string os "hidebysig " + if md.IsReqSecObj then output_string os "reqsecobj " + if md.IsSpecialName then output_string os "specialname " + if md.IsUnmanagedExport then output_string os "unmanagedexp " + output_member_access os md.Access + output_string os " " + output_string os attrs + output_string os " " + output_callconv os md.CallingConv + output_string os " " + (goutput_typ menv) os md.Return.Type + output_string os " " + output_id os md.Name + output_string os " " + (goutput_gparams env) os md.GenericParams + output_string os " " + (goutput_params menv) os md.Parameters + output_string os " " if md.IsSynchronized then output_string os "synchronized " if md.IsMustRun then output_string os "/* mustrun */ " if md.IsPreserveSig then output_string os "preservesig " if md.IsNoInline then output_string os "noinlining " if md.IsAggressiveInline then output_string os "aggressiveinlining " - (goutput_mbody is_entrypoint menv) os md; + (goutput_mbody is_entrypoint menv) os md output_string os "\n" let goutput_pdef env os (pd: ILPropertyDef) = - output_string os "property\n\tgetter: "; - (match pd.GetMethod with None -> () | Some mref -> goutput_mref env os mref); - output_string os "\n\tsetter: "; + output_string os "property\n\tgetter: " + (match pd.GetMethod with None -> () | Some mref -> goutput_mref env os mref) + output_string os "\n\tsetter: " (match pd.SetMethod with None -> () | Some mref -> goutput_mref env os mref) let goutput_superclass env os = function @@ -887,7 +887,7 @@ let goutput_implements env os (imp:ILTypes) = let the = function Some x -> x | None -> failwith "the" let output_type_layout_info os info = - if info.Size <> None then (output_string os " .size "; output_i32 os (the info.Size)); + if info.Size <> None then (output_string os " .size "; output_i32 os (the info.Size)) if info.Pack <> None then (output_string os " .pack "; output_u16 os (the info.Pack)) let splitTypeLayout = function @@ -909,41 +909,41 @@ let rec goutput_tdef enc env contents os (cd: ILTypeDef) = if isTypeNameForGlobalFunctions cd.Name then if contents then let tref = (mkILNestedTyRef (ILScopeRef.Local,enc,cd.Name)) - goutput_mdefs env os cd.Methods; - goutput_fdefs tref env os cd.Fields; - goutput_pdefs env os cd.Properties; + goutput_mdefs env os cd.Methods + goutput_fdefs tref env os cd.Fields + goutput_pdefs env os cd.Properties else - output_string os "\n"; + output_string os "\n" if cd.IsInterface then output_string os ".class interface " else output_string os ".class " - output_init_semantics os cd.Attributes; - output_string os " "; - output_type_access os cd.Access; - output_string os " "; - output_encoding os cd.Encoding; - output_string os " "; - output_string os layout_attr; - output_string os " "; - if cd.IsSealed then output_string os "sealed "; - if cd.IsAbstract then output_string os "abstract "; - if cd.IsSerializable then output_string os "serializable "; - if cd.IsComInterop then output_string os "import "; - output_sqstring os cd.Name ; - goutput_gparams env os cd.GenericParams; - output_string os "\n\t"; - goutput_superclass env os cd.Extends; - output_string os "\n\t"; - goutput_implements env os cd.Implements; - output_string os "\n{\n "; + output_init_semantics os cd.Attributes + output_string os " " + output_type_access os cd.Access + output_string os " " + output_encoding os cd.Encoding + output_string os " " + output_string os layout_attr + output_string os " " + if cd.IsSealed then output_string os "sealed " + if cd.IsAbstract then output_string os "abstract " + if cd.IsSerializable then output_string os "serializable " + if cd.IsComInterop then output_string os "import " + output_sqstring os cd.Name + goutput_gparams env os cd.GenericParams + output_string os "\n\t" + goutput_superclass env os cd.Extends + output_string os "\n\t" + goutput_implements env os cd.Implements + output_string os "\n{\n " if contents then let tref = (mkILNestedTyRef (ILScopeRef.Local,enc,cd.Name)) - goutput_custom_attrs env os cd.CustomAttrs; - goutput_security_decls env os cd.SecurityDecls; - pp_layout_decls os (); - goutput_fdefs tref env os cd.Fields; - goutput_mdefs env os cd.Methods; - goutput_tdefs contents (enc@[cd.Name]) env os cd.NestedTypes; - output_string os "\n}"; + goutput_custom_attrs env os cd.CustomAttrs + goutput_security_decls env os cd.SecurityDecls + pp_layout_decls os () + goutput_fdefs tref env os cd.Fields + goutput_mdefs env os cd.Methods + goutput_tdefs contents (enc@[cd.Name]) env os cd.NestedTypes + output_string os "\n}" and output_init_semantics os f = if f &&& TypeAttributes.BeforeFieldInit <> enum 0 then output_string os "beforefieldinit" @@ -955,7 +955,7 @@ and goutput_lambdas env os lambdas = output_string os " " (goutput_lambdas env) os l | Lambdas_lambda (ps,l) -> - output_parens (goutput_param env) os ps; + output_parens (goutput_param env) os ps output_string os " " (goutput_lambdas env) os l | Lambdas_return typ -> output_string os "--> "; (goutput_typ env) os typ @@ -987,56 +987,56 @@ let output_publickeyinfo os = function | PublicKeyToken k -> output_publickeytoken os k let output_assemblyRef os (aref:ILAssemblyRef) = - output_string os " .assembly extern "; - output_sqstring os aref.Name; - if aref.Retargetable then output_string os " retargetable "; - output_string os " { "; - (output_option output_hash) os aref.Hash; - (output_option output_publickeyinfo) os aref.PublicKey; - (output_option output_ver) os aref.Version; - (output_option output_locale) os aref.Locale; + output_string os " .assembly extern " + output_sqstring os aref.Name + if aref.Retargetable then output_string os " retargetable " + output_string os " { " + output_option output_hash os aref.Hash + output_option output_publickeyinfo os aref.PublicKey + output_option output_ver os aref.Version + output_option output_locale os aref.Locale output_string os " } " let output_modref os (modref:ILModuleRef) = - output_string os (if modref.HasMetadata then " .module extern " else " .file nometadata " ); - output_sqstring os modref.Name; - (output_option output_hash) os modref.Hash + output_string os (if modref.HasMetadata then " .module extern " else " .file nometadata " ) + output_sqstring os modref.Name + output_option output_hash os modref.Hash let goutput_resource env os r = - output_string os " .mresource "; - output_string os (match r.Access with ILResourceAccess.Public -> " public " | ILResourceAccess.Private -> " private "); - output_sqstring os r.Name; - output_string os " { "; - goutput_custom_attrs env os r.CustomAttrs; + output_string os " .mresource " + output_string os (match r.Access with ILResourceAccess.Public -> " public " | ILResourceAccess.Private -> " private ") + output_sqstring os r.Name + output_string os " { " + goutput_custom_attrs env os r.CustomAttrs match r.Location with | ILResourceLocation.LocalIn _ | ILResourceLocation.LocalOut _ -> - output_string os " /* loc nyi */ "; + output_string os " /* loc nyi */ " | ILResourceLocation.File (mref,off) -> - output_string os " .file "; - output_sqstring os mref.Name; - output_string os " at "; + output_string os " .file " + output_sqstring os mref.Name + output_string os " at " output_i32 os off | ILResourceLocation.Assembly aref -> - output_string os " .assembly extern "; + output_string os " .assembly extern " output_sqstring os aref.Name output_string os " }\n " let goutput_manifest env os m = - output_string os " .assembly "; + output_string os " .assembly " match m.AssemblyLongevity with | ILAssemblyLongevity.Unspecified -> () - | ILAssemblyLongevity.Library -> output_string os "library "; - | ILAssemblyLongevity.PlatformAppDomain -> output_string os "platformappdomain "; - | ILAssemblyLongevity.PlatformProcess -> output_string os "platformprocess "; - | ILAssemblyLongevity.PlatformSystem -> output_string os "platformmachine "; - output_sqstring os m.Name; - output_string os " { \n"; - output_string os ".hash algorithm "; output_i32 os m.AuxModuleHashAlgorithm; output_string os "\n"; + | ILAssemblyLongevity.Library -> output_string os "library " + | ILAssemblyLongevity.PlatformAppDomain -> output_string os "platformappdomain " + | ILAssemblyLongevity.PlatformProcess -> output_string os "platformprocess " + | ILAssemblyLongevity.PlatformSystem -> output_string os "platformmachine " + output_sqstring os m.Name + output_string os " { \n" + output_string os ".hash algorithm "; output_i32 os m.AuxModuleHashAlgorithm; output_string os "\n" goutput_custom_attrs env os m.CustomAttrs - (output_option output_publickey) os m.PublicKey - (output_option output_ver) os m.Version - (output_option output_locale) os m.Locale + output_option output_publickey os m.PublicKey + output_option output_ver os m.Version + output_option output_locale os m.Locale output_string os " } \n" @@ -1044,10 +1044,10 @@ let output_module_fragment_aux _refs os (ilg: ILGlobals) modul = try let env = mk_ppenv ilg let env = ppenv_enter_modul env - goutput_tdefs false ([]) env os modul.TypeDefs; - goutput_tdefs true ([]) env os modul.TypeDefs; + goutput_tdefs false ([]) env os modul.TypeDefs + goutput_tdefs true ([]) env os modul.TypeDefs with e -> - output_string os "*** Error during printing : "; output_string os (e.ToString()); os.Flush(); + output_string os "*** Error during printing : "; output_string os (e.ToString()); os.Flush() reraise() let output_module_fragment os (ilg: ILGlobals) modul = @@ -1056,30 +1056,30 @@ let output_module_fragment os (ilg: ILGlobals) modul = refs let output_module_refs os refs = - List.iter (fun x -> output_assemblyRef os x; output_string os "\n") refs.AssemblyReferences; + List.iter (fun x -> output_assemblyRef os x; output_string os "\n") refs.AssemblyReferences List.iter (fun x -> output_modref os x; output_string os "\n") refs.ModuleReferences let goutput_module_manifest env os modul = - output_string os " .module "; output_sqstring os modul.Name; - goutput_custom_attrs env os modul.CustomAttrs; - output_string os " .imagebase "; output_i32 os modul.ImageBase; - output_string os " .file alignment "; output_i32 os modul.PhysicalAlignment; - output_string os " .subsystem "; output_i32 os modul.SubSystemFlags; - output_string os " .corflags "; output_i32 os ((if modul.IsILOnly then 0x0001 else 0) ||| (if modul.Is32Bit then 0x0002 else 0) ||| (if modul.Is32BitPreferred then 0x00020003 else 0)); - List.iter (fun r -> goutput_resource env os r) modul.Resources.AsList; - output_string os "\n"; - (output_option (goutput_manifest env)) os modul.Manifest + output_string os " .module "; output_sqstring os modul.Name + goutput_custom_attrs env os modul.CustomAttrs + output_string os " .imagebase "; output_i32 os modul.ImageBase + output_string os " .file alignment "; output_i32 os modul.PhysicalAlignment + output_string os " .subsystem "; output_i32 os modul.SubSystemFlags + output_string os " .corflags "; output_i32 os ((if modul.IsILOnly then 0x0001 else 0) ||| (if modul.Is32Bit then 0x0002 else 0) ||| (if modul.Is32BitPreferred then 0x00020003 else 0)) + List.iter (fun r -> goutput_resource env os r) modul.Resources.AsList + output_string os "\n" + output_option (goutput_manifest env) os modul.Manifest let output_module os (ilg: ILGlobals) modul = try let refs = computeILRefs modul let env = mk_ppenv ilg let env = ppenv_enter_modul env - output_module_refs os refs; - goutput_module_manifest env os modul; - output_module_fragment_aux refs os ilg modul; + output_module_refs os refs + goutput_module_manifest env os modul + output_module_fragment_aux refs os ilg modul with e -> - output_string os "*** Error during printing : "; output_string os (e.ToString()); os.Flush(); + output_string os "*** Error during printing : "; output_string os (e.ToString()); os.Flush() raise e diff --git a/src/absil/ilread.fs b/src/absil/ilread.fs index d7e5b14bacc1bb08258eaf5fc08ce0d2376d1cab..b7130c44ba95440a79426dbe0da0fb3594bad526 100644 --- a/src/absil/ilread.fs +++ b/src/absil/ilread.fs @@ -1588,7 +1588,7 @@ let getDataEndPointsDelayed (pectxt: PEReader) ctxtH = let nm = readStringHeap ctxt nameIdx res := (nm, rva) :: !res !res - ([ pectxt.textSegmentPhysicalLoc + pectxt.textSegmentPhysicalSize ; + ([ pectxt.textSegmentPhysicalLoc + pectxt.textSegmentPhysicalSize pectxt.dataSegmentPhysicalLoc + pectxt.dataSegmentPhysicalSize ] @ (List.map pectxt.anyV2P @@ -3762,8 +3762,8 @@ let openPEFileReader (fileName, pefile: BinaryFile, pdbDirPath, noFileOnDisk) = let subsysMajor = seekReadUInt16AsInt32 pev (peOptionalHeaderPhysLoc + 48) // SubSys Major Always 4 (see Section 23.1). let subsysMinor = seekReadUInt16AsInt32 pev (peOptionalHeaderPhysLoc + 50) // SubSys Minor Always 0 (see Section 23.1). (* x86: 000000d0 *) - let _imageEndAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 56) // Image Size: Size, in bytes, of image, including all headers and padding; - let _headerPhysSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 60) // Header Size Combined size of MS-DOS Header, PE Header, PE Optional Header and padding; + let _imageEndAddr = seekReadInt32 pev (peOptionalHeaderPhysLoc + 56) // Image Size: Size, in bytes, of image, including all headers and padding + let _headerPhysSize = seekReadInt32 pev (peOptionalHeaderPhysLoc + 60) // Header Size Combined size of MS-DOS Header, PE Header, PE Optional Header and padding let subsys = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 68) // SubSystem Subsystem required to run this image. let useHighEnthropyVA = let n = seekReadUInt16 pev (peOptionalHeaderPhysLoc + 70) diff --git a/src/absil/ilreflect.fs b/src/absil/ilreflect.fs index 60ae0350b26665070b6defeb8c2875b4aa880739..1381efd591f58edb79fe76779b78b36fd970276b 100644 --- a/src/absil/ilreflect.fs +++ b/src/absil/ilreflect.fs @@ -253,28 +253,28 @@ type System.Reflection.Emit.ILGenerator with 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); + 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; + 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) = - if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, %d)" (abs <| hash x) op.RefEmitName v; + 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) = - if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, methodBuilder%d) // method %s" (abs <| hash x) op.RefEmitName (abs <| hash v) v.Name; + 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; + 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; + 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) = - if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, fieldBuilder%d) // field %s" (abs <| hash x) op.RefEmitName (abs <| hash v) v.Name; + 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; + if logRefEmitCalls then printfn "ilg%d.Emit(OpCodes.%s, constructor_%s)" (abs <| hash x) op.RefEmitName v.DeclaringType.Name x.Emit(op, v) @@ -305,18 +305,18 @@ let getTypeConstructor (ty: Type) = let convAssemblyRef (aref:ILAssemblyRef) = let asmName = new System.Reflection.AssemblyName() - asmName.Name <- aref.Name; + asmName.Name <- aref.Name (match aref.PublicKey with | None -> () | Some (PublicKey bytes) -> asmName.SetPublicKey(bytes) - | Some (PublicKeyToken bytes) -> asmName.SetPublicKeyToken(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) - Option.iter setVersion aref.Version; - // asmName.ProcessorArchitecture <- System.Reflection.ProcessorArchitecture.MSIL; + Option.iter setVersion aref.Version + // asmName.ProcessorArchitecture <- System.Reflection.ProcessorArchitecture.MSIL #if !FX_RESHAPED_GLOBALIZATION - //Option.iter (fun name -> asmName.CultureInfo <- System.Globalization.CultureInfo.CreateSpecificCulture(name)) aref.Locale; - asmName.CultureInfo <- System.Globalization.CultureInfo.InvariantCulture; + //Option.iter (fun name -> asmName.CultureInfo <- System.Globalization.CultureInfo.CreateSpecificCulture(name)) aref.Locale + asmName.CultureInfo <- System.Globalization.CultureInfo.InvariantCulture #endif asmName @@ -364,13 +364,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; - emLocals : LocalBuilder[]; - emLabels : Zmap; + { emTypMap : Zmap + emConsMap : Zmap + emMethMap : Zmap + emFieldMap : Zmap + emPropMap : Zmap + emLocals : LocalBuilder[] + emLabels : Zmap emTyvars : Type[] list; // stack emEntryPts : (TypeBuilder * string) list delayedFieldInits : (unit -> unit) list} @@ -381,20 +381,20 @@ let orderILFieldRef = ComparisonIdentity.Structural let orderILPropertyRef = ComparisonIdentity.Structural let emEnv0 = - { emTypMap = Zmap.empty orderILTypeRef; - emConsMap = Zmap.empty orderILMethodRef; - emMethMap = Zmap.empty orderILMethodRef; - emFieldMap = Zmap.empty orderILFieldRef; - emPropMap = Zmap.empty orderILPropertyRef; - emLocals = [| |]; - emLabels = Zmap.empty codeLabelOrder; - emTyvars = []; + { emTypMap = Zmap.empty orderILTypeRef + emConsMap = Zmap.empty orderILMethodRef + emMethMap = Zmap.empty orderILMethodRef + emFieldMap = Zmap.empty orderILFieldRef + emPropMap = Zmap.empty orderILPropertyRef + emLocals = [| |] + emLabels = Zmap.empty codeLabelOrder + emTyvars = [] emEntryPts = [] delayedFieldInits = [] } let envBindTypeRef emEnv (tref:ILTypeRef) (typT, typB, typeDef) = match typT with - | null -> failwithf "binding null type in envBindTypeRef: %s\n" tref.Name; + | null -> failwithf "binding null type in envBindTypeRef: %s\n" tref.Name | _ -> {emEnv with emTypMap = Zmap.add tref (typT, typB, typeDef, None) emEnv.emTypMap} let envUpdateCreatedTypeRef emEnv (tref:ILTypeRef) = @@ -419,7 +419,7 @@ let envUpdateCreatedTypeRef emEnv (tref:ILTypeRef) = {emEnv with emTypMap = Zmap.add tref (typT, typB, typeDef, Some ty) emEnv.emTypMap} else #if DEBUG - printf "envUpdateCreatedTypeRef: expected type to be created\n"; + printf "envUpdateCreatedTypeRef: expected type to be created\n" #endif emEnv @@ -470,7 +470,7 @@ let envSetLocals emEnv locs = assert (emEnv.emLocals.Length = 0); // check "loca let envGetLocal emEnv i = emEnv.emLocals.[i] // implicit bounds checking let envSetLabel emEnv name lab = - assert (not (Zmap.mem name emEnv.emLabels)); + assert (not (Zmap.mem name emEnv.emLabels)) {emEnv with emLabels = Zmap.add name lab emEnv.emLabels} let envGetLabel emEnv name = @@ -1112,7 +1112,7 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = | 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_switch labels -> ilG.Emit(OpCodes.Switch, Array.ofList (List.map (envGetLabel emEnv) labels)) | I_ret -> ilG.EmitAndLog(OpCodes.Ret) | I_call (tail, mspec, varargs) -> @@ -1124,7 +1124,7 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = emitInstrCall cenv emEnv ilG OpCodes.Callvirt tail mspec varargs | I_callconstraint (tail, ty, mspec, varargs) -> - ilG.Emit(OpCodes.Constrained, convType cenv emEnv ty); + ilG.Emit(OpCodes.Constrained, convType cenv emEnv ty) emitInstrCall cenv emEnv ilG OpCodes.Callvirt tail mspec varargs | I_calli (tail, callsig, None) -> @@ -1164,7 +1164,7 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = | I_stfld (align, vol, fspec) -> emitInstrAlign ilG align - emitInstrVolatile ilG vol; + emitInstrVolatile ilG vol ilG.EmitAndLog(OpCodes.Stfld, convFieldSpec cenv emEnv fspec) | I_ldstr s -> ilG.EmitAndLog(OpCodes.Ldstr, s) @@ -1240,7 +1240,7 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = | DT_REF -> ilG.EmitAndLog(OpCodes.Stelem_Ref) | I_ldelema (ro, _isNativePtr, shape, ty) -> - if (ro = ReadonlyAddress) then ilG.EmitAndLog(OpCodes.Readonly); + if (ro = ReadonlyAddress) then ilG.EmitAndLog(OpCodes.Readonly) if (shape = ILArrayShape.SingleDimensional) then ilG.EmitAndLog(OpCodes.Ldelema, convType cenv emEnv ty) else @@ -1313,12 +1313,12 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = ilG.EmitAndLog(OpCodes.Cpblk) | I_initblk (align, vol) -> - emitInstrAlign ilG align; + 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 (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 -> failwithf "the IL instruction %s cannot be emitted" (i.ToString()) @@ -1454,7 +1454,7 @@ let buildGenParamsPass1b cenv emEnv (genArgs : Type array) (gps : ILGenericParam [ ] -> () // Q: should a baseType be set? It is in some samples. Should this be a failure case? | [ baseT ] -> gpB.SetBaseTypeConstraint(baseT) | _ -> failwith "buildGenParam: multiple base types" - ); + ) // set interface constraints (interfaces that instances of gp must meet) gpB.SetInterfaceConstraints(Array.ofList interfaceTs) gp.CustomAttrs |> emitCustomAttrs cenv emEnv (wrapCustomAttr gpB.SetCustomAttribute) @@ -1477,8 +1477,8 @@ let buildGenParamsPass1b cenv emEnv (genArgs : Type array) (gps : ILGenericParam //---------------------------------------------------------------------------- let emitParameter cenv emEnv (defineParameter : int * ParameterAttributes * string -> ParameterBuilder) i (param: ILParameter) = - // -Type: ty; - // -Default: ILFieldInit option; + // -Type: ty + // -Default: ILFieldInit option // -Marshal: NativeType option; (* Marshalling map for parameters. COM Interop only. *) let attrs = flagsIf param.IsIn ParameterAttributes.In ||| flagsIf param.IsOut ParameterAttributes.Out ||| @@ -1530,7 +1530,7 @@ let rec buildMethodPass2 cenv tref (typB:TypeBuilder) emEnv (mdef : ILMethodDef) (* p.NoMangle *) let methB = typB.DefinePInvokeMethod(mdef.Name, p.Where.Name, p.Name, attrs, cconv, rty, null, null, argtys, null, null, pcc, pcs) - methB.SetImplementationFlagsAndLog(implflags); + methB.SetImplementationFlagsAndLog(implflags) envBindMethodRef emEnv mref methB #endif @@ -1539,17 +1539,17 @@ let rec buildMethodPass2 cenv tref (typB:TypeBuilder) emEnv (mdef : ILMethodDef) | ".cctor" | ".ctor" -> let consB = typB.DefineConstructorAndLog(attrs, cconv, convTypesToArray cenv emEnv mdef.ParameterTypes) - consB.SetImplementationFlagsAndLog(implflags); + 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) // Method generic type parameters - buildGenParamsPass1 emEnv methB.DefineGenericParametersAndLog mdef.GenericParams; + buildGenParamsPass1 emEnv methB.DefineGenericParametersAndLog mdef.GenericParams let genArgs = getGenericArgumentsOfMethod methB let emEnv = envPushTyvars emEnv (Array.append (getGenericArgumentsOfType (typB.AsType())) genArgs) - buildGenParamsPass1b cenv emEnv genArgs mdef.GenericParams; + buildGenParamsPass1b cenv emEnv genArgs mdef.GenericParams // Set parameter and return types (may depend on generic args) let parameterTypes = convTypesToArray cenv emEnv mdef.ParameterTypes @@ -1562,7 +1562,7 @@ let rec buildMethodPass2 cenv tref (typB:TypeBuilder) emEnv (mdef : ILMethodDef) let returnTypeRequiredCustomModifiers, returnTypeOptionalCustomModifiers = mdef.Return |> convReturnModifiers cenv emEnv let returnType = convType cenv emEnv mdef.Return.Type - methB.SetSignatureAndLog(returnType, returnTypeRequiredCustomModifiers, returnTypeOptionalCustomModifiers, parameterTypes, parameterTypeRequiredCustomModifiers,parameterTypeOptionalCustomModifiers); + methB.SetSignatureAndLog(returnType, returnTypeRequiredCustomModifiers, returnTypeOptionalCustomModifiers, parameterTypes, parameterTypeRequiredCustomModifiers,parameterTypeOptionalCustomModifiers) let emEnv = envPopTyvars emEnv methB.SetImplementationFlagsAndLog(implflags) @@ -1586,10 +1586,10 @@ let rec buildMethodPass3 cenv tref modB (typB:TypeBuilder) emEnv (mdef : ILMetho assert isNil mdef.GenericParams // Value parameters let defineParameter (i, attr, name) = consB.DefineParameterAndLog(i+1, attr, name) - mdef.Parameters |> List.iteri (emitParameter cenv emEnv defineParameter); + mdef.Parameters |> List.iteri (emitParameter cenv emEnv defineParameter) // Body - emitMethodBody cenv modB emEnv consB.GetILGenerator mdef.Name mdef.Body; - emitCustomAttrs cenv emEnv (wrapCustomAttr consB.SetCustomAttribute) mdef.CustomAttrs; + emitMethodBody cenv modB emEnv consB.GetILGenerator mdef.Name mdef.Body + emitCustomAttrs cenv emEnv (wrapCustomAttr consB.SetCustomAttribute) mdef.CustomAttrs () | _name -> @@ -1604,10 +1604,10 @@ let rec buildMethodPass3 cenv tref modB (typB:TypeBuilder) emEnv (mdef : ILMetho // Value parameters let defineParameter (i, attr, name) = methB.DefineParameterAndLog(i+1, attr, name) - mdef.Parameters |> List.iteri (fun a b -> emitParameter cenv emEnv defineParameter a b); + mdef.Parameters |> List.iteri (fun a b -> emitParameter cenv emEnv defineParameter a b) // Body if not isPInvoke then - emitMethodBody cenv modB emEnv methB.GetILGeneratorAndLog mdef.Name mdef.Body; + emitMethodBody cenv modB emEnv methB.GetILGeneratorAndLog mdef.Name mdef.Body let emEnv = envPopTyvars emEnv // case fold later... emitCustomAttrs cenv emEnv methB.SetCustomAttributeAndLog mdef.CustomAttrs @@ -1642,7 +1642,7 @@ let buildFieldPass2 cenv tref (typB:TypeBuilder) emEnv (fdef : ILFieldDef) = // => here we cannot detect if underlying type is already set so as a conservative solution we delay initialization of fields // to the end of pass2 (types and members are already created but method bodies are yet not emitted) { emEnv with delayedFieldInits = (fun() -> fieldB.SetConstant(convFieldInit initial))::emEnv.delayedFieldInits } - fdef.Offset |> Option.iter (fun offset -> fieldB.SetOffset(offset)); + fdef.Offset |> Option.iter (fun offset -> fieldB.SetOffset(offset)) // custom attributes: done on pass 3 as they may reference attribute constructors generated on // pass 2. let fref = mkILFieldRef (tref, fdef.Name, fdef.FieldType) @@ -1663,10 +1663,10 @@ let buildPropertyPass2 cenv tref (typB:TypeBuilder) emEnv (prop : ILPropertyDef) let propB = typB.DefinePropertyAndLog(prop.Name, attrs, convType cenv emEnv prop.PropertyType, convTypesToArray cenv emEnv prop.Args) - prop.SetMethod |> Option.iter (fun mref -> propB.SetSetMethod(envGetMethB emEnv mref)); - prop.GetMethod |> Option.iter (fun mref -> propB.SetGetMethod(envGetMethB emEnv mref)); + 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)); + prop.Init |> Option.iter (fun initial -> propB.SetConstant(convFieldInit initial)) // custom attributes let pref = ILPropertyRef.Create (tref, prop.Name) envBindPropRef emEnv pref propB @@ -1687,10 +1687,10 @@ let buildEventPass3 cenv (typB:TypeBuilder) emEnv (eventDef : ILEventDef) = assert eventDef.EventType.IsSome let eventB = typB.DefineEventAndLog(eventDef.Name, attrs, convType cenv emEnv eventDef.EventType.Value) - eventDef.AddMethod |> (fun mref -> eventB.SetAddOnMethod(envGetMethB emEnv mref)); - eventDef.RemoveMethod |> (fun mref -> eventB.SetRemoveOnMethod(envGetMethB emEnv mref)); - eventDef.FireMethod |> Option.iter (fun mref -> eventB.SetRaiseMethod(envGetMethB emEnv mref)); - eventDef.OtherMethods |> List.iter (fun mref -> eventB.AddOtherMethod(envGetMethB emEnv mref)); + eventDef.AddMethod |> (fun mref -> eventB.SetAddOnMethod(envGetMethB emEnv mref)) + eventDef.RemoveMethod |> (fun mref -> eventB.SetRemoveOnMethod(envGetMethB emEnv mref)) + eventDef.FireMethod |> Option.iter (fun mref -> eventB.SetRaiseMethod(envGetMethB emEnv mref)) + eventDef.OtherMethods |> List.iter (fun mref -> eventB.AddOtherMethod(envGetMethB emEnv mref)) emitCustomAttrs cenv emEnv (wrapCustomAttr eventB.SetCustomAttribute) eventDef.CustomAttrs //---------------------------------------------------------------------------- @@ -1702,7 +1702,7 @@ let buildMethodImplsPass3 cenv _tref (typB:TypeBuilder) emEnv (mimpl : IL.ILMeth 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 //---------------------------------------------------------------------------- @@ -1765,8 +1765,8 @@ let typeAttributesOfTypeLayout cenv emEnv x = let rec buildTypeDefPass1 cenv emEnv (modB:ModuleBuilder) rootTypeBuilder nesting (tdef : ILTypeDef) = // -IsComInterop: bool; (* Class or interface generated for COM interop *) - // -SecurityDecls: Permissions; - // -InitSemantics: ILTypeInit; + // -SecurityDecls: Permissions + // -InitSemantics: ILTypeInit // TypeAttributes let cattrsLayout = typeAttributesOfTypeLayout cenv emEnv tdef.Layout @@ -1774,9 +1774,9 @@ let rec buildTypeDefPass1 cenv emEnv (modB:ModuleBuilder) rootTypeBuilder nestin // TypeBuilder from TypeAttributes. let typB : TypeBuilder = rootTypeBuilder (tdef.Name, attrsType) - cattrsLayout |> Option.iter typB.SetCustomAttributeAndLog; + cattrsLayout |> Option.iter typB.SetCustomAttributeAndLog - buildGenParamsPass1 emEnv typB.DefineGenericParametersAndLog tdef.GenericParams; + buildGenParamsPass1 emEnv typB.DefineGenericParametersAndLog tdef.GenericParams // bind tref -> (typT, typB) let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting, tdef) let typT = @@ -1805,10 +1805,10 @@ let rec buildTypeDefPass1b cenv nesting emEnv (tdef : ILTypeDef) = let genArgs = getGenericArgumentsOfType (typB.AsType()) let emEnv = envPushTyvars emEnv genArgs // Parent may reference types being defined, so has to come after it's Pass1 creation - tdef.Extends |> Option.iter (fun ty -> typB.SetParentAndLog(convType cenv emEnv ty)); + tdef.Extends |> Option.iter (fun ty -> typB.SetParentAndLog(convType cenv emEnv ty)) // build constraints on ILGenericParameterDefs. Constraints may reference types being defined, // so have to come after all types are created - buildGenParamsPass1b cenv emEnv genArgs tdef.GenericParams; + buildGenParamsPass1b cenv emEnv genArgs tdef.GenericParams let emEnv = envPopTyvars emEnv let nesting = nesting @ [tdef] List.iter (buildTypeDefPass1b cenv nesting emEnv) tdef.NestedTypes.AsList @@ -1822,7 +1822,7 @@ let rec buildTypeDefPass2 cenv nesting emEnv (tdef : ILTypeDef) = let typB = envGetTypB emEnv tref let emEnv = envPushTyvars emEnv (getGenericArgumentsOfType (typB.AsType())) // add interface impls - tdef.Implements |> convTypes cenv emEnv |> List.iter (fun implT -> typB.AddInterfaceImplementationAndLog(implT)); + tdef.Implements |> convTypes cenv emEnv |> List.iter (fun implT -> typB.AddInterfaceImplementationAndLog(implT)) // add methods, properties let emEnv = Array.fold (buildMethodPass2 cenv tref typB) emEnv tdef.Methods.AsArray let emEnv = List.fold (buildFieldPass2 cenv tref typB) emEnv tdef.Fields.AsList @@ -1842,12 +1842,12 @@ let rec buildTypeDefPass3 cenv nesting modB emEnv (tdef : ILTypeDef) = let typB = envGetTypB emEnv tref let emEnv = envPushTyvars emEnv (getGenericArgumentsOfType (typB.AsType())) // add method bodies, properties, events - tdef.Methods |> Seq.iter (buildMethodPass3 cenv tref modB typB emEnv); - tdef.Properties.AsList |> List.iter (buildPropertyPass3 cenv tref typB emEnv); - tdef.Events.AsList |> List.iter (buildEventPass3 cenv typB emEnv); - tdef.Fields.AsList |> List.iter (buildFieldPass3 cenv tref typB emEnv); + tdef.Methods |> Seq.iter (buildMethodPass3 cenv tref modB typB emEnv) + tdef.Properties.AsList |> List.iter (buildPropertyPass3 cenv tref typB emEnv) + tdef.Events.AsList |> List.iter (buildEventPass3 cenv typB emEnv) + tdef.Fields.AsList |> List.iter (buildFieldPass3 cenv tref typB emEnv) let emEnv = List.fold (buildMethodImplsPass3 cenv tref typB) emEnv tdef.MethodImpls.AsList - tdef.CustomAttrs |> emitCustomAttrs cenv emEnv typB.SetCustomAttributeAndLog ; + tdef.CustomAttrs |> emitCustomAttrs cenv emEnv typB.SetCustomAttributeAndLog // custom attributes let emEnv = envPopTyvars emEnv // nested types @@ -2010,9 +2010,9 @@ let createTypeRef (visited : Dictionary<_, _>, created : Dictionary<_, _>) emEnv traverseTypeRef tref let rec buildTypeDefPass4 (visited, created) nesting emEnv (tdef : ILTypeDef) = - if verbose2 then dprintf "buildTypeDefPass4 %s\n" tdef.Name; + if verbose2 then dprintf "buildTypeDefPass4 %s\n" tdef.Name let tref = mkRefForNestedILTypeDef ILScopeRef.Local (nesting, tdef) - createTypeRef (visited, created) emEnv tref; + createTypeRef (visited, created) emEnv tref // nested types @@ -2052,7 +2052,7 @@ let buildModuleFragment cenv emEnv (asmB : AssemblyBuilder) (modB : ModuleBuilde 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; + emitCustomAttrs cenv emEnv modB.SetCustomAttributeAndLog m.CustomAttrs #if FX_RESHAPED_REFEMIT ignore asmB #else @@ -2067,7 +2067,7 @@ let buildModuleFragment cenv emEnv (asmB : AssemblyBuilder) (modB : ModuleBuilde | 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"); + failwith "references to resources other assemblies may not be emitted using System.Reflection") #endif emEnv @@ -2092,7 +2092,7 @@ let mkDynamicAssemblyAndModule (assemblyName, optimize, debugInfo, collectible) let filename = assemblyName + ".dll" let asmDir = "." let asmName = new AssemblyName() - asmName.Name <- assemblyName; + asmName.Name <- assemblyName let asmAccess = if collectible then AssemblyBuilderAccess.RunAndCollect #if FX_RESHAPED_REFEMIT @@ -2102,10 +2102,10 @@ let mkDynamicAssemblyAndModule (assemblyName, optimize, debugInfo, collectible) #endif let asmB = defineDynamicAssemblyAndLog(asmName, asmAccess, asmDir) if not optimize then - let daType = typeof; + let daType = typeof let daCtor = daType.GetConstructor [| typeof |] let daBuilder = new CustomAttributeBuilder(daCtor, [| System.Diagnostics.DebuggableAttribute.DebuggingModes.DisableOptimizations ||| System.Diagnostics.DebuggableAttribute.DebuggingModes.Default |]) - asmB.SetCustomAttributeAndLog(daBuilder); + asmB.SetCustomAttributeAndLog(daBuilder) let modB = asmB.DefineDynamicModuleAndLog(assemblyName, filename, debugInfo) asmB, modB @@ -2118,11 +2118,11 @@ let emitModuleFragment (ilg, emEnv, asmB : AssemblyBuilder, modB : ModuleBuilder | None -> () | Some mani -> // REVIEW: remainder of manifest - emitCustomAttrs cenv emEnv asmB.SetCustomAttributeAndLog mani.CustomAttrs; + emitCustomAttrs cenv emEnv asmB.SetCustomAttributeAndLog mani.CustomAttrs // invoke entry point methods let execEntryPtFun ((typB : TypeBuilder), methodName) () = try - ignore (typB.InvokeMemberAndLog(methodName, BindingFlags.InvokeMethod ||| BindingFlags.Public ||| BindingFlags.Static, [| |])); + ignore (typB.InvokeMemberAndLog(methodName, BindingFlags.InvokeMethod ||| BindingFlags.Public ||| BindingFlags.Static, [| |])) None with | :? System.Reflection.TargetInvocationException as e -> diff --git a/src/absil/ilsign.fs b/src/absil/ilsign.fs index 4608a9f9d5df281503f91c79dc4a4248ccda32ff..6b51af598d77c36e9360099b74d43f502c83d125 100644 --- a/src/absil/ilsign.fs +++ b/src/absil/ilsign.fs @@ -44,7 +44,7 @@ open System.Runtime.InteropServices val UnderlyingArray: byte[] []val ImmutableArray: ImmutableArray - new (immutableArray:ImmutableArray) = { UnderlyingArray = Array.empty ; ImmutableArray = immutableArray} + new (immutableArray:ImmutableArray) = { UnderlyingArray = Array.empty; ImmutableArray = immutableArray} end let getUnderlyingArray (array:ImmutableArray) =ByteArrayUnion(array).UnderlyingArray @@ -53,8 +53,8 @@ open System.Runtime.InteropServices // remain static (skip checksum, Authenticode signatures and strong name signature blob) let hashAssembly (peReader:PEReader) (hashAlgorithm:IncrementalHash ) = // Hash content of all headers - let peHeaders = peReader.PEHeaders; - let peHeaderOffset = peHeaders.PEHeaderStartOffset; + let peHeaders = peReader.PEHeaders + let peHeaderOffset = peHeaders.PEHeaderStartOffset // Even though some data in OptionalHeader is different for 32 and 64, this field is the same let checkSumOffset = peHeaderOffset + 0x40; // offsetof(IMAGE_OPTIONAL_HEADER, CheckSum) @@ -67,7 +67,7 @@ open System.Runtime.InteropServices let allHeadersSize = peHeaderOffset + peHeaderSize + int(peHeaders.CoffHeader.NumberOfSections) * 0x28; // sizeof(IMAGE_SECTION_HEADER) let allHeaders = let array:byte[] = Array.zeroCreate allHeadersSize - peReader.GetEntireImage().GetContent().CopyTo(0, array, 0, allHeadersSize); + peReader.GetEntireImage().GetContent().CopyTo(0, array, 0, allHeadersSize) array // Clear checksum and security data directory @@ -117,7 +117,7 @@ open System.Runtime.InteropServices member x.ReadBigInteger (length:int):byte[] = let arr:byte[] = Array.zeroCreate length Array.Copy(x._blob, x._offset, arr, 0, length) |> ignore - x._offset <- x._offset + length; + x._offset <- x._offset + length arr |> Array.rev let RSAParamatersFromBlob (blob:byte[]) keyType = diff --git a/src/absil/ilsupp.fs b/src/absil/ilsupp.fs index 6fbdc5bb72d5b48192b1dff1d720972545c8150d..4f4837238cc2d899fef0ba59acae36cb3e2bee62 100644 --- a/src/absil/ilsupp.fs +++ b/src/absil/ilsupp.fs @@ -488,25 +488,25 @@ type ResFormatNode(tid:int32, nid:int32, lid:int32, dataOffset:int32, pbLinkedRe do if (tid &&& 0x80000000) <> 0 then // REVIEW: Are names and types mutually exclusive? The C++ code didn't seem to think so, but I can't find any documentation - resHdr.TypeID <- 0 ; + resHdr.TypeID <- 0 let mtid = tid &&& 0x7fffffff - cType <- bytesToDWord(pbLinkedResource.[mtid], pbLinkedResource.[mtid+1], pbLinkedResource.[mtid+2], pbLinkedResource.[mtid+3]) ; - wzType <- Bytes.zeroCreate ((cType + 1) * 2) ; + cType <- bytesToDWord(pbLinkedResource.[mtid], pbLinkedResource.[mtid+1], pbLinkedResource.[mtid+2], pbLinkedResource.[mtid+3]) + wzType <- Bytes.zeroCreate ((cType + 1) * 2) Bytes.blit pbLinkedResource 4 wzType 0 (cType * 2) else - resHdr.TypeID <- (0xffff ||| ((tid &&& 0xffff) <<< 16)) ; + resHdr.TypeID <- (0xffff ||| ((tid &&& 0xffff) <<< 16)) if (nid &&& 0x80000000) <> 0 then - resHdr.NameID <- 0 ; + resHdr.NameID <- 0 let mnid = nid &&& 0x7fffffff - cName <- bytesToDWord(pbLinkedResource.[mnid], pbLinkedResource.[mnid+1], pbLinkedResource.[mnid+2], pbLinkedResource.[mnid+3]) ; - wzName <- Bytes.zeroCreate ((cName + 1) * 2) ; + cName <- bytesToDWord(pbLinkedResource.[mnid], pbLinkedResource.[mnid+1], pbLinkedResource.[mnid+2], pbLinkedResource.[mnid+3]) + wzName <- Bytes.zeroCreate ((cName + 1) * 2) Bytes.blit pbLinkedResource 4 wzName 0 (cName * 2) else resHdr.NameID <- (0xffff ||| ((nid &&& 0xffff) <<< 16)) - resHdr.LangID <- (int16)lid ; - dataEntry <- bytesToIRDataE pbLinkedResource dataOffset ; + resHdr.LangID <- (int16)lid + dataEntry <- bytesToIRDataE pbLinkedResource dataOffset resHdr.DataSize <- dataEntry.Size member x.ResHdr @@ -572,7 +572,7 @@ type ResFormatNode(tid:int32, nid:int32, lid:int32, dataOffset:int32, pbLinkedRe let pbData = pbLinkedResource.[(dataEntry.OffsetToData - ulLinkedResourceBaseRVA) ..] SaveChunk(pbData, dataEntry.Size) - dwFiller <- dataEntry.Size &&& 0x3 ; + dwFiller <- dataEntry.Size &&& 0x3 if dwFiller <> 0 then SaveChunk(bNil, 4 - dwFiller) @@ -623,7 +623,7 @@ let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRV for _ulr in unlinkedResources do let tempResFileName = GetUniqueRandomFileName(path) - resFiles <- tempResFileName :: resFiles ; + resFiles <- tempResFileName :: resFiles cmdLineArgs <- cmdLineArgs + " \"" + tempResFileName + "\"" let trf = resFiles let cmd = cmdLineArgs @@ -649,7 +649,7 @@ let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRV for ulr in unlinkedResources do // REVIEW: What can go wrong here? What happens when the various file calls fail // dump the unlinked resource bytes into the temp file - System.IO.File.WriteAllBytes(tempResFileNames.[iFiles], ulr) ; + System.IO.File.WriteAllBytes(tempResFileNames.[iFiles], ulr) iFiles <- iFiles + 1 // call cvtres.exe using the full cmd line string we've generated @@ -660,9 +660,9 @@ let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRV // REVIEW: We really shouldn't be calling out to cvtres let mutable psi = System.Diagnostics.ProcessStartInfo(cvtres) - psi.Arguments <- cmdLineArgs ; + psi.Arguments <- cmdLineArgs psi.CreateNoWindow <- true ; // REVIEW: For some reason, this still creates a window unless WindowStyle is set to hidden - psi.WindowStyle <- System.Diagnostics.ProcessWindowStyle.Hidden ; + psi.WindowStyle <- System.Diagnostics.ProcessWindowStyle.Hidden let p = System.Diagnostics.Process.Start(psi) // Wait for the process to finish @@ -671,7 +671,7 @@ let linkNativeResources (unlinkedResources:byte[] list) (ulLinkedResourceBaseRV check "Process.Start" p.ExitCode // TODO: really need to check against 0 // Conversion was successful, so read the object file - objBytes <- FileSystem.ReadAllBytesShim(tempObjFileName) ; + objBytes <- FileSystem.ReadAllBytesShim(tempObjFileName) //Array.Copy(objBytes, pbUnlinkedResource, pbUnlinkedResource.Length) FileSystem.FileDelete(tempObjFileName) finally @@ -756,7 +756,7 @@ let unlinkResource (ulLinkedResourceBaseRVA:int32) (pbLinkedResource:byte[]) = // determine entry buffer size // TODO: coalesce these two loops for iEntry = 0 to ((int)nEntries - 1) do - pirdeType <- bytesToIRDE pbLinkedResource (IMAGE_RESOURCE_DIRECTORY.Width + (iEntry * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) ; + pirdeType <- bytesToIRDE pbLinkedResource (IMAGE_RESOURCE_DIRECTORY.Width + (iEntry * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) if pirdeType.DataIsDirectory then let nameBase = pirdeType.OffsetToDirectory @@ -765,25 +765,25 @@ let unlinkResource (ulLinkedResourceBaseRVA:int32) (pbLinkedResource:byte[]) = let nEntries2 = pirdName.NumberOfNamedEntries + pirdName.NumberOfIdEntries for iEntry2 = 0 to ((int)nEntries2 - 1) do - pirdeName <- bytesToIRDE pbLinkedResource (nameBase + (iEntry2 * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) ; + pirdeName <- bytesToIRDE pbLinkedResource (nameBase + (iEntry2 * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) if pirdeName.DataIsDirectory then let langBase = pirdeName.OffsetToDirectory let pirdLang = bytesToIRD pbLinkedResource langBase let nEntries3 = pirdLang.NumberOfNamedEntries + pirdLang.NumberOfIdEntries - nResNodes <- nResNodes + ((int)nEntries3) ; + nResNodes <- nResNodes + ((int)nEntries3) else - nResNodes <- nResNodes + 1 ; + nResNodes <- nResNodes + 1 else - nResNodes <- nResNodes + 1 ; + nResNodes <- nResNodes + 1 let pResNodes : ResFormatNode [] = Array.zeroCreate nResNodes - nResNodes <- 0 ; + nResNodes <- 0 // fill out the entry buffer for iEntry = 0 to ((int)nEntries - 1) do - pirdeType <- bytesToIRDE pbLinkedResource (IMAGE_RESOURCE_DIRECTORY.Width + (iEntry * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) ; + pirdeType <- bytesToIRDE pbLinkedResource (IMAGE_RESOURCE_DIRECTORY.Width + (iEntry * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) let dwTypeID = pirdeType.Name // Need to skip VERSION and RT_MANIFEST resources // REVIEW: ideally we shouldn't allocate space for these, or rename properly so we don't get the naming conflict @@ -795,7 +795,7 @@ let unlinkResource (ulLinkedResourceBaseRVA:int32) (pbLinkedResource:byte[]) = let nEntries2 = pirdName.NumberOfNamedEntries + pirdName.NumberOfIdEntries for iEntry2 = 0 to ((int)nEntries2 - 1) do - pirdeName <- bytesToIRDE pbLinkedResource (nameBase + (iEntry2 * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) ; + pirdeName <- bytesToIRDE pbLinkedResource (nameBase + (iEntry2 * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) let dwNameID = pirdeName.Name if pirdeName.DataIsDirectory then @@ -805,7 +805,7 @@ let unlinkResource (ulLinkedResourceBaseRVA:int32) (pbLinkedResource:byte[]) = let nEntries3 = pirdLang.NumberOfNamedEntries + pirdLang.NumberOfIdEntries for iEntry3 = 0 to ((int)nEntries3 - 1) do - pirdeLang <- bytesToIRDE pbLinkedResource (langBase + (iEntry3 * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) ; + pirdeLang <- bytesToIRDE pbLinkedResource (langBase + (iEntry3 * IMAGE_RESOURCE_DIRECTORY_ENTRY.Width)) let dwLangID = pirdeLang.Name if pirdeLang.DataIsDirectory then @@ -814,25 +814,25 @@ let unlinkResource (ulLinkedResourceBaseRVA:int32) (pbLinkedResource:byte[]) = else if (not skipResource) then let rfn = ResFormatNode(dwTypeID, dwNameID, dwLangID, pirdeLang.OffsetToData, pbLinkedResource) - pResNodes.[nResNodes] <- rfn ; - nResNodes <- nResNodes + 1 ; + pResNodes.[nResNodes] <- rfn + nResNodes <- nResNodes + 1 else if (not skipResource) then let rfn = ResFormatNode(dwTypeID, dwNameID, 0, pirdeName.OffsetToData, pbLinkedResource) - pResNodes.[nResNodes] <- rfn ; - nResNodes <- nResNodes + 1 ; + pResNodes.[nResNodes] <- rfn + nResNodes <- nResNodes + 1 else if (not skipResource) then let rfn = ResFormatNode(dwTypeID, 0, 0, pirdeType.OffsetToData, pbLinkedResource) // REVIEW: I believe these 0s are what's causing the duplicate res naming problems - pResNodes.[nResNodes] <- rfn ; - nResNodes <- nResNodes + 1 ; + pResNodes.[nResNodes] <- rfn + nResNodes <- nResNodes + 1 // Ok, all tree leaves are in ResFormatNode structs, and nResNodes ptrs are in pResNodes let mutable size = 0 if nResNodes <> 0 then size <- size + ResFormatHeader.Width ; // sizeof(ResFormatHeader) for i = 0 to (nResNodes - 1) do - size <- size + pResNodes.[i].Save(ulLinkedResourceBaseRVA, pbLinkedResource, Unchecked.defaultof, 0) ; + size <- size + pResNodes.[i].Save(ulLinkedResourceBaseRVA, pbLinkedResource, Unchecked.defaultof, 0) let pResBuffer = Bytes.zeroCreate size @@ -1005,11 +1005,11 @@ type ISymUnmanagedWriter2 = type PdbWriter = { symWriter : ISymUnmanagedWriter2 } type PdbDocumentWriter = { symDocWriter : ISymUnmanagedDocumentWriter } (* pointer to pDocumentWriter COM object *) type idd = - { iddCharacteristics: int32; + { iddCharacteristics: int32 iddMajorVersion: int32; (* actually u16 in IMAGE_DEBUG_DIRECTORY *) iddMinorVersion: int32; (* actually u16 in IMAGE_DEBUG_DIRECTORY *) - iddType: int32; - iddData: byte[];} + iddType: int32 + iddData: byte[] } #endif #if !FX_NO_PDB_WRITER @@ -1019,7 +1019,7 @@ let pdbInitialize (binaryName:string) (pdbName:string) = // get the importer pointer let mdd = System.Activator.CreateInstance(CorMetaDataDispenser) :?> IMetaDataDispenser - let mutable IID_IMetaDataEmit = new Guid("BA3FEE4C-ECB9-4E41-83B7-183FA41CD859"); + let mutable IID_IMetaDataEmit = new Guid("BA3FEE4C-ECB9-4E41-83B7-183FA41CD859") let mutable o = Object() mdd.OpenScope(binaryName, 0x1, &IID_IMetaDataEmit, &o) // 0x1 = ofWrite let emitterPtr = Marshal.GetComInterfaceForObject(o, typeof) @@ -1139,10 +1139,10 @@ let pdbWriteDebugInfo (writer: PdbWriter) = let mutable data : byte [] = Array.zeroCreate length writer.symWriter.GetDebugInfo(&iDD, length, &length, data) - { iddCharacteristics = iDD.Characteristics; - iddMajorVersion = (int32)iDD.MajorVersion; - iddMinorVersion = (int32)iDD.MinorVersion; - iddType = iDD.Type; + { iddCharacteristics = iDD.Characteristics + iddMajorVersion = (int32)iDD.MajorVersion + iddMinorVersion = (int32)iDD.MinorVersion + iddType = iDD.Type iddData = data} #endif @@ -1156,19 +1156,19 @@ type PdbVariable = { symVariable: ISymbolVariable } type PdbMethodScope = { symScope: ISymbolScope } type PdbSequencePoint = - { pdbSeqPointOffset: int; - pdbSeqPointDocument: PdbDocument; - pdbSeqPointLine: int; - pdbSeqPointColumn: int; - pdbSeqPointEndLine: int; - pdbSeqPointEndColumn: int; } + { pdbSeqPointOffset: int + pdbSeqPointDocument: PdbDocument + pdbSeqPointLine: int + pdbSeqPointColumn: int + pdbSeqPointEndLine: int + pdbSeqPointEndColumn: int } let pdbReadOpen (moduleName:string) (path:string) : PdbReader = let CorMetaDataDispenser = System.Type.GetTypeFromProgID("CLRMetaData.CorMetaDataDispenser") - let mutable IID_IMetaDataImport = new Guid("7DAC8207-D3AE-4c75-9B67-92801A497D44"); + let mutable IID_IMetaDataImport = new Guid("7DAC8207-D3AE-4c75-9B67-92801A497D44") let mdd = System.Activator.CreateInstance(CorMetaDataDispenser) :?> IMetaDataDispenser let mutable o : Object = new Object() - mdd.OpenScope(moduleName, 0, &IID_IMetaDataImport, &o) ; + mdd.OpenScope(moduleName, 0, &IID_IMetaDataImport, &o) let importerPtr = Marshal.GetComInterfaceForObject(o, typeof) try #if ENABLE_MONO_SUPPORT @@ -1242,12 +1242,12 @@ let pdbMethodGetSequencePoints (meth:PdbMethod) : PdbSequencePoint array = meth.symMethod.GetSequencePoints(offsets, docs, lines, cols, endLines, endColumns) Array.init pSize (fun i -> - { pdbSeqPointOffset = offsets.[i]; - pdbSeqPointDocument = { symDocument = docs.[i] }; - pdbSeqPointLine = lines.[i]; - pdbSeqPointColumn = cols.[i]; - pdbSeqPointEndLine = endLines.[i]; - pdbSeqPointEndColumn = endColumns.[i]; }) + { pdbSeqPointOffset = offsets.[i] + pdbSeqPointDocument = { symDocument = docs.[i] } + pdbSeqPointLine = lines.[i] + pdbSeqPointColumn = cols.[i] + pdbSeqPointEndLine = endLines.[i] + pdbSeqPointEndColumn = endColumns.[i] }) let pdbScopeGetChildren (scope:PdbMethodScope) : PdbMethodScope array = let arr = scope.symScope.GetChildren() diff --git a/src/absil/ilwrite.fs b/src/absil/ilwrite.fs index cac9ccbcefec8a63e19e53479ee62fe6efe03ab7..a3a4d61f7f5560c5883897041e47753901667deb 100644 --- a/src/absil/ilwrite.fs +++ b/src/absil/ilwrite.fs @@ -87,9 +87,15 @@ type ByteBuffer with buf.EmitByte 0x0uy // Emit compressed untagged integer - member buf.EmitZUntaggedIndex big idx = + member buf.EmitZUntaggedIndex nm sz big idx = if big then buf.EmitInt32 idx - elif idx > 0xffff then failwith "EmitZUntaggedIndex: too big for small address or simple index" + elif idx > 0xffff then +#if NETSTANDARD1_6 + let trace = "no stack trace on.NET Standard 1.6" +#else + let trace = (new System.Diagnostics.StackTrace()).ToString() +#endif + failwithf "EmitZUntaggedIndex: index into table '%d' is too big for small address or simple index, idx = %d, big = %A, size of table = %d, stack = %s" nm idx big sz trace else buf.EmitInt32AsUInt16 idx // Emit compressed tagged integer @@ -220,15 +226,15 @@ module RowElementTags = let [] SimpleIndexMax = 119 let [] TypeDefOrRefOrSpecMin = 120 - let TypeDefOrRefOrSpec (t: TypeDefOrRefTag) = assert (t.Tag <= 2); TypeDefOrRefOrSpecMin + t.Tag (* + 111 + 1 = 0x70 + 1 = max TableName.Tndex + 1 *) + let TypeDefOrRefOrSpec (t: TypeDefOrRefTag) = assert (t.Tag <= 2); TypeDefOrRefOrSpecMin + t.Tag (* + 111 + 1 = 0x70 + 1 = max TableName.Tndex + 1 *) let [] TypeDefOrRefOrSpecMax = 122 let [] TypeOrMethodDefMin = 123 - let TypeOrMethodDef (t: TypeOrMethodDefTag) = assert (t.Tag <= 1); TypeOrMethodDefMin + t.Tag (* + 2 + 1 = max TypeDefOrRefOrSpec.Tag + 1 *) + let TypeOrMethodDef (t: TypeOrMethodDefTag) = assert (t.Tag <= 1); TypeOrMethodDefMin + t.Tag (* + 2 + 1 = max TypeDefOrRefOrSpec.Tag + 1 *) let [] TypeOrMethodDefMax = 124 let [] HasConstantMin = 125 - let HasConstant (t: HasConstantTag) = assert (t.Tag <= 2); HasConstantMin + t.Tag (* + 1 + 1 = max TypeOrMethodDef.Tag + 1 *) + let HasConstant (t: HasConstantTag) = assert (t.Tag <= 2); HasConstantMin + t.Tag (* + 1 + 1 = max TypeOrMethodDef.Tag + 1 *) let [] HasConstantMax = 127 let [] HasCustomAttributeMin = 128 @@ -236,39 +242,39 @@ module RowElementTags = let [] HasCustomAttributeMax = 149 let [] HasFieldMarshalMin = 150 - let HasFieldMarshal (t: HasFieldMarshalTag) = assert (t.Tag <= 1); HasFieldMarshalMin + t.Tag (* + 21 + 1 = max HasCustomAttribute.Tag + 1 *) + let HasFieldMarshal (t: HasFieldMarshalTag) = assert (t.Tag <= 1); HasFieldMarshalMin + t.Tag (* + 21 + 1 = max HasCustomAttribute.Tag + 1 *) let [] HasFieldMarshalMax = 151 let [] HasDeclSecurityMin = 152 - let HasDeclSecurity (t: HasDeclSecurityTag) = assert (t.Tag <= 2); HasDeclSecurityMin + t.Tag (* + 1 + 1 = max HasFieldMarshal.Tag + 1 *) + let HasDeclSecurity (t: HasDeclSecurityTag) = assert (t.Tag <= 2); HasDeclSecurityMin + t.Tag (* + 1 + 1 = max HasFieldMarshal.Tag + 1 *) let [] HasDeclSecurityMax = 154 let [] MemberRefParentMin = 155 - let MemberRefParent (t: MemberRefParentTag) = assert (t.Tag <= 4); MemberRefParentMin + t.Tag (* + 2 + 1 = max HasDeclSecurity.Tag + 1 *) + let MemberRefParent (t: MemberRefParentTag) = assert (t.Tag <= 4); MemberRefParentMin + t.Tag (* + 2 + 1 = max HasDeclSecurity.Tag + 1 *) let [] MemberRefParentMax = 159 let [] HasSemanticsMin = 160 - let HasSemantics (t: HasSemanticsTag) = assert (t.Tag <= 1); HasSemanticsMin + t.Tag (* + 4 + 1 = max MemberRefParent.Tag + 1 *) + let HasSemantics (t: HasSemanticsTag) = assert (t.Tag <= 1); HasSemanticsMin + t.Tag (* + 4 + 1 = max MemberRefParent.Tag + 1 *) let [] HasSemanticsMax = 161 let [] MethodDefOrRefMin = 162 - let MethodDefOrRef (t: MethodDefOrRefTag) = assert (t.Tag <= 2); MethodDefOrRefMin + t.Tag (* + 1 + 1 = max HasSemantics.Tag + 1 *) + let MethodDefOrRef (t: MethodDefOrRefTag) = assert (t.Tag <= 2); MethodDefOrRefMin + t.Tag (* + 1 + 1 = max HasSemantics.Tag + 1 *) let [] MethodDefOrRefMax = 164 let [] MemberForwardedMin = 165 - let MemberForwarded (t: MemberForwardedTag) = assert (t.Tag <= 1); MemberForwardedMin + t.Tag (* + 2 + 1 = max MethodDefOrRef.Tag + 1 *) + let MemberForwarded (t: MemberForwardedTag) = assert (t.Tag <= 1); MemberForwardedMin + t.Tag (* + 2 + 1 = max MethodDefOrRef.Tag + 1 *) let [] MemberForwardedMax = 166 let [] ImplementationMin = 167 - let Implementation (t: ImplementationTag) = assert (t.Tag <= 2); ImplementationMin + t.Tag (* + 1 + 1 = max MemberForwarded.Tag + 1 *) + let Implementation (t: ImplementationTag) = assert (t.Tag <= 2); ImplementationMin + t.Tag (* + 1 + 1 = max MemberForwarded.Tag + 1 *) let [] ImplementationMax = 169 let [] CustomAttributeTypeMin = 170 - let CustomAttributeType (t: CustomAttributeTypeTag) = assert (t.Tag <= 3); CustomAttributeTypeMin + t.Tag (* + 2 + 1 = max Implementation.Tag + 1 *) + let CustomAttributeType (t: CustomAttributeTypeTag) = assert (t.Tag <= 3); CustomAttributeTypeMin + t.Tag (* + 2 + 1 = max Implementation.Tag + 1 *) let [] CustomAttributeTypeMax = 173 let [] ResolutionScopeMin = 174 - let ResolutionScope (t: ResolutionScopeTag) = assert (t.Tag <= 4); ResolutionScopeMin + t.Tag (* + 3 + 1 = max CustomAttributeType.Tag + 1 *) + let ResolutionScope (t: ResolutionScopeTag) = assert (t.Tag <= 4); ResolutionScopeMin + t.Tag (* + 3 + 1 = max CustomAttributeType.Tag + 1 *) let [] ResolutionScopeMax = 178 [] @@ -1392,8 +1398,8 @@ and GetCustomAttrRow cenv hca (attr: ILAttribute) = | _ -> () UnsharedRow - [| HasCustomAttribute (fst hca, snd hca); - CustomAttributeType (fst cat, snd cat); + [| HasCustomAttribute (fst hca, snd hca) + CustomAttributeType (fst cat, snd cat) Blob (GetCustomAttrDataAsBlobIdx cenv data) |] @@ -3198,8 +3204,10 @@ let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailca let codedTables = + let sizesTable = Array.map Array.length sortedTables let bignessTable = Array.map (fun rows -> Array.length rows >= 0x10000) sortedTables let bigness (tab:int32) = bignessTable.[tab] + let size (tab:int32) = sizesTable.[tab] let codedBigness nbits tab = (tableSize tab) >= (0x10000 >>> nbits) @@ -3289,7 +3297,7 @@ let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailca // Now the coded tables themselves - first the schemata header tablesBuf.EmitIntsAsBytes - [| 0x00; 0x00; 0x00; 0x00; + [| 0x00; 0x00; 0x00; 0x00 mdtableVersionMajor // major version of table schemata mdtableVersionMinor // minor version of table schemata @@ -3323,10 +3331,12 @@ let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailca | _ when t = RowElementTags.ULong -> tablesBuf.EmitInt32 n | _ when t = RowElementTags.Data -> recordRequiredDataFixup requiredDataFixups tablesBuf (tablesStreamStart + tablesBuf.Position) (n, false) | _ when t = RowElementTags.DataResources -> recordRequiredDataFixup requiredDataFixups tablesBuf (tablesStreamStart + tablesBuf.Position) (n, true) - | _ when t = RowElementTags.Guid -> tablesBuf.EmitZUntaggedIndex guidsBig (guidAddress n) - | _ when t = RowElementTags.Blob -> tablesBuf.EmitZUntaggedIndex blobsBig (blobAddress n) - | _ when t = RowElementTags.String -> tablesBuf.EmitZUntaggedIndex stringsBig (stringAddress n) - | _ when t <= RowElementTags.SimpleIndexMax -> tablesBuf.EmitZUntaggedIndex (bigness (t - RowElementTags.SimpleIndexMin)) n + | _ when t = RowElementTags.Guid -> tablesBuf.EmitZUntaggedIndex -3 guidsStreamPaddedSize guidsBig (guidAddress n) + | _ when t = RowElementTags.Blob -> tablesBuf.EmitZUntaggedIndex -2 blobsStreamPaddedSize blobsBig (blobAddress n) + | _ when t = RowElementTags.String -> tablesBuf.EmitZUntaggedIndex -1 stringsStreamPaddedSize stringsBig (stringAddress n) + | _ when t <= RowElementTags.SimpleIndexMax -> + let tnum = t - RowElementTags.SimpleIndexMin + tablesBuf.EmitZUntaggedIndex tnum (size tnum) (bigness tnum) n | _ when t <= RowElementTags.TypeDefOrRefOrSpecMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.TypeDefOrRefOrSpecMin) 2 tdorBigness n | _ when t <= RowElementTags.TypeOrMethodDefMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.TypeOrMethodDefMin) 1 tomdBigness n | _ when t <= RowElementTags.HasConstantMax -> tablesBuf.EmitZTaggedIndex (t - RowElementTags.HasConstantMin) 2 hcBigness n @@ -3366,72 +3376,72 @@ let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailca let metadata, guidStart = let mdbuf = ByteBuffer.Create 500000 mdbuf.EmitIntsAsBytes - [| 0x42; 0x53; 0x4a; 0x42; // Magic signature - 0x01; 0x00; // Major version - 0x01; 0x00; // Minor version - |]; - mdbuf.EmitInt32 0x0; // Reserved - - mdbuf.EmitInt32 paddedVersionLength; - mdbuf.EmitBytes version; + [| 0x42; 0x53; 0x4a; 0x42 // Magic signature + 0x01; 0x00 // Major version + 0x01; 0x00 // Minor version + |] + mdbuf.EmitInt32 0x0 // Reserved + + mdbuf.EmitInt32 paddedVersionLength + mdbuf.EmitBytes version for i = 1 to (paddedVersionLength - Array.length version) do - mdbuf.EmitIntAsByte 0x00; + mdbuf.EmitIntAsByte 0x00 mdbuf.EmitBytes - [| 0x00uy; 0x00uy; // flags, reserved - b0 numStreams; b1 numStreams; |]; - mdbuf.EmitInt32 tablesChunk.addr; - mdbuf.EmitInt32 tablesChunk.size; - mdbuf.EmitIntsAsBytes [| 0x23; 0x7e; 0x00; 0x00; (* #~00 *)|]; - mdbuf.EmitInt32 stringsChunk.addr; - mdbuf.EmitInt32 stringsChunk.size; - mdbuf.EmitIntsAsBytes [| 0x23; 0x53; 0x74; 0x72; 0x69; 0x6e; 0x67; 0x73; 0x00; 0x00; 0x00; 0x00 (* "#Strings0000" *)|]; - mdbuf.EmitInt32 userStringsChunk.addr; - mdbuf.EmitInt32 userStringsChunk.size; - mdbuf.EmitIntsAsBytes [| 0x23; 0x55; 0x53; 0x00; (* #US0*) |]; - mdbuf.EmitInt32 guidsChunk.addr; - mdbuf.EmitInt32 guidsChunk.size; - mdbuf.EmitIntsAsBytes [| 0x23; 0x47; 0x55; 0x49; 0x44; 0x00; 0x00; 0x00; (* #GUID000 *)|]; - mdbuf.EmitInt32 blobsChunk.addr; - mdbuf.EmitInt32 blobsChunk.size; - mdbuf.EmitIntsAsBytes [| 0x23; 0x42; 0x6c; 0x6f; 0x62; 0x00; 0x00; 0x00; (* #Blob000 *)|]; + [| 0x00uy; 0x00uy // flags, reserved + b0 numStreams; b1 numStreams; |] + mdbuf.EmitInt32 tablesChunk.addr + mdbuf.EmitInt32 tablesChunk.size + mdbuf.EmitIntsAsBytes [| 0x23; 0x7e; 0x00; 0x00; (* #~00 *)|] + mdbuf.EmitInt32 stringsChunk.addr + mdbuf.EmitInt32 stringsChunk.size + mdbuf.EmitIntsAsBytes [| 0x23; 0x53; 0x74; 0x72; 0x69; 0x6e; 0x67; 0x73; 0x00; 0x00; 0x00; 0x00 (* "#Strings0000" *)|] + mdbuf.EmitInt32 userStringsChunk.addr + mdbuf.EmitInt32 userStringsChunk.size + mdbuf.EmitIntsAsBytes [| 0x23; 0x55; 0x53; 0x00; (* #US0*) |] + mdbuf.EmitInt32 guidsChunk.addr + mdbuf.EmitInt32 guidsChunk.size + mdbuf.EmitIntsAsBytes [| 0x23; 0x47; 0x55; 0x49; 0x44; 0x00; 0x00; 0x00; (* #GUID000 *)|] + mdbuf.EmitInt32 blobsChunk.addr + mdbuf.EmitInt32 blobsChunk.size + mdbuf.EmitIntsAsBytes [| 0x23; 0x42; 0x6c; 0x6f; 0x62; 0x00; 0x00; 0x00; (* #Blob000 *)|] - reportTime showTimes "Write Metadata Header"; + reportTime showTimes "Write Metadata Header" // Now the coded tables themselves - mdbuf.EmitBytes codedTables; + mdbuf.EmitBytes codedTables for i = 1 to tablesStreamPadding do - mdbuf.EmitIntAsByte 0x00; - reportTime showTimes "Write Metadata Tables"; + mdbuf.EmitIntAsByte 0x00 + reportTime showTimes "Write Metadata Tables" // The string stream - mdbuf.EmitByte 0x00uy; + mdbuf.EmitByte 0x00uy for s in strings do - mdbuf.EmitBytes s; + mdbuf.EmitBytes s for i = 1 to stringsStreamPadding do - mdbuf.EmitIntAsByte 0x00; - reportTime showTimes "Write Metadata Strings"; + mdbuf.EmitIntAsByte 0x00 + reportTime showTimes "Write Metadata Strings" // The user string stream - mdbuf.EmitByte 0x00uy; + mdbuf.EmitByte 0x00uy for s in userStrings do - mdbuf.EmitZ32 (s.Length + 1); - mdbuf.EmitBytes s; + mdbuf.EmitZ32 (s.Length + 1) + mdbuf.EmitBytes s mdbuf.EmitIntAsByte (markerForUnicodeBytes s) for i = 1 to userStringsStreamPadding do - mdbuf.EmitIntAsByte 0x00; + mdbuf.EmitIntAsByte 0x00 - reportTime showTimes "Write Metadata User Strings"; + reportTime showTimes "Write Metadata User Strings" // The GUID stream let guidStart = mdbuf.Position - Array.iter mdbuf.EmitBytes guids; + Array.iter mdbuf.EmitBytes guids // The blob stream - mdbuf.EmitByte 0x00uy; + mdbuf.EmitByte 0x00uy for s in blobs do - mdbuf.EmitZ32 s.Length; + mdbuf.EmitZ32 s.Length mdbuf.EmitBytes s for i = 1 to blobsStreamPadding do - mdbuf.EmitIntAsByte 0x00; - reportTime showTimes "Write Blob Stream"; + mdbuf.EmitIntAsByte 0x00 + reportTime showTimes "Write Blob Stream" // Done - close the buffer and return the result. mdbuf.Close(), guidStart @@ -3441,13 +3451,13 @@ let writeILMetadataAndCode (generatePdb, desiredMetadataVersion, ilg, emitTailca for (codeStartAddr, l) in requiredStringFixups 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"; + 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; + checkFixup32 code locInCode 0xdeadbeef let token = getUncodedToken TableNames.UserStrings (userStringAddress userStringIndex) - if (Bytes.get code (locInCode-1) <> i_ldstr) then failwith "strings-in-code fixup: not at ldstr instruction!"; + if (Bytes.get code (locInCode-1) <> i_ldstr) then failwith "strings-in-code fixup: not at ldstr instruction!" applyFixup32 code locInCode token - reportTime showTimes "Fixup Metadata"; + reportTime showTimes "Fixup Metadata" entryPointToken, code, codePadding, metadata, data, resources, !requiredDataFixups, pdbData, mappings, guidStart @@ -3484,27 +3494,27 @@ let msdosHeader : byte[] = 0x24uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy; 0x00uy |] let writeInt64 (os: BinaryWriter) x = - os.Write (dw0 x); - os.Write (dw1 x); - os.Write (dw2 x); - os.Write (dw3 x); - os.Write (dw4 x); - os.Write (dw5 x); - os.Write (dw6 x); + os.Write (dw0 x) + os.Write (dw1 x) + os.Write (dw2 x) + os.Write (dw3 x) + os.Write (dw4 x) + os.Write (dw5 x) + os.Write (dw6 x) os.Write (dw7 x) let writeInt32 (os: BinaryWriter) x = - os.Write (byte (b0 x)); - os.Write (byte (b1 x)); - os.Write (byte (b2 x)); + os.Write (byte (b0 x)) + os.Write (byte (b1 x)) + os.Write (byte (b2 x)) os.Write (byte (b3 x)) let writeInt32AsUInt16 (os: BinaryWriter) x = - os.Write (byte (b0 x)); + os.Write (byte (b0 x)) os.Write (byte (b1 x)) let writeDirectory os dict = - writeInt32 os (if dict.size = 0x0 then 0x0 else dict.addr); + 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) @@ -3516,7 +3526,7 @@ let writeBinaryAndReportMappings (outfile, // Store the public key from the signer into the manifest. This means it will be written // to the binary and also acts as an indicator to leave space for delay sign - reportTime showTimes "Write Started"; + reportTime showTimes "Write Started" let isDll = modul.IsDLL let signer = @@ -3524,13 +3534,13 @@ let writeBinaryAndReportMappings (outfile, | Some _, _ -> signer | _, None -> signer | None, Some {PublicKey=Some pubkey} -> - (dprintn "Note: The output assembly will be delay-signed using the original public"; - dprintn "Note: key. In order to load it you will need to either sign it with"; - dprintn "Note: the original private key or to turn off strong-name verification"; - dprintn "Note: (use sn.exe from the .NET Framework SDK to do this, e.g. 'sn -Vr *')."; - dprintn "Note: Alternatively if this tool supports it you can provide the original"; - dprintn "Note: private key when converting the assembly, assuming you have access to"; - dprintn "Note: it."; + (dprintn "Note: The output assembly will be delay-signed using the original public" + dprintn "Note: key. In order to load it you will need to either sign it with" + dprintn "Note: the original private key or to turn off strong-name verification" + dprintn "Note: (use sn.exe from the .NET Framework SDK to do this, e.g. 'sn -Vr *')." + dprintn "Note: Alternatively if this tool supports it you can provide the original" + dprintn "Note: private key when converting the assembly, assuming you have access to" + dprintn "Note: it." Some (ILStrongNameSigner.OpenPublicKey pubkey)) | _ -> signer @@ -3541,14 +3551,14 @@ let writeBinaryAndReportMappings (outfile, | Some s -> try Some s.PublicKey with e -> - failwith ("A call to StrongNameGetPublicKey failed ("+e.Message+")"); + failwith ("A call to StrongNameGetPublicKey failed ("+e.Message+")") None begin match modul.Manifest with | None -> () | Some m -> if m.PublicKey <> None && m.PublicKey <> pubkey then dprintn "Warning: The output assembly is being signed or delay-signed with a strong name that is different to the original." - end; + end { modul with Manifest = match modul.Manifest with None -> None | Some m -> Some {m with PublicKey = pubkey} } let os = @@ -3631,7 +3641,7 @@ let writeBinaryAndReportMappings (outfile, let entryPointToken, code, codePadding, metadata, data, resources, requiredDataFixups, pdbData, mappings, guidStart = writeILMetadataAndCode ((pdbfile <> None), desiredMetadataVersion, ilg, emitTailcalls, deterministic, showTimes) modul next normalizeAssemblyRefs - reportTime showTimes "Generated IL and metadata"; + reportTime showTimes "Generated IL and metadata" let _codeChunk, next = chunk code.Length next let _codePaddingChunk, next = chunk codePadding.Length next @@ -3767,62 +3777,62 @@ let writeBinaryAndReportMappings (outfile, requiredDataFixups |> List.iter (fun (metadataOffset32, (dataOffset, kind)) -> let metadataOffset = metadataOffset32 - if metadataOffset < 0 || metadataOffset >= metadata.Length - 4 then failwith "data RVA fixup: fixup located outside metadata"; - checkFixup32 metadata metadataOffset 0xdeaddddd; + if metadataOffset < 0 || metadataOffset >= metadata.Length - 4 then failwith "data RVA fixup: fixup located outside metadata" + checkFixup32 metadata metadataOffset 0xdeaddddd let dataRva = if kind then let res = dataOffset - if res >= resourcesChunk.size then dprintn ("resource offset bigger than resource data section"); + if res >= resourcesChunk.size then dprintn ("resource offset bigger than resource data section") res else let res = rawdataChunk.addr + dataOffset - if res < rawdataChunk.addr then dprintn ("data rva before data section"); + if res < rawdataChunk.addr then dprintn ("data rva before data section") if res >= rawdataChunk.addr + rawdataChunk.size then dprintn ("data rva after end of data section, dataRva = "+string res+", rawdataChunk.addr = "+string rawdataChunk.addr - + ", rawdataChunk.size = "+string rawdataChunk.size); + + ", rawdataChunk.size = "+string rawdataChunk.size) res - applyFixup32 metadata metadataOffset dataRva); - end; + applyFixup32 metadata metadataOffset dataRva) + end // IMAGE TOTAL SIZE let imageEndSectionPhysLoc = nextPhys let imageEndAddr = next - reportTime showTimes "Layout image"; + reportTime showTimes "Layout image" let write p (os: BinaryWriter) chunkName chunk = match p with | None -> () | Some pExpected -> - os.Flush(); + os.Flush() let pCurrent = int32 os.BaseStream.Position if pCurrent <> pExpected then failwith ("warning: "+chunkName+" not where expected, pCurrent = "+string pCurrent+", p.addr = "+string pExpected) writeBytes os chunk let writePadding (os: BinaryWriter) _comment sz = - if sz < 0 then failwith "writePadding: size < 0"; + if sz < 0 then failwith "writePadding: size < 0" for i = 0 to sz - 1 do os.Write 0uy // Now we've computed all the offsets, write the image - write (Some msdosHeaderChunk.addr) os "msdos header" msdosHeader; + write (Some msdosHeaderChunk.addr) os "msdos header" msdosHeader - write (Some peSignatureChunk.addr) os "pe signature" [| |]; + write (Some peSignatureChunk.addr) os "pe signature" [| |] - writeInt32 os 0x4550; + writeInt32 os 0x4550 - write (Some peFileHeaderChunk.addr) os "pe file header" [| |]; + write (Some peFileHeaderChunk.addr) os "pe file header" [| |] if (modul.Platform = Some(AMD64)) then writeInt32AsUInt16 os 0x8664 // Machine - IMAGE_FILE_MACHINE_AMD64 elif isItanium then writeInt32AsUInt16 os 0x200 else - writeInt32AsUInt16 os 0x014c; // Machine - IMAGE_FILE_MACHINE_I386 + writeInt32AsUInt16 os 0x014c // Machine - IMAGE_FILE_MACHINE_I386 - writeInt32AsUInt16 os numSections; + writeInt32AsUInt16 os numSections let pdbData = if deterministic then @@ -3850,58 +3860,58 @@ let writeBinaryAndReportMappings (outfile, writeInt32 os timestamp // date since 1970 pdbData - writeInt32 os 0x00; // Pointer to Symbol Table Always 0 + writeInt32 os 0x00 // Pointer to Symbol Table Always 0 // 00000090 - writeInt32 os 0x00; // Number of Symbols Always 0 - writeInt32AsUInt16 os peOptionalHeaderSize; // Size of the optional header, the format is described below. + writeInt32 os 0x00 // Number of Symbols Always 0 + writeInt32AsUInt16 os peOptionalHeaderSize // Size of the optional header, the format is described below. // 64bit: IMAGE_FILE_32BIT_MACHINE ||| IMAGE_FILE_LARGE_ADDRESS_AWARE // 32bit: IMAGE_FILE_32BIT_MACHINE // Yes, 32BIT_MACHINE is set for AMD64... let iMachineCharacteristic = match modul.Platform with | Some IA64 -> 0x20 | Some AMD64 -> 0x0120 | _ -> 0x0100 - writeInt32AsUInt16 os ((if isDll then 0x2000 else 0x0000) ||| 0x0002 ||| 0x0004 ||| 0x0008 ||| iMachineCharacteristic); + writeInt32AsUInt16 os ((if isDll then 0x2000 else 0x0000) ||| 0x0002 ||| 0x0004 ||| 0x0008 ||| iMachineCharacteristic) // Now comes optional header let peOptionalHeaderByte = peOptionalHeaderByteByCLRVersion desiredMetadataVersion - write (Some peOptionalHeaderChunk.addr) os "pe optional header" [| |]; + write (Some peOptionalHeaderChunk.addr) os "pe optional header" [| |] if modul.Is64Bit then writeInt32AsUInt16 os 0x020B // Magic number is 0x020B for 64-bit else - writeInt32AsUInt16 os 0x010b; // Always 0x10B (see Section 23.1). - writeInt32AsUInt16 os peOptionalHeaderByte; // ECMA spec says 6, some binaries, e.g. fscmanaged.exe say 7, Whidbey binaries say 8 - writeInt32 os textSectionPhysSize; // Size of the code (text) section, or the sum of all code sections if there are multiple sections. + writeInt32AsUInt16 os 0x010b // Always 0x10B (see Section 23.1). + writeInt32AsUInt16 os peOptionalHeaderByte // ECMA spec says 6, some binaries, e.g. fscmanaged.exe say 7, Whidbey binaries say 8 + writeInt32 os textSectionPhysSize // Size of the code (text) section, or the sum of all code sections if there are multiple sections. // 000000a0 - writeInt32 os dataSectionPhysSize; // Size of the initialized data section - writeInt32 os 0x00; // Size of the uninitialized data section - writeInt32 os entrypointCodeChunk.addr; // RVA of entry point , needs to point to bytes 0xFF 0x25 followed by the RVA+!0x4000000 - writeInt32 os textSectionAddr; // e.g. 0x0002000 + writeInt32 os dataSectionPhysSize // Size of the initialized data section + writeInt32 os 0x00 // Size of the uninitialized data section + writeInt32 os entrypointCodeChunk.addr // RVA of entry point , needs to point to bytes 0xFF 0x25 followed by the RVA+!0x4000000 + writeInt32 os textSectionAddr // e.g. 0x0002000 // 000000b0 if modul.Is64Bit then writeInt64 os ((int64)imageBaseReal) // REVIEW: For 64-bit, we should use a 64-bit image base else - writeInt32 os dataSectionAddr; // e.g. 0x0000c000 - writeInt32 os imageBaseReal; // Image Base Always 0x400000 (see Section 23.1). - QUERY : no it's not always 0x400000, e.g. 0x034f0000 + writeInt32 os dataSectionAddr // e.g. 0x0000c000 + writeInt32 os imageBaseReal // Image Base Always 0x400000 (see Section 23.1). - QUERY : no it's not always 0x400000, e.g. 0x034f0000 - writeInt32 os alignVirt; // Section Alignment Always 0x2000 (see Section 23.1). - writeInt32 os alignPhys; // File Alignment Either 0x200 or 0x1000. + writeInt32 os alignVirt // Section Alignment Always 0x2000 (see Section 23.1). + writeInt32 os alignPhys // File Alignment Either 0x200 or 0x1000. // 000000c0 - writeInt32AsUInt16 os 0x04; // OS Major Always 4 (see Section 23.1). - writeInt32AsUInt16 os 0x00; // OS Minor Always 0 (see Section 23.1). - writeInt32AsUInt16 os 0x00; // User Major Always 0 (see Section 23.1). - writeInt32AsUInt16 os 0x00; // User Minor Always 0 (see Section 23.1). + writeInt32AsUInt16 os 0x04 // OS Major Always 4 (see Section 23.1). + writeInt32AsUInt16 os 0x00 // OS Minor Always 0 (see Section 23.1). + writeInt32AsUInt16 os 0x00 // User Major Always 0 (see Section 23.1). + writeInt32AsUInt16 os 0x00 // User Minor Always 0 (see Section 23.1). do let (major, minor) = modul.SubsystemVersion - writeInt32AsUInt16 os major; - writeInt32AsUInt16 os minor; - writeInt32 os 0x00; // Reserved Always 0 (see Section 23.1). + writeInt32AsUInt16 os major + writeInt32AsUInt16 os minor + writeInt32 os 0x00 // Reserved Always 0 (see Section 23.1). // 000000d0 - writeInt32 os imageEndAddr; // Image Size: Size, in bytes, of image, including all headers and padding; - writeInt32 os headerSectionPhysSize; // Header Size Combined size of MS-DOS Header, PE Header, PE Optional Header and padding; - writeInt32 os 0x00; // File Checksum Always 0 (see Section 23.1). QUERY: NOT ALWAYS ZERO - writeInt32AsUInt16 os modul.SubSystemFlags; // SubSystem Subsystem required to run this image. + writeInt32 os imageEndAddr // Image Size: Size, in bytes, of image, including all headers and padding + writeInt32 os headerSectionPhysSize // Header Size Combined size of MS-DOS Header, PE Header, PE Optional Header and padding + writeInt32 os 0x00 // File Checksum Always 0 (see Section 23.1). QUERY: NOT ALWAYS ZERO + writeInt32AsUInt16 os modul.SubSystemFlags // SubSystem Subsystem required to run this image. // DLL Flags Always 0x400 (no unmanaged windows exception handling - see Section 23.1). // Itanium: see notes at end of file // IMAGE_DLLCHARACTERISTICS_NX_COMPAT: See FSharp 1.0 bug 5019 and http://blogs.msdn.com/ed_maurer/archive/2007/12/14/nxcompat-and-the-c-compiler.aspx @@ -4108,12 +4118,12 @@ let writeBinaryAndReportMappings (outfile, // Two zero bytes of hint, then Case sensitive, null-terminated ASCII string containing name to import. // Shall _CorExeMain a .exe file _CorDllMain for a .dll file. if isDll then - writeBytes os [| 0x00uy; 0x00uy; 0x5fuy; 0x43uy ; 0x6fuy; 0x72uy; 0x44uy; 0x6cuy; 0x6cuy; 0x4duy; 0x61uy; 0x69uy; 0x6euy; 0x00uy |] + writeBytes os [| 0x00uy; 0x00uy; 0x5fuy; 0x43uy ; 0x6fuy; 0x72uy; 0x44uy; 0x6cuy; 0x6cuy; 0x4duy; 0x61uy; 0x69uy; 0x6euy; 0x00uy |] else - writeBytes os [| 0x00uy; 0x00uy; 0x5fuy; 0x43uy; 0x6fuy; 0x72uy; 0x45uy; 0x78uy; 0x65uy; 0x4duy; 0x61uy; 0x69uy; 0x6euy; 0x00uy |] + writeBytes os [| 0x00uy; 0x00uy; 0x5fuy; 0x43uy; 0x6fuy; 0x72uy; 0x45uy; 0x78uy; 0x65uy; 0x4duy; 0x61uy; 0x69uy; 0x6euy; 0x00uy |] write (Some (textV2P mscoreeStringChunk.addr)) os "mscoree string" - [| 0x6duy; 0x73uy; 0x63uy; 0x6fuy ; 0x72uy; 0x65uy ; 0x65uy; 0x2euy ; 0x64uy; 0x6cuy ; 0x6cuy; 0x00uy ; |] + [| 0x6duy; 0x73uy; 0x63uy; 0x6fuy ; 0x72uy; 0x65uy ; 0x65uy; 0x2euy ; 0x64uy; 0x6cuy ; 0x6cuy; 0x00uy ; |] writePadding os "end of import tab" importTableChunkPadding @@ -4165,9 +4175,9 @@ let writeBinaryAndReportMappings (outfile, 0xA000 ||| (globalpointerCodeChunk.addr - ((globalpointerCodeChunk.addr / 4096) * 4096)) write (Some (relocV2P baseRelocTableChunk.addr)) os "base reloc table" - [| b0 entrypointFixupBlock; b1 entrypointFixupBlock; b2 entrypointFixupBlock; b3 entrypointFixupBlock; - 0x0cuy; 0x00uy; 0x00uy; 0x00uy; - b0 reloc; b1 reloc; + [| b0 entrypointFixupBlock; b1 entrypointFixupBlock; b2 entrypointFixupBlock; b3 entrypointFixupBlock + 0x0cuy; 0x00uy; 0x00uy; 0x00uy + b0 reloc; b1 reloc b0 reloc2; b1 reloc2; |] writePadding os "end of .reloc" (imageEndSectionPhysLoc - relocSectionPhysLoc - relocSectionSize) @@ -4268,7 +4278,7 @@ let writeBinaryAndReportMappings (outfile, mappings type options = - { ilg: ILGlobals; + { ilg: ILGlobals pdbfile: string option portablePDB: bool embeddedPDB: bool diff --git a/src/absil/ilwritepdb.fs b/src/absil/ilwritepdb.fs index 0377916fd56b7156ae9bd421ae4e89b121b12fb4..21f79159290fc17b54ad543d62827125b6f4887d 100644 --- a/src/absil/ilwritepdb.fs +++ b/src/absil/ilwritepdb.fs @@ -117,12 +117,12 @@ type BinaryChunk = addr: int32 } type idd = - { iddCharacteristics: int32; + { iddCharacteristics: int32 iddMajorVersion: int32; (* actually u16 in IMAGE_DEBUG_DIRECTORY *) iddMinorVersion: int32; (* actually u16 in IMAGE_DEBUG_DIRECTORY *) - iddType: int32; - iddTimestamp: int32; - iddData: byte[]; + iddType: int32 + iddTimestamp: int32 + iddData: byte[] iddChunk: BinaryChunk } //--------------------------------------------------------------------- @@ -143,13 +143,13 @@ let pdbGetCvDebugInfo (mvid:byte[]) (timestamp:int32) (filepath:string) (cvChunk let (offset, size) = (offset + size, path.Length) // Path to pdb string Buffer.BlockCopy(path, 0, buffer, offset, size) buffer - { iddCharacteristics = 0; // Reserved - iddMajorVersion = 0x0100; // VersionMajor should be 0x0100 - iddMinorVersion = 0x504d; // VersionMinor should be 0x504d - iddType = 2; // IMAGE_DEBUG_TYPE_CODEVIEW - iddTimestamp = timestamp; - iddData = iddCvBuffer; // Path name to the pdb file when built - iddChunk = cvChunk; + { iddCharacteristics = 0 // Reserved + iddMajorVersion = 0x0100 // VersionMajor should be 0x0100 + iddMinorVersion = 0x504d // VersionMinor should be 0x504d + iddType = 2 // IMAGE_DEBUG_TYPE_CODEVIEW + iddTimestamp = timestamp + iddData = iddCvBuffer // Path name to the pdb file when built + iddChunk = cvChunk } let pdbMagicNumber= 0x4244504dL @@ -163,19 +163,19 @@ let pdbGetPdbDebugInfo (embeddedPDBChunk:BinaryChunk) (uncompressedLength:int64) let (offset, size) = (offset + size, int(stream.Length)) // Uncompressed size Buffer.BlockCopy(stream.ToArray(), 0, buffer, offset, size) buffer - { iddCharacteristics = 0; // Reserved - iddMajorVersion = 0; // VersionMajor should be 0 - iddMinorVersion = 0x0100; // VersionMinor should be 0x0100 - iddType = 17; // IMAGE_DEBUG_TYPE_EMBEDDEDPDB - iddTimestamp = 0; - iddData = iddPdbBuffer; // Path name to the pdb file when built - iddChunk = embeddedPDBChunk; + { iddCharacteristics = 0 // Reserved + iddMajorVersion = 0 // VersionMajor should be 0 + iddMinorVersion = 0x0100 // VersionMinor should be 0x0100 + iddType = 17 // IMAGE_DEBUG_TYPE_EMBEDDEDPDB + iddTimestamp = 0 + iddData = iddPdbBuffer // Path name to the pdb file when built + iddChunk = embeddedPDBChunk } let pdbGetDebugInfo (mvid:byte[]) (timestamp:int32) (filepath:string) (cvChunk:BinaryChunk) (embeddedPDBChunk:BinaryChunk option) (uncompressedLength:int64) (stream:MemoryStream option) = match stream, embeddedPDBChunk with | None, _ | _, None -> [| pdbGetCvDebugInfo mvid timestamp filepath cvChunk |] - | Some s, Some chunk -> [| pdbGetCvDebugInfo mvid timestamp filepath cvChunk; pdbGetPdbDebugInfo chunk uncompressedLength s; |] + | Some s, Some chunk -> [| pdbGetCvDebugInfo mvid timestamp filepath cvChunk; pdbGetPdbDebugInfo chunk uncompressedLength s |] // Document checksum algorithms let guidSourceHashMD5 = System.Guid(0x406ea660u, 0x64cfus, 0x4c82us, 0xb6uy, 0xf0uy, 0x42uy, 0xd4uy, 0x81uy, 0x72uy, 0xa7uy, 0x99uy) //406ea660-64cf-4c82-b6f0-42d48172a799 @@ -579,14 +579,14 @@ let writePdbInfo showTimes f fpdb info cvChunk = let res = pdbWriteDebugInfo !pdbw for pdbDoc in docs do pdbCloseDocument pdbDoc - pdbClose !pdbw f fpdb; + pdbClose !pdbw f fpdb reportTime showTimes "PDB: Closed" - [| { iddCharacteristics = res.iddCharacteristics; - iddMajorVersion = res.iddMajorVersion; - iddMinorVersion = res.iddMinorVersion; - iddType = res.iddType; - iddTimestamp = info.Timestamp; + [| { iddCharacteristics = res.iddCharacteristics + iddMajorVersion = res.iddMajorVersion + iddMinorVersion = res.iddMinorVersion + iddType = res.iddType + iddTimestamp = info.Timestamp iddData = res.iddData iddChunk = cvChunk } |] #endif diff --git a/src/buildfromsource/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.fsproj b/src/buildfromsource/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.fsproj index 74fd6fa0fccd14e99b375cc8560c2fdbeb397691..492b91aa34bde80b619cb9cfd09de30a20058023 100644 --- a/src/buildfromsource/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.fsproj +++ b/src/buildfromsource/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.fsproj @@ -4,7 +4,7 @@ Library - netstandard1.6 + netstandard2.0 FSharp.Compiler.Interactive.Settings $(NoWarn);45;55;62;75;1182;1204 true diff --git a/src/buildfromsource/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj b/src/buildfromsource/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj index bd976bb12ca1298ac783089af7fc0ff0abb00cbf..6be5ea1e37d654221950035999ed14589a72769b 100644 --- a/src/buildfromsource/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj +++ b/src/buildfromsource/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj @@ -4,7 +4,7 @@ Library - netstandard1.6 + netstandard2.0 FSharp.Compiler.Private $(NoWarn);45;55;62;75;1204 true diff --git a/src/fsharp/AugmentWithHashCompare.fs b/src/fsharp/AugmentWithHashCompare.fs index ed1b6f0cf0951467ae4dacaedba0cfb4a742bc01..c892035d841ac4f44508289f6284949b95bda3ca 100644 --- a/src/fsharp/AugmentWithHashCompare.fs +++ b/src/fsharp/AugmentWithHashCompare.fs @@ -14,28 +14,28 @@ open FSharp.Compiler.TcGlobals open FSharp.Compiler.Infos let mkIComparableCompareToSlotSig (g: TcGlobals) = - TSlotSig("CompareTo",g.mk_IComparable_ty, [],[], [[TSlotParam(Some("obj"),g.obj_ty,false,false,false,[])]],Some g.int_ty) + TSlotSig("CompareTo", g.mk_IComparable_ty, [], [], [[TSlotParam(Some("obj"), g.obj_ty, false, false, false, [])]], Some g.int_ty) let mkGenericIComparableCompareToSlotSig (g: TcGlobals) ty = - TSlotSig("CompareTo",(mkAppTy g.system_GenericIComparable_tcref [ty]),[],[], [[TSlotParam(Some("obj"),ty,false,false,false,[])]],Some g.int_ty) + TSlotSig("CompareTo", (mkAppTy g.system_GenericIComparable_tcref [ty]), [], [], [[TSlotParam(Some("obj"), ty, false, false, false, [])]], Some g.int_ty) let mkIStructuralComparableCompareToSlotSig (g: TcGlobals) = - TSlotSig("CompareTo",g.mk_IStructuralComparable_ty,[],[],[[TSlotParam(None,(mkRefTupledTy g [g.obj_ty ; g.IComparer_ty]),false,false,false,[])]], Some g.int_ty) + TSlotSig("CompareTo", g.mk_IStructuralComparable_ty, [], [], [[TSlotParam(None, (mkRefTupledTy g [g.obj_ty ; g.IComparer_ty]), false, false, false, [])]], Some g.int_ty) let mkGenericIEquatableEqualsSlotSig (g: TcGlobals) ty = - TSlotSig("Equals",(mkAppTy g.system_GenericIEquatable_tcref [ty]),[],[], [[TSlotParam(Some("obj"),ty,false,false,false,[])]],Some g.bool_ty) + TSlotSig("Equals", (mkAppTy g.system_GenericIEquatable_tcref [ty]), [], [], [[TSlotParam(Some("obj"), ty, false, false, false, [])]], Some g.bool_ty) let mkIStructuralEquatableEqualsSlotSig (g: TcGlobals) = - TSlotSig("Equals",g.mk_IStructuralEquatable_ty,[],[],[[TSlotParam(None,(mkRefTupledTy g [g.obj_ty ; g.IEqualityComparer_ty]),false,false,false,[])]], Some g.bool_ty) + TSlotSig("Equals", g.mk_IStructuralEquatable_ty, [], [], [[TSlotParam(None, (mkRefTupledTy g [g.obj_ty ; g.IEqualityComparer_ty]), false, false, false, [])]], Some g.bool_ty) let mkIStructuralEquatableGetHashCodeSlotSig (g: TcGlobals) = - TSlotSig("GetHashCode",g.mk_IStructuralEquatable_ty,[],[],[[TSlotParam(None,g.IEqualityComparer_ty,false,false,false,[])]], Some g.int_ty) + TSlotSig("GetHashCode", g.mk_IStructuralEquatable_ty, [], [], [[TSlotParam(None, g.IEqualityComparer_ty, false, false, false, [])]], Some g.int_ty) let mkGetHashCodeSlotSig (g: TcGlobals) = - TSlotSig("GetHashCode", g.obj_ty, [],[], [[]],Some g.int_ty) + TSlotSig("GetHashCode", g.obj_ty, [], [], [[]], Some g.int_ty) let mkEqualsSlotSig (g: TcGlobals) = - TSlotSig("Equals", g.obj_ty, [],[], [[TSlotParam(Some("obj"),g.obj_ty,false,false,false,[])]],Some g.bool_ty) + TSlotSig("Equals", g.obj_ty, [], [], [[TSlotParam(Some("obj"), g.obj_ty, false, false, false, [])]], Some g.bool_ty) //------------------------------------------------------------------------- // Helpers associated with code-generation of comparison/hash augmentations @@ -63,7 +63,7 @@ let mkHashWithComparerTy g ty = (mkThisTy g ty) --> (g.IEqualityComparer_ty --> // Polymorphic comparison //------------------------------------------------------------------------- -let mkRelBinOp (g: TcGlobals) op m e1 e2 = mkAsmExpr ([ op ],[], [e1; e2],[g.bool_ty],m) +let mkRelBinOp (g: TcGlobals) op m e1 e2 = mkAsmExpr ([ op ], [], [e1; e2], [g.bool_ty], m) let mkClt g m e1 e2 = mkRelBinOp g IL.AI_clt m e1 e2 @@ -80,21 +80,21 @@ let mkILLangPrimTy (g: TcGlobals) = mkILNonGenericBoxedTy g.tcref_LanguagePrimit let mkILCallGetComparer (g: TcGlobals) m = let ty = mkILNonGenericBoxedTy g.tcref_System_Collections_IComparer.CompiledRepresentationForNamedType - let mspec = mkILNonGenericStaticMethSpecInTy (mkILLangPrimTy g, "get_GenericComparer",[],ty) + let mspec = mkILNonGenericStaticMethSpecInTy (mkILLangPrimTy g, "get_GenericComparer", [], ty) mkAsmExpr([IL.mkNormalCall mspec], [], [], [g.IComparer_ty], m) let mkILCallGetEqualityComparer (g: TcGlobals) m = let ty = mkILNonGenericBoxedTy g.tcref_System_Collections_IEqualityComparer.CompiledRepresentationForNamedType - let mspec = mkILNonGenericStaticMethSpecInTy (mkILLangPrimTy g,"get_GenericEqualityComparer",[],ty) + let mspec = mkILNonGenericStaticMethSpecInTy (mkILLangPrimTy g, "get_GenericEqualityComparer", [], ty) mkAsmExpr([IL.mkNormalCall mspec], [], [], [g.IEqualityComparer_ty], m) let mkThisVar g m ty = mkCompGenLocal m "this" (mkThisTy g ty) -let mkShl g m acce n = mkAsmExpr([ IL.AI_shl ],[],[acce; mkInt g m n],[g.int_ty],m) +let mkShl g m acce n = mkAsmExpr([ IL.AI_shl ], [], [acce; mkInt g m n], [g.int_ty], m) -let mkShr g m acce n = mkAsmExpr([ IL.AI_shr ],[],[acce; mkInt g m n],[g.int_ty],m) +let mkShr g m acce n = mkAsmExpr([ IL.AI_shr ], [], [acce; mkInt g m n], [g.int_ty], m) -let mkAdd (g: TcGlobals) m e1 e2 = mkAsmExpr([ IL.AI_add ],[],[e1;e2],[g.int_ty],m) +let mkAdd (g: TcGlobals) m e1 e2 = mkAsmExpr([ IL.AI_add ], [], [e1;e2], [g.int_ty], m) let mkAddToHashAcc g m e accv acce = mkValSet m accv (mkAdd g m (mkInt g m 0x9e3779b9) @@ -103,7 +103,7 @@ let mkAddToHashAcc g m e accv acce = let mkCombineHashGenerators g m exprs accv acce = - (acce,exprs) ||> List.fold (fun tm e -> mkCompGenSequential m (mkAddToHashAcc g m e accv acce) tm) + (acce, exprs) ||> List.fold (fun tm e -> mkCompGenSequential m (mkAddToHashAcc g m e accv acce) tm) //------------------------------------------------------------------------- // Build comparison functions for union, record and exception types. @@ -115,18 +115,18 @@ let mkThatAddrLocalIfNeeded g m tcve ty = if isStructTy g ty then let thataddrv, thataddre = mkCompGenLocal m "obj" (mkThisTy g ty) Some thataddrv, thataddre - else None,tcve + else None, tcve let mkThisVarThatVar g m ty = - let thisv,thise = mkThisVar g m ty - let thataddrv,thataddre = mkThatAddrLocal g m ty - thisv,thataddrv,thise,thataddre + let thisv, thise = mkThisVar g m ty + let thataddrv, thataddre = mkThatAddrLocal g m ty + thisv, thataddrv, thise, thataddre let mkThatVarBind g m ty thataddrv expr = if isStructTy g ty then - let thatv2,_ = mkMutableCompGenLocal m "obj" ty - thatv2,mkCompGenLet m thataddrv (mkValAddr m false (mkLocalValRef thatv2)) expr - else thataddrv,expr + let thatv2, _ = mkMutableCompGenLocal m "obj" ty + thatv2, mkCompGenLet m thataddrv (mkValAddr m false (mkLocalValRef thatv2)) expr + else thataddrv, expr let mkBindThatAddr g m ty thataddrv thatv thate expr = if isStructTy g ty then @@ -152,9 +152,9 @@ let mkCompareTestConjuncts g m exprs = | [] -> mkZero g m | [h] -> h | l -> - let a,b = List.frontAndBack l - (a,b) ||> List.foldBack (fun e acc -> - let nv,ne = mkCompGenLocal m "n" g.int_ty + let a, b = List.frontAndBack l + (a, b) ||> List.foldBack (fun e acc -> + let nv, ne = mkCompGenLocal m "n" g.int_ty mkCompGenLet m nv e (mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.int_ty (mkClt g m ne (mkZero g m)) @@ -169,7 +169,7 @@ let mkEqualsTestConjuncts g m exprs = | [] -> mkOne g m | [h] -> h | l -> - let a,b = List.frontAndBack l + let a, b = List.frontAndBack l List.foldBack (fun e acc -> mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.bool_ty e acc (mkFalse g m)) a b let mkMinimalTy (g: TcGlobals) (tcref:TyconRef) = @@ -199,8 +199,8 @@ let mkBindNullHash g m thise expr = let mkRecdCompare g tcref (tycon:Tycon) = let m = tycon.Range let fields = tycon.AllInstanceFieldsAsList - let tinst,ty = mkMinimalTy g tcref - let thisv,thataddrv,thise,thataddre = mkThisVarThatVar g m ty + let tinst, ty = mkMinimalTy g tcref + let thisv, thataddrv, thise, thataddre = mkThisVarThatVar g m ty let compe = mkILCallGetComparer g m let mkTest (fspec:RecdField) = let fty = fspec.FormalType @@ -214,17 +214,17 @@ let mkRecdCompare g tcref (tycon:Tycon) = let expr = if tycon.IsStructOrEnumTycon then expr else mkBindNullComparison g m thise thataddre expr - let thatv,expr = mkThatVarBind g m ty thataddrv expr - thisv,thatv, expr + let thatv, expr = mkThatVarBind g m ty thataddrv expr + thisv, thatv, expr /// Build the comparison implementation for a record type when parameterized by a comparer -let mkRecdCompareWithComparer g tcref (tycon:Tycon) (_thisv,thise) (_,thate) compe = +let mkRecdCompareWithComparer g tcref (tycon:Tycon) (_thisv, thise) (_, thate) compe = let m = tycon.Range let fields = tycon.AllInstanceFieldsAsList - let tinst,ty = mkMinimalTy g tcref - let tcv,tce = mkCompGenLocal m "objTemp" ty // let tcv = thate - let thataddrv,thataddre = mkThatAddrLocal g m ty // let thataddrv = &tcv, if a struct + let tinst, ty = mkMinimalTy g tcref + let tcv, tce = mkCompGenLocal m "objTemp" ty // let tcv = thate + let thataddrv, thataddre = mkThatAddrLocal g m ty // let thataddrv = &tcv, if a struct let mkTest (fspec:RecdField) = let fty = fspec.FormalType @@ -248,8 +248,8 @@ let mkRecdCompareWithComparer g tcref (tycon:Tycon) (_thisv,thise) (_,thate) com let mkRecdEquality g tcref (tycon:Tycon) = let m = tycon.Range let fields = tycon.AllInstanceFieldsAsList - let tinst,ty = mkMinimalTy g tcref - let thisv,thataddrv,thise,thataddre = mkThisVarThatVar g m ty + let tinst, ty = mkMinimalTy g tcref + let thisv, thataddrv, thise, thataddre = mkThisVarThatVar g m ty let mkTest (fspec:RecdField) = let fty = fspec.FormalType let fref = tcref.MakeNestedRecdFieldRef fspec @@ -261,15 +261,15 @@ let mkRecdEquality g tcref (tycon:Tycon) = let expr = if tycon.IsStructOrEnumTycon then expr else mkBindThatNullEquals g m thise thataddre expr - let thatv,expr = mkThatVarBind g m ty thataddrv expr - thisv,thatv,expr + let thatv, expr = mkThatVarBind g m ty thataddrv expr + thisv, thatv, expr /// Build the equality implementation for a record type when parameterized by a comparer -let mkRecdEqualityWithComparer g tcref (tycon:Tycon) (_thisv,thise) thatobje (thatv,thate) compe = +let mkRecdEqualityWithComparer g tcref (tycon:Tycon) (_thisv, thise) thatobje (thatv, thate) compe = let m = tycon.Range let fields = tycon.AllInstanceFieldsAsList - let tinst,ty = mkMinimalTy g tcref - let thataddrv,thataddre = mkThatAddrLocal g m ty + let tinst, ty = mkMinimalTy g tcref + let thataddrv, thataddre = mkThatAddrLocal g m ty let mkTest (fspec:RecdField) = let fty = fspec.FormalType @@ -292,8 +292,8 @@ let mkRecdEqualityWithComparer g tcref (tycon:Tycon) (_thisv,thise) thatobje (th /// Build the equality implementation for an exception definition let mkExnEquality (g: TcGlobals) exnref (exnc:Tycon) = let m = exnc.Range - let thatv,thate = mkCompGenLocal m "obj" g.exn_ty - let thisv,thise = mkThisVar g m g.exn_ty + let thatv, thate = mkCompGenLocal m "obj" g.exn_ty + let thisv, thise = mkThisVar g m g.exn_ty let mkTest i (rfield:RecdField) = let fty = rfield.FormalType mkCallGenericEqualityEROuter g m fty @@ -301,22 +301,22 @@ let mkExnEquality (g: TcGlobals) exnref (exnc:Tycon) = (mkExnCaseFieldGet(thate, exnref, i, m)) let expr = mkEqualsTestConjuncts g m (List.mapi mkTest (exnc.AllInstanceFieldsAsList)) let expr = - let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) + let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding, m ) let cases = - [ mkCase(DecisionTreeTest.IsInst(g.exn_ty,mkAppTy exnref []), - mbuilder.AddResultTarget(expr,SuppressSequencePointAtTarget)) ] - let dflt = Some(mbuilder.AddResultTarget(mkFalse g m,SuppressSequencePointAtTarget)) - let dtree = TDSwitch(thate,cases,dflt,m) - mbuilder.Close(dtree,m,g.bool_ty) + [ mkCase(DecisionTreeTest.IsInst(g.exn_ty, mkAppTy exnref []), + mbuilder.AddResultTarget(expr, SuppressSequencePointAtTarget)) ] + let dflt = Some(mbuilder.AddResultTarget(mkFalse g m, SuppressSequencePointAtTarget)) + let dtree = TDSwitch(thate, cases, dflt, m) + mbuilder.Close(dtree, m, g.bool_ty) let expr = mkBindThatNullEquals g m thise thate expr - thisv,thatv, expr + thisv, thatv, expr /// Build the equality implementation for an exception definition when parameterized by a comparer -let mkExnEqualityWithComparer g exnref (exnc:Tycon) (_thisv,thise) thatobje (thatv,thate) compe = +let mkExnEqualityWithComparer g exnref (exnc:Tycon) (_thisv, thise) thatobje (thatv, thate) compe = let m = exnc.Range - let thataddrv,thataddre = mkThatAddrLocal g m g.exn_ty + let thataddrv, thataddre = mkThatAddrLocal g m g.exn_ty let mkTest i (rfield:RecdField) = let fty = rfield.FormalType mkCallGenericEqualityWithComparerOuter g m fty @@ -325,13 +325,13 @@ let mkExnEqualityWithComparer g exnref (exnc:Tycon) (_thisv,thise) thatobje (tha (mkExnCaseFieldGet(thataddre, exnref, i, m)) let expr = mkEqualsTestConjuncts g m (List.mapi mkTest (exnc.AllInstanceFieldsAsList)) let expr = - let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) + let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding, m ) let cases = - [ mkCase(DecisionTreeTest.IsInst(g.exn_ty,mkAppTy exnref []), - mbuilder.AddResultTarget(expr,SuppressSequencePointAtTarget)) ] - let dflt = mbuilder.AddResultTarget(mkFalse g m,SuppressSequencePointAtTarget) - let dtree = TDSwitch(thate,cases,Some dflt,m) - mbuilder.Close(dtree,m,g.bool_ty) + [ mkCase(DecisionTreeTest.IsInst(g.exn_ty, mkAppTy exnref []), + mbuilder.AddResultTarget(expr, SuppressSequencePointAtTarget)) ] + let dflt = mbuilder.AddResultTarget(mkFalse g m, SuppressSequencePointAtTarget) + let dtree = TDSwitch(thate, cases, Some dflt, m) + mbuilder.Close(dtree, m, g.bool_ty) let expr = mkBindThatAddr g m g.exn_ty thataddrv thatv thate expr let expr = mkIsInstConditional g m g.exn_ty thatobje thatv expr (mkFalse g m) let expr = if exnc.IsStructOrEnumTycon then expr else mkBindThisNullEquals g m thise thatobje expr @@ -341,14 +341,14 @@ let mkExnEqualityWithComparer g exnref (exnc:Tycon) (_thisv,thise) thatobje (tha let mkUnionCompare g tcref (tycon:Tycon) = let m = tycon.Range let ucases = tycon.UnionCasesAsList - let tinst,ty = mkMinimalTy g tcref - let thisv,thataddrv,thise,thataddre = mkThisVarThatVar g m ty - let thistagv,thistage = mkCompGenLocal m "thisTag" g.int_ty - let thattagv,thattage = mkCompGenLocal m "thatTag" g.int_ty + let tinst, ty = mkMinimalTy g tcref + let thisv, thataddrv, thise, thataddre = mkThisVarThatVar g m ty + let thistagv, thistage = mkCompGenLocal m "thisTag" g.int_ty + let thattagv, thattage = mkCompGenLocal m "thatTag" g.int_ty let compe = mkILCallGetComparer g m let expr = - let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) + let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding, m ) let mkCase ucase = let cref = tcref.MakeNestedUnionCaseRef ucase let m = cref.Range @@ -363,19 +363,19 @@ let mkUnionCompare g tcref (tycon:Tycon) = if cref.Tycon.IsStructOrEnumTycon then mkCompareTestConjuncts g m (List.mapi (mkTest thise thataddre) rfields) else - let thisucv,thisucve = mkCompGenLocal m "thisCast" (mkProvenUnionCaseTy cref tinst) - let thatucv,thatucve = mkCompGenLocal m "objCast" (mkProvenUnionCaseTy cref tinst) - mkCompGenLet m thisucv (mkUnionCaseProof (thise,cref,tinst,m)) - (mkCompGenLet m thatucv (mkUnionCaseProof (thataddre,cref,tinst,m)) + let thisucv, thisucve = mkCompGenLocal m "thisCast" (mkProvenUnionCaseTy cref tinst) + let thatucv, thatucve = mkCompGenLocal m "objCast" (mkProvenUnionCaseTy cref tinst) + mkCompGenLet m thisucv (mkUnionCaseProof (thise, cref, tinst, m)) + (mkCompGenLet m thatucv (mkUnionCaseProof (thataddre, cref, tinst, m)) (mkCompareTestConjuncts g m (List.mapi (mkTest thisucve thatucve) rfields))) - Some (mkCase(DecisionTreeTest.UnionCase(cref,tinst),mbuilder.AddResultTarget(test,SuppressSequencePointAtTarget))) + Some (mkCase(DecisionTreeTest.UnionCase(cref, tinst), mbuilder.AddResultTarget(test, SuppressSequencePointAtTarget))) - let nullary,nonNullary = List.partition Option.isNone (List.map mkCase ucases) + let nullary, nonNullary = List.partition Option.isNone (List.map mkCase ucases) if isNil nonNullary then mkZero g m else let cases = nonNullary |> List.map (function (Some c) -> c | None -> failwith "mkUnionCompare") - let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkZero g m,SuppressSequencePointAtTarget)) - let dtree = TDSwitch(thise, cases, dflt,m) - mbuilder.Close(dtree,m,g.int_ty) + let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkZero g m, SuppressSequencePointAtTarget)) + let dtree = TDSwitch(thise, cases, dflt, m) + mbuilder.Close(dtree, m, g.int_ty) let expr = if ucases.Length = 1 then expr else @@ -383,30 +383,30 @@ let mkUnionCompare g tcref (tycon:Tycon) = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.int_ty (mkILAsmCeq g m thistage thattage) expr - (mkAsmExpr ([ IL.AI_sub ],[], [thistage; thattage],[g.int_ty],m))in + (mkAsmExpr ([ IL.AI_sub ], [], [thistage; thattage], [g.int_ty], m))in mkCompGenLet m thistagv - (mkUnionCaseTagGetViaExprAddr (thise,tcref,tinst,m)) + (mkUnionCaseTagGetViaExprAddr (thise, tcref, tinst, m)) (mkCompGenLet m thattagv - (mkUnionCaseTagGetViaExprAddr (thataddre,tcref,tinst,m)) + (mkUnionCaseTagGetViaExprAddr (thataddre, tcref, tinst, m)) tagsEqTested) let expr = if tycon.IsStructOrEnumTycon then expr else mkBindNullComparison g m thise thataddre expr - let thatv,expr = mkThatVarBind g m ty thataddrv expr - thisv,thatv, expr + let thatv, expr = mkThatVarBind g m ty thataddrv expr + thisv, thatv, expr /// Build the comparison implementation for a union type when parameterized by a comparer -let mkUnionCompareWithComparer g tcref (tycon:Tycon) (_thisv,thise) (_thatobjv,thatcaste) compe = +let mkUnionCompareWithComparer g tcref (tycon:Tycon) (_thisv, thise) (_thatobjv, thatcaste) compe = let m = tycon.Range let ucases = tycon.UnionCasesAsList - let tinst,ty = mkMinimalTy g tcref - let tcv,tce = mkCompGenLocal m "objTemp" ty // let tcv = (thatobj :?> ty) - let thataddrvOpt,thataddre = mkThatAddrLocalIfNeeded g m tce ty // let thataddrv = &tcv if struct, otherwise thataddre is just tce - let thistagv,thistage = mkCompGenLocal m "thisTag" g.int_ty - let thattagv,thattage = mkCompGenLocal m "thatTag" g.int_ty + let tinst, ty = mkMinimalTy g tcref + let tcv, tce = mkCompGenLocal m "objTemp" ty // let tcv = (thatobj :?> ty) + let thataddrvOpt, thataddre = mkThatAddrLocalIfNeeded g m tce ty // let thataddrv = &tcv if struct, otherwise thataddre is just tce + let thistagv, thistage = mkCompGenLocal m "thisTag" g.int_ty + let thattagv, thattage = mkCompGenLocal m "thatTag" g.int_ty let expr = - let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) + let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding, m ) let mkCase ucase = let cref = tcref.MakeNestedUnionCaseRef ucase let m = cref.Range @@ -423,20 +423,20 @@ let mkUnionCompareWithComparer g tcref (tycon:Tycon) (_thisv,thise) (_thatobjv,t if cref.Tycon.IsStructOrEnumTycon then mkCompareTestConjuncts g m (List.mapi (mkTest thise thataddre) rfields) else - let thisucv,thisucve = mkCompGenLocal m "thisCastu" (mkProvenUnionCaseTy cref tinst) - let thatucv,thatucve = mkCompGenLocal m "thatCastu" (mkProvenUnionCaseTy cref tinst) - mkCompGenLet m thisucv (mkUnionCaseProof (thise,cref,tinst,m)) - (mkCompGenLet m thatucv (mkUnionCaseProof (thataddre,cref,tinst,m)) + let thisucv, thisucve = mkCompGenLocal m "thisCastu" (mkProvenUnionCaseTy cref tinst) + let thatucv, thatucve = mkCompGenLocal m "thatCastu" (mkProvenUnionCaseTy cref tinst) + mkCompGenLet m thisucv (mkUnionCaseProof (thise, cref, tinst, m)) + (mkCompGenLet m thatucv (mkUnionCaseProof (thataddre, cref, tinst, m)) (mkCompareTestConjuncts g m (List.mapi (mkTest thisucve thatucve) rfields))) - Some (mkCase(DecisionTreeTest.UnionCase(cref,tinst),mbuilder.AddResultTarget(test,SuppressSequencePointAtTarget))) + Some (mkCase(DecisionTreeTest.UnionCase(cref, tinst), mbuilder.AddResultTarget(test, SuppressSequencePointAtTarget))) - let nullary,nonNullary = List.partition Option.isNone (List.map mkCase ucases) + let nullary, nonNullary = List.partition Option.isNone (List.map mkCase ucases) if isNil nonNullary then mkZero g m else let cases = nonNullary |> List.map (function (Some c) -> c | None -> failwith "mkUnionCompare") - let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkZero g m,SuppressSequencePointAtTarget)) - let dtree = TDSwitch(thise, cases, dflt,m) - mbuilder.Close(dtree,m,g.int_ty) + let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkZero g m, SuppressSequencePointAtTarget)) + let dtree = TDSwitch(thise, cases, dflt, m) + mbuilder.Close(dtree, m, g.int_ty) let expr = if ucases.Length = 1 then expr else @@ -444,11 +444,11 @@ let mkUnionCompareWithComparer g tcref (tycon:Tycon) (_thisv,thise) (_thatobjv,t mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.int_ty (mkILAsmCeq g m thistage thattage) expr - (mkAsmExpr ([ IL.AI_sub ],[], [thistage; thattage],[g.int_ty],m)) + (mkAsmExpr ([ IL.AI_sub ], [], [thistage; thattage], [g.int_ty], m)) mkCompGenLet m thistagv - (mkUnionCaseTagGetViaExprAddr (thise,tcref,tinst,m)) + (mkUnionCaseTagGetViaExprAddr (thise, tcref, tinst, m)) (mkCompGenLet m thattagv - (mkUnionCaseTagGetViaExprAddr (thataddre,tcref,tinst,m)) + (mkUnionCaseTagGetViaExprAddr (thataddre, tcref, tinst, m)) tagsEqTested) let expr = if tycon.IsStructOrEnumTycon then expr else mkBindNullComparison g m thise thatcaste expr @@ -461,13 +461,13 @@ let mkUnionCompareWithComparer g tcref (tycon:Tycon) (_thisv,thise) (_thatobjv,t let mkUnionEquality g tcref (tycon:Tycon) = let m = tycon.Range let ucases = tycon.UnionCasesAsList - let tinst,ty = mkMinimalTy g tcref - let thisv,thataddrv,thise,thataddre = mkThisVarThatVar g m ty - let thistagv,thistage = mkCompGenLocal m "thisTag" g.int_ty - let thattagv,thattage = mkCompGenLocal m "thatTag" g.int_ty + let tinst, ty = mkMinimalTy g tcref + let thisv, thataddrv, thise, thataddre = mkThisVarThatVar g m ty + let thistagv, thistage = mkCompGenLocal m "thisTag" g.int_ty + let thattagv, thattage = mkCompGenLocal m "thatTag" g.int_ty let expr = - let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) + let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding, m ) let mkCase ucase = let cref = tcref.MakeNestedUnionCaseRef ucase let m = cref.Range @@ -483,20 +483,20 @@ let mkUnionEquality g tcref (tycon:Tycon) = if cref.Tycon.IsStructOrEnumTycon then mkEqualsTestConjuncts g m (List.mapi (mkTest thise thataddre) rfields) else - let thisucv,thisucve = mkCompGenLocal m "thisCast" (mkProvenUnionCaseTy cref tinst) - let thatucv,thatucve = mkCompGenLocal m "objCast" (mkProvenUnionCaseTy cref tinst) - mkCompGenLet m thisucv (mkUnionCaseProof (thise,cref,tinst,m)) - (mkCompGenLet m thatucv (mkUnionCaseProof (thataddre,cref,tinst,m)) + let thisucv, thisucve = mkCompGenLocal m "thisCast" (mkProvenUnionCaseTy cref tinst) + let thatucv, thatucve = mkCompGenLocal m "objCast" (mkProvenUnionCaseTy cref tinst) + mkCompGenLet m thisucv (mkUnionCaseProof (thise, cref, tinst, m)) + (mkCompGenLet m thatucv (mkUnionCaseProof (thataddre, cref, tinst, m)) (mkEqualsTestConjuncts g m (List.mapi (mkTest thisucve thatucve) rfields))) - Some (mkCase(DecisionTreeTest.UnionCase(cref,tinst), mbuilder.AddResultTarget(test, SuppressSequencePointAtTarget))) + Some (mkCase(DecisionTreeTest.UnionCase(cref, tinst), mbuilder.AddResultTarget(test, SuppressSequencePointAtTarget))) - let nullary,nonNullary = List.partition Option.isNone (List.map mkCase ucases) + let nullary, nonNullary = List.partition Option.isNone (List.map mkCase ucases) if isNil nonNullary then mkTrue g m else let cases = List.map (function (Some c) -> c | None -> failwith "mkUnionEquality") nonNullary - let dflt = (if isNil nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m,SuppressSequencePointAtTarget))) + let dflt = (if isNil nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m, SuppressSequencePointAtTarget))) let dtree = TDSwitch(thise, cases, dflt, m) - mbuilder.Close(dtree,m,g.bool_ty) + mbuilder.Close(dtree, m, g.bool_ty) let expr = if ucases.Length = 1 then expr else @@ -507,26 +507,26 @@ let mkUnionEquality g tcref (tycon:Tycon) = (mkFalse g m) mkCompGenLet m thistagv - (mkUnionCaseTagGetViaExprAddr (thise,tcref,tinst,m)) + (mkUnionCaseTagGetViaExprAddr (thise, tcref, tinst, m)) (mkCompGenLet m thattagv - (mkUnionCaseTagGetViaExprAddr (thataddre,tcref,tinst,m)) + (mkUnionCaseTagGetViaExprAddr (thataddre, tcref, tinst, m)) tagsEqTested) - let thatv,expr = mkThatVarBind g m ty thataddrv expr + let thatv, expr = mkThatVarBind g m ty thataddrv expr let expr = if tycon.IsStructOrEnumTycon then expr else mkBindThatNullEquals g m thise thataddre expr - thisv,thatv,expr + thisv, thatv, expr /// Build the equality implementation for a union type when parameterized by a comparer -let mkUnionEqualityWithComparer g tcref (tycon:Tycon) (_thisv,thise) thatobje (thatv,thate) compe = +let mkUnionEqualityWithComparer g tcref (tycon:Tycon) (_thisv, thise) thatobje (thatv, thate) compe = let m = tycon.Range let ucases = tycon.UnionCasesAsList - let tinst,ty = mkMinimalTy g tcref - let thistagv,thistage = mkCompGenLocal m "thisTag" g.int_ty - let thattagv,thattage = mkCompGenLocal m "thatTag" g.int_ty - let thataddrv,thataddre = mkThatAddrLocal g m ty + let tinst, ty = mkMinimalTy g tcref + let thistagv, thistage = mkCompGenLocal m "thisTag" g.int_ty + let thattagv, thattage = mkCompGenLocal m "thatTag" g.int_ty + let thataddrv, thataddre = mkThatAddrLocal g m ty let expr = - let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) + let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding, m ) let mkCase ucase = let cref = tcref.MakeNestedUnionCaseRef ucase let m = cref.Range @@ -544,21 +544,21 @@ let mkUnionEqualityWithComparer g tcref (tycon:Tycon) (_thisv,thise) thatobje (t if cref.Tycon.IsStructOrEnumTycon then mkEqualsTestConjuncts g m (List.mapi (mkTest thise thataddre) rfields) else - let thisucv,thisucve = mkCompGenLocal m "thisCastu" (mkProvenUnionCaseTy cref tinst) - let thatucv,thatucve = mkCompGenLocal m "thatCastu" (mkProvenUnionCaseTy cref tinst) + let thisucv, thisucve = mkCompGenLocal m "thisCastu" (mkProvenUnionCaseTy cref tinst) + let thatucv, thatucve = mkCompGenLocal m "thatCastu" (mkProvenUnionCaseTy cref tinst) - mkCompGenLet m thisucv (mkUnionCaseProof (thise,cref,tinst,m)) - (mkCompGenLet m thatucv (mkUnionCaseProof (thataddre,cref,tinst,m)) + mkCompGenLet m thisucv (mkUnionCaseProof (thise, cref, tinst, m)) + (mkCompGenLet m thatucv (mkUnionCaseProof (thataddre, cref, tinst, m)) (mkEqualsTestConjuncts g m (List.mapi (mkTest thisucve thatucve) rfields))) - Some (mkCase(DecisionTreeTest.UnionCase(cref,tinst), mbuilder.AddResultTarget (test, SuppressSequencePointAtTarget))) + Some (mkCase(DecisionTreeTest.UnionCase(cref, tinst), mbuilder.AddResultTarget (test, SuppressSequencePointAtTarget))) - let nullary,nonNullary = List.partition Option.isNone (List.map mkCase ucases) + let nullary, nonNullary = List.partition Option.isNone (List.map mkCase ucases) if isNil nonNullary then mkTrue g m else let cases = List.map (function (Some c) -> c | None -> failwith "mkUnionEquality") nonNullary - let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m,SuppressSequencePointAtTarget)) + let dflt = if isNil nullary then None else Some (mbuilder.AddResultTarget(mkTrue g m, SuppressSequencePointAtTarget)) let dtree = TDSwitch(thise, cases, dflt, m) - mbuilder.Close(dtree,m,g.bool_ty) + mbuilder.Close(dtree, m, g.bool_ty) let expr = if ucases.Length = 1 then expr else @@ -569,9 +569,9 @@ let mkUnionEqualityWithComparer g tcref (tycon:Tycon) (_thisv,thise) thatobje (t (mkFalse g m) mkCompGenLet m thistagv - (mkUnionCaseTagGetViaExprAddr (thise,tcref,tinst,m)) + (mkUnionCaseTagGetViaExprAddr (thise, tcref, tinst, m)) (mkCompGenLet m thattagv - (mkUnionCaseTagGetViaExprAddr (thataddre,tcref,tinst,m)) + (mkUnionCaseTagGetViaExprAddr (thataddre, tcref, tinst, m)) tagsEqTested) let expr = mkBindThatAddr g m ty thataddrv thatv thate expr let expr = mkIsInstConditional g m ty thatobje thatv expr (mkFalse g m) @@ -587,8 +587,8 @@ let mkUnionEqualityWithComparer g tcref (tycon:Tycon) (_thisv,thise) thatobje (t let mkRecdHashWithComparer g tcref (tycon:Tycon) compe = let m = tycon.Range let fields = tycon.AllInstanceFieldsAsList - let tinst,ty = mkMinimalTy g tcref - let thisv,thise = mkThisVar g m ty + let tinst, ty = mkMinimalTy g tcref + let thisv, thise = mkThisVar g m ty let mkFieldHash (fspec:RecdField) = let fty = fspec.FormalType let fref = tcref.MakeNestedRecdFieldRef fspec @@ -597,16 +597,16 @@ let mkRecdHashWithComparer g tcref (tycon:Tycon) compe = mkCallGenericHashWithComparerOuter g m fty compe e - let accv,acce = mkMutableCompGenLocal m "i" g.int_ty + let accv, acce = mkMutableCompGenLocal m "i" g.int_ty let stmt = mkCombineHashGenerators g m (List.map mkFieldHash fields) (mkLocalValRef accv) acce let expr = mkCompGenLet m accv (mkZero g m) stmt let expr = if tycon.IsStructOrEnumTycon then expr else mkBindNullHash g m thise expr - thisv,expr + thisv, expr /// Structural hash implementation for exception types when parameterized by a comparer let mkExnHashWithComparer g exnref (exnc:Tycon) compe = let m = exnc.Range - let thisv,thise = mkThisVar g m g.exn_ty + let thisv, thise = mkThisVar g m g.exn_ty let mkHash i (rfield:RecdField) = let fty = rfield.FormalType @@ -614,20 +614,20 @@ let mkExnHashWithComparer g exnref (exnc:Tycon) compe = mkCallGenericHashWithComparerOuter g m fty compe e - let accv,acce = mkMutableCompGenLocal m "i" g.int_ty + let accv, acce = mkMutableCompGenLocal m "i" g.int_ty let stmt = mkCombineHashGenerators g m (List.mapi mkHash (exnc.AllInstanceFieldsAsList)) (mkLocalValRef accv) acce let expr = mkCompGenLet m accv (mkZero g m) stmt let expr = mkBindNullHash g m thise expr - thisv,expr + thisv, expr /// Structural hash implementation for union types when parameterized by a comparer let mkUnionHashWithComparer g tcref (tycon:Tycon) compe = let m = tycon.Range let ucases = tycon.UnionCasesAsList - let tinst,ty = mkMinimalTy g tcref - let thisv,thise = mkThisVar g m ty - let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) - let accv,acce = mkMutableCompGenLocal m "i" g.int_ty + let tinst, ty = mkMinimalTy g tcref + let thisv, thise = mkThisVar g m ty + let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding, m ) + let accv, acce = mkMutableCompGenLocal m "i" g.int_ty let mkCase i ucase1 = let c1ref = tcref.MakeNestedUnionCaseRef ucase1 let m = c1ref.Range @@ -644,33 +644,33 @@ let mkUnionHashWithComparer g tcref (tycon:Tycon) compe = (mkValSet m (mkLocalValRef accv) (mkInt g m i)) (mkCombineHashGenerators g m (List.mapi (mkHash thise) ucase1.RecdFields) (mkLocalValRef accv) acce) else - let ucv,ucve = mkCompGenLocal m "unionCase" (mkProvenUnionCaseTy c1ref tinst) + let ucv, ucve = mkCompGenLocal m "unionCase" (mkProvenUnionCaseTy c1ref tinst) mkCompGenLet m ucv - (mkUnionCaseProof (thise,c1ref,tinst,m)) + (mkUnionCaseProof (thise, c1ref, tinst, m)) (mkCompGenSequential m (mkValSet m (mkLocalValRef accv) (mkInt g m i)) (mkCombineHashGenerators g m (List.mapi (mkHash ucve) ucase1.RecdFields) (mkLocalValRef accv) acce)) - Some(mkCase(DecisionTreeTest.UnionCase(c1ref,tinst),mbuilder.AddResultTarget(test,SuppressSequencePointAtTarget))) + Some(mkCase(DecisionTreeTest.UnionCase(c1ref, tinst), mbuilder.AddResultTarget(test, SuppressSequencePointAtTarget))) - let nullary,nonNullary = ucases + let nullary, nonNullary = ucases |> List.mapi mkCase |> List.partition (fun i -> i.IsNone) let cases = nonNullary |> List.map (function (Some c) -> c | None -> failwith "mkUnionHash") let dflt = if isNil nullary then None else - let tag = mkUnionCaseTagGetViaExprAddr (thise,tcref,tinst,m) - Some(mbuilder.AddResultTarget(tag,SuppressSequencePointAtTarget)) - let dtree = TDSwitch(thise, cases, dflt,m) - let stmt = mbuilder.Close(dtree,m,g.int_ty) + let tag = mkUnionCaseTagGetViaExprAddr (thise, tcref, tinst, m) + Some(mbuilder.AddResultTarget(tag, SuppressSequencePointAtTarget)) + let dtree = TDSwitch(thise, cases, dflt, m) + let stmt = mbuilder.Close(dtree, m, g.int_ty) let expr = mkCompGenLet m accv (mkZero g m) stmt let expr = if tycon.IsStructOrEnumTycon then expr else mkBindNullHash g m thise expr - thisv,expr + thisv, expr //------------------------------------------------------------------------- // The predicate that determines which types implement the // pre-baked IStructuralHash and IComparable semantics associated with F# -// types. Note abstract types are not _known_ to implement these interfaces, +// types. Note abstract types are not _known_ to implement these interfaces, // though the interfaces may be discoverable via type tests. //------------------------------------------------------------------------- @@ -694,14 +694,14 @@ let canBeAugmentedWithCompare g (tycon:Tycon) = isTrueFSharpStructTycon g tycon let getAugmentationAttribs g (tycon:Tycon) = - canBeAugmentedWithEquals g tycon, - canBeAugmentedWithCompare g tycon, - TryFindFSharpBoolAttribute g g.attrib_NoEqualityAttribute tycon.Attribs, - TryFindFSharpBoolAttribute g g.attrib_CustomEqualityAttribute tycon.Attribs, - TryFindFSharpBoolAttribute g g.attrib_ReferenceEqualityAttribute tycon.Attribs, - TryFindFSharpBoolAttribute g g.attrib_StructuralEqualityAttribute tycon.Attribs, - TryFindFSharpBoolAttribute g g.attrib_NoComparisonAttribute tycon.Attribs, - TryFindFSharpBoolAttribute g g.attrib_CustomComparisonAttribute tycon.Attribs, + canBeAugmentedWithEquals g tycon, + canBeAugmentedWithCompare g tycon, + TryFindFSharpBoolAttribute g g.attrib_NoEqualityAttribute tycon.Attribs, + TryFindFSharpBoolAttribute g g.attrib_CustomEqualityAttribute tycon.Attribs, + TryFindFSharpBoolAttribute g g.attrib_ReferenceEqualityAttribute tycon.Attribs, + TryFindFSharpBoolAttribute g g.attrib_StructuralEqualityAttribute tycon.Attribs, + TryFindFSharpBoolAttribute g g.attrib_NoComparisonAttribute tycon.Attribs, + TryFindFSharpBoolAttribute g g.attrib_CustomComparisonAttribute tycon.Attribs, TryFindFSharpBoolAttribute g g.attrib_StructuralComparisonAttribute tycon.Attribs let CheckAugmentationAttribs isImplementation g amap (tycon:Tycon) = @@ -712,7 +712,7 @@ let CheckAugmentationAttribs isImplementation g amap (tycon:Tycon) = // THESE ARE THE LEGITIMATE CASES // [< >] on anything - | _, _ , None , None, None , None, None , None , None + | _, _ , None , None, None , None, None , None , None // [] on union/record/struct | true, _, None, Some(true), None , None , None , Some(true), None @@ -750,7 +750,7 @@ let CheckAugmentationAttribs isImplementation g amap (tycon:Tycon) = (* THESE ARE THE ERROR CASES *) // [] - | _, _, Some(true), _, _, _, None, _, _ -> + | _, _, Some(true), _, _, _, None, _, _ -> errorR(Error(FSComp.SR.augNoEqualityNeedsNoComparison(), m)) // [] @@ -765,18 +765,18 @@ let CheckAugmentationAttribs isImplementation g amap (tycon:Tycon) = errorR(Error(FSComp.SR.augCustomEqNeedsNoCompOrCustomComp(), m)) // [] - | true, _, _, _, Some(true) , Some(true) , _, _, _ + | true, _, _, _, Some(true) , Some(true) , _, _, _ // [] - | true, _, _, _, Some(true), _, _, _, Some(true) -> + | true, _, _, _, Some(true), _, _, _, Some(true) -> errorR(Error(FSComp.SR.augTypeCantHaveRefEqAndStructAttrs(), m)) // non augmented type, [] // non augmented type, [] // non augmented type, [] - | false, _, _, _, Some(true), _ , _ , _, _ - | false, _, _, _, _ , Some(true), _ , _, _ - | false, _, _, _, _ , _ , _ , _, Some(true) -> + | false, _, _, _, Some(true), _ , _ , _, _ + | false, _, _, _, _ , Some(true), _ , _, _ + | false, _, _, _, _ , _ , _ , _, Some(true) -> errorR(Error(FSComp.SR.augOnlyCertainTypesCanHaveAttrs(), m)) // All other cases | _ -> @@ -805,7 +805,7 @@ let CheckAugmentationAttribs isImplementation g amap (tycon:Tycon) = | _, _, Some(true), _, _, _, _, _, _ when (hasExplicitEquals || hasExplicitGenericEquals) -> warning(Error(FSComp.SR.augNoEqNeedsNoObjEquals(), m)) // [] + any comparison semantics - | _, _, _, _, _, _, Some(true), _, _ when (hasExplicitICompare || hasExplicitIGenericCompare) -> + | _, _, _, _, _, _, Some(true), _, _ when (hasExplicitICompare || hasExplicitIGenericCompare) -> warning(Error(FSComp.SR.augNoCompCantImpIComp(), m)) // [] + no explicit override Object.Equals + no explicit IStructuralEquatable @@ -859,7 +859,7 @@ let TyconIsCandidateForAugmentationWithHash g tycon = TyconIsCandidateForAugment // IComparable semantics associated with F# types. //------------------------------------------------------------------------- -let slotImplMethod (final,c,slotsig) : ValMemberInfo = +let slotImplMethod (final, c, slotsig) : ValMemberInfo = { ImplementedSlotSigs=[slotsig] MemberFlags= { IsInstance=true @@ -887,7 +887,7 @@ let mkValSpec g (tcref:TyconRef) tmty vis slotsig methn ty argData = let m = tcref.Range let tps = tcref.Typars(m) let final = isUnionTy g tmty || isRecdTy g tmty || isStructTy g tmty - let membInfo = match slotsig with None -> nonVirtualMethod tcref | Some(slotsig) -> slotImplMethod(final,tcref,slotsig) + let membInfo = match slotsig with None -> nonVirtualMethod tcref | Some(slotsig) -> slotImplMethod(final, tcref, slotsig) let inl = ValInline.Optional let args = ValReprInfo.unnamedTopArg :: argData let topValInfo = Some (ValReprInfo (ValReprInfo.InferTyparInfo tps, args, ValReprInfo.unnamedRetVal)) @@ -895,7 +895,7 @@ let mkValSpec g (tcref:TyconRef) tmty vis slotsig methn ty argData = let MakeValsForCompareAugmentation g (tcref:TyconRef) = let m = tcref.Range - let _,tmty = mkMinimalTy g tcref + let _, tmty = mkMinimalTy g tcref let tps = tcref.Typars m let vis = tcref.TypeReprAccessibility @@ -904,29 +904,29 @@ let MakeValsForCompareAugmentation g (tcref:TyconRef) = let MakeValsForCompareWithComparerAugmentation g (tcref:TyconRef) = let m = tcref.Range - let _,tmty = mkMinimalTy g tcref + let _, tmty = mkMinimalTy g tcref let tps = tcref.Typars m let vis = tcref.TypeReprAccessibility mkValSpec g tcref tmty vis (Some(mkIStructuralComparableCompareToSlotSig g)) "CompareTo" (tps +-> (mkCompareWithComparerTy g tmty)) tupArg let MakeValsForEqualsAugmentation g (tcref:TyconRef) = let m = tcref.Range - let _,tmty = mkMinimalTy g tcref + let _, tmty = mkMinimalTy g tcref let vis = tcref.TypeReprAccessibility let tps = tcref.Typars m let objEqualsVal = mkValSpec g tcref tmty vis (Some(mkEqualsSlotSig g)) "Equals" (tps +-> (mkEqualsObjTy g tmty)) unaryArg let nocEqualsVal = mkValSpec g tcref tmty vis (if tcref.Deref.IsExceptionDecl then None else Some(mkGenericIEquatableEqualsSlotSig g tmty)) "Equals" (tps +-> (mkEqualsTy g tmty)) unaryArg - objEqualsVal,nocEqualsVal + objEqualsVal, nocEqualsVal let MakeValsForEqualityWithComparerAugmentation g (tcref:TyconRef) = - let _,tmty = mkMinimalTy g tcref + let _, tmty = mkMinimalTy g tcref let vis = tcref.TypeReprAccessibility let tps = tcref.Typars(tcref.Range) let objGetHashCodeVal = mkValSpec g tcref tmty vis (Some(mkGetHashCodeSlotSig g)) "GetHashCode" (tps +-> (mkHashTy g tmty)) unitArg let withcGetHashCodeVal = mkValSpec g tcref tmty vis (Some(mkIStructuralEquatableGetHashCodeSlotSig g)) "GetHashCode" (tps +-> (mkHashWithComparerTy g tmty)) unaryArg let withcEqualsVal = mkValSpec g tcref tmty vis (Some(mkIStructuralEquatableEqualsSlotSig g)) "Equals" (tps +-> (mkEqualsWithComparerTy g tmty)) tupArg - objGetHashCodeVal,withcGetHashCodeVal,withcEqualsVal + objGetHashCodeVal, withcGetHashCodeVal, withcEqualsVal let MakeBindingsForCompareAugmentation g (tycon:Tycon) = let tcref = mkLocalTyconRef tycon @@ -935,25 +935,25 @@ let MakeBindingsForCompareAugmentation g (tycon:Tycon) = let mkCompare comparef = match tycon.GeneratedCompareToValues with | None -> [] - | Some (vref1,vref2) -> + | Some (vref1, vref2) -> let vspec1 = vref1.Deref let vspec2 = vref2.Deref (* this is the body of the override *) let rhs1 = - let tinst,ty = mkMinimalTy g tcref + let tinst, ty = mkMinimalTy g tcref - let thisv,thise = mkThisVar g m ty - let thatobjv,thatobje = mkCompGenLocal m "obj" g.obj_ty + let thisv, thise = mkThisVar g m ty + let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty let comparee = if isUnitTy g ty then mkZero g m else let thate = mkCoerceExpr (thatobje, ty, m, g.obj_ty) - mkApps g ((exprForValRef m vref2,vref2.Type), (if isNil tinst then [] else [tinst]), [thise;thate], m) + mkApps g ((exprForValRef m vref2, vref2.Type), (if isNil tinst then [] else [tinst]), [thise;thate], m) - mkLambdas m tps [thisv;thatobjv] (comparee,g.int_ty) + mkLambdas m tps [thisv;thatobjv] (comparee, g.int_ty) let rhs2 = - let thisv,thatv,comparee = comparef g tcref tycon - mkLambdas m tps [thisv;thatv] (comparee,g.int_ty) + let thisv, thatv, comparee = comparef g tcref tycon + mkLambdas m tps [thisv;thatv] (comparee, g.int_ty) [ // This one must come first because it may be inlined into the second mkCompGenBind vspec2 rhs2 mkCompGenBind vspec1 rhs1; ] @@ -970,18 +970,18 @@ let MakeBindingsForCompareWithComparerAugmentation g (tycon:Tycon) = | None -> [] | Some (vref) -> let vspec = vref.Deref - let _,ty = mkMinimalTy g tcref + let _, ty = mkMinimalTy g tcref - let compv,compe = mkCompGenLocal m "comp" g.IComparer_ty + let compv, compe = mkCompGenLocal m "comp" g.IComparer_ty - let thisv,thise = mkThisVar g m ty - let thatobjv,thatobje = mkCompGenLocal m "obj" g.obj_ty + let thisv, thise = mkThisVar g m ty + let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty let thate = mkCoerceExpr (thatobje, ty, m, g.obj_ty) let rhs = - let comparee = comparef g tcref tycon (thisv,thise) (thatobjv,thate) compe + let comparee = comparef g tcref tycon (thisv, thise) (thatobjv, thate) compe let comparee = if isUnitTy g ty then mkZero g m else comparee - mkMultiLambdas m tps [[thisv];[thatobjv;compv]] (comparee,g.int_ty) + mkMultiLambdas m tps [[thisv];[thatobjv;compv]] (comparee, g.int_ty) [mkCompGenBind vspec rhs] if tycon.IsUnionTycon then mkCompare mkUnionCompareWithComparer elif tycon.IsRecordTycon || tycon.IsStructOrEnumTycon then mkCompare mkRecdCompareWithComparer @@ -994,37 +994,37 @@ let MakeBindingsForEqualityWithComparerAugmentation (g: TcGlobals) (tycon:Tycon) let mkStructuralEquatable hashf equalsf = match tycon.GeneratedHashAndEqualsWithComparerValues with | None -> [] - | Some (objGetHashCodeVal,withcGetHashCodeVal,withcEqualsVal) -> + | Some (objGetHashCodeVal, withcGetHashCodeVal, withcEqualsVal) -> // build the hash rhs let withcGetHashCodeExpr = - let compv,compe = mkCompGenLocal m "comp" g.IEqualityComparer_ty - let thisv,hashe = hashf g tcref tycon compe - mkLambdas m tps [thisv;compv] (hashe,g.int_ty) + let compv, compe = mkCompGenLocal m "comp" g.IEqualityComparer_ty + let thisv, hashe = hashf g tcref tycon compe + mkLambdas m tps [thisv;compv] (hashe, g.int_ty) // build the equals rhs let withcEqualsExpr = - let _tinst,ty = mkMinimalTy g tcref - let thisv,thise = mkThisVar g m ty - let thatobjv,thatobje = mkCompGenLocal m "obj" g.obj_ty - let thatv,thate = mkCompGenLocal m "that" ty - let compv,compe = mkCompGenLocal m "comp" g.IEqualityComparer_ty - let equalse = equalsf g tcref tycon (thisv,thise) thatobje (thatv,thate) compe - mkMultiLambdas m tps [[thisv];[thatobjv;compv]] (equalse,g.bool_ty) + let _tinst, ty = mkMinimalTy g tcref + let thisv, thise = mkThisVar g m ty + let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty + let thatv, thate = mkCompGenLocal m "that" ty + let compv, compe = mkCompGenLocal m "comp" g.IEqualityComparer_ty + let equalse = equalsf g tcref tycon (thisv, thise) thatobje (thatv, thate) compe + mkMultiLambdas m tps [[thisv];[thatobjv;compv]] (equalse, g.bool_ty) let objGetHashCodeExpr = - let tinst,ty = mkMinimalTy g tcref + let tinst, ty = mkMinimalTy g tcref - let thisv,thise = mkThisVar g m ty - let unitv,_ = mkCompGenLocal m "unitArg" g.unit_ty + let thisv, thise = mkThisVar g m ty + let unitv, _ = mkCompGenLocal m "unitArg" g.unit_ty let hashe = if isUnitTy g ty then mkZero g m else let compe = mkILCallGetEqualityComparer g m - mkApps g ((exprForValRef m withcGetHashCodeVal,withcGetHashCodeVal.Type), (if isNil tinst then [] else [tinst]), [thise; compe], m) + mkApps g ((exprForValRef m withcGetHashCodeVal, withcGetHashCodeVal.Type), (if isNil tinst then [] else [tinst]), [thise; compe], m) - mkLambdas m tps [thisv; unitv] (hashe,g.int_ty) + mkLambdas m tps [thisv; unitv] (hashe, g.int_ty) [(mkCompGenBind withcGetHashCodeVal.Deref withcGetHashCodeExpr) (mkCompGenBind objGetHashCodeVal.Deref objGetHashCodeExpr) @@ -1041,27 +1041,27 @@ let MakeBindingsForEqualsAugmentation (g: TcGlobals) (tycon:Tycon) = let mkEquals equalsf = match tycon.GeneratedHashAndEqualsValues with | None -> [] - | Some (objEqualsVal,nocEqualsVal) -> + | Some (objEqualsVal, nocEqualsVal) -> // this is the body of the real strongly typed implementation let nocEqualsExpr = - let thisv,thatv,equalse = equalsf g tcref tycon - mkLambdas m tps [thisv;thatv] (equalse,g.bool_ty) + let thisv, thatv, equalse = equalsf g tcref tycon + mkLambdas m tps [thisv;thatv] (equalse, g.bool_ty) // this is the body of the override let objEqualsExpr = - let tinst,ty = mkMinimalTy g tcref + let tinst, ty = mkMinimalTy g tcref - let thisv,thise = mkThisVar g m ty - let thatobjv,thatobje = mkCompGenLocal m "obj" g.obj_ty + let thisv, thise = mkThisVar g m ty + let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty let equalse = if isUnitTy g ty then mkTrue g m else - let thatv,thate = mkCompGenLocal m "that" ty + let thatv, thate = mkCompGenLocal m "that" ty mkIsInstConditional g m ty thatobje thatv - (mkApps g ((exprForValRef m nocEqualsVal,nocEqualsVal.Type), (if isNil tinst then [] else [tinst]), [thise;thate], m)) + (mkApps g ((exprForValRef m nocEqualsVal, nocEqualsVal.Type), (if isNil tinst then [] else [tinst]), [thise;thate], m)) (mkFalse g m) - mkLambdas m tps [thisv;thatobjv] (equalse,g.bool_ty) + mkLambdas m tps [thisv;thatobjv] (equalse, g.bool_ty) [ mkCompGenBind nocEqualsVal.Deref nocEqualsExpr @@ -1074,7 +1074,8 @@ let MakeBindingsForEqualsAugmentation (g: TcGlobals) (tycon:Tycon) = let rec TypeDefinitelyHasEquality g ty = if isAppTy g ty && HasFSharpAttribute g g.attrib_NoEqualityAttribute (tcrefOfAppTy g ty).Attribs then false - elif isTyparTy g ty && (destTyparTy g ty).Constraints |> List.exists (function TyparConstraint.SupportsEquality _ -> true | _ -> false) then + elif isTyparTy g ty && + (destTyparTy g ty).Constraints |> List.exists (function TyparConstraint.SupportsEquality _ -> true | _ -> false) then true else match ty with @@ -1085,7 +1086,7 @@ let rec TypeDefinitelyHasEquality g ty = | _ -> // The type is equatable because it has Object.Equals(...) isAppTy g ty && - let tcref,tinst = destAppTy g ty + let tcref, tinst = destAppTy g ty // Give a good error for structural types excluded from the equality relation because of their fields not (TyconIsCandidateForAugmentationWithEquals g tcref.Deref && Option.isNone tcref.GeneratedHashAndEqualsWithComparerValues) && // Check the (possibly inferred) structural dependencies diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 1111ddf4a04295d1f5626a83528d6f4fc17ba93a..4a525b9597057f1cd972df59ab8b3ad950b0fc1c 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -52,10 +52,6 @@ open FSharp.Compiler.ExtensionTyping open Microsoft.FSharp.Core.CompilerServices #endif -#if FX_RESHAPED_REFLECTION -open Microsoft.FSharp.Core.ReflectionAdapters -#endif - #if DEBUG [] module internal CompilerService = @@ -2650,7 +2646,7 @@ let OpenILBinary(filename, reduceMemoryUsage, ilGlobals, pdbDirPath, shadowCopyR tryGetMetadataSnapshot = tryGetMetadataSnapshot } let location = -#if !FX_RESHAPED_REFLECTION // shadow copy not supported +#if FX_NO_APP_DOMAINS // In order to use memory mapped files on the shadow copied version of the Assembly, we `preload the assembly // We swallow all exceptions so that we do not change the exception contract of this API if shadowCopyReferences then @@ -2827,7 +2823,7 @@ type TcConfig private (data : TcConfigBuilder, validate:bool) = // FUTURE: remove this, we only read the binary for the exception it raises let fsharpBinariesDirValue = // NOTE: It's not clear why this behaviour has been changed for the NETSTANDARD compilations of the F# compiler -#if NETSTANDARD1_6 || NETSTANDARD2_0 +#if NETSTANDARD ignore ilGlobals data.defaultFSharpBinariesDir #else @@ -2991,7 +2987,7 @@ type TcConfig private (data : TcConfigBuilder, validate:bool) = | None -> // "there is no really good notion of runtime directory on .NETCore" -#if NETSTANDARD1_6 || NETSTANDARD2_0 +#if NETSTANDARD let runtimeRoot = Path.GetDirectoryName(typeof.Assembly.Location) #else let runtimeRoot = System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory() diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index 6e9152d59867a429d121224dc19fdb89f184a859..9a441c51fd014ed4c00160e68e49abf95d31ec24 100644 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -21,17 +21,11 @@ open FSharp.Compiler.Lib open FSharp.Compiler.Range open FSharp.Compiler.IlxGen -#if FX_RESHAPED_REFLECTION -open Microsoft.FSharp.Core.ReflectionAdapters -#endif - module Attributes = open System.Runtime.CompilerServices //[] -#if !FX_NO_DEFAULT_DEPENDENCY_TYPE [] -#endif do() //---------------------------------------------------------------------------- @@ -332,7 +326,7 @@ let ParseCompilerOptions (collectOtherArgument : string -> unit, blocks: Compile reportDeprecatedOption d let al = getOptionArgList compilerOption argString if al <> [] then - List.iter (fun i -> f (try int32 i with _ -> errorR(Error(FSComp.SR.buildArgInvalidInt(i),rangeCmdArgs)); 0)) al ; + List.iter (fun i -> f (try int32 i with _ -> errorR(Error(FSComp.SR.buildArgInvalidInt(i),rangeCmdArgs)); 0)) al t | (CompilerOption(s, _, OptionIntListSwitch f, d, _) as compilerOption :: _) when getSwitchOpt(optToken) = s -> reportDeprecatedOption d @@ -391,18 +385,18 @@ let SetOptimizeOff(tcConfigB : TcConfigBuilder) = tcConfigB.optSettings <- { tcConfigB.optSettings with localOptUser = Some false } tcConfigB.optSettings <- { tcConfigB.optSettings with crossModuleOptUser = Some false } tcConfigB.optSettings <- { tcConfigB.optSettings with lambdaInlineThreshold = 0 } - tcConfigB.doDetuple <- false; - tcConfigB.doTLR <- false; - tcConfigB.doFinalSimplify <- false; + tcConfigB.doDetuple <- false + tcConfigB.doTLR <- false + tcConfigB.doFinalSimplify <- false let SetOptimizeOn(tcConfigB : TcConfigBuilder) = tcConfigB.optSettings <- { tcConfigB.optSettings with jitOptUser = Some true } tcConfigB.optSettings <- { tcConfigB.optSettings with localOptUser = Some true } tcConfigB.optSettings <- { tcConfigB.optSettings with crossModuleOptUser = Some true } tcConfigB.optSettings <- { tcConfigB.optSettings with lambdaInlineThreshold = 6 } - tcConfigB.doDetuple <- true; - tcConfigB.doTLR <- true; - tcConfigB.doFinalSimplify <- true; + tcConfigB.doDetuple <- true + tcConfigB.doTLR <- true + tcConfigB.doFinalSimplify <- true let SetOptimizeSwitch (tcConfigB : TcConfigBuilder) switch = if (switch = OptionSwitch.On) then SetOptimizeOn(tcConfigB) else SetOptimizeOff(tcConfigB) @@ -490,7 +484,7 @@ let SetDebugSwitch (tcConfigB : TcConfigBuilder) (dtype : string option) (s : Op #endif | _ -> error(Error(FSComp.SR.optsUnrecognizedDebugType(s), rangeCmdArgs)) - | None -> tcConfigB.portablePDB <- false; tcConfigB.embeddedPDB <- false; tcConfigB.jitTracking <- s = OptionSwitch.On; + | None -> tcConfigB.portablePDB <- false; tcConfigB.embeddedPDB <- false; tcConfigB.jitTracking <- s = OptionSwitch.On tcConfigB.debuginfo <- s = OptionSwitch.On let SetEmbedAllSourceSwitch (tcConfigB : TcConfigBuilder) switch = @@ -552,7 +546,7 @@ let PrintOptionInfo (tcConfigB:TcConfigBuilder) = let inputFileFlagsBoth (tcConfigB : TcConfigBuilder) = [ CompilerOption("reference", tagFile, OptionString (fun s -> tcConfigB.AddReferencedAssemblyByPath (rangeStartup,s)), None, - Some (FSComp.SR.optsReference()) ); + Some (FSComp.SR.optsReference()) ) ] let referenceFlagAbbrev (tcConfigB : TcConfigBuilder) = @@ -622,7 +616,7 @@ let outputFileFlagsFsc (tcConfigB : TcConfigBuilder) = CompilerOption ("out", tagFile, OptionString (setOutFileName tcConfigB), None, - Some (FSComp.SR.optsNameOfOutputFile()) ); + Some (FSComp.SR.optsNameOfOutputFile()) ) CompilerOption ("target", tagExe, @@ -981,7 +975,6 @@ let testFlag tcConfigB = match s with | "StackSpan" -> tcConfigB.internalTestSpanStackReferring <- true | "ErrorRanges" -> tcConfigB.errorStyle <- ErrorStyle.TestErrors - | "MemberBodyRanges" -> PostTypeCheckSemanticChecks.testFlagMemberBody := true | "Tracking" -> Lib.tracking := true (* general purpose on/off diagnostics flag *) | "NoNeedToTailcall" -> tcConfigB.optSettings <- { tcConfigB.optSettings with reportNoNeedToTailcall = true } | "FunctionSizes" -> tcConfigB.optSettings <- { tcConfigB.optSettings with reportFunctionSizes = true } diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 4eaa78530426ed7910deac4b0b1fdd8f052d4ca0..7e714678e595a4f3443cfe212652774a02cc3432 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -311,14 +311,14 @@ type TraitConstraintSolution = let BakedInTraitConstraintNames = [ "op_Division" ; "op_Multiply"; "op_Addition" "op_Equality" ; "op_Inequality"; "op_GreaterThan" ; "op_LessThan"; "op_LessThanOrEqual"; "op_GreaterThanOrEqual" - "op_Subtraction"; "op_Modulus"; - "get_Zero"; "get_One"; - "DivideByInt";"get_Item"; "set_Item"; - "op_BitwiseAnd"; "op_BitwiseOr"; "op_ExclusiveOr"; "op_LeftShift"; + "op_Subtraction"; "op_Modulus" + "get_Zero"; "get_One" + "DivideByInt";"get_Item"; "set_Item" + "op_BitwiseAnd"; "op_BitwiseOr"; "op_ExclusiveOr"; "op_LeftShift" "op_RightShift"; "op_UnaryPlus"; "op_UnaryNegation"; "get_Sign"; "op_LogicalNot" - "op_OnesComplement"; "Abs"; "Sqrt"; "Sin"; "Cos"; "Tan"; - "Sinh"; "Cosh"; "Tanh"; "Atan"; "Acos"; "Asin"; "Exp"; "Ceiling"; "Floor"; "Round"; "Log10"; "Log"; "Sqrt"; - "Truncate"; "op_Explicit"; + "op_OnesComplement"; "Abs"; "Sqrt"; "Sin"; "Cos"; "Tan" + "Sinh"; "Cosh"; "Tanh"; "Atan"; "Acos"; "Asin"; "Exp"; "Ceiling"; "Floor"; "Round"; "Log10"; "Log"; "Sqrt" + "Truncate"; "op_Explicit" "Pow"; "Atan2" ] |> set @@ -448,12 +448,12 @@ let FindPreferredTypar vs = find vs let SubstMeasure (r:Typar) ms = - if r.Rigidity = TyparRigidity.Rigid then error(InternalError("SubstMeasure: rigid", r.Range)); - if r.Kind = TyparKind.Type then error(InternalError("SubstMeasure: kind=type", r.Range)); + if r.Rigidity = TyparRigidity.Rigid then error(InternalError("SubstMeasure: rigid", r.Range)) + if r.Kind = TyparKind.Type then error(InternalError("SubstMeasure: kind=type", r.Range)) match r.typar_solution with | None -> r.typar_solution <- Some (TType_measure ms) - | Some _ -> error(InternalError("already solved", r.Range)); + | Some _ -> error(InternalError("already solved", r.Range)) let rec TransactStaticReq (csenv:ConstraintSolverEnv) (trace:OptionalTrace) (tpr:Typar) req = let m = csenv.m @@ -573,7 +573,7 @@ let SimplifyMeasure g vars ms = let remainingvars = ListSet.remove typarEq v vars let newvarExpr = if SignRational e < 0 then Measure.Inv (Measure.Var newvar) else Measure.Var newvar let newms = (ProdMeasures (List.map (fun (c, e') -> Measure.RationalPower (Measure.Con c, NegRational (DivRational e' e))) (ListMeasureConOccsWithNonZeroExponents g false ms) - @ List.map (fun (v', e') -> if typarEq v v' then newvarExpr else Measure.RationalPower (Measure.Var v', NegRational (DivRational e' e))) (ListMeasureVarOccsWithNonZeroExponents ms))); + @ List.map (fun (v', e') -> if typarEq v v' then newvarExpr else Measure.RationalPower (Measure.Var v', NegRational (DivRational e' e))) (ListMeasureVarOccsWithNonZeroExponents ms))) SubstMeasure v newms match vs with | [] -> (remainingvars, Some newvar) @@ -1435,21 +1435,21 @@ and RecordMemberConstraintSolution css m trace traitInfo res = | TTraitSolved (minfo, minst) -> let sln = MemberConstraintSolutionOfMethInfo css m minfo minst - TransactMemberConstraintSolution traitInfo trace sln; + TransactMemberConstraintSolution traitInfo trace sln ResultD true | TTraitBuiltIn -> - TransactMemberConstraintSolution traitInfo trace BuiltInSln; + TransactMemberConstraintSolution traitInfo trace BuiltInSln ResultD true | TTraitSolvedRecdProp (rfinfo, isSet) -> let sln = FSRecdFieldSln(rfinfo.TypeInst,rfinfo.RecdFieldRef,isSet) - TransactMemberConstraintSolution traitInfo trace sln; + TransactMemberConstraintSolution traitInfo trace sln ResultD true | TTraitSolvedAnonRecdProp (anonInfo, tinst, i) -> let sln = FSAnonRecdFieldSln(anonInfo, tinst, i) - TransactMemberConstraintSolution traitInfo trace sln; + TransactMemberConstraintSolution traitInfo trace sln ResultD true /// Convert a MethInfo into the data we save in the TAST @@ -1758,29 +1758,33 @@ and AddConstraint (csenv:ConstraintSolverEnv) ndeep m2 trace tp newConstraint = elif tp.Rigidity = TyparRigidity.Rigid then return! ErrorD (ConstraintSolverMissingConstraint(denv, tp, newConstraint, m, m2)) else - // It is important that we give a warning if a constraint is missing from a - // will-be-made-rigid type variable. This is because the existence of these warnings - // is relevant to the overload resolution rules (see 'candidateWarnCount' in the overload resolution - // implementation). See also FSharp 1.0 bug 5461 - if tp.Rigidity.WarnIfMissingConstraint then - do! WarnD (ConstraintSolverMissingConstraint(denv, tp, newConstraint, m, m2)) - let newConstraints = - // Eliminate any constraints where one constraint implies another - // Keep constraints in the left-to-right form according to the order they are asserted. - // NOTE: QUADRATIC - let rec eliminateRedundant cxs acc = - match cxs with - | [] -> acc - | cx :: rest -> - eliminateRedundant rest (if List.exists (fun cx2 -> implies cx2 cx) acc then acc else (cx::acc)) + // It is important that we give a warning if a constraint is missing from a + // will-be-made-rigid type variable. This is because the existence of these warnings + // is relevant to the overload resolution rules (see 'candidateWarnCount' in the overload resolution + // implementation). + if tp.Rigidity.WarnIfMissingConstraint then + do! WarnD (ConstraintSolverMissingConstraint(denv, tp, newConstraint, m, m2)) + + let newConstraints = + // Eliminate any constraints where one constraint implies another + // Keep constraints in the left-to-right form according to the order they are asserted. + // NOTE: QUADRATIC + let rec eliminateRedundant cxs acc = + match cxs with + | [] -> acc + | cx :: rest -> + let acc = + if List.exists (fun cx2 -> implies cx2 cx) acc then acc + else (cx::acc) + eliminateRedundant rest acc - eliminateRedundant allCxs [] + eliminateRedundant allCxs [] - // Write the constraint into the type variable - // Record a entry in the undo trace if one is provided - let orig = tp.Constraints - trace.Exec (fun () -> tp.SetConstraints newConstraints) (fun () -> tp.SetConstraints orig) - () + // Write the constraint into the type variable + // Record a entry in the undo trace if one is provided + let orig = tp.Constraints + trace.Exec (fun () -> tp.SetConstraints newConstraints) (fun () -> tp.SetConstraints orig) + () } diff --git a/src/fsharp/DetupleArgs.fs b/src/fsharp/DetupleArgs.fs index 9973e452761c1887802e906e538b70794562522a..160c0e66526bcab5988afa479227b6a5eb7a42b4 100644 --- a/src/fsharp/DetupleArgs.fs +++ b/src/fsharp/DetupleArgs.fs @@ -256,14 +256,16 @@ module GlobalUsageAnalysis = let foldLocalVal f z (vref: ValRef) = if valRefInThisAssembly g.compilingFslib vref then f z vref.Deref else z - let exprUsageIntercept exprF z expr = + + let exprUsageIntercept exprF noInterceptF z origExpr = + let rec recognise context expr = - match expr with - | Expr.Val (v, _, _) -> + match expr with + | Expr.Val (v, _, _) -> // YES: count free occurrence - let z = foldLocalVal (fun z v -> logUse v (context, [], []) z) z v - Some z - | TyappAndApp(f, _, tys, args, _) -> + foldLocalVal (fun z v -> logUse v (context, [], []) z) z v + + | TyappAndApp(f, _, tys, args, _) -> match f with | Expr.Val (fOrig, _, _) -> // app where function is val @@ -271,27 +273,27 @@ module GlobalUsageAnalysis = // collect from args (have intercepted this node) let collect z f = logUse f (context, tys, args) z let z = foldLocalVal collect z fOrig - let z = List.fold exprF z args - Some z + List.fold exprF z args | _ -> // NO: app but function is not val - None + noInterceptF z origExpr + | Expr.Op(TOp.TupleFieldGet (tupInfo, n), ts, [x], _) when not (evalTupInfoIsStruct tupInfo) -> let context = TupleGet (n, ts) :: context recognise context x // lambdas end top-level status | Expr.Lambda(_id, _ctorThisValOpt, _baseValOpt, _vs, body, _, _) -> - let z = foldUnderLambda exprF z body - Some z + foldUnderLambda exprF z body + | Expr.TyLambda(_id, _tps, body, _, _) -> - let z = foldUnderLambda exprF z body - Some z + foldUnderLambda exprF z body + | _ -> - None // NO: no intercept + noInterceptF z origExpr let context = [] - recognise context expr + recognise context origExpr let targetIntercept exprF z = function TTarget(_argvs, body, _) -> Some (foldUnderLambda exprF z body) let tmethodIntercept exprF z = function TObjExprMethod(_, _, _, _, e, _m) -> Some (foldUnderLambda exprF z e) diff --git a/src/fsharp/ExtensionTyping.fs b/src/fsharp/ExtensionTyping.fs index eda980f5e2876ed27d00344756982a7d17d28317..ce02e3a53e397970e5ec2220ebec2fb794cd61b6 100755 --- a/src/fsharp/ExtensionTyping.fs +++ b/src/fsharp/ExtensionTyping.fs @@ -18,10 +18,6 @@ module internal ExtensionTyping = open FSharp.Compiler.AbstractIL.Diagnostics // dprintfn open FSharp.Compiler.AbstractIL.Internal.Library // frontAndBack -#if FX_RESHAPED_REFLECTION - open Microsoft.FSharp.Core.ReflectionAdapters -#endif - type TypeProviderDesignation = TypeProviderDesignation of string exception ProvidedTypeResolution of range * System.Exception @@ -359,33 +355,14 @@ module internal ExtensionTyping = for KeyValue (st, tcref) in d2.Force() do dict.Add(st, f tcref) dict)) -#if FX_NO_CUSTOMATTRIBUTEDATA - type CustomAttributeData = Microsoft.FSharp.Core.CompilerServices.IProvidedCustomAttributeData - type CustomAttributeNamedArgument = Microsoft.FSharp.Core.CompilerServices.IProvidedCustomAttributeNamedArgument - type CustomAttributeTypedArgument = Microsoft.FSharp.Core.CompilerServices.IProvidedCustomAttributeTypedArgument -#else type CustomAttributeData = System.Reflection.CustomAttributeData type CustomAttributeNamedArgument = System.Reflection.CustomAttributeNamedArgument type CustomAttributeTypedArgument = System.Reflection.CustomAttributeTypedArgument -#endif [] type ProvidedType (x:System.Type, ctxt: ProvidedTypeContext) = -#if FX_RESHAPED_REFLECTION - inherit ProvidedMemberInfo(x.GetTypeInfo(), ctxt) -#if FX_NO_CUSTOMATTRIBUTEDATA - let provide () = ProvidedCustomAttributeProvider.Create (fun provider -> provider.GetMemberCustomAttributesData(x.GetTypeInfo()) :> _) -#else - let provide () = ProvidedCustomAttributeProvider.Create (fun _provider -> x.GetTypeInfo().CustomAttributes) -#endif -#else inherit ProvidedMemberInfo(x, ctxt) -#if FX_NO_CUSTOMATTRIBUTEDATA - let provide () = ProvidedCustomAttributeProvider.Create (fun provider -> provider.GetMemberCustomAttributesData(x) :> _) -#else let provide () = ProvidedCustomAttributeProvider.Create (fun _provider -> x.CustomAttributes) -#endif -#endif interface IProvidedCustomAttributeProvider with member __.GetHasTypeProviderEditorHideMethodsAttribute(provider) = provide().GetHasTypeProviderEditorHideMethodsAttribute(provider) member __.GetDefinitionLocationAttribute(provider) = provide().GetDefinitionLocationAttribute(provider) @@ -514,12 +491,7 @@ module internal ExtensionTyping = and [] ProvidedMemberInfo (x: System.Reflection.MemberInfo, ctxt) = -#if FX_NO_CUSTOMATTRIBUTEDATA - let provide () = ProvidedCustomAttributeProvider.Create (fun provider -> provider.GetMemberCustomAttributesData(x) :> _) -#else let provide () = ProvidedCustomAttributeProvider.Create (fun _provider -> x.CustomAttributes) -#endif - member __.Name = x.Name /// DeclaringType can be null if MemberInfo belongs to Module, not to Type member __.DeclaringType = ProvidedType.Create ctxt x.DeclaringType @@ -531,18 +503,10 @@ module internal ExtensionTyping = and [] ProvidedParameterInfo (x: System.Reflection.ParameterInfo, ctxt) = -#if FX_NO_CUSTOMATTRIBUTEDATA - let provide () = ProvidedCustomAttributeProvider.Create (fun provider -> provider.GetParameterCustomAttributesData(x) :> _) -#else let provide () = ProvidedCustomAttributeProvider.Create (fun _provider -> x.CustomAttributes) -#endif member __.Name = x.Name member __.IsOut = x.IsOut -#if FX_NO_ISIN_ON_PARAMETER_INFO - member __.IsIn = not x.IsOut -#else member __.IsIn = x.IsIn -#endif member __.IsOptional = x.IsOptional member __.RawDefaultValue = x.RawDefaultValue member __.HasDefaultValue = x.Attributes.HasFlag(System.Reflection.ParameterAttributes.HasDefault) diff --git a/src/fsharp/ExtensionTyping.fsi b/src/fsharp/ExtensionTyping.fsi index f062717fec72c9fb8add0a129bf99ece8ebc958d..d4b58be8cb0759e5a77b18b8dca16bbf92d41475 100755 --- a/src/fsharp/ExtensionTyping.fsi +++ b/src/fsharp/ExtensionTyping.fsi @@ -85,12 +85,6 @@ module internal ExtensionTyping = /// Map the TyconRef objects, if any member RemapTyconRefs : (obj -> obj) -> ProvidedTypeContext - -#if FX_NO_CUSTOMATTRIBUTEDATA - type CustomAttributeData = Microsoft.FSharp.Core.CompilerServices.IProvidedCustomAttributeData - type CustomAttributeNamedArgument = Microsoft.FSharp.Core.CompilerServices.IProvidedCustomAttributeNamedArgument - type CustomAttributeTypedArgument = Microsoft.FSharp.Core.CompilerServices.IProvidedCustomAttributeTypedArgument -#endif type [] ProvidedType = diff --git a/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs b/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs index 606fc9c23c957f08899121f991baf465f141093e..0777c0a79feb76abfb96904038544a023314545c 100644 --- a/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs +++ b/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs @@ -238,19 +238,9 @@ open Printf let StringBoilerPlate filename = @" // BEGIN BOILERPLATE - static let getCurrentAssembly () = - #if FX_RESHAPED_REFLECTION - typeof.GetTypeInfo().Assembly - #else - System.Reflection.Assembly.GetExecutingAssembly() - #endif + static let getCurrentAssembly () = System.Reflection.Assembly.GetExecutingAssembly() - static let getTypeInfo (t: System.Type) = - #if FX_RESHAPED_REFLECTION - t.GetTypeInfo() - #else - t - #endif + static let getTypeInfo (t: System.Type) = t static let resources = lazy (new System.Resources.ResourceManager(""" + filename + @""", getCurrentAssembly())) diff --git a/src/fsharp/FSharp.Build/Fsc.fs b/src/fsharp/FSharp.Build/Fsc.fs index c45ecc2e31c179c0ef35ad4a2ece1f7e6a0ff378..d56dab90f0f9fcba1abebc27071ee47d23c502e8 100644 --- a/src/fsharp/FSharp.Build/Fsc.fs +++ b/src/fsharp/FSharp.Build/Fsc.fs @@ -11,10 +11,6 @@ open Microsoft.Build.Framework open Microsoft.Build.Utilities open Internal.Utilities -#if FX_RESHAPED_REFLECTION -open Microsoft.FSharp.Core.ReflectionAdapters -#endif - //There are a lot of flags on fsc.exe. //For now, not all of them are represented in the "Fsc class" object model. //The goal is to have the most common/important flags available via the Fsc class, and the diff --git a/src/fsharp/FSharp.Build/Fsi.fs b/src/fsharp/FSharp.Build/Fsi.fs index c019a8a2dc2066c7048cd20811072bdef3f4ebf1..93d8fc6659026c2c5bc26bf4acb9df418fe61196 100644 --- a/src/fsharp/FSharp.Build/Fsi.fs +++ b/src/fsharp/FSharp.Build/Fsi.fs @@ -11,10 +11,6 @@ open Microsoft.Build.Framework open Microsoft.Build.Utilities open Internal.Utilities -#if FX_RESHAPED_REFLECTION -open Microsoft.FSharp.Core.ReflectionAdapters -#endif - //There are a lot of flags on fsi.exe. //For now, not all of them are represented in the "Fsi class" object model. //The goal is to have the most common/important flags available via the Fsi class, and the diff --git a/src/fsharp/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.fsproj b/src/fsharp/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.fsproj index 8f0af202e980a4d368e2f36e2497828476d79278..fb2b1cfa5ed7e7c2fb55be954e0a795513916fb3 100644 --- a/src/fsharp/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.fsproj +++ b/src/fsharp/FSharp.Compiler.Interactive.Settings/FSharp.Compiler.Interactive.Settings.fsproj @@ -4,7 +4,7 @@ Library - net472;netstandard1.6 + net472;netstandard2.0 FSharp.Compiler.Interactive.Settings $(NoWarn);45;55;62;75;1182;1204 true diff --git a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj index 8851f0ca3af169ac3bbae3d530c5e74c52249db6..e01d5ddd6c4f5bcbe7c74e182c580c4bfda9a7ad 100644 --- a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj +++ b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj @@ -4,7 +4,7 @@ Library - net472;netstandard1.6 + net472;netstandard2.0 FSharp.Compiler.Private $(NoWarn);45;55;62;75;1204 true @@ -235,7 +235,7 @@ AbsIL\ilmorph.fs - + AbsIL\ilsign.fs @@ -692,7 +692,7 @@ - + diff --git a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.netcore.nuspec b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.netcore.nuspec index dfac86f35685f10595922325e27fa6c74063718f..2133f3bcf141e7c6284fe24f0daf028a61cb2bd0 100644 --- a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.netcore.nuspec +++ b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.netcore.nuspec @@ -36,6 +36,6 @@ - + diff --git a/src/fsharp/FSharp.Compiler.nuget/Microsoft.FSharp.Compiler.nuspec b/src/fsharp/FSharp.Compiler.nuget/Microsoft.FSharp.Compiler.nuspec index f10712a641e3b5d610f825b7717bcc6d02036b59..1082f9b47b387c67a1cfd80bac914260693002bf 100644 --- a/src/fsharp/FSharp.Compiler.nuget/Microsoft.FSharp.Compiler.nuspec +++ b/src/fsharp/FSharp.Compiler.nuget/Microsoft.FSharp.Compiler.nuspec @@ -54,19 +54,21 @@ this approach gives a very small deployment. Which is kind of necessary. --> - - - - - - + + + + + + - - - - - - + + + + + + @@ -74,10 +76,13 @@ + - - - - + + + + diff --git a/src/fsharp/FSharp.Core/array2.fs b/src/fsharp/FSharp.Core/array2.fs index d6836475f7e77dbc63aef7c98ec1b3f48b2925e1..3ef0c9ff4379fd0035106e9006f132599702e62f 100644 --- a/src/fsharp/FSharp.Core/array2.fs +++ b/src/fsharp/FSharp.Core/array2.fs @@ -53,7 +53,7 @@ namespace Microsoft.FSharp.Collections [] let zeroCreateBased (base1:int) (base2:int) (length1:int) (length2:int) = if (base1 = 0 && base2 = 0) then -#if NETSTANDARD1_6 +#if NETSTANDARD zeroCreate length1 length2 #else // Note: this overload is available on Compact Framework and Silverlight, but not Portable diff --git a/src/fsharp/FSharp.Core/math/z.fs b/src/fsharp/FSharp.Core/math/z.fs index 1a33c9588f24ffbd7b5f60160179efb951dec207..c9e9614b3daf994e91e6821ab802de500f27d0cf 100644 --- a/src/fsharp/FSharp.Core/math/z.fs +++ b/src/fsharp/FSharp.Core/math/z.fs @@ -19,7 +19,7 @@ namespace System.Numerics // NOTE: 0 has two repns (+1,0) or (-1,0). [] [] -#if !NETSTANDARD1_6 +#if !NETSTANDARD [] #endif type BigInteger(signInt:int, v : BigNat) = diff --git a/src/fsharp/FSharp.Core/reflect.fs b/src/fsharp/FSharp.Core/reflect.fs index 78528294f5cd726c95cb1dd6080e6862d8b1a4a7..ea8f1bfdf703c73cf5bb944eba23b99a75435f35 100644 --- a/src/fsharp/FSharp.Core/reflect.fs +++ b/src/fsharp/FSharp.Core/reflect.fs @@ -447,11 +447,11 @@ module internal Impl = // Item1, Item2, ..., Item // Item1, Item2, ..., Item, Rest // The PropertyInfo may not come back in order, so ensure ordering here. -#if !NETSTANDARD1_6 +#if !NETSTANDARD assert(maxTuple < 10) // Alphasort will only works for upto 9 items: Item1, Item10, Item2, Item3, ..., Item9, Rest #endif let props = props |> Array.sortBy (fun p -> p.Name) // they are not always in alphabetic order -#if !NETSTANDARD1_6 +#if !NETSTANDARD assert(props.Length <= maxTuple) assert(let haveNames = props |> Array.map (fun p -> p.Name) let expectNames = Array.init props.Length (fun i -> let j = i+1 // index j = 1,2,..,props.Length <= maxTuple @@ -469,11 +469,11 @@ module internal Impl = // Item1, Item2, ..., Item // Item1, Item2, ..., Item, Rest // The PropertyInfo may not come back in order, so ensure ordering here. -#if !NETSTANDARD1_6 +#if !NETSTANDARD assert(maxTuple < 10) // Alphasort will only works for upto 9 items: Item1, Item10, Item2, Item3, ..., Item9, Rest #endif let fields = fields |> Array.sortBy (fun fi -> fi.Name) // they are not always in alphabetic order -#if !NETSTANDARD1_6 +#if !NETSTANDARD assert(fields.Length <= maxTuple) assert(let haveNames = fields |> Array.map (fun fi -> fi.Name) let expectNames = Array.init fields.Length (fun i -> let j = i+1 // index j = 1,2,..,fields.Length <= maxTuple @@ -707,12 +707,11 @@ type UnionCaseInfo(typ: System.Type, tag:int) = props member __.GetCustomAttributes() = getMethInfo().GetCustomAttributes(false) - + member __.GetCustomAttributes(attributeType) = getMethInfo().GetCustomAttributes(attributeType,false) -#if !FX_NO_CUSTOMATTRIBUTEDATA member __.GetCustomAttributesData() = getMethInfo().CustomAttributes |> Seq.toArray :> System.Collections.Generic.IList<_> -#endif + member __.Tag = tag override x.ToString() = typ.Name + "." + x.Name override x.GetHashCode() = typ.GetHashCode() + tag diff --git a/src/fsharp/FSharp.Core/reflect.fsi b/src/fsharp/FSharp.Core/reflect.fsi index 99d4e491891499b630f8beaf09afc182d4073dc6..359f36af777ad2cf0a3b02d389a95ef15f848d98 100644 --- a/src/fsharp/FSharp.Core/reflect.fsi +++ b/src/fsharp/FSharp.Core/reflect.fsi @@ -29,13 +29,10 @@ type UnionCaseInfo = /// An array of custom attributes. member GetCustomAttributes: attributeType:System.Type -> obj[] -#if !FX_NO_CUSTOMATTRIBUTEDATA /// Returns the custom attributes data associated with the case. /// An list of custom attribute data items. member GetCustomAttributesData: unit -> System.Collections.Generic.IList -#endif - /// The fields associated with the case, represented by a PropertyInfo. /// The fields associated with the case. member GetFields: unit -> PropertyInfo [] diff --git a/src/fsharp/FindUnsolved.fs b/src/fsharp/FindUnsolved.fs index 386545c7e2afc380e4500042bba57fcb73c031cc..0bfd0b5de81072e312dccffd43990eb4074ebf6d 100644 --- a/src/fsharp/FindUnsolved.fs +++ b/src/fsharp/FindUnsolved.fs @@ -38,46 +38,65 @@ let rec accExpr (cenv:cenv) (env:env) expr = | Expr.Sequential (e1,e2,_,_,_) -> accExpr cenv env e1 accExpr cenv env e2 + | Expr.Let (bind,body,_,_) -> accBind cenv env bind accExpr cenv env body + | Expr.Const (_,_,ty) -> accTy cenv env ty | Expr.Val (_v,_vFlags,_m) -> () + | Expr.Quote(ast,_,_,_m,ty) -> accExpr cenv env ast accTy cenv env ty + | Expr.Obj (_,ty,basev,basecall,overrides,iimpls,_m) -> accTy cenv env ty accExpr cenv env basecall accMethods cenv env basev overrides accIntfImpls cenv env basev iimpls + + | LinearOpExpr (_op, tyargs, argsHead, argLast, _m) -> + // Note, LinearOpExpr doesn't include any of the "special" cases for accOp + accTypeInst cenv env tyargs + accExprs cenv env argsHead + // tailcall + accExpr cenv env argLast + | Expr.Op (c,tyargs,args,m) -> accOp cenv env (c,tyargs,args,m) + | Expr.App(f,fty,tyargs,argsl,_m) -> accTy cenv env fty accTypeInst cenv env tyargs accExpr cenv env f accExprs cenv env argsl + | Expr.Lambda(_,_ctorThisValOpt,_baseValOpt,argvs,_body,m,rty) -> let topValInfo = ValReprInfo ([],[argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)],ValReprInfo.unnamedRetVal) let ty = mkMultiLambdaTy m argvs rty accLambdas cenv env topValInfo expr ty + | Expr.TyLambda(_,tps,_body,_m,rty) -> let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps,[],ValReprInfo.unnamedRetVal) accTy cenv env rty let ty = mkForallTyIfNeeded tps rty accLambdas cenv env topValInfo expr ty + | Expr.TyChoose(_tps,e1,_m) -> accExpr cenv env e1 + | Expr.Match(_,_exprm,dtree,targets,m,ty) -> accTy cenv env ty accDTree cenv env dtree accTargets cenv env m ty targets + | Expr.LetRec (binds,e,_m,_) -> accBinds cenv env binds accExpr cenv env e + | Expr.StaticOptimization (constraints,e2,e3,_m) -> accExpr cenv env e2 accExpr cenv env e3 @@ -87,14 +106,19 @@ let rec accExpr (cenv:cenv) (env:env) expr = accTy cenv env ty2 | TTyconIsStruct(ty1) -> accTy cenv env ty1) + | Expr.Link _eref -> failwith "Unexpected reclink" -and accMethods cenv env baseValOpt l = List.iter (accMethod cenv env baseValOpt) l +and accMethods cenv env baseValOpt l = + List.iter (accMethod cenv env baseValOpt) l + and accMethod cenv env _baseValOpt (TObjExprMethod(_slotsig,_attribs,_tps,vs,e,_m)) = vs |> List.iterSquared (accVal cenv env) accExpr cenv env e -and accIntfImpls cenv env baseValOpt l = List.iter (accIntfImpl cenv env baseValOpt) l +and accIntfImpls cenv env baseValOpt l = + List.iter (accIntfImpl cenv env baseValOpt) l + and accIntfImpl cenv env baseValOpt (ty,overrides) = accTy cenv env ty accMethods cenv env baseValOpt overrides @@ -132,11 +156,14 @@ and accLambdas cenv env topValInfo e ety = | _ -> accExpr cenv env e -and accExprs cenv env exprs = exprs |> List.iter (accExpr cenv env) +and accExprs cenv env exprs = + exprs |> List.iter (accExpr cenv env) -and accTargets cenv env m ty targets = Array.iter (accTarget cenv env m ty) targets +and accTargets cenv env m ty targets = + Array.iter (accTarget cenv env m ty) targets -and accTarget cenv env _m _ty (TTarget(_vs,e,_)) = accExpr cenv env e +and accTarget cenv env _m _ty (TTarget(_vs,e,_)) = + accExpr cenv env e and accDTree cenv env x = match x with @@ -169,7 +196,8 @@ and accAttrib cenv env (Attrib(_,_k,args,props,_,_,_m)) = accExpr cenv env expr2 accTy cenv env ty) -and accAttribs cenv env attribs = List.iter (accAttrib cenv env) attribs +and accAttribs cenv env attribs = + List.iter (accAttrib cenv env) attribs and accValReprInfo cenv env (ValReprInfo(_,args,ret)) = args |> List.iterSquared (accArgReprInfo cenv env) @@ -188,7 +216,8 @@ and accBind cenv env (bind:Binding) = let topValInfo = match bind.Var.ValReprInfo with Some info -> info | _ -> ValReprInfo.emptyValData accLambdas cenv env topValInfo bind.Expr bind.Var.Type -and accBinds cenv env xs = xs |> List.iter (accBind cenv env) +and accBinds cenv env xs = + xs |> List.iter (accBind cenv env) let accTyconRecdField cenv env _tycon (rfield:RecdField) = accAttribs cenv env rfield.PropertyAttribs @@ -203,13 +232,15 @@ let accTycon cenv env (tycon:Tycon) = accAttribs cenv env uc.Attribs uc.RecdFieldsArray |> Array.iter (accTyconRecdField cenv env tycon)) -let accTycons cenv env tycons = List.iter (accTycon cenv env) tycons +let accTycons cenv env tycons = + List.iter (accTycon cenv env) tycons let rec accModuleOrNamespaceExpr cenv env x = match x with | ModuleOrNamespaceExprWithSig(_mty, def, _m) -> accModuleOrNamespaceDef cenv env def -and accModuleOrNamespaceDefs cenv env x = List.iter (accModuleOrNamespaceDef cenv env) x +and accModuleOrNamespaceDefs cenv env x = + List.iter (accModuleOrNamespaceDef cenv env) x and accModuleOrNamespaceDef cenv env x = match x with @@ -221,12 +252,16 @@ and accModuleOrNamespaceDef cenv env x = | TMAbstract(def) -> accModuleOrNamespaceExpr cenv env def | TMDefs(defs) -> accModuleOrNamespaceDefs cenv env defs -and accModuleOrNamespaceBinds cenv env xs = List.iter (accModuleOrNamespaceBind cenv env) xs +and accModuleOrNamespaceBinds cenv env xs = + List.iter (accModuleOrNamespaceBind cenv env) xs and accModuleOrNamespaceBind cenv env x = match x with - | ModuleOrNamespaceBinding.Binding bind -> accBind cenv env bind - | ModuleOrNamespaceBinding.Module(mspec, rhs) -> accTycon cenv env mspec; accModuleOrNamespaceDef cenv env rhs + | ModuleOrNamespaceBinding.Binding bind -> + accBind cenv env bind + | ModuleOrNamespaceBinding.Module(mspec, rhs) -> + accTycon cenv env mspec + accModuleOrNamespaceDef cenv env rhs let UnsolvedTyparsOfModuleDef g amap denv (mdef, extraAttribs) = let cenv = diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 9703dd76b9c76689ff63edeef2dea3de40aaa3cd..1d503c8d7670c5ecbf83dd5ecc413a3920dc8bfc 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -1,8 +1,8 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. //-------------------------------------------------------------------------- -// The ILX generator. -//-------------------------------------------------------------------------- +// The ILX generator. +//-------------------------------------------------------------------------- module internal FSharp.Compiler.IlxGen @@ -13,15 +13,15 @@ open System.Collections.Generic open Internal.Utilities open Internal.Utilities.Collections -open FSharp.Compiler.AbstractIL -open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.AbstractIL.Internal +open FSharp.Compiler.AbstractIL +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.AbstractIL.Extensions.ILX open FSharp.Compiler.AbstractIL.Extensions.ILX.Types -open FSharp.Compiler.AbstractIL.Internal.BinaryConstants +open FSharp.Compiler.AbstractIL.Internal.BinaryConstants -open FSharp.Compiler +open FSharp.Compiler open FSharp.Compiler.AttributeChecking open FSharp.Compiler.Ast open FSharp.Compiler.ErrorLogger @@ -36,344 +36,424 @@ open FSharp.Compiler.Tastops open FSharp.Compiler.Tastops.DebugPrint open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypeRelations - -let IsNonErasedTypar (tp:Typar) = not tp.IsErased -let DropErasedTypars (tps:Typar list) = tps |> List.filter IsNonErasedTypar -let DropErasedTyargs tys = tys |> List.filter (fun ty -> match ty with TType_measure _ -> false | _ -> true) -let AddNonUserCompilerGeneratedAttribs (g: TcGlobals) (mdef:ILMethodDef) = g.AddMethodGeneratedAttributes mdef +let IsNonErasedTypar (tp:Typar) = + not tp.IsErased + +let DropErasedTypars (tps:Typar list) = + tps |> List.filter IsNonErasedTypar + +let DropErasedTyargs tys = + tys |> List.filter (fun ty -> match ty with TType_measure _ -> false | _ -> true) + +let AddNonUserCompilerGeneratedAttribs (g: TcGlobals) (mdef:ILMethodDef) = + g.AddMethodGeneratedAttributes mdef let debugDisplayMethodName = "__DebugDisplay" let useHiddenInitCode = true -//-------------------------------------------------------------------------- -// misc -//-------------------------------------------------------------------------- +let iLdcZero = AI_ldc (DT_I4, ILConst.I4 0) -let iLdcZero = AI_ldc (DT_I4,ILConst.I4 0) -let iLdcInt64 i = AI_ldc (DT_I8,ILConst.I8 i) -let iLdcDouble i = AI_ldc (DT_R8,ILConst.R8 i) -let iLdcSingle i = AI_ldc (DT_R4,ILConst.R4 i) +let iLdcInt64 i = AI_ldc (DT_I8, ILConst.I8 i) + +let iLdcDouble i = AI_ldc (DT_R8, ILConst.R8 i) + +let iLdcSingle i = AI_ldc (DT_R4, ILConst.R4 i) /// Make a method that simply loads a field -let mkLdfldMethodDef (ilMethName,reprAccess,isStatic,ilTy,ilFieldName,ilPropType) = - let ilFieldSpec = mkILFieldSpecInTy(ilTy,ilFieldName,ilPropType) +let mkLdfldMethodDef (ilMethName, reprAccess, isStatic, ilTy, ilFieldName, ilPropType) = + let ilFieldSpec = mkILFieldSpecInTy(ilTy, ilFieldName, ilPropType) let ilReturn = mkILReturn ilPropType - let ilMethodDef = - if isStatic then - mkILNonGenericStaticMethod (ilMethName,reprAccess,[],ilReturn,mkMethodBody(true,[],2,nonBranchingInstrsToCode [mkNormalLdsfld ilFieldSpec],None)) - else - mkILNonGenericInstanceMethod (ilMethName,reprAccess,[],ilReturn,mkMethodBody (true,[],2,nonBranchingInstrsToCode [ mkLdarg0; mkNormalLdfld ilFieldSpec],None)) + let ilMethodDef = + if isStatic then + mkILNonGenericStaticMethod (ilMethName, reprAccess, [], ilReturn, mkMethodBody(true, [], 2, nonBranchingInstrsToCode [mkNormalLdsfld ilFieldSpec], None)) + else + mkILNonGenericInstanceMethod (ilMethName, reprAccess, [], ilReturn, mkMethodBody (true, [], 2, nonBranchingInstrsToCode [ mkLdarg0; mkNormalLdfld ilFieldSpec], None)) ilMethodDef.WithSpecialName -let ChooseParamNames fieldNamesAndTypes = +/// Choose the constructor parameter names for fields +let ChooseParamNames fieldNamesAndTypes = let takenFieldNames = fieldNamesAndTypes |> List.map p23 |> Set.ofList fieldNamesAndTypes - |> List.map (fun (ilPropName,ilFieldName,ilPropType) -> - let lowerPropName = String.uncapitalize ilPropName - let ilParamName = if takenFieldNames.Contains(lowerPropName) then ilPropName else lowerPropName - ilParamName,ilFieldName,ilPropType) - -let markup s = Seq.indexed s + |> List.map (fun (ilPropName, ilFieldName, ilPropType) -> + let lowerPropName = String.uncapitalize ilPropName + let ilParamName = if takenFieldNames.Contains(lowerPropName) then ilPropName else lowerPropName + ilParamName, ilFieldName, ilPropType) -// Approximation for purposes of optimization and giving a warning when compiling definition-only files as EXEs -let rec CheckCodeDoesSomething (code: ILCode) = - code.Instrs |> Array.exists (function AI_ldnull | AI_nop | AI_pop | I_ret | I_seqpoint _ -> false | _ -> true) +/// Approximation for purposes of optimization and giving a warning when compiling definition-only files as EXEs +let rec CheckCodeDoesSomething (code: ILCode) = + code.Instrs |> Array.exists (function AI_ldnull | AI_nop | AI_pop | I_ret | I_seqpoint _ -> false | _ -> true) +/// Choose the field names for variables captured by closures let ChooseFreeVarNames takenNames ts = - let tns = List.map (fun t -> (t,None)) ts - let rec chooseName names (t,nOpt) = + let tns = List.map (fun t -> (t, None)) ts + let rec chooseName names (t, nOpt) = let tn = match nOpt with None -> t | Some n -> t + string n if Zset.contains tn names then - chooseName names (t,Some(match nOpt with None -> 0 | Some n -> (n+1))) + chooseName names (t, Some(match nOpt with None -> 0 | Some n -> (n+1))) else let names = Zset.add tn names - tn,names + tn, names let names = Zset.empty String.order |> Zset.addList takenNames - let ts,_names = List.mapFold chooseName names tns + let ts, _names = List.mapFold chooseName names tns ts +/// +++GLOBAL STATE: a name generator used by IlxGen for static fields, some generated arguments and other things. +/// REVIEW: this will mean the hosted compiler service is not deterministic. We should at least create a new one +/// of these for each compilation. let ilxgenGlobalNng = NiceNameGenerator () -// We can't tailcall to methods taking byrefs. This helper helps search for them +/// We can't tailcall to methods taking byrefs. This helper helps search for them let IsILTypeByref = function ILType.Byref _ -> true | _ -> false let mainMethName = CompilerGeneratedName "main" -type AttributeDecoder(namedArgs) = - let nameMap = namedArgs |> List.map (fun (AttribNamedArg(s,_,_,c)) -> s,c) |> NameMap.ofList - let findConst x = match NameMap.tryFind x nameMap with | Some(AttribExpr(_,Expr.Const(c,_,_))) -> Some c | _ -> None - let findAppTr x = match NameMap.tryFind x nameMap with | Some(AttribExpr(_,Expr.App(_,_,[TType_app(tr,_)],_,_))) -> Some tr | _ -> None +/// Used to query custom attributes when emitting COM interop code. +type AttributeDecoder (namedArgs) = + + let nameMap = namedArgs |> List.map (fun (AttribNamedArg(s, _, _, c)) -> s, c) |> NameMap.ofList + let findConst x = match NameMap.tryFind x nameMap with | Some(AttribExpr(_, Expr.Const(c, _, _))) -> Some c | _ -> None + let findAppTr x = match NameMap.tryFind x nameMap with | Some(AttribExpr(_, Expr.App(_, _, [TType_app(tr, _)], _, _))) -> Some tr | _ -> None + + member __.FindInt16 x dflt = match findConst x with | Some(Const.Int16 x) -> x | _ -> dflt + + member __.FindInt32 x dflt = match findConst x with | Some(Const.Int32 x) -> x | _ -> dflt + + member __.FindBool x dflt = match findConst x with | Some(Const.Bool x) -> x | _ -> dflt + + member __.FindString x dflt = match findConst x with | Some(Const.String x) -> x | _ -> dflt + + member __.FindTypeName x dflt = match findAppTr x with | Some(tr) -> tr.DisplayName | _ -> dflt - member self.FindInt16 x dflt = match findConst x with | Some(Const.Int16 x) -> x | _ -> dflt - member self.FindInt32 x dflt = match findConst x with | Some(Const.Int32 x) -> x | _ -> dflt - member self.FindBool x dflt = match findConst x with | Some(Const.Bool x) -> x | _ -> dflt - member self.FindString x dflt = match findConst x with | Some(Const.String x) -> x | _ -> dflt - member self.FindTypeName x dflt = match findAppTr x with | Some(tr) -> tr.DisplayName | _ -> dflt - //-------------------------------------------------------------------------- // Statistics -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- + +let mutable reports = (fun _ -> ()) + +let AddReport f = + let old = reports + reports <- (fun oc -> old oc; f oc) -let mutable reports = (fun _ -> ()) -let AddReport f = let old = reports in reports <- (fun oc -> old oc; f oc) -let ReportStatistics (oc:TextWriter) = reports oc +let ReportStatistics (oc:TextWriter) = + reports oc -let NewCounter nm = +let NewCounter nm = let count = ref 0 AddReport (fun oc -> if !count <> 0 then oc.WriteLine (string !count + " " + nm)) (fun () -> incr count) let CountClosure = NewCounter "closures" + let CountMethodDef = NewCounter "IL method defintitions corresponding to values" + let CountStaticFieldDef = NewCounter "IL field defintitions corresponding to values" + let CountCallFuncInstructions = NewCounter "callfunc instructions (indirect calls)" /// Non-local information related to internals of code generation within an assembly -type IlxGenIntraAssemblyInfo = - { /// A table recording the generated name of the static backing fields for each mutable top level value where - /// we may need to take the address of that value, e.g. static mutable module-bound values which are structs. These are +type IlxGenIntraAssemblyInfo = + { + /// A table recording the generated name of the static backing fields for each mutable top level value where + /// we may need to take the address of that value, e.g. static mutable module-bound values which are structs. These are /// only accessible intra-assembly. Across assemblies, taking the address of static mutable module-bound values is not permitted. /// The key to the table is the method ref for the property getter for the value, which is a stable name for the Val's /// that come from both the signature and the implementation. - StaticFieldInfo : Dictionary } + StaticFieldInfo : Dictionary + } -//-------------------------------------------------------------------------- +/// Helper to make sure we take tailcalls in some situations +type FakeUnit = | Fake -/// Indicates how the generated IL code is ultimately emitted +/// Indicates how the generated IL code is ultimately emitted type IlxGenBackend = -| IlWriteBackend -| IlReflectBackend + /// Indicates we are emitting code for ilwrite + | IlWriteBackend + + /// Indicates we are emitting code for Reflection.Emit in F# Interactive. + | IlReflectBackend [] -type IlxGenOptions = - { fragName: string +type IlxGenOptions = + { + /// Indicates the "fragment name" for the part of the assembly we are emitting, particularly for incremental + /// emit using Reflection.Emit in F# Interactive. + fragName: string + + /// Indicates if we are generating filter blocks generateFilterBlocks: bool + + /// Indicates if we are working around historical Reflection.Emit bugs workAroundReflectionEmitBugs: bool + + /// Indicates if we should/shouldn't emit constant arrays as static data blobs emitConstantArraysUsingStaticDataBlobs: bool - /// If this is set, then the last module becomes the "main" module and its toplevel bindings are executed at startup + + /// If this is set, then the last module becomes the "main" module and its toplevel bindings are executed at startup mainMethodInfo: Tast.Attribs option + + /// Indicates if local optimizations are on localOptimizationsAreOn: bool + + /// Indicates if we are generating debug symbols generateDebugSymbols: bool + + /// Indicates that FeeFee debug values should be emitted as value 100001 for + /// easier detection in debug output testFlagEmitFeeFeeAs100001: bool + ilxBackend: IlxGenBackend /// Indicates the code is being generated in FSI.EXE and is executed immediately after code generation /// This includes all interactively compiled code, including #load, definitions, and expressions - isInteractive: bool + isInteractive: bool /// Indicates the code generated is an interactive 'it' expression. We generate a setter to allow clearing of the underlying /// storage, even though 'it' is not logically mutable isInteractiveItExpr: bool /// Whenever possible, use callvirt instead of call - alwaysCallVirt: bool } - + alwaysCallVirt: bool + } /// Compilation environment for compiling a fragment of an assembly [] -type cenv = - { g: TcGlobals +type cenv = + { + /// The TcGlobals for the compilation + g: TcGlobals + + /// The ImportMap for reading IL + amap: ImportMap + + /// A callback for TcVal in the typechecker. Used to generalize values when finding witnesses. + /// It is unfortunate this is needed but it is until we supply witnesses through the compiation. TcVal : ConstraintSolver.TcValF + + /// The TAST for the assembly being emitted viewCcu: CcuThunk + + /// The options for ILX code generation opts: IlxGenOptions + /// Cache the generation of the "unit" type mutable ilUnitTy: ILType option - amap: ImportMap + + /// Other information from the emit of this assembly intraAssemblyInfo : IlxGenIntraAssemblyInfo + /// Cache methods with SecurityAttribute applied to them, to prevent unnecessary calls to ExistsInEntireHierarchyOfType - casApplied : Dictionary + casApplied : Dictionary + /// Used to apply forced inlining optimizations to witnesses generated late during codegen - mutable optimizeDuringCodeGen : (Expr -> Expr) } + mutable optimizeDuringCodeGen : (Expr -> Expr) + } - -let mkTypeOfExpr cenv m ilty = +let mkTypeOfExpr cenv m ilty = mkAsmExpr ([ mkNormalCall (mspec_Type_GetTypeFromHandle cenv.g) ], [], - [mkAsmExpr ([ I_ldtoken (ILToken.ILType ilty) ], [],[],[cenv.g.system_RuntimeTypeHandle_ty],m)], - [cenv.g.system_Type_ty],m) - + [mkAsmExpr ([ I_ldtoken (ILToken.ILType ilty) ], [], [], [cenv.g.system_RuntimeTypeHandle_ty], m)], + [cenv.g.system_Type_ty], m) + let mkGetNameExpr cenv (ilt : ILType) m = - mkAsmExpr ([I_ldstr ilt.BasicQualifiedName],[],[],[cenv.g.string_ty],m) + mkAsmExpr ([I_ldstr ilt.BasicQualifiedName], [], [], [cenv.g.string_ty], m) -let useCallVirt cenv boxity (mspec : ILMethodSpec) isBaseCall = - cenv.opts.alwaysCallVirt && - (boxity = AsObject) && - not mspec.CallingConv.IsStatic && - not isBaseCall +let useCallVirt cenv boxity (mspec : ILMethodSpec) isBaseCall = + cenv.opts.alwaysCallVirt && + (boxity = AsObject) && + not mspec.CallingConv.IsStatic && + not isBaseCall -//-------------------------------------------------------------------------- -// CompileLocation -//-------------------------------------------------------------------------- - -/// compilation location = path to a ccu, namespace or class -/// Referencing other stuff, and descriptions of where items are to be placed -/// within the generated IL namespace/typespace. This should be cleaned up. -type CompileLocation = - { clocScope: IL.ILScopeRef - clocTopImplQualifiedName: string - clocNamespace: string option - clocEncl: string list - clocQualifiedNameOfFile : string } +/// Describes where items are to be placed within the generated IL namespace/typespace. +/// This should be cleaned up. +type CompileLocation = + { Scope: IL.ILScopeRef + + TopImplQualifiedName: string + + Namespace: string option + + Enclosing: string list + + QualifiedNameOfFile: string + } //-------------------------------------------------------------------------- // Access this and other assemblies -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- let mkTopName ns n = String.concat "." (match ns with Some x -> [x;n] | None -> [n]) -let CompLocForFragment fragName (ccu:CcuThunk) = - { clocQualifiedNameOfFile =fragName - clocTopImplQualifiedName= fragName - clocScope=ccu.ILScopeRef - clocNamespace=None - clocEncl=[]} +let CompLocForFragment fragName (ccu:CcuThunk) = + { QualifiedNameOfFile = fragName + TopImplQualifiedName = fragName + Scope = ccu.ILScopeRef + Namespace = None + Enclosing = []} let CompLocForCcu (ccu:CcuThunk) = CompLocForFragment ccu.AssemblyName ccu let CompLocForSubModuleOrNamespace cloc (submod:ModuleOrNamespace) = let n = submod.CompiledName - match submod.ModuleOrNamespaceType.ModuleOrNamespaceKind with - | FSharpModuleWithSuffix | ModuleOrType -> { cloc with clocEncl= cloc.clocEncl @ [n]} - | Namespace -> {cloc with clocNamespace=Some (mkTopName cloc.clocNamespace n)} + match submod.ModuleOrNamespaceType.ModuleOrNamespaceKind with + | FSharpModuleWithSuffix | ModuleOrType -> { cloc with Enclosing= cloc.Enclosing @ [n]} + | Namespace -> {cloc with Namespace=Some (mkTopName cloc.Namespace n)} -let CompLocForFixedPath fragName qname (CompPath(sref,cpath)) = - let ns,t = List.takeUntil (fun (_,mkind) -> mkind <> Namespace) cpath +let CompLocForFixedPath fragName qname (CompPath(sref, cpath)) = + let ns, t = List.takeUntil (fun (_, mkind) -> mkind <> Namespace) cpath let ns = List.map fst ns let ns = textOfPath ns - let encl = t |> List.map (fun (s ,_)-> s) + let encl = t |> List.map (fun (s , _)-> s) let ns = if ns = "" then None else Some ns - { clocQualifiedNameOfFile =fragName - clocTopImplQualifiedName=qname - clocScope=sref - clocNamespace=ns - clocEncl=encl } + { QualifiedNameOfFile = fragName + TopImplQualifiedName = qname + Scope = sref + Namespace = ns + Enclosing = encl } -let CompLocForFixedModule fragName qname (mspec:ModuleOrNamespace) = +let CompLocForFixedModule fragName qname (mspec:ModuleOrNamespace) = let cloc = CompLocForFixedPath fragName qname mspec.CompilationPath let cloc = CompLocForSubModuleOrNamespace cloc mspec - cloc + cloc -let NestedTypeRefForCompLoc cloc n = - match cloc.clocEncl with +let NestedTypeRefForCompLoc cloc n = + match cloc.Enclosing with | [] -> - let tyname = mkTopName cloc.clocNamespace n - mkILTyRef(cloc.clocScope,tyname) - | h::t -> mkILNestedTyRef(cloc.clocScope,mkTopName cloc.clocNamespace h :: t,n) - -let CleanUpGeneratedTypeName (nm:string) = - if nm.IndexOfAny IllegalCharactersInTypeAndNamespaceNames = -1 then + let tyname = mkTopName cloc.Namespace n + mkILTyRef(cloc.Scope, tyname) + | h::t -> mkILNestedTyRef(cloc.Scope, mkTopName cloc.Namespace h :: t, n) + +let CleanUpGeneratedTypeName (nm:string) = + if nm.IndexOfAny IllegalCharactersInTypeAndNamespaceNames = -1 then nm else - (nm,IllegalCharactersInTypeAndNamespaceNames) ||> Array.fold (fun nm c -> nm.Replace(string c, "-")) - + (nm, IllegalCharactersInTypeAndNamespaceNames) ||> Array.fold (fun nm c -> nm.Replace(string c, "-")) + +let TypeNameForInitClass cloc = + ".$" + cloc.TopImplQualifiedName -let TypeNameForInitClass cloc = ".$" + cloc.clocTopImplQualifiedName -let TypeNameForImplicitMainMethod cloc = TypeNameForInitClass cloc + "$Main" -let TypeNameForPrivateImplementationDetails cloc = "" +let TypeNameForImplicitMainMethod cloc = + TypeNameForInitClass cloc + "$Main" -let CompLocForInitClass cloc = - {cloc with clocEncl=[TypeNameForInitClass cloc]; clocNamespace=None} +let TypeNameForPrivateImplementationDetails cloc = + "" -let CompLocForImplicitMainMethod cloc = - {cloc with clocEncl=[TypeNameForImplicitMainMethod cloc]; clocNamespace=None} +let CompLocForInitClass cloc = + {cloc with Enclosing=[TypeNameForInitClass cloc]; Namespace=None} -let CompLocForPrivateImplementationDetails cloc = - {cloc with - clocEncl=[TypeNameForPrivateImplementationDetails cloc]; clocNamespace=None} +let CompLocForImplicitMainMethod cloc = + {cloc with Enclosing=[TypeNameForImplicitMainMethod cloc]; Namespace=None} +let CompLocForPrivateImplementationDetails cloc = + {cloc with + Enclosing=[TypeNameForPrivateImplementationDetails cloc]; Namespace=None} + +/// Compute an ILTypeRef for a CompilationLocation let rec TypeRefForCompLoc cloc = - match cloc.clocEncl with - | [] -> - mkILTyRef(cloc.clocScope,TypeNameForPrivateImplementationDetails cloc) - | [h] -> - let tyname = mkTopName cloc.clocNamespace h - mkILTyRef(cloc.clocScope,tyname) - | _ -> - let encl,n = List.frontAndBack cloc.clocEncl - NestedTypeRefForCompLoc {cloc with clocEncl=encl} n + match cloc.Enclosing with + | [] -> + mkILTyRef(cloc.Scope, TypeNameForPrivateImplementationDetails cloc) + | [h] -> + let tyname = mkTopName cloc.Namespace h + mkILTyRef(cloc.Scope, tyname) + | _ -> + let encl, n = List.frontAndBack cloc.Enclosing + NestedTypeRefForCompLoc {cloc with Enclosing=encl} n +/// Compute an ILType for a CompilationLocation for a non-generic type let mkILTyForCompLoc cloc = mkILNonGenericBoxedTy (TypeRefForCompLoc cloc) let ComputeMemberAccess hidden = if hidden then ILMemberAccess.Assembly else ILMemberAccess.Public - // Under --publicasinternal change types from Public to Private (internal for types) let ComputePublicTypeAccess() = ILTypeDefAccess.Public -let ComputeTypeAccess (tref:ILTypeRef) hidden = - match tref.Enclosing with - | [] -> if hidden then ILTypeDefAccess.Private else ComputePublicTypeAccess() +let ComputeTypeAccess (tref:ILTypeRef) hidden = + match tref.Enclosing with + | [] -> if hidden then ILTypeDefAccess.Private else ComputePublicTypeAccess() | _ -> ILTypeDefAccess.Nested (ComputeMemberAccess hidden) - + //-------------------------------------------------------------------------- // TypeReprEnv -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- -/// Indicates how type parameters are mapped to IL type variables +/// Indicates how type parameters are mapped to IL type variables [] -type TypeReprEnv(reprs : Map, count: int) = +type TypeReprEnv(reprs : Map, count: int) = - member tyenv.Item (tp:Typar, m:range) = - try reprs.[tp.Stamp] - with :? KeyNotFoundException -> - errorR(InternalError("Undefined or unsolved type variable: " + showL(typarL tp),m)) + /// Lookup a type parameter + member __.Item (tp:Typar, m:range) = + try reprs.[tp.Stamp] + with :? KeyNotFoundException -> + errorR(InternalError("Undefined or unsolved type variable: " + showL(typarL tp), m)) // Random value for post-hoc diagnostic analysis on generated tree * - uint16 666 + uint16 666 + /// Add an additional type parameter to the environment. If the parameter is a units-of-measure parameter + /// then it is ignored, since it doesn't corespond to a .NET type parameter. member tyenv.AddOne (tp: Typar) = - if IsNonErasedTypar tp then + if IsNonErasedTypar tp then TypeReprEnv(reprs.Add (tp.Stamp, uint16 count), count + 1) else tyenv + /// Add multiple additional type parameters to the environment. member tyenv.Add tps = - (tyenv,tps) ||> List.fold (fun tyenv tp -> tyenv.AddOne tp) + (tyenv, tps) ||> List.fold (fun tyenv tp -> tyenv.AddOne tp) - member tyenv.Count = count + /// Get the count of the non-erased type parameters in scope. + member __.Count = count - static member Empty = + /// Get the empty environment, where no type parameters are in scope. + static member Empty = TypeReprEnv(count = 0, reprs = Map.empty) - static member ForTypars tps = + /// Get the environment for a fixed set of type parameters + static member ForTypars tps = TypeReprEnv.Empty.Add tps - - static member ForTycon (tycon:Tycon) = + + /// Get the environment for within a type definition + static member ForTycon (tycon:Tycon) = TypeReprEnv.ForTypars (tycon.TyparsNoRange) - - static member ForTyconRef (tycon:TyconRef) = + + /// Get the environment for generating a reference to items within a type definition + static member ForTyconRef (tycon:TyconRef) = TypeReprEnv.ForTycon tycon.Deref - + //-------------------------------------------------------------------------- // Generate type references -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- -let GenTyconRef (tcref:TyconRef) = +/// Get the ILTypeRef or other representation information for a type +let GenTyconRef (tcref:TyconRef) = assert(not tcref.IsTypeAbbrev) tcref.CompiledRepresentation -type VoidNotOK = VoidNotOK | VoidOK -#if DEBUG -let voidCheck m g permits ty = - if permits=VoidNotOK && isVoidTy g ty then - error(InternalError("System.Void unexpectedly detected in IL code generation. This should not occur.",m)) +type VoidNotOK = + | VoidNotOK + | VoidOK + +#if DEBUG +let voidCheck m g permits ty = + if permits=VoidNotOK && isVoidTy g ty then + error(InternalError("System.Void unexpectedly detected in IL code generation. This should not occur.", m)) #endif /// When generating parameter and return types generate precise .NET IL pointer types. -/// These can't be generated for generic instantiations, since .NET generics doesn't -/// permit this. But for 'naked' values (locals, parameters, return values etc.) machine -/// integer values and native pointer values are compatible (though the code is unverifiable). -type PtrsOK = - | PtrTypesOK +/// These can't be generated for generic instantiations, since .NET generics doesn't +/// permit this. But for 'naked' values (locals, parameters, return values etc.) machine +/// integer values and native pointer values are compatible (though the code is unverifiable). +type PtrsOK = + | PtrTypesOK | PtrTypesNotOK let GenReadOnlyAttributeIfNecessary (g: TcGlobals) ty = let add = isInByrefTy g ty && g.attrib_IsReadOnlyAttribute.TyconRef.CanDeref - if add then + if add then let attr = mkILCustomAttribute g.ilg (g.attrib_IsReadOnlyAttribute.TypeRef, [], [], []) Some attr else @@ -382,409 +462,446 @@ let GenReadOnlyAttributeIfNecessary (g: TcGlobals) ty = /// Generate "modreq([mscorlib]System.Runtime.InteropServices.InAttribute)" on inref types. let GenReadOnlyModReqIfNecessary (g: TcGlobals) ty ilTy = let add = isInByrefTy g ty && g.attrib_InAttribute.TyconRef.CanDeref - if add then + if add then ILType.Modified(true, g.attrib_InAttribute.TypeRef, ilTy) else ilTy -let rec GenTypeArgAux amap m tyenv tyarg = +let rec GenTypeArgAux amap m tyenv tyarg = GenTypeAux amap m tyenv VoidNotOK PtrTypesNotOK tyarg -and GenTypeArgsAux amap m tyenv tyargs = +and GenTypeArgsAux amap m tyenv tyargs = List.map (GenTypeArgAux amap m tyenv) (DropErasedTyargs tyargs) and GenTyAppAux amap m tyenv repr tinst = - match repr with - | CompiledTypeRepr.ILAsmOpen ty -> + match repr with + | CompiledTypeRepr.ILAsmOpen ty -> let ilTypeInst = GenTypeArgsAux amap m tyenv tinst let ty = IL.instILType ilTypeInst ty ty - | CompiledTypeRepr.ILAsmNamed (tref, boxity, ilTypeOpt) -> + | CompiledTypeRepr.ILAsmNamed (tref, boxity, ilTypeOpt) -> GenILTyAppAux amap m tyenv (tref, boxity, ilTypeOpt) tinst and GenILTyAppAux amap m tyenv (tref, boxity, ilTypeOpt) tinst = - match ilTypeOpt with - | None -> + match ilTypeOpt with + | None -> let ilTypeInst = GenTypeArgsAux amap m tyenv tinst - mkILTy boxity (mkILTySpec (tref,ilTypeInst)) - | Some ilType -> + mkILTy boxity (mkILTySpec (tref, ilTypeInst)) + | Some ilType -> ilType // monomorphic types include a cached ilType to avoid reallocation of an ILType node -and GenNamedTyAppAux (amap:ImportMap) m tyenv ptrsOK tcref tinst = +and GenNamedTyAppAux (amap:ImportMap) m tyenv ptrsOK tcref tinst = let g = amap.g - let tinst = DropErasedTyargs tinst - - // See above note on ptrsOK - if ptrsOK = PtrTypesOK && tyconRefEq g tcref g.nativeptr_tcr && (freeInTypes CollectTypars tinst).FreeTypars.IsEmpty then + let tinst = DropErasedTyargs tinst + + // See above note on ptrsOK + if ptrsOK = PtrTypesOK && tyconRefEq g tcref g.nativeptr_tcr && (freeInTypes CollectTypars tinst).FreeTypars.IsEmpty then GenNamedTyAppAux amap m tyenv ptrsOK g.ilsigptr_tcr tinst else #if !NO_EXTENSIONTYPING - match tcref.TypeReprInfo with + match tcref.TypeReprInfo with // Generate the base type, because that is always the representation of the erased type, unless the assembly is being injected - | TProvidedTypeExtensionPoint info when info.IsErased -> - GenTypeAux amap m tyenv VoidNotOK ptrsOK (info.BaseTypeForErased (m,g.obj_ty)) - | _ -> + | TProvidedTypeExtensionPoint info when info.IsErased -> + GenTypeAux amap m tyenv VoidNotOK ptrsOK (info.BaseTypeForErased (m, g.obj_ty)) + | _ -> #endif GenTyAppAux amap m tyenv (GenTyconRef tcref) tinst and GenTypeAux amap m (tyenv: TypeReprEnv) voidOK ptrsOK ty = let g = amap.g -#if DEBUG +#if DEBUG voidCheck m g voidOK ty #else - ignore voidOK + ignore voidOK #endif - match stripTyEqnsAndMeasureEqns g ty with + match stripTyEqnsAndMeasureEqns g ty with | TType_app (tcref, tinst) -> GenNamedTyAppAux amap m tyenv ptrsOK tcref tinst - + | TType_tuple (tupInfo, args) -> GenTypeAux amap m tyenv VoidNotOK ptrsOK (mkCompiledTupleTy g (evalTupInfoIsStruct tupInfo) args) | TType_fun (dty, returnTy) -> EraseClosures.mkILFuncTy g.ilxPubCloEnv (GenTypeArgAux amap m tyenv dty) (GenTypeArgAux amap m tyenv returnTy) - | TType_anon (anonInfo, tinst) -> + + | TType_anon (anonInfo, tinst) -> let tref = anonInfo.ILTypeRef let boxity = if evalAnonInfoIsStruct anonInfo then ILBoxity.AsValue else ILBoxity.AsObject - GenILTyAppAux amap m tyenv (tref, boxity, None) tinst + GenILTyAppAux amap m tyenv (tref, boxity, None) tinst - | TType_ucase (ucref, args) -> - let cuspec,idx = GenUnionCaseSpec amap m tyenv ucref args + | TType_ucase (ucref, args) -> + let cuspec, idx = GenUnionCaseSpec amap m tyenv ucref args EraseUnions.GetILTypeForAlternative cuspec idx - | TType_forall (tps, tau) -> - let tps = DropErasedTypars tps + | TType_forall (tps, tau) -> + let tps = DropErasedTypars tps if tps.IsEmpty then GenTypeAux amap m tyenv VoidNotOK ptrsOK tau - else EraseClosures.mkILTyFuncTy g.ilxPubCloEnv + else EraseClosures.mkILTyFuncTy g.ilxPubCloEnv - | TType_var tp -> mkILTyvarTy tyenv.[tp,m] + | TType_var tp -> mkILTyvarTy tyenv.[tp, m] - | TType_measure _ -> g.ilg.typ_Int32 + | TType_measure _ -> g.ilg.typ_Int32 //-------------------------------------------------------------------------- // Generate ILX references to closures, classunions etc. given a tyenv -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- -and GenUnionCaseRef (amap: ImportMap) m tyenv i (fspecs:RecdField[]) = +and GenUnionCaseRef (amap: ImportMap) m tyenv i (fspecs:RecdField[]) = let g = amap.g - fspecs |> Array.mapi (fun j fspec -> - let ilFieldDef = IL.mkILInstanceField(fspec.Name,GenType amap m tyenv fspec.FormalType, None, ILMemberAccess.Public) + fspecs |> Array.mapi (fun j fspec -> + let ilFieldDef = IL.mkILInstanceField(fspec.Name, GenType amap m tyenv fspec.FormalType, None, ILMemberAccess.Public) // These properties on the "field" of an alternative end up going on a property generated by cu_erase.fs IlxUnionField (ilFieldDef.With(customAttrs = mkILCustomAttrs [(mkCompilationMappingAttrWithVariantNumAndSeqNum g (int SourceConstructFlags.Field) i j )]))) - -and GenUnionRef (amap: ImportMap) m (tcref: TyconRef) = + +and GenUnionRef (amap: ImportMap) m (tcref: TyconRef) = let g = amap.g let tycon = tcref.Deref assert(not tycon.IsTypeAbbrev) - match tycon.UnionTypeInfo with + match tycon.UnionTypeInfo with | ValueNone -> failwith "GenUnionRef m" - | ValueSome funion -> - cached funion.CompiledRepresentation (fun () -> + | ValueSome funion -> + cached funion.CompiledRepresentation (fun () -> let tyenvinner = TypeReprEnv.ForTycon tycon match tcref.CompiledRepresentation with | CompiledTypeRepr.ILAsmOpen _ -> failwith "GenUnionRef m: unexpected ASM tyrep" - | CompiledTypeRepr.ILAsmNamed (tref,_,_) -> - let alternatives = - tycon.UnionCasesArray |> Array.mapi (fun i cspec -> + | CompiledTypeRepr.ILAsmNamed (tref, _, _) -> + let alternatives = + tycon.UnionCasesArray |> Array.mapi (fun i cspec -> { altName=cspec.CompiledName altCustomAttrs=emptyILCustomAttrs altFields=GenUnionCaseRef amap m tyenvinner i cspec.RecdFieldsArray }) let nullPermitted = IsUnionTypeWithNullAsTrueValue g tycon let hasHelpers = ComputeUnionHasHelpers g tcref let boxity = (if tcref.IsStructOrEnumTycon then ILBoxity.AsValue else ILBoxity.AsObject) - IlxUnionRef(boxity, tref,alternatives,nullPermitted,hasHelpers)) + IlxUnionRef(boxity, tref, alternatives, nullPermitted, hasHelpers)) -and ComputeUnionHasHelpers g (tcref : TyconRef) = +and ComputeUnionHasHelpers g (tcref : TyconRef) = if tyconRefEq g tcref g.unit_tcr_canon then NoHelpers elif tyconRefEq g tcref g.list_tcr_canon then SpecialFSharpListHelpers elif tyconRefEq g tcref g.option_tcr_canon then SpecialFSharpOptionHelpers else match TryFindFSharpAttribute g g.attrib_DefaultAugmentationAttribute tcref.Attribs with - | Some(Attrib(_,_,[ AttribBoolArg (b) ],_,_,_,_)) -> + | Some(Attrib(_, _, [ AttribBoolArg (b) ], _, _, _, _)) -> if b then AllHelpers else NoHelpers - | Some (Attrib(_,_,_,_,_,_,m)) -> - errorR(Error(FSComp.SR.ilDefaultAugmentationAttributeCouldNotBeDecoded(),m)) + | Some (Attrib(_, _, _, _, _, _, m)) -> + errorR(Error(FSComp.SR.ilDefaultAugmentationAttributeCouldNotBeDecoded(), m)) AllHelpers - | _ -> + | _ -> AllHelpers (* not hiddenRepr *) -and GenUnionSpec amap m tyenv tcref tyargs = +and GenUnionSpec amap m tyenv tcref tyargs = let curef = GenUnionRef amap m tcref let tinst = GenTypeArgs amap m tyenv tyargs - IlxUnionSpec(curef,tinst) + IlxUnionSpec(curef, tinst) -and GenUnionCaseSpec amap m tyenv (ucref:UnionCaseRef) tyargs = +and GenUnionCaseSpec amap m tyenv (ucref:UnionCaseRef) tyargs = let cuspec = GenUnionSpec amap m tyenv ucref.TyconRef tyargs cuspec, ucref.Index -and GenType amap m tyenv ty = +and GenType amap m tyenv ty = GenTypeAux amap m tyenv VoidNotOK PtrTypesNotOK ty - and GenTypes amap m tyenv tys = List.map (GenType amap m tyenv) tys + and GenTypePermitVoid amap m tyenv ty = (GenTypeAux amap m tyenv VoidOK PtrTypesNotOK ty) + and GenTypesPermitVoid amap m tyenv tys = List.map (GenTypePermitVoid amap m tyenv) tys and GenTyApp amap m tyenv repr tyargs = GenTyAppAux amap m tyenv repr tyargs -and GenNamedTyApp amap m tyenv tcref tinst = GenNamedTyAppAux amap m tyenv PtrTypesNotOK tcref tinst -/// IL void types are only generated for return types -and GenReturnType amap m tyenv returnTyOpt = - match returnTyOpt with +and GenNamedTyApp amap m tyenv tcref tinst = GenNamedTyAppAux amap m tyenv PtrTypesNotOK tcref tinst + +/// IL void types are only generated for return types +and GenReturnType amap m tyenv returnTyOpt = + match returnTyOpt with | None -> ILType.Void - | Some returnTy -> + | Some returnTy -> let ilTy = GenTypeAux amap m tyenv VoidNotOK(*1*) PtrTypesOK returnTy (*1: generate void from unit, but not accept void *) GenReadOnlyModReqIfNecessary amap.g returnTy ilTy -and GenParamType amap m tyenv isSlotSig ty = +and GenParamType amap m tyenv isSlotSig ty = let ilTy = GenTypeAux amap m tyenv VoidNotOK PtrTypesOK ty - if isSlotSig then - GenReadOnlyModReqIfNecessary amap.g ty ilTy - else + if isSlotSig then + GenReadOnlyModReqIfNecessary amap.g ty ilTy + else ilTy -and GenParamTypes amap m tyenv isSlotSig tys = - tys |> List.map (GenParamType amap m tyenv isSlotSig) +and GenParamTypes amap m tyenv isSlotSig tys = + tys |> List.map (GenParamType amap m tyenv isSlotSig) and GenTypeArgs amap m tyenv tyargs = GenTypeArgsAux amap m tyenv tyargs + and GenTypePermitVoidAux amap m tyenv ty = GenTypeAux amap m tyenv VoidOK PtrTypesNotOK ty -// Static fields generally go in a private InitializationCodeAndBackingFields section. This is to ensure all static -// fields are initialized only in their class constructors (we generate one primary -// cctor for each file to ensure initialization coherence across the file, regardless +// Static fields generally go in a private InitializationCodeAndBackingFields section. This is to ensure all static +// fields are initialized only in their class constructors (we generate one primary +// cctor for each file to ensure initialization coherence across the file, regardless // of how many modules are in the file). This means F# passes an extra check applied by SQL Server when it // verifies stored procedures: SQL Server checks that all 'initionly' static fields are only initialized from -// their own class constructor. -// +// their own class constructor. +// // However, mutable static fields must be accessible across compilation units. This means we place them in their "natural" location -// which may be in a nested module etc. This means mutable static fields can't be used in code to be loaded by SQL Server. -// -// Computes the location where the static field for a value lives. -// - Literals go in their type/module. +// which may be in a nested module etc. This means mutable static fields can't be used in code to be loaded by SQL Server. +// +// Computes the location where the static field for a value lives. +// - Literals go in their type/module. // - For interactive code, we always place fields in their type/module with an accurate name let GenFieldSpecForStaticField (isInteractive, g, ilContainerTy, vspec:Val, nm, m, cloc, ilTy) = - if isInteractive || HasFSharpAttribute g g.attrib_LiteralAttribute vspec.Attribs then - let fieldName = vspec.CompiledName + if isInteractive || HasFSharpAttribute g g.attrib_LiteralAttribute vspec.Attribs then + let fieldName = vspec.CompiledName let fieldName = if isInteractive then CompilerGeneratedName fieldName else fieldName - mkILFieldSpecInTy (ilContainerTy, fieldName, ilTy) + mkILFieldSpecInTy (ilContainerTy, fieldName, ilTy) else - let fieldName = ilxgenGlobalNng.FreshCompilerGeneratedName (nm,m) + let fieldName = ilxgenGlobalNng.FreshCompilerGeneratedName (nm, m) let ilFieldContainerTy = mkILTyForCompLoc (CompLocForInitClass cloc) - mkILFieldSpecInTy (ilFieldContainerTy, fieldName, ilTy) + mkILFieldSpecInTy (ilFieldContainerTy, fieldName, ilTy) -let GenRecdFieldRef m cenv tyenv (rfref:RecdFieldRef) tyargs = +let GenRecdFieldRef m cenv tyenv (rfref:RecdFieldRef) tyargs = let tyenvinner = TypeReprEnv.ForTycon rfref.Tycon mkILFieldSpecInTy(GenTyApp cenv.amap m tyenv rfref.TyconRef.CompiledRepresentation tyargs, ComputeFieldName rfref.Tycon rfref.RecdField, GenType cenv.amap m tyenvinner rfref.RecdField.FormalType) let GenExnType amap m tyenv (ecref:TyconRef) = GenTyApp amap m tyenv ecref.CompiledRepresentation [] - + //-------------------------------------------------------------------------- // Closure summaries -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- type ArityInfo = int list - - + [] -type IlxClosureInfo = - { cloExpr: Expr +type IlxClosureInfo = + { /// The whole expression for the closure + cloExpr: Expr + + /// The name of the generated closure class cloName: string + + /// The counts of curried arguments for the closure cloArityInfo: ArityInfo + + /// The formal return type cloILFormalRetTy: ILType + /// An immutable array of free variable descriptions for the closure - cloILFreeVars: IlxClosureFreeVar[] + cloILFreeVars: IlxClosureFreeVar[] + + /// The ILX specification for the closure cloSpec: IlxClosureSpec + + /// The attributes that get attached to the closure class cloAttribs: Attribs + + /// The generic parameters for the closure, i.e. the type variables it captures cloILGenericParams: IL.ILGenericParameterDefs - cloFreeVars: Val list (* nb. the freevars we actually close over *) + + /// The free variables for the closure, i.e. the values it captures + cloFreeVars: Val list + + /// ILX view of the lambdas for the closures ilCloLambdas: IlxClosureLambdas - (* local type func support *) /// The free type parameters occuring in the type of the closure (and not just its body) /// This is used for local type functions, whose contract class must use these types /// type Contract<'fv> = /// abstract DirectInvoke : ty['fv] - /// type Implementation<'fv,'fv2> : Contract<'fv> = - /// override DirectInvoke : ty['fv] = expr['fv,'fv2] + /// type Implementation<'fv, 'fv2> : Contract<'fv> = + /// override DirectInvoke : ty['fv] = expr['fv, 'fv2] /// /// At the callsite we generate /// unbox ty['fv] /// callvirt clo.DirectInvoke localTypeFuncILGenericArgs: ILType list + + /// The free type parameters for the local type function as F# TAST types localTypeFuncContractFreeTypars: Typar list - localTypeFuncDirectILGenericParams: IL.ILGenericParameterDefs - localTypeFuncInternalFreeTypars: Typar list} + + localTypeFuncDirectILGenericParams: IL.ILGenericParameterDefs + + localTypeFuncInternalFreeTypars: Typar list + } //-------------------------------------------------------------------------- -// Representation of term declarations = Environments for compiling expressions. -//-------------------------------------------------------------------------- +// ValStorage +//-------------------------------------------------------------------------- - + +/// Describes the storage for a value [] -type ValStorage = +type ValStorage = /// Indicates the value is always null - | Null - /// Indicates the value is stored in a static field. + | Null + + /// Indicates the value is stored in a static field. | StaticField of ILFieldSpec * ValRef * (*hasLiteralAttr:*)bool * ILType * string * ILType * ILMethodRef * ILMethodRef * OptionalShadowLocal + /// Indicates the value is "stored" as a property that recomputes it each time it is referenced. Used for simple constants that do not cause initialization triggers | StaticProperty of ILMethodSpec * OptionalShadowLocal - /// Indicates the value is "stored" as a IL static method (in a "main" class for a F# - /// compilation unit, or as a member) according to its inferred or specified arity. + + /// Indicates the value is "stored" as a IL static method (in a "main" class for a F# + /// compilation unit, or as a member) according to its inferred or specified arity. | Method of ValReprInfo * ValRef * ILMethodSpec * Range.range * ArgReprInfo list * TType list * ArgReprInfo + /// Indicates the value is stored at the given position in the closure environment accessed via "ldarg 0" - | Env of ILType * int * ILFieldSpec * NamedLocalIlxClosureInfo ref option + | Env of ILType * int * ILFieldSpec * NamedLocalIlxClosureInfo ref option + /// Indicates that the value is an argument of a method being generated - | Arg of int + | Arg of int + /// Indicates that the value is stored in local of the method being generated. NamedLocalIlxClosureInfo is normally empty. /// It is non-empty for 'local type functions', see comments on definition of NamedLocalIlxClosureInfo. - | Local of idx: int * realloc: bool * NamedLocalIlxClosureInfo ref option + | Local of idx: int * realloc: bool * NamedLocalIlxClosureInfo ref option -and OptionalShadowLocal = +/// Indicates if there is a shadow local storage for a local, to make sure it gets a good name in debugging +and OptionalShadowLocal = | NoShadowLocal | ShadowLocal of ValStorage -/// The representation of a NamedLocalClosure is based on a cloinfo. However we can't generate a cloinfo until we've -/// decided the representations of other items in the recursive set. Hence we use two phases to decide representations in -/// a recursive set. Yuck. -and NamedLocalIlxClosureInfo = +/// The representation of a NamedLocalClosure is based on a cloinfo. However we can't generate a cloinfo until we've +/// decided the representations of other items in the recursive set. Hence we use two phases to decide representations in +/// a recursive set. Yuck. +and NamedLocalIlxClosureInfo = | NamedLocalIlxClosureInfoGenerator of (IlxGenEnv -> IlxClosureInfo) | NamedLocalIlxClosureInfoGenerated of IlxClosureInfo - -and ModuleStorage = - { Vals: Lazy> + +/// Indicates the overall representation decisions for all the elements of a namespace of module +and ModuleStorage = + { Vals: Lazy> SubModules: Lazy> } -/// BranchCallItems are those where a call to the value can be implemented as -/// a branch. At the moment these are only used for generating branch calls back to -/// the entry label of the method currently being generated. -and BranchCallItem = +/// Indicate whether a call to the value can be implemented as +/// a branch. At the moment these are only used for generating branch calls back to +/// the entry label of the method currently being generated when a direct tailcall is +/// made in the method itself. +and BranchCallItem = | BranchCallClosure of ArityInfo - | BranchCallMethod of + | BranchCallMethod of // Argument counts for compiled form of F# method or value - ArityInfo * + ArityInfo * // Arg infos for compiled form of F# method or value - (TType * ArgReprInfo) list list * + (TType * ArgReprInfo) list list * // Typars for F# method or value - Tast.Typars * + Tast.Typars * // Typars for F# method or value int * - // num obj args - int - -and Mark = - | Mark of ILCodeLabel (* places we can branch to *) + // num obj args + int + +/// Represents a place we can branch to +and Mark = + | Mark of ILCodeLabel member x.CodeLabel = (let (Mark(lab)) = x in lab) +/// The overall environment at a particular point in an expression tree. and IlxGenEnv = - { tyenv: TypeReprEnv + { /// The representation decisions for the (non-erased) type parameters that are in scope + tyenv: TypeReprEnv + + /// An ILType for some random type in this assembly someTypeInThisAssembly: ILType + + /// Indicates if we are generating code for the last file in a .EXE isFinalFile: bool - /// Where to place the stuff we're currently generating - cloc: CompileLocation - /// Hiding information down the signature chain, used to compute what's public to the assembly - sigToImplRemapInfo: (Remap * SignatureHidingInfo) list - /// All values in scope - valsInScope: ValMap> - /// For optimizing direct tail recursion to a loop - mark says where to branch to. Length is 0 or 1. - /// REVIEW: generalize to arbitrary nested local loops?? - innerVals: (ValRef * (BranchCallItem * Mark)) list - /// Full list of enclosing bound values. First non-compiler-generated element is used to help give nice names for closures and other expressions. - letBoundVars: ValRef list - /// The set of IL local variable indexes currently in use by lexically scoped variables, to allow reuse on different branches. - /// Really an integer set. - liveLocals: IntMap + + /// Indicates the default "place" for stuff we're currently generating + cloc: CompileLocation + + /// Hiding information down the signature chain, used to compute what's public to the assembly + sigToImplRemapInfo: (Remap * SignatureHidingInfo) list + + /// All values in scope + valsInScope: ValMap> + + /// For optimizing direct tail recursion to a loop - mark says where to branch to. Length is 0 or 1. + /// REVIEW: generalize to arbitrary nested local loops?? + innerVals: (ValRef * (BranchCallItem * Mark)) list + + /// Full list of enclosing bound values. First non-compiler-generated element is used to help give nice names for closures and other expressions. + letBoundVars: ValRef list + + /// The set of IL local variable indexes currently in use by lexically scoped variables, to allow reuse on different branches. + /// Really an integer set. + liveLocals: IntMap + /// Are we under the scope of a try, catch or finally? If so we can't tailcall. SEH = structured exception handling - withinSEH: bool } + withinSEH: bool + } + +let ReplaceTyenv tyenv (eenv: IlxGenEnv) = {eenv with tyenv = tyenv } + +let EnvForTypars tps eenv = {eenv with tyenv = TypeReprEnv.ForTypars tps } -let ReplaceTyenv tyenv (eenv: IlxGenEnv) = {eenv with tyenv = tyenv } -let EnvForTypars tps eenv = {eenv with tyenv = TypeReprEnv.ForTypars tps } let AddTyparsToEnv typars (eenv: IlxGenEnv) = {eenv with tyenv = eenv.tyenv.Add typars} -let AddSignatureRemapInfo _msg (rpi, mhi) eenv = - { eenv with sigToImplRemapInfo = (mkRepackageRemapping rpi,mhi) :: eenv.sigToImplRemapInfo } - -//-------------------------------------------------------------------------- -// Print eenv -//-------------------------------------------------------------------------- - -let OutputStorage (pps: TextWriter) s = - match s with - | StaticField _ -> pps.Write "(top)" - | StaticProperty _ -> pps.Write "(top)" - | Method _ -> pps.Write "(top)" - | Local _ -> pps.Write "(local)" - | Arg _ -> pps.Write "(arg)" - | Env _ -> pps.Write "(env)" +let AddSignatureRemapInfo _msg (rpi, mhi) eenv = + { eenv with sigToImplRemapInfo = (mkRepackageRemapping rpi, mhi) :: eenv.sigToImplRemapInfo } + +let OutputStorage (pps: TextWriter) s = + match s with + | StaticField _ -> pps.Write "(top)" + | StaticProperty _ -> pps.Write "(top)" + | Method _ -> pps.Write "(top)" + | Local _ -> pps.Write "(local)" + | Arg _ -> pps.Write "(arg)" + | Env _ -> pps.Write "(env)" | Null -> pps.Write "(null)" //-------------------------------------------------------------------------- // Augment eenv with values -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- -let AddStorageForVal (g: TcGlobals) (v,s) eenv = +let AddStorageForVal (g: TcGlobals) (v, s) eenv = let eenv = { eenv with valsInScope = eenv.valsInScope.Add v s } - // If we're compiling fslib then also bind the value as a non-local path to + // If we're compiling fslib then also bind the value as a non-local path to // allow us to resolve the compiler-non-local-references that arise from env.fs // // Do this by generating a fake "looking from the outside in" non-local value reference for // v, dereferencing it to find the corresponding signature Val, and adding an entry for the signature val. // // A similar code path exists in ilxgen.fs for the tables of "optimization data" for values - if g.compilingFslib then + if g.compilingFslib then // Passing an empty remap is sufficient for FSharp.Core.dll because it turns out the remapped type signature can // still be resolved. - match tryRescopeVal g.fslibCcu Remap.Empty v with + match tryRescopeVal g.fslibCcu Remap.Empty v with | ValueNone -> eenv - | ValueSome vref -> + | ValueSome vref -> match vref.TryDeref with - | ValueNone -> + | ValueNone -> //let msg = sprintf "could not dereference external value reference to something in FSharp.Core.dll during code generation, v.MangledName = '%s', v.Range = %s" v.MangledName (stringOfRange v.Range) //System.Diagnostics.Debug.Assert(false, msg) eenv - | ValueSome gv -> + | ValueSome gv -> { eenv with valsInScope = eenv.valsInScope.Add gv s } - else + else eenv -let AddStorageForLocalVals g vals eenv = List.foldBack (fun (v,s) acc -> AddStorageForVal g (v,notlazy s) acc) vals eenv +let AddStorageForLocalVals g vals eenv = List.foldBack (fun (v, s) acc -> AddStorageForVal g (v, notlazy s) acc) vals eenv //-------------------------------------------------------------------------- -// Lookup eenv -//-------------------------------------------------------------------------- - -open FSharp.Compiler.AbstractIL -open FSharp.Compiler.AbstractIL.Internal -open FSharp.Compiler.AbstractIL.Internal.Library +// Lookup eenv +//-------------------------------------------------------------------------- -let StorageForVal m v eenv = - let v = +let StorageForVal m v eenv = + let v = try eenv.valsInScope.[v] with :? KeyNotFoundException -> assert false - errorR(Error(FSComp.SR.ilUndefinedValue(showL(valAtBindL v)),m)) + errorR(Error(FSComp.SR.ilUndefinedValue(showL(valAtBindL v)), m)) notlazy (Arg 668(* random value for post-hoc diagnostic analysis on generated tree *) ) v.Force() let StorageForValRef m (v: ValRef) eenv = StorageForVal m v.Deref eenv -//-------------------------------------------------------------------------- -// Imported modules and the environment -// -// How a top level value is represented depends on its type. If it's a -// function or is polymorphic, then it gets represented as a -// method (possibly and instance method). Otherwise it gets represented as a -// static field. -//-------------------------------------------------------------------------- - -let IsValRefIsDllImport g (vref:ValRef) = - vref.Attribs |> HasFSharpAttributeOpt g g.attrib_DllImportAttribute +let IsValRefIsDllImport g (vref:ValRef) = + vref.Attribs |> HasFSharpAttributeOpt g g.attrib_DllImportAttribute -let GetMethodSpecForMemberVal amap g (memberInfo:ValMemberInfo) (vref:ValRef) = +/// Determine how a top level value is represented, when it is being represented +/// as a method. +let GetMethodSpecForMemberVal amap g (memberInfo:ValMemberInfo) (vref:ValRef) = let m = vref.Range - let tps,curriedArgInfos,returnTy,retInfo = + let tps, curriedArgInfos, returnTy, retInfo = assert(vref.ValReprInfo.IsSome) GetTopValTypeInCompiledForm g (Option.get vref.ValReprInfo) vref.Type m let tyenvUnderTypars = TypeReprEnv.ForTypars tps @@ -795,324 +912,348 @@ let GetMethodSpecForMemberVal amap g (memberInfo:ValMemberInfo) (vref:ValRef) = let parentTypars = parentTcref.TyparsNoRange let numParentTypars = parentTypars.Length if tps.Length < numParentTypars then error(InternalError("CodeGen check: type checking did not ensure that this method is sufficiently generic", m)) - let ctps,mtps = List.splitAt numParentTypars tps + let ctps, mtps = List.splitAt numParentTypars tps let isCompiledAsInstance = ValRefIsCompiledAsInstanceMember g vref - let ilActualRetTy = + let ilActualRetTy = let ilRetTy = GenReturnType amap m tyenvUnderTypars returnTy if isCtor || cctor then ILType.Void else ilRetTy let ilTy = GenType amap m tyenvUnderTypars (mkAppTy parentTcref (List.map mkTyparTy ctps)) - if isCompiledAsInstance || isCtor then - // Find the 'this' argument type if any - let thisTy,flatArgInfos = - if isCtor then (GetFSharpViewOfReturnType g returnTy),flatArgInfos - else - match flatArgInfos with + if isCompiledAsInstance || isCtor then + // Find the 'this' argument type if any + let thisTy, flatArgInfos = + if isCtor then (GetFSharpViewOfReturnType g returnTy), flatArgInfos + else + match flatArgInfos with | [] -> error(InternalError("This instance method '" + vref.LogicalName + "' has no arguments", m)) - | (h,_):: t -> h,t + | (h, _):: t -> h, t let thisTy = if isByrefTy g thisTy then destByrefTy g thisTy else thisTy let thisArgTys = argsOfAppTy g thisTy if numParentTypars <> thisArgTys.Length then let msg = sprintf "CodeGen check: type checking did not quantify the correct number of type variables for this method, #parentTypars = %d, #mtps = %d, #thisArgTys = %d" numParentTypars mtps.Length thisArgTys.Length - warning(InternalError(msg,m)) - else + warning(InternalError(msg, m)) + else List.iter2 - (fun gtp ty2 -> - if not (typeEquiv g (mkTyparTy gtp) ty2) then + (fun gtp ty2 -> + if not (typeEquiv g (mkTyparTy gtp) ty2) then warning(InternalError("CodeGen check: type checking did not quantify the correct type variables for this method: generalization list contained " + gtp.Name + "#" + string gtp.Stamp + " and list from 'this' pointer contained " + (showL(typeL ty2)), m))) - ctps + ctps thisArgTys - let methodArgTys,paramInfos = List.unzip flatArgInfos - let isSlotSig = memberInfo.MemberFlags.IsDispatchSlot || memberInfo.MemberFlags.IsOverrideOrExplicitImpl + let methodArgTys, paramInfos = List.unzip flatArgInfos + let isSlotSig = memberInfo.MemberFlags.IsDispatchSlot || memberInfo.MemberFlags.IsOverrideOrExplicitImpl let ilMethodArgTys = GenParamTypes amap m tyenvUnderTypars isSlotSig methodArgTys let ilMethodInst = GenTypeArgs amap m tyenvUnderTypars (List.map mkTyparTy mtps) - let mspec = mkILInstanceMethSpecInTy (ilTy,vref.CompiledName,ilMethodArgTys,ilActualRetTy,ilMethodInst) - - mspec,ctps,mtps,paramInfos,retInfo,methodArgTys - else - let methodArgTys,paramInfos = List.unzip flatArgInfos + let mspec = mkILInstanceMethSpecInTy (ilTy, vref.CompiledName, ilMethodArgTys, ilActualRetTy, ilMethodInst) + + mspec, ctps, mtps, paramInfos, retInfo, methodArgTys + else + let methodArgTys, paramInfos = List.unzip flatArgInfos let ilMethodArgTys = GenParamTypes amap m tyenvUnderTypars false methodArgTys let ilMethodInst = GenTypeArgs amap m tyenvUnderTypars (List.map mkTyparTy mtps) - let mspec = mkILStaticMethSpecInTy (ilTy,vref.CompiledName,ilMethodArgTys,ilActualRetTy,ilMethodInst) - - mspec,ctps,mtps,paramInfos,retInfo,methodArgTys - -// Generate the ILFieldSpec for a top-level value + let mspec = mkILStaticMethSpecInTy (ilTy, vref.CompiledName, ilMethodArgTys, ilActualRetTy, ilMethodInst) + + mspec, ctps, mtps, paramInfos, retInfo, methodArgTys -let ComputeFieldSpecForVal(optIntraAssemblyInfo:IlxGenIntraAssemblyInfo option, isInteractive, g, ilTyForProperty, vspec:Val, nm, m, cloc, ilTy, ilGetterMethRef) = +/// Determine how a top-level value is represented, when representing as a field, by computing an ILFieldSpec +let ComputeFieldSpecForVal(optIntraAssemblyInfo:IlxGenIntraAssemblyInfo option, isInteractive, g, ilTyForProperty, vspec:Val, nm, m, cloc, ilTy, ilGetterMethRef) = assert vspec.IsCompiledAsTopLevel let generate() = GenFieldSpecForStaticField (isInteractive, g, ilTyForProperty, vspec, nm, m, cloc, ilTy) - match optIntraAssemblyInfo with + match optIntraAssemblyInfo with | None -> generate() - | Some intraAssemblyInfo -> + | Some intraAssemblyInfo -> if vspec.IsMutable && vspec.IsCompiledAsTopLevel && isStructTy g vspec.Type then let ok, res = intraAssemblyInfo.StaticFieldInfo.TryGetValue ilGetterMethRef - if ok then - res - else + if ok then + res + else let res = generate() intraAssemblyInfo.StaticFieldInfo.[ilGetterMethRef] <- res res - else + else generate() -let IsValCompiledAsMethod g (v:Val) = - match v.ValReprInfo with +/// Compute the representation information for an F#-declared value (not a member nor a function). +/// Mutable and literal static fields must have stable names and live in the "public" location +let ComputeStorageForFSharpValue amap g cloc optIntraAssemblyInfo optShadowLocal isInteractive returnTy (vref:ValRef) m = + let nm = vref.CompiledName + let vspec = vref.Deref + let ilTy = GenType amap m TypeReprEnv.Empty returnTy (* TypeReprEnv.Empty ok: not a field in a generic class *) + let ilTyForProperty = mkILTyForCompLoc cloc + let attribs = vspec.Attribs + let hasLiteralAttr = HasFSharpAttribute g g.attrib_LiteralAttribute attribs + let ilTypeRefForProperty = ilTyForProperty.TypeRef + let ilGetterMethRef = mkILMethRef (ilTypeRefForProperty, ILCallingConv.Static, "get_"+nm, 0, [], ilTy) + let ilSetterMethRef = mkILMethRef (ilTypeRefForProperty, ILCallingConv.Static, "set_"+nm, 0, [ilTy], ILType.Void) + let ilFieldSpec = ComputeFieldSpecForVal(optIntraAssemblyInfo, isInteractive, g, ilTyForProperty, vspec, nm, m, cloc, ilTy, ilGetterMethRef) + StaticField (ilFieldSpec, vref, hasLiteralAttr, ilTyForProperty, nm, ilTy, ilGetterMethRef, ilSetterMethRef, optShadowLocal) + +/// Compute the representation information for an F#-declared member +let ComputeStorageForFSharpMember amap g topValInfo memberInfo (vref:ValRef) m = + let mspec, _, _, paramInfos, retInfo, methodArgTys = GetMethodSpecForMemberVal amap g memberInfo vref + Method (topValInfo, vref, mspec, m, paramInfos, methodArgTys, retInfo) + +/// Compute the representation information for an F#-declared function in a module or an F#-decalared extension member. +/// Note, there is considerable overlap with ComputeStorageForFSharpMember/GetMethodSpecForMemberVal and these could be +/// rationalized. +let ComputeStorageForFSharpFunctionOrFSharpExtensionMember amap g cloc topValInfo (vref:ValRef) m = + let nm = vref.CompiledName + let (tps, curriedArgInfos, returnTy, retInfo) = GetTopValTypeInCompiledForm g topValInfo vref.Type m + let tyenvUnderTypars = TypeReprEnv.ForTypars tps + let (methodArgTys, paramInfos) = curriedArgInfos |> List.concat |> List.unzip + let ilMethodArgTys = GenParamTypes amap m tyenvUnderTypars false methodArgTys + let ilRetTy = GenReturnType amap m tyenvUnderTypars returnTy + let ilLocTy = mkILTyForCompLoc cloc + let ilMethodInst = GenTypeArgs amap m tyenvUnderTypars (List.map mkTyparTy tps) + let mspec = mkILStaticMethSpecInTy (ilLocTy, nm, ilMethodArgTys, ilRetTy, ilMethodInst) + Method (topValInfo, vref, mspec, m, paramInfos, methodArgTys, retInfo) + +/// Determine if an F#-declared value, method or function is compiled as a method. +let IsFSharpValCompiledAsMethod g (v:Val) = + match v.ValReprInfo with | None -> false - | Some topValInfo -> + | Some topValInfo -> not (isUnitTy g v.Type && not v.IsMemberOrModuleBinding && not v.IsMutable) && not v.IsCompiledAsStaticPropertyWithoutField && - match GetTopValTypeInFSharpForm g topValInfo v.Type v.Range with - | [],[],_,_ when not v.IsMember -> false + match GetTopValTypeInFSharpForm g topValInfo v.Type v.Range with + | [], [], _, _ when not v.IsMember -> false | _ -> true -// This called via 2 routes. -// (a) ComputeAndAddStorageForLocalTopVal -// (b) ComputeStorageForNonLocalTopVal -// -/// This function decides the storage for the val. -/// The decision is based on arityInfo. +/// Determine how a top level value is represented, when it is being represented +/// as a method. This depends on its type and other representation inforrmation. +/// If it's a function or is polymorphic, then it gets represented as a +/// method (possibly and instance method). Otherwise it gets represented as a +/// static field and property. let ComputeStorageForTopVal (amap, g, optIntraAssemblyInfo:IlxGenIntraAssemblyInfo option, isInteractive, optShadowLocal, vref:ValRef, cloc) = - if isUnitTy g vref.Type && not vref.IsMemberOrModuleBinding && not vref.IsMutable then - Null + if isUnitTy g vref.Type && not vref.IsMemberOrModuleBinding && not vref.IsMutable then + Null else - let topValInfo = - match vref.ValReprInfo with - | None -> error(InternalError("ComputeStorageForTopVal: no arity found for " + showL(valRefL vref),vref.Range)) + let topValInfo = + match vref.ValReprInfo with + | None -> error(InternalError("ComputeStorageForTopVal: no arity found for " + showL(valRefL vref), vref.Range)) | Some a -> a - + let m = vref.Range - let nm = vref.CompiledName + let nm = vref.CompiledName - if vref.Deref.IsCompiledAsStaticPropertyWithoutField then - let nm = "get_"+nm + if vref.Deref.IsCompiledAsStaticPropertyWithoutField then + let nm = "get_"+nm let tyenvUnderTypars = TypeReprEnv.ForTypars [] let ilRetTy = GenType amap m tyenvUnderTypars vref.Type let ty = mkILTyForCompLoc cloc let mspec = mkILStaticMethSpecInTy (ty, nm, [], ilRetTy, []) - + StaticProperty (mspec, optShadowLocal) - else + else // Determine when a static field is required. // // REVIEW: This call to GetTopValTypeInFSharpForm is only needed to determine if this is a (type) function or a value // We should just look at the arity - match GetTopValTypeInFSharpForm g topValInfo vref.Type vref.Range with - | [],[], returnTy,_ when not vref.IsMember -> - // Mutable and literal static fields must have stable names and live in the "public" location - // See notes on GenFieldSpecForStaticField above. - let vspec = vref.Deref - let ilTy = GenType amap m TypeReprEnv.Empty returnTy (* TypeReprEnv.Empty ok: not a field in a generic class *) - let ilTyForProperty = mkILTyForCompLoc cloc - let attribs = vspec.Attribs - let hasLiteralAttr = HasFSharpAttribute g g.attrib_LiteralAttribute attribs - - let ilTypeRefForProperty = ilTyForProperty.TypeRef - let ilGetterMethRef = mkILMethRef (ilTypeRefForProperty, ILCallingConv.Static, "get_"+nm, 0, [], ilTy) - let ilSetterMethRef = mkILMethRef (ilTypeRefForProperty, ILCallingConv.Static, "set_"+nm, 0, [ilTy], ILType.Void) - - let fspec = ComputeFieldSpecForVal(optIntraAssemblyInfo, isInteractive, g, ilTyForProperty, vspec, nm, m, cloc, ilTy, ilGetterMethRef) - - StaticField (fspec, vref, hasLiteralAttr, ilTyForProperty, nm, ilTy, ilGetterMethRef, ilSetterMethRef, optShadowLocal) - - | _ -> - match vref.MemberInfo with - | Some memberInfo when not vref.IsExtensionMember -> - let mspec,_,_,paramInfos,retInfo,methodArgTys = GetMethodSpecForMemberVal amap g memberInfo vref - Method (topValInfo, vref, mspec, m, paramInfos, methodArgTys, retInfo) - | _ -> - let (tps, curriedArgInfos, returnTy, retInfo) = GetTopValTypeInCompiledForm g topValInfo vref.Type m - let tyenvUnderTypars = TypeReprEnv.ForTypars tps - let (methodArgTys,paramInfos) = curriedArgInfos |> List.concat |> List.unzip - let ilMethodArgTys = GenParamTypes amap m tyenvUnderTypars false methodArgTys - let ilRetTy = GenReturnType amap m tyenvUnderTypars returnTy - let ilLocTy = mkILTyForCompLoc cloc - let ilMethodInst = GenTypeArgs amap m tyenvUnderTypars (List.map mkTyparTy tps) - let mspec = mkILStaticMethSpecInTy (ilLocTy, nm, ilMethodArgTys, ilRetTy, ilMethodInst) - Method (topValInfo, vref, mspec, m, paramInfos, methodArgTys, retInfo) + match GetTopValTypeInFSharpForm g topValInfo vref.Type vref.Range with + | [], [], returnTy, _ when not vref.IsMember -> + ComputeStorageForFSharpValue amap g cloc optIntraAssemblyInfo optShadowLocal isInteractive returnTy vref m + | _ -> + match vref.MemberInfo with + | Some memberInfo when not vref.IsExtensionMember -> + ComputeStorageForFSharpMember amap g topValInfo memberInfo vref m + | _ -> + ComputeStorageForFSharpFunctionOrFSharpExtensionMember amap g cloc topValInfo vref m +/// Determine how an F#-declared value, function or member is represented, if it is in the assembly being compiled. let ComputeAndAddStorageForLocalTopVal (amap, g, intraAssemblyFieldTable, isInteractive, optShadowLocal) cloc (v:Val) eenv = let storage = ComputeStorageForTopVal (amap, g, Some intraAssemblyFieldTable, isInteractive, optShadowLocal, mkLocalValRef v, cloc) - AddStorageForVal g (v,notlazy storage) eenv + AddStorageForVal g (v, notlazy storage) eenv +/// Determine how an F#-declared value, function or member is represented, if it is an external assembly. let ComputeStorageForNonLocalTopVal amap g cloc modref (v:Val) = - match v.ValReprInfo with - | None -> error(InternalError("ComputeStorageForNonLocalTopVal, expected an arity for " + v.LogicalName,v.Range)) + match v.ValReprInfo with + | None -> error(InternalError("ComputeStorageForNonLocalTopVal, expected an arity for " + v.LogicalName, v.Range)) | Some _ -> ComputeStorageForTopVal (amap, g, None, false, NoShadowLocal, mkNestedValRef modref v, cloc) -let rec ComputeStorageForNonLocalModuleOrNamespaceRef amap g cloc acc (modref:ModuleOrNamespaceRef) (modul:ModuleOrNamespace) = - let acc = - (acc, modul.ModuleOrNamespaceType.ModuleAndNamespaceDefinitions) ||> List.fold (fun acc smodul -> - ComputeStorageForNonLocalModuleOrNamespaceRef amap g (CompLocForSubModuleOrNamespace cloc smodul) acc (modref.NestedTyconRef smodul) smodul) +/// Determine how all the F#-decalred top level values, functions and members are represented, for an external module or namespace. +let rec AddStorageForNonLocalModuleOrNamespaceRef amap g cloc acc (modref:ModuleOrNamespaceRef) (modul:ModuleOrNamespace) = + let acc = + (acc, modul.ModuleOrNamespaceType.ModuleAndNamespaceDefinitions) ||> List.fold (fun acc smodul -> + AddStorageForNonLocalModuleOrNamespaceRef amap g (CompLocForSubModuleOrNamespace cloc smodul) acc (modref.NestedTyconRef smodul) smodul) - let acc = - (acc, modul.ModuleOrNamespaceType.AllValsAndMembers) ||> Seq.fold (fun acc v -> - AddStorageForVal g (v, lazy (ComputeStorageForNonLocalTopVal amap g cloc modref v)) acc) + let acc = + (acc, modul.ModuleOrNamespaceType.AllValsAndMembers) ||> Seq.fold (fun acc v -> + AddStorageForVal g (v, lazy (ComputeStorageForNonLocalTopVal amap g cloc modref v)) acc) acc -let ComputeStorageForExternalCcu amap g eenv (ccu:CcuThunk) = +/// Determine how all the F#-declared top level values, functions and members are represented, for an external assembly. +let AddStorageForExternalCcu amap g eenv (ccu:CcuThunk) = if not ccu.IsFSharp then eenv else let cloc = CompLocForCcu ccu - let eenv = + let eenv = List.foldBack - (fun smodul acc -> + (fun smodul acc -> let cloc = CompLocForSubModuleOrNamespace cloc smodul let modref = mkNonLocalCcuRootEntityRef ccu smodul - ComputeStorageForNonLocalModuleOrNamespaceRef amap g cloc acc modref smodul) + AddStorageForNonLocalModuleOrNamespaceRef amap g cloc acc modref smodul) ccu.RootModulesAndNamespaces eenv - let eenv = + let eenv = let eref = ERefNonLocalPreResolved ccu.Contents (mkNonLocalEntityRef ccu [| |]) - (eenv, ccu.Contents.ModuleOrNamespaceType.AllValsAndMembers) ||> Seq.fold (fun acc v -> - AddStorageForVal g (v, lazy (ComputeStorageForNonLocalTopVal amap g cloc eref v)) acc) + (eenv, ccu.Contents.ModuleOrNamespaceType.AllValsAndMembers) ||> Seq.fold (fun acc v -> + AddStorageForVal g (v, lazy (ComputeStorageForNonLocalTopVal amap g cloc eref v)) acc) + eenv + +/// Record how all the top level F#-declared values, functions and members are represented, for a local module or namespace. +let rec AddBindingsForLocalModuleType allocVal cloc eenv (mty:ModuleOrNamespaceType) = + let eenv = List.fold (fun eenv submodul -> AddBindingsForLocalModuleType allocVal (CompLocForSubModuleOrNamespace cloc submodul) eenv submodul.ModuleOrNamespaceType) eenv mty.ModuleAndNamespaceDefinitions + let eenv = Seq.fold (fun eenv v -> allocVal cloc v eenv) eenv mty.AllValsAndMembers eenv - -let rec AddBindingsForLocalModuleType allocVal cloc eenv (mty:ModuleOrNamespaceType) = - let eenv = List.fold (fun eenv submodul -> AddBindingsForLocalModuleType allocVal (CompLocForSubModuleOrNamespace cloc submodul) eenv submodul.ModuleOrNamespaceType) eenv mty.ModuleAndNamespaceDefinitions - let eenv = Seq.fold (fun eenv v -> allocVal cloc v eenv) eenv mty.AllValsAndMembers - eenv -let AddExternalCcusToIlxGenEnv amap g eenv ccus = List.fold (ComputeStorageForExternalCcu amap g) eenv ccus +/// Record how all the top level F#-declared values, functions and members are represented, for a set of referenced assemblies. +let AddExternalCcusToIlxGenEnv amap g eenv ccus = + List.fold (AddStorageForExternalCcu amap g) eenv ccus +/// Record how all the unrealized abstract slots are represented, for a type definition. let AddBindingsForTycon allocVal (cloc:CompileLocation) (tycon:Tycon) eenv = - let unrealizedSlots = + let unrealizedSlots = if tycon.IsFSharpObjectModelTycon - then tycon.FSharpObjectModelTypeInfo.fsobjmodel_vslots + then tycon.FSharpObjectModelTypeInfo.fsobjmodel_vslots else [] - (eenv,unrealizedSlots) ||> List.fold (fun eenv vref -> allocVal cloc vref.Deref eenv) + (eenv, unrealizedSlots) ||> List.fold (fun eenv vref -> allocVal cloc vref.Deref eenv) -let rec AddBindingsForModuleDefs allocVal (cloc:CompileLocation) eenv mdefs = +/// Record how constructs are represented, for a sequence of definitions in a module or namespace fragment. +let rec AddBindingsForModuleDefs allocVal (cloc:CompileLocation) eenv mdefs = List.fold (AddBindingsForModuleDef allocVal cloc) eenv mdefs -and AddBindingsForModuleDef allocVal cloc eenv x = - match x with - | TMDefRec(_isRec,tycons,mbinds,_) -> - (* Virtual don't have 'let' bindings and must be added to the environment *) +/// Record how constructs are represented, for a module or namespace fragment definition. +and AddBindingsForModuleDef allocVal cloc eenv x = + match x with + | TMDefRec(_isRec, tycons, mbinds, _) -> + // Virtual don't have 'let' bindings and must be added to the environment let eenv = List.foldBack (AddBindingsForTycon allocVal cloc) tycons eenv let eenv = List.foldBack (AddBindingsForModule allocVal cloc) mbinds eenv eenv - | TMDefLet(bind,_) -> + | TMDefLet(bind, _) -> allocVal cloc bind.Var eenv - | TMDefDo _ -> + | TMDefDo _ -> eenv - | TMAbstract(ModuleOrNamespaceExprWithSig(mtyp, _, _)) -> + | TMAbstract(ModuleOrNamespaceExprWithSig(mtyp, _, _)) -> AddBindingsForLocalModuleType allocVal cloc eenv mtyp - | TMDefs(mdefs) -> - AddBindingsForModuleDefs allocVal cloc eenv mdefs + | TMDefs(mdefs) -> + AddBindingsForModuleDefs allocVal cloc eenv mdefs -and AddBindingsForModule allocVal cloc x eenv = - match x with - | ModuleOrNamespaceBinding.Binding bind -> +/// Record how constructs are represented, for a module or namespace. +and AddBindingsForModule allocVal cloc x eenv = + match x with + | ModuleOrNamespaceBinding.Binding bind -> allocVal cloc bind.Var eenv - | ModuleOrNamespaceBinding.Module (mspec, mdef) -> - let cloc = - if mspec.IsNamespace then cloc - else CompLocForFixedModule cloc.clocQualifiedNameOfFile cloc.clocTopImplQualifiedName mspec - + | ModuleOrNamespaceBinding.Module (mspec, mdef) -> + let cloc = + if mspec.IsNamespace then cloc + else CompLocForFixedModule cloc.QualifiedNameOfFile cloc.TopImplQualifiedName mspec + AddBindingsForModuleDef allocVal cloc eenv mdef -and AddBindingsForModuleTopVals _g allocVal _cloc eenv vs = +/// Record how constructs are represented, for the values and functions defined in a module or namespace fragment. +and AddBindingsForModuleTopVals _g allocVal _cloc eenv vs = List.foldBack allocVal vs eenv -// Put the partial results for a generated fragment (i.e. a part of a CCU generated by FSI) -// into the stored results for the whole CCU. -// isIncrementalFragment = true --> "typed input" -// isIncrementalFragment = false --> "#load" -let AddIncrementalLocalAssemblyFragmentToIlxGenEnv (amap:ImportMap, isIncrementalFragment, g, ccu, fragName, intraAssemblyInfo, eenv, typedImplFiles) = +/// Put the partial results for a generated fragment (i.e. a part of a CCU generated by FSI) +/// into the stored results for the whole CCU. +/// isIncrementalFragment = true --> "typed input" +/// isIncrementalFragment = false --> "#load" +let AddIncrementalLocalAssemblyFragmentToIlxGenEnv (amap:ImportMap, isIncrementalFragment, g, ccu, fragName, intraAssemblyInfo, eenv, typedImplFiles) = let cloc = CompLocForFragment fragName ccu let allocVal = ComputeAndAddStorageForLocalTopVal (amap, g, intraAssemblyInfo, true, NoShadowLocal) - (eenv, typedImplFiles) ||> List.fold (fun eenv (TImplFile(qname, _, mexpr, _, _, _)) -> - let cloc = { cloc with clocTopImplQualifiedName = qname.Text } - if isIncrementalFragment then + (eenv, typedImplFiles) ||> List.fold (fun eenv (TImplFile(qname, _, mexpr, _, _, _)) -> + let cloc = { cloc with TopImplQualifiedName = qname.Text } + if isIncrementalFragment then match mexpr with | ModuleOrNamespaceExprWithSig(_, mdef, _) -> AddBindingsForModuleDef allocVal cloc eenv mdef else - AddBindingsForLocalModuleType allocVal cloc eenv mexpr.Type) + AddBindingsForLocalModuleType allocVal cloc eenv mexpr.Type) //-------------------------------------------------------------------------- -// Generate debugging marks -//-------------------------------------------------------------------------- +// Generate debugging marks +//-------------------------------------------------------------------------- -let GenILSourceMarker (g: TcGlobals) (m:range) = +/// Generate IL debuging information. +let GenILSourceMarker (g: TcGlobals) (m:range) = ILSourceMarker.Create(document=g.memoize_file m.FileIndex, line=m.StartLine, /// NOTE: .NET && VS measure first column as column 1 - column= m.StartColumn+1, + column= m.StartColumn+1, endLine= m.EndLine, endColumn=m.EndColumn+1) -let GenPossibleILSourceMarker cenv m = - if cenv.opts.generateDebugSymbols then +/// Optionally generate IL debuging information. +let GenPossibleILSourceMarker cenv m = + if cenv.opts.generateDebugSymbols then Some (GenILSourceMarker cenv.g m ) - else + else None //-------------------------------------------------------------------------- // Helpers for merging property definitions //-------------------------------------------------------------------------- -let HashRangeSorted (ht: IDictionary<_, (int * _)>) = - [ for KeyValue(_k,v) in ht -> v ] |> List.sortBy fst |> List.map snd +let HashRangeSorted (ht: IDictionary<_, (int * _)>) = + [ for KeyValue(_k, v) in ht -> v ] |> List.sortBy fst |> List.map snd -let MergeOptions m o1 o2 = - match o1,o2 with +let MergeOptions m o1 o2 = + match o1, o2 with | Some x, None | None, Some x -> Some x | None, None -> None - | Some x, Some _ -> + | Some x, Some _ -> #if DEBUG // This warning fires on some code that also triggers this warning: - // The implementation of a specified generic interface - // required a method implementation not fully supported by F# Interactive. In - // the unlikely event that the resulting class fails to load then compile + // The implementation of a specified generic interface + // required a method implementation not fully supported by F# Interactive. In + // the unlikely event that the resulting class fails to load then compile // the interface type into a statically-compiled DLL and reference it using '#r' // The code is OK so we don't print this. - errorR(InternalError("MergeOptions: two values given",m)) + errorR(InternalError("MergeOptions: two values given", m)) #else ignore m #endif - Some x + Some x -let MergePropertyPair m (pd: ILPropertyDef) (pdef: ILPropertyDef) = +let MergePropertyPair m (pd: ILPropertyDef) (pdef: ILPropertyDef) = pd.With(getMethod=MergeOptions m pd.GetMethod pdef.GetMethod, setMethod=MergeOptions m pd.SetMethod pdef.SetMethod) type PropKey = PropKey of string * ILTypes * ILThisConvention -let AddPropertyDefToHash (m:range) (ht:Dictionary) (pdef: ILPropertyDef) = +let AddPropertyDefToHash (m:range) (ht:Dictionary) (pdef: ILPropertyDef) = let nm = PropKey(pdef.Name, pdef.Args, pdef.CallingConv) match ht.TryGetValue(nm) with | true, (idx, pd) -> ht.[nm] <- (idx, MergePropertyPair m pd pdef) | _ -> ht.[nm] <- (ht.Count, pdef) - -/// Merge a whole group of properties all at once -let MergePropertyDefs m ilPropertyDefs = - let ht = new Dictionary<_,_>(3,HashIdentity.Structural) - ilPropertyDefs |> List.iter (AddPropertyDefToHash m ht) + +/// Merge a whole group of properties all at once +let MergePropertyDefs m ilPropertyDefs = + let ht = new Dictionary<_, _>(3, HashIdentity.Structural) + ilPropertyDefs |> List.iter (AddPropertyDefToHash m ht) HashRangeSorted ht //-------------------------------------------------------------------------- // Buffers for compiling modules. The entire assembly gets compiled via an AssemblyBuilder -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- -/// Information collected imperatively for each type definition -type TypeDefBuilder(tdef: ILTypeDef, tdefDiscards) = +/// Information collected imperatively for each type definition +type TypeDefBuilder(tdef: ILTypeDef, tdefDiscards) = let gmethods = new ResizeArray(0) let gfields = new ResizeArray(0) - let gproperties : Dictionary = new Dictionary<_,_>(3,HashIdentity.Structural) + let gproperties : Dictionary = new Dictionary<_, _>(3, HashIdentity.Structural) let gevents = new ResizeArray(0) let gnested = new TypeDefsBuilder() - - member b.Close() = + + member b.Close() = tdef.With(methods = mkILMethods (tdef.Methods.AsList @ ResizeArray.toList gmethods), fields = mkILFields (tdef.Fields.AsList @ ResizeArray.toList gfields), properties = mkILProperties (tdef.Properties.AsList @ HashRangeSorted gproperties ), @@ -1123,65 +1264,65 @@ type TypeDefBuilder(tdef: ILTypeDef, tdefDiscards) = member b.AddFieldDef(ilFieldDef) = gfields.Add ilFieldDef - member b.AddMethodDef(ilMethodDef) = - let discard = - match tdefDiscards with + member b.AddMethodDef(ilMethodDef) = + let discard = + match tdefDiscards with | Some (mdefDiscard, _) -> mdefDiscard ilMethodDef | None -> false - if not discard then + if not discard then gmethods.Add ilMethodDef member b.NestedTypeDefs = gnested member b.GetCurrentFields() = gfields |> Seq.readonly - /// Merge Get and Set property nodes, which we generate independently for F# code - /// when we come across their corresponding methods. - member b.AddOrMergePropertyDef(pdef,m) = - let discard = - match tdefDiscards with + /// Merge Get and Set property nodes, which we generate independently for F# code + /// when we come across their corresponding methods. + member b.AddOrMergePropertyDef(pdef, m) = + let discard = + match tdefDiscards with | Some (_, pdefDiscard) -> pdefDiscard pdef | None -> false - if not discard then + if not discard then AddPropertyDefToHash m gproperties pdef - member b.PrependInstructionsToSpecificMethodDef(cond,instrs,tag) = + member b.PrependInstructionsToSpecificMethodDef(cond, instrs, tag) = match ResizeArray.tryFindIndex cond gmethods with | Some idx -> gmethods.[idx] <- prependInstrsToMethod instrs gmethods.[idx] - | None -> gmethods.Add(mkILClassCtor (mkMethodBody (false,[],1,nonBranchingInstrsToCode instrs,tag))) + | None -> gmethods.Add(mkILClassCtor (mkMethodBody (false, [], 1, nonBranchingInstrsToCode instrs, tag))) -and TypeDefsBuilder() = +and TypeDefsBuilder() = let tdefs : Internal.Utilities.Collections.HashMultiMap = HashMultiMap(0, HashIdentity.Structural) - let mutable countDown = System.Int32.MaxValue + let mutable countDown = System.Int32.MaxValue - member b.Close() = - //The order we emit type definitions is not deterministic since it is using the reverse of a range from a hash table. We should use an approximation of source order. - // Ideally it shouldn't matter which order we use. + member b.Close() = + //The order we emit type definitions is not deterministic since it is using the reverse of a range from a hash table. We should use an approximation of source order. + // Ideally it shouldn't matter which order we use. // However, for some tests FSI generated code appears sensitive to the order, especially for nested types. - - [ for (b, eliminateIfEmpty) in HashRangeSorted tdefs do - let tdef = b.Close() + + [ for (b, eliminateIfEmpty) in HashRangeSorted tdefs do + let tdef = b.Close() // Skip the type if it is empty - if not eliminateIfEmpty - || not tdef.NestedTypes.AsList.IsEmpty - || not tdef.Fields.AsList.IsEmpty - || not tdef.Events.AsList.IsEmpty - || not tdef.Properties.AsList.IsEmpty - || not (Array.isEmpty tdef.Methods.AsArray) then + if not eliminateIfEmpty + || not tdef.NestedTypes.AsList.IsEmpty + || not tdef.Fields.AsList.IsEmpty + || not tdef.Events.AsList.IsEmpty + || not tdef.Properties.AsList.IsEmpty + || not (Array.isEmpty tdef.Methods.AsArray) then yield tdef ] - member b.FindTypeDefBuilder(nm) = + member b.FindTypeDefBuilder(nm) = try tdefs.[nm] |> snd |> fst with :? KeyNotFoundException -> failwith ("FindTypeDefBuilder: " + nm + " not found") - member b.FindNestedTypeDefsBuilder(path) = + member b.FindNestedTypeDefsBuilder(path) = List.fold (fun (acc:TypeDefsBuilder) x -> acc.FindTypeDefBuilder(x).NestedTypeDefs) b path - member b.FindNestedTypeDefBuilder(tref:ILTypeRef) = + member b.FindNestedTypeDefBuilder(tref:ILTypeRef) = b.FindNestedTypeDefsBuilder(tref.Enclosing).FindTypeDefBuilder(tref.Name) - member b.AddTypeDef(tdef:ILTypeDef, eliminateIfEmpty, addAtEnd, tdefDiscards) = + member b.AddTypeDef(tdef:ILTypeDef, eliminateIfEmpty, addAtEnd, tdefDiscards) = let idx = if addAtEnd then (countDown <- countDown - 1; countDown) else tdefs.Count tdefs.Add (tdef.Name, (idx, (new TypeDefBuilder(tdef, tdefDiscards), eliminateIfEmpty))) @@ -1189,75 +1330,75 @@ type AnonTypeGenerationTable() = let dict = Dictionary(HashIdentity.Structural) member __.Table = dict -/// Assembly generation buffers -type AssemblyBuilder(cenv:cenv, anonTypeTable: AnonTypeGenerationTable) as mgbuf = - // The Abstract IL table of types - let gtdefs= new TypeDefsBuilder() - // The definitions of top level values, as quotations. - let mutable reflectedDefinitions : Dictionary = Dictionary(HashIdentity.Reference) +/// Assembly generation buffers +type AssemblyBuilder(cenv:cenv, anonTypeTable: AnonTypeGenerationTable) as mgbuf = + // The Abstract IL table of types + let gtdefs= new TypeDefsBuilder() + // The definitions of top level values, as quotations. + let mutable reflectedDefinitions : Dictionary = Dictionary(HashIdentity.Reference) let mutable extraBindingsToGenerate = [] - // A memoization table for generating value types for big constant arrays + // A memoization table for generating value types for big constant arrays let rawDataValueTypeGenerator = new MemoizationTable<(CompileLocation * int) , ILTypeSpec> - ((fun (cloc,size) -> + ((fun (cloc, size) -> let name = CompilerGeneratedName ("T" + string(newUnique()) + "_" + string size + "Bytes") // Type names ending ...$T_37Bytes - let vtdef = mkRawDataValueTypeDef cenv.g.iltyp_ValueType (name,size,0us) - let vtref = NestedTypeRefForCompLoc cloc vtdef.Name - let vtspec = mkILTySpec(vtref,[]) + let vtdef = mkRawDataValueTypeDef cenv.g.iltyp_ValueType (name, size, 0us) + let vtref = NestedTypeRefForCompLoc cloc vtdef.Name + let vtspec = mkILTySpec(vtref, []) let vtdef = vtdef.WithAccess(ComputeTypeAccess vtref true) mgbuf.AddTypeDef(vtref, vtdef, false, true, None) - vtspec), + vtspec), keyComparer=HashIdentity.Structural) let generateAnonType genToStringMethod (isStruct, ilTypeRef, nms) = - - let flds = [ for (i,nm) in Array.indexed nms -> (nm, nm + "@", ILType.TypeVar (uint16 i)) ] + + let flds = [ for (i, nm) in Array.indexed nms -> (nm, nm + "@", ILType.TypeVar (uint16 i)) ] // Note that this alternative below would give the same names as C#, but the generated // comparison/equality doesn't know about these names. - //let flds = [ for (i,nm) in Array.indexed nms -> (nm, "<" + nm + ">" + "i__Field", ILType.TypeVar (uint16 i)) ] + //let flds = [ for (i, nm) in Array.indexed nms -> (nm, "<" + nm + ">" + "i__Field", ILType.TypeVar (uint16 i)) ] - let ilGenericParams = - [ for nm in nms -> - { Name = sprintf "<%s>j__TPar" nm + let ilGenericParams = + [ for nm in nms -> + { Name = sprintf "<%s>j__TPar" nm Constraints = [] Variance=NonVariant CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs HasReferenceTypeConstraint=false HasNotNullableValueTypeConstraint=false - HasDefaultConstructorConstraint= false + HasDefaultConstructorConstraint= false MetadataIndex = NoMetadataIdx } ] let ilTy = mkILFormalNamedTy (if isStruct then ILBoxity.AsValue else ILBoxity.AsObject) ilTypeRef ilGenericParams - // Generate the IL fields - let ilFieldDefs = - mkILFields - [ for (_, fldName, fldTy) in flds -> - let fdef = mkILInstanceField (fldName, fldTy, None, ILMemberAccess.Private) + // Generate the IL fields + let ilFieldDefs = + mkILFields + [ for (_, fldName, fldTy) in flds -> + let fdef = mkILInstanceField (fldName, fldTy, None, ILMemberAccess.Private) fdef.With(customAttrs = mkILCustomAttrs [ cenv.g.DebuggerBrowsableNeverAttribute ]) ] - - // Generate property definitions for the fields compiled as properties - let ilProperties = - mkILProperties - [ for (i,(propName, _fldName, fldTy)) in List.indexed flds -> + + // Generate property definitions for the fields compiled as properties + let ilProperties = + mkILProperties + [ for (i, (propName, _fldName, fldTy)) in List.indexed flds -> ILPropertyDef(name=propName, attributes=PropertyAttributes.None, setMethod=None, - getMethod=Some(mkILMethRef(ilTypeRef,ILCallingConv.Instance,"get_" + propName,0,[],fldTy )), + getMethod=Some(mkILMethRef(ilTypeRef, ILCallingConv.Instance, "get_" + propName, 0, [], fldTy )), callingConv=ILCallingConv.Instance.ThisConv, propertyType=fldTy, init= None, args=[], - customAttrs=mkILCustomAttrs [ mkCompilationMappingAttrWithSeqNum cenv.g (int SourceConstructFlags.Field) i ]) ] - - let ilMethods = - [ for (propName, fldName, fldTy) in flds -> - mkLdfldMethodDef ("get_" + propName,ILMemberAccess.Public,false,ilTy,fldName,fldTy) + customAttrs=mkILCustomAttrs [ mkCompilationMappingAttrWithSeqNum cenv.g (int SourceConstructFlags.Field) i ]) ] + + let ilMethods = + [ for (propName, fldName, fldTy) in flds -> + mkLdfldMethodDef ("get_" + propName, ILMemberAccess.Public, false, ilTy, fldName, fldTy) yield! genToStringMethod ilTy ] let ilBaseTy = (if isStruct then cenv.g.iltyp_ValueType else cenv.g.ilg.typ_Object) - + let ilCtorDef = mkILSimpleStorageCtorWithParamNames(None, (if isStruct then None else Some ilBaseTy.TypeSpec), ilTy, [], flds, ILMemberAccess.Public) let ilCtorRef = mkRefToILMethod(ilTypeRef, ilCtorDef) let ilMethodRefs = [| for mdef in ilMethods -> mkRefToILMethod(ilTypeRef, mdef) |] @@ -1266,38 +1407,38 @@ type AssemblyBuilder(cenv:cenv, anonTypeTable: AnonTypeGenerationTable) as mgbuf // Create a tycon that looks exactly like a record definition, to help drive the generation of equality/comparison code let m = range0 - let tps = - [ for nm in nms -> - let stp = Typar(mkSynId m ("T"+nm),TyparStaticReq.NoStaticReq,true) - NewTypar (TyparKind.Type, TyparRigidity.WarnIfNotRigid,stp,false,TyparDynamicReq.Yes,[],true,true) ] + let tps = + [ for nm in nms -> + let stp = Typar(mkSynId m ("T"+nm), TyparStaticReq.NoStaticReq, true) + NewTypar (TyparKind.Type, TyparRigidity.WarnIfNotRigid, stp, false, TyparDynamicReq.Yes, [], true, true) ] - let tycon = + let tycon = let lmtyp = MaybeLazy.Strict (NewEmptyModuleOrNamespaceType ModuleOrType) - let cpath = CompPath(ilTypeRef.Scope,[]) - NewTycon(Some cpath, ilTypeRef.Name, m, taccessPublic, taccessPublic, TyparKind.Type, LazyWithContext.NotLazy tps, XmlDoc.Empty, false, false, false, lmtyp) + let cpath = CompPath(ilTypeRef.Scope, []) + NewTycon(Some cpath, ilTypeRef.Name, m, taccessPublic, taccessPublic, TyparKind.Type, LazyWithContext.NotLazy tps, XmlDoc.Empty, false, false, false, lmtyp) - if isStruct then + if isStruct then tycon.SetIsStructRecordOrUnion(true) - tycon.entity_tycon_repr <- - TRecdRepr (MakeRecdFieldsTable - [ for (tp, (propName, _fldName, _fldTy)) in (List.zip tps flds) -> + tycon.entity_tycon_repr <- + TRecdRepr (MakeRecdFieldsTable + [ for (tp, (propName, _fldName, _fldTy)) in (List.zip tps flds) -> NewRecdField false None (mkSynId m propName) false (mkTyparTy tp) true false [] [] XmlDoc.Empty taccessPublic false ]) let tcref = mkLocalTyconRef tycon - let _,typ = generalizeTyconRef tcref + let _, typ = generalizeTyconRef tcref let tcaug = tcref.TypeContents - - tcaug.tcaug_interfaces <- - [ (cenv.g.mk_IStructuralComparable_ty,true,m) - (cenv.g.mk_IComparable_ty,true,m) - (mkAppTy cenv.g.system_GenericIComparable_tcref [typ],true,m) - (cenv.g.mk_IStructuralEquatable_ty,true,m) - (mkAppTy cenv.g.system_GenericIEquatable_tcref [typ],true,m) ] - - let vspec1,vspec2 = AugmentWithHashCompare.MakeValsForEqualsAugmentation cenv.g tcref - let evspec1,evspec2,evspec3 = AugmentWithHashCompare.MakeValsForEqualityWithComparerAugmentation cenv.g tcref - let cvspec1,cvspec2 = AugmentWithHashCompare.MakeValsForCompareAugmentation cenv.g tcref + + tcaug.tcaug_interfaces <- + [ (cenv.g.mk_IStructuralComparable_ty, true, m) + (cenv.g.mk_IComparable_ty, true, m) + (mkAppTy cenv.g.system_GenericIComparable_tcref [typ], true, m) + (cenv.g.mk_IStructuralEquatable_ty, true, m) + (mkAppTy cenv.g.system_GenericIEquatable_tcref [typ], true, m) ] + + let vspec1, vspec2 = AugmentWithHashCompare.MakeValsForEqualsAugmentation cenv.g tcref + let evspec1, evspec2, evspec3 = AugmentWithHashCompare.MakeValsForEqualityWithComparerAugmentation cenv.g tcref + let cvspec1, cvspec2 = AugmentWithHashCompare.MakeValsForCompareAugmentation cenv.g tcref let cvspec3 = AugmentWithHashCompare.MakeValsForCompareWithComparerAugmentation cenv.g tcref tcaug.SetCompare (mkLocalValRef cvspec1, mkLocalValRef cvspec2) @@ -1309,121 +1450,121 @@ type AssemblyBuilder(cenv:cenv, anonTypeTable: AnonTypeGenerationTable) as mgbuf let ilTypeDefAttribs = mkILCustomAttrs [ cenv.g.CompilerGeneratedAttribute; mkCompilationMappingAttr cenv.g (int SourceConstructFlags.RecordType) ] - let ilInterfaceTys = [ for (ity,_,_) in tcaug.tcaug_interfaces -> GenType cenv.amap m (TypeReprEnv.ForTypars tps) ity ] + let ilInterfaceTys = [ for (ity, _, _) in tcaug.tcaug_interfaces -> GenType cenv.amap m (TypeReprEnv.ForTypars tps) ity ] - let ilTypeDef = - mkILGenericClass (ilTypeRef.Name, ILTypeDefAccess.Public, ilGenericParams, ilBaseTy, ilInterfaceTys, - mkILMethods (ilCtorDef :: ilMethods), ilFieldDefs, emptyILTypeDefs, - ilProperties, mkILEvents [], ilTypeDefAttribs, + let ilTypeDef = + mkILGenericClass (ilTypeRef.Name, ILTypeDefAccess.Public, ilGenericParams, ilBaseTy, ilInterfaceTys, + mkILMethods (ilCtorDef :: ilMethods), ilFieldDefs, emptyILTypeDefs, + ilProperties, mkILEvents [], ilTypeDefAttribs, ILTypeInit.BeforeField) - + let ilTypeDef = ilTypeDef.WithSealed(true).WithSerializable(true) mgbuf.AddTypeDef(ilTypeRef, ilTypeDef, false, true, None) - - let extraBindings = + + let extraBindings = [ yield! AugmentWithHashCompare.MakeBindingsForCompareAugmentation cenv.g tycon yield! AugmentWithHashCompare.MakeBindingsForCompareWithComparerAugmentation cenv.g tycon - yield! AugmentWithHashCompare.MakeBindingsForEqualityWithComparerAugmentation cenv.g tycon + yield! AugmentWithHashCompare.MakeBindingsForEqualityWithComparerAugmentation cenv.g tycon yield! AugmentWithHashCompare.MakeBindingsForEqualsAugmentation cenv.g tycon ] - let optimizedExtraBindings = extraBindings |> List.map (fun (TBind(a,b,c)) -> TBind(a,cenv.optimizeDuringCodeGen b,c)) + let optimizedExtraBindings = extraBindings |> List.map (fun (TBind(a, b, c)) -> TBind(a, cenv.optimizeDuringCodeGen b, c)) extraBindingsToGenerate <- optimizedExtraBindings @ extraBindingsToGenerate - (ilCtorRef,ilMethodRefs,ilTy) + (ilCtorRef, ilMethodRefs, ilTy) let mutable explicitEntryPointInfo : ILTypeRef option = None /// static init fields on script modules. - let mutable scriptInitFspecs : (ILFieldSpec * range) list = [] + let mutable scriptInitFspecs : (ILFieldSpec * range) list = [] + + member mgbuf.AddScriptInitFieldSpec(fieldSpec, range) = + scriptInitFspecs <- (fieldSpec, range) :: scriptInitFspecs - member mgbuf.AddScriptInitFieldSpec(fieldSpec,range) = - scriptInitFspecs <- (fieldSpec,range) :: scriptInitFspecs - /// This initializes the script in #load and fsc command-line order causing their /// sideeffects to be executed. - member mgbuf.AddInitializeScriptsInOrderToEntryPoint() = + member mgbuf.AddInitializeScriptsInOrderToEntryPoint() = // Get the entry point and initialized any scripts in order. match explicitEntryPointInfo with | Some tref -> - let IntializeCompiledScript(fspec,m) = - mgbuf.AddExplicitInitToSpecificMethodDef((fun (md:ILMethodDef) -> md.IsEntryPoint), tref, fspec, GenPossibleILSourceMarker cenv m, [], []) + let IntializeCompiledScript(fspec, m) = + mgbuf.AddExplicitInitToSpecificMethodDef((fun (md:ILMethodDef) -> md.IsEntryPoint), tref, fspec, GenPossibleILSourceMarker cenv m, [], []) scriptInitFspecs |> List.iter IntializeCompiledScript | None -> () - member mgbuf.GenerateRawDataValueType(cloc,size) = + member mgbuf.GenerateRawDataValueType(cloc, size) = // Byte array literals require a ValueType of size the required number of bytes. // With fsi.exe, S.R.Emit TypeBuilder CreateType has restrictions when a ValueType VT is nested inside a type T, and T has a field of type VT. // To avoid this situation, these ValueTypes are generated under the private implementation rather than in the current cloc. [was bug 1532]. let cloc = CompLocForPrivateImplementationDetails cloc - rawDataValueTypeGenerator.Apply((cloc,size)) + rawDataValueTypeGenerator.Apply((cloc, size)) - member mgbuf.GenerateAnonType(genToStringMethod, anonInfo:AnonRecdTypeInfo) = + member mgbuf.GenerateAnonType(genToStringMethod, anonInfo:AnonRecdTypeInfo) = let isStruct = evalAnonInfoIsStruct anonInfo let key = anonInfo.Stamp - match anonTypeTable.Table.TryGetValue key with + match anonTypeTable.Table.TryGetValue key with | true, res -> res - | _ -> - let info = generateAnonType genToStringMethod (isStruct,anonInfo.ILTypeRef,anonInfo.SortedNames) + | _ -> + let info = generateAnonType genToStringMethod (isStruct, anonInfo.ILTypeRef, anonInfo.SortedNames) anonTypeTable.Table.[key] <- info info - member mgbuf.LookupAnonType(anonInfo:AnonRecdTypeInfo) = - match anonTypeTable.Table.TryGetValue anonInfo.Stamp with + member mgbuf.LookupAnonType(anonInfo:AnonRecdTypeInfo) = + match anonTypeTable.Table.TryGetValue anonInfo.Stamp with | true, res -> res | _ -> failwithf "the anonymous record %A has not been generated in the pre-phase of generating this module" anonInfo.ILTypeRef - member mgbuf.GrabExtraBindingsToGenerate() = + member mgbuf.GrabExtraBindingsToGenerate() = let result = extraBindingsToGenerate extraBindingsToGenerate <- [] result - member mgbuf.AddTypeDef(tref:ILTypeRef, tdef, eliminateIfEmpty, addAtEnd, tdefDiscards) = + member mgbuf.AddTypeDef(tref:ILTypeRef, tdef, eliminateIfEmpty, addAtEnd, tdefDiscards) = gtdefs.FindNestedTypeDefsBuilder(tref.Enclosing).AddTypeDef(tdef, eliminateIfEmpty, addAtEnd, tdefDiscards) member mgbuf.GetCurrentFields(tref:ILTypeRef) = gtdefs.FindNestedTypeDefBuilder(tref).GetCurrentFields() - member mgbuf.AddReflectedDefinition(vspec : Tast.Val,expr) = + member mgbuf.AddReflectedDefinition(vspec : Tast.Val, expr) = // preserve order by storing index of item let n = reflectedDefinitions.Count reflectedDefinitions.Add(vspec, (vspec.CompiledName, n, expr)) - - member mgbuf.ReplaceNameOfReflectedDefinition(vspec, newName) = + + member mgbuf.ReplaceNameOfReflectedDefinition(vspec, newName) = match reflectedDefinitions.TryGetValue vspec with | true, (name, n, expr) when name <> newName -> reflectedDefinitions.[vspec] <- (newName, n, expr) | _ -> () - member mgbuf.AddMethodDef(tref:ILTypeRef,ilMethodDef) = + member mgbuf.AddMethodDef(tref:ILTypeRef, ilMethodDef) = gtdefs.FindNestedTypeDefBuilder(tref).AddMethodDef(ilMethodDef) - if ilMethodDef.IsEntryPoint then + if ilMethodDef.IsEntryPoint then explicitEntryPointInfo <- Some(tref) - member mgbuf.AddExplicitInitToSpecificMethodDef(cond,tref,fspec,sourceOpt,feefee,seqpt) = - // Authoring a .cctor with effects forces the cctor for the 'initialization' module by doing a dummy store & load of a field - // Doing both a store and load keeps FxCop happier because it thinks the field is useful - let instrs = + member mgbuf.AddExplicitInitToSpecificMethodDef(cond, tref, fspec, sourceOpt, feefee, seqpt) = + // Authoring a .cctor with effects forces the cctor for the 'initialization' module by doing a dummy store & load of a field + // Doing both a store and load keeps FxCop happier because it thinks the field is useful + let instrs = [ yield! (if condition "NO_ADD_FEEFEE_TO_CCTORS" then [] elif condition "ADD_SEQPT_TO_CCTORS" then seqpt else feefee) // mark start of hidden code - yield mkLdcInt32 0 - yield mkNormalStsfld fspec - yield mkNormalLdsfld fspec - yield AI_pop] - gtdefs.FindNestedTypeDefBuilder(tref).PrependInstructionsToSpecificMethodDef(cond,instrs,sourceOpt) + yield mkLdcInt32 0 + yield mkNormalStsfld fspec + yield mkNormalLdsfld fspec + yield AI_pop] + gtdefs.FindNestedTypeDefBuilder(tref).PrependInstructionsToSpecificMethodDef(cond, instrs, sourceOpt) - member mgbuf.AddEventDef(tref,edef) = + member mgbuf.AddEventDef(tref, edef) = gtdefs.FindNestedTypeDefBuilder(tref).AddEventDef(edef) - member mgbuf.AddFieldDef(tref,ilFieldDef) = + member mgbuf.AddFieldDef(tref, ilFieldDef) = gtdefs.FindNestedTypeDefBuilder(tref).AddFieldDef(ilFieldDef) - member mgbuf.AddOrMergePropertyDef(tref,pdef,m) = - gtdefs.FindNestedTypeDefBuilder(tref).AddOrMergePropertyDef(pdef,m) + member mgbuf.AddOrMergePropertyDef(tref, pdef, m) = + gtdefs.FindNestedTypeDefBuilder(tref).AddOrMergePropertyDef(pdef, m) - member mgbuf.Close() = + member mgbuf.Close() = // old implementation adds new element to the head of list so result was accumulated in reversed order - let orderedReflectedDefinitions = - [for (KeyValue(vspec, (name, n, expr))) in reflectedDefinitions -> n, ((name,vspec), expr)] + let orderedReflectedDefinitions = + [for (KeyValue(vspec, (name, n, expr))) in reflectedDefinitions -> n, ((name, vspec), expr)] |> List.sortBy (fst >> (~-)) // invert the result to get 'order-by-descending' behavior (items in list are 0..* so we don't need to worry about int.MinValue) |> List.map snd gtdefs.Close(), orderedReflectedDefinitions @@ -1431,8 +1572,8 @@ type AssemblyBuilder(cenv:cenv, anonTypeTable: AnonTypeGenerationTable) as mgbuf member mgbuf.GetExplicitEntryPointInfo() = explicitEntryPointInfo -/// Record the types of the things on the evaluation stack. -/// Used for the few times we have to flush the IL evaluation stack and to compute maxStack. +/// Record the types of the things on the evaluation stack. +/// Used for the few times we have to flush the IL evaluation stack and to compute maxStack. type Pushes = ILType list type Pops = int let pop (i:int) : Pops = i @@ -1440,7 +1581,7 @@ let Push tys : Pushes = tys let Push0 = Push [] let FeeFee (cenv:cenv) = (if cenv.opts.testFlagEmitFeeFeeAs100001 then 100001 else 0x00feefee) -let FeeFeeInstr (cenv:cenv) doc = +let FeeFeeInstr (cenv:cenv) doc = I_seqpoint (ILSourceMarker.Create(document = doc, line = FeeFee cenv, column = 0, @@ -1451,95 +1592,95 @@ let FeeFeeInstr (cenv:cenv) doc = type CodeGenBuffer(m:range, mgbuf: AssemblyBuilder, methodName, - alreadyUsedArgs:int) = + alreadyUsedArgs:int) = let locals = new ResizeArray<((string * (Mark * Mark)) list * ILType * bool)>(10) let codebuf = new ResizeArray(200) let exnSpecs = new ResizeArray(10) // Keep track of the current stack so we can spill stuff when we hit a "try" when some stuff - // is on the stack. + // is on the stack. let mutable stack: ILType list = [] let mutable nstack = 0 let mutable maxStack = 0 let mutable hasSequencePoints = false let mutable anyDocument = None // we collect an arbitrary document in order to emit the header FeeFee if needed - - let codeLabelToPC : Dictionary = new Dictionary<_,_>(10) - let codeLabelToCodeLabel : Dictionary = new Dictionary<_,_>(10) - - let rec lab2pc n lbl = - if n = System.Int32.MaxValue then error(InternalError("recursive label graph",m)) + + let codeLabelToPC : Dictionary = new Dictionary<_, _>(10) + let codeLabelToCodeLabel : Dictionary = new Dictionary<_, _>(10) + + let rec lab2pc n lbl = + if n = System.Int32.MaxValue then error(InternalError("recursive label graph", m)) match codeLabelToCodeLabel.TryGetValue(lbl) with | true, l -> lab2pc (n + 1) l - | _ -> codeLabelToPC.[lbl] - + | _ -> codeLabelToPC.[lbl] + let mutable lastSeqPoint = None - // Add a nop to make way for the first sequence point. - do if mgbuf.cenv.opts.generateDebugSymbols then + // Add a nop to make way for the first sequence point. + do if mgbuf.cenv.opts.generateDebugSymbols then let doc = mgbuf.cenv.g.memoize_file m.FileIndex let i = FeeFeeInstr mgbuf.cenv doc codebuf.Add(i) // for the FeeFee or a better sequence point - member cgbuf.DoPushes (pushes: Pushes) = - for ty in pushes do - stack <- ty :: stack + member cgbuf.DoPushes (pushes: Pushes) = + for ty in pushes do + stack <- ty :: stack nstack <- nstack + 1 maxStack <- Operators.max maxStack nstack - member cgbuf.DoPops (n:Pops) = + member cgbuf.DoPops (n:Pops) = for i = 0 to n - 1 do match stack with - | [] -> + | [] -> let msg = sprintf "pop on empty stack during code generation, methodName = %s, m = %s" methodName (stringOfRange m) System.Diagnostics.Debug.Assert(false, msg) - warning(InternalError(msg,m)) - | _ :: t -> - stack <- t + warning(InternalError(msg, m)) + | _ :: t -> + stack <- t nstack <- nstack - 1 member cgbuf.GetCurrentStack() = stack - member cgbuf.AssertEmptyStack() = - if not (isNil stack) then - let msg = - sprintf "stack flush didn't work, or extraneous expressions left on stack before stack restore, methodName = %s, stack = %+A, m = %s" + member cgbuf.AssertEmptyStack() = + if not (isNil stack) then + let msg = + sprintf "stack flush didn't work, or extraneous expressions left on stack before stack restore, methodName = %s, stack = %+A, m = %s" methodName stack (stringOfRange m) System.Diagnostics.Debug.Assert(false, msg) - warning(InternalError(msg,m)) + warning(InternalError(msg, m)) () - member cgbuf.EmitInstr(pops,pushes,i) = + member cgbuf.EmitInstr(pops, pushes, i) = cgbuf.DoPops pops cgbuf.DoPushes pushes codebuf.Add i - member cgbuf.EmitInstrs (pops,pushes,is) = + member cgbuf.EmitInstrs (pops, pushes, is) = cgbuf.DoPops pops cgbuf.DoPushes pushes - is |> List.iter codebuf.Add + is |> List.iter codebuf.Add - member cgbuf.GetLastSequencePoint() = + member cgbuf.GetLastSequencePoint() = lastSeqPoint - - member private cgbuf.EnsureNopBetweenDebugPoints() = + + member private cgbuf.EnsureNopBetweenDebugPoints() = // Always add a nop between sequence points to help .NET get the stepping right // Don't do this after a FeeFee marker for hidden code - if (codebuf.Count > 0 && - (match codebuf.[codebuf.Count-1] with - | I_seqpoint sm when sm.Line <> FeeFee mgbuf.cenv -> true - | _ -> false)) then - + if (codebuf.Count > 0 && + (match codebuf.[codebuf.Count-1] with + | I_seqpoint sm when sm.Line <> FeeFee mgbuf.cenv -> true + | _ -> false)) then + codebuf.Add(AI_nop) - member cgbuf.EmitSeqPoint(src) = - if mgbuf.cenv.opts.generateDebugSymbols then + member cgbuf.EmitSeqPoint(src) = + if mgbuf.cenv.opts.generateDebugSymbols then let attr = GenILSourceMarker mgbuf.cenv.g src let i = I_seqpoint attr hasSequencePoints <- true // Replace the FeeFee seqpoint at the entry with a better sequence point - if codebuf.Count = 1 then + if codebuf.Count = 1 then assert (match codebuf.[0] with I_seqpoint _ -> true | _ -> false) codebuf.[0] <- i @@ -1550,10 +1691,10 @@ type CodeGenBuffer(m:range, // Save the last sequence point away so we can make a decision graph look consistent (i.e. reassert the sequence point at each target) lastSeqPoint <- Some src anyDocument <- Some attr.Document - + // Emit FeeFee breakpoints for hidden code, see https://blogs.msdn.microsoft.com/jmstall/2005/06/19/line-hidden-and-0xfeefee-sequence-points/ - member cgbuf.EmitStartOfHiddenCode() = - if mgbuf.cenv.opts.generateDebugSymbols then + member cgbuf.EmitStartOfHiddenCode() = + if mgbuf.cenv.opts.generateDebugSymbols then let doc = mgbuf.cenv.g.memoize_file m.FileIndex let i = FeeFeeInstr mgbuf.cenv doc hasSequencePoints <- true @@ -1561,80 +1702,80 @@ type CodeGenBuffer(m:range, // don't emit just after another FeeFee match codebuf.[codebuf.Count-1] with | I_seqpoint sm when sm.Line = FeeFee mgbuf.cenv -> () - | _ -> + | _ -> cgbuf.EnsureNopBetweenDebugPoints() codebuf.Add(i) - member cgbuf.EmitExceptionClause(clause) = + member cgbuf.EmitExceptionClause(clause) = exnSpecs.Add clause - member cgbuf.GenerateDelayMark(_nm) = + member cgbuf.GenerateDelayMark(_nm) = let lab = IL.generateCodeLabel() Mark lab - member cgbuf.SetCodeLabelToCodeLabel(lab1,lab2) = + member cgbuf.SetCodeLabelToCodeLabel(lab1, lab2) = #if DEBUG - if codeLabelToCodeLabel.ContainsKey(lab1) then + if codeLabelToCodeLabel.ContainsKey(lab1) then let msg = sprintf "two values given for label %s, methodName = %s, m = %s" (formatCodeLabel lab1) methodName (stringOfRange m) System.Diagnostics.Debug.Assert(false, msg) - warning(InternalError(msg,m)) + warning(InternalError(msg, m)) #endif codeLabelToCodeLabel.[lab1] <- lab2 - member cgbuf.SetCodeLabelToPC(lab,pc) = + member cgbuf.SetCodeLabelToPC(lab, pc) = #if DEBUG - if codeLabelToPC.ContainsKey(lab) then + if codeLabelToPC.ContainsKey(lab) then let msg = sprintf "two values given for label %s, methodName = %s, m = %s" (formatCodeLabel lab) methodName (stringOfRange m) System.Diagnostics.Debug.Assert(false, msg) - warning(InternalError(msg,m)) + warning(InternalError(msg, m)) #endif - codeLabelToPC.[lab] <- pc + codeLabelToPC.[lab] <- pc - member cgbuf.SetMark (mark1: Mark, mark2: Mark) = + member cgbuf.SetMark (mark1: Mark, mark2: Mark) = cgbuf.SetCodeLabelToCodeLabel(mark1.CodeLabel, mark2.CodeLabel) - - member cgbuf.SetMarkToHere (Mark lab) = - cgbuf.SetCodeLabelToPC(lab,codebuf.Count) + + member cgbuf.SetMarkToHere (Mark lab) = + cgbuf.SetCodeLabelToPC(lab, codebuf.Count) - member cgbuf.SetStack(s) = - stack <- s + member cgbuf.SetStack(s) = + stack <- s nstack <- s.Length - member cgbuf.Mark(s) = + member cgbuf.Mark(s) = let res = cgbuf.GenerateDelayMark(s) cgbuf.SetMarkToHere(res) - res + res member cgbuf.mgbuf = mgbuf member cgbuf.MethodName = methodName member cgbuf.PreallocatedArgCount = alreadyUsedArgs - member cgbuf.AllocLocal(ranges,ty,isFixed) = + member cgbuf.AllocLocal(ranges, ty, isFixed) = let j = locals.Count - locals.Add((ranges,ty,isFixed)) - j - - member cgbuf.ReallocLocal(cond,ranges,ty,isFixed) = - match ResizeArray.tryFindIndexi cond locals with - | Some j -> - let (prevRanges,_,isFixed) = locals.[j] - locals.[j] <- ((ranges@prevRanges),ty,isFixed) + locals.Add((ranges, ty, isFixed)) + j + + member cgbuf.ReallocLocal(cond, ranges, ty, isFixed) = + match ResizeArray.tryFindIndexi cond locals with + | Some j -> + let (prevRanges, _, isFixed) = locals.[j] + locals.[j] <- ((ranges@prevRanges), ty, isFixed) j, true - | None -> - cgbuf.AllocLocal(ranges,ty,isFixed), false + | None -> + cgbuf.AllocLocal(ranges, ty, isFixed), false - member cgbuf.Close() = + member cgbuf.Close() = - let instrs = codebuf.ToArray() + let instrs = codebuf.ToArray() // Fixup the first instruction to be a FeeFee sequence point if needed - let instrs = - instrs |> Array.mapi (fun idx i2 -> - if idx = 0 && (match i2 with AI_nop -> true | _ -> false) && anyDocument.IsSome then + let instrs = + instrs |> Array.mapi (fun idx i2 -> + if idx = 0 && (match i2 with AI_nop -> true | _ -> false) && anyDocument.IsSome then // This special dummy sequence point says skip the start of the method hasSequencePoints <- true FeeFeeInstr mgbuf.cenv anyDocument.Value - else + else i2) let codeLabels = @@ -1645,12 +1786,12 @@ type CodeGenBuffer(m:range, (ResizeArray.toList locals, maxStack, codeLabels, instrs, ResizeArray.toList exnSpecs, hasSequencePoints) -module CG = - let EmitInstr (cgbuf:CodeGenBuffer) pops pushes i = cgbuf.EmitInstr(pops,pushes,i) - let EmitInstrs (cgbuf:CodeGenBuffer) pops pushes is = cgbuf.EmitInstrs(pops,pushes,is) +module CG = + let EmitInstr (cgbuf:CodeGenBuffer) pops pushes i = cgbuf.EmitInstr(pops, pushes, i) + let EmitInstrs (cgbuf:CodeGenBuffer) pops pushes is = cgbuf.EmitInstrs(pops, pushes, is) let EmitSeqPoint (cgbuf:CodeGenBuffer) src = cgbuf.EmitSeqPoint(src) let GenerateDelayMark (cgbuf:CodeGenBuffer) nm = cgbuf.GenerateDelayMark(nm) - let SetMark (cgbuf:CodeGenBuffer) m1 m2 = cgbuf.SetMark(m1,m2) + let SetMark (cgbuf:CodeGenBuffer) m1 m2 = cgbuf.SetMark(m1, m2) let SetMarkToHere (cgbuf:CodeGenBuffer) m1 = cgbuf.SetMarkToHere(m1) let SetStack (cgbuf:CodeGenBuffer) s = cgbuf.SetStack(s) let GenerateMark (cgbuf:CodeGenBuffer) s = cgbuf.Mark(s) @@ -1659,36 +1800,36 @@ open CG //-------------------------------------------------------------------------- -// Compile constants -//-------------------------------------------------------------------------- +// Compile constants +//-------------------------------------------------------------------------- -let GenString cenv cgbuf s = +let GenString cenv cgbuf s = CG.EmitInstrs cgbuf (pop 0) (Push [cenv.g.ilg.typ_String]) [ I_ldstr s ] -let GenConstArray cenv (cgbuf:CodeGenBuffer) eenv ilElementType (data:'a[]) (write : ByteBuffer -> 'a -> unit) = +let GenConstArray cenv (cgbuf:CodeGenBuffer) eenv ilElementType (data:'a[]) (write : ByteBuffer -> 'a -> unit) = let buf = ByteBuffer.Create data.Length data |> Array.iter (write buf) let bytes = buf.Close() let ilArrayType = mkILArr1DTy ilElementType - if data.Length = 0 then - CG.EmitInstrs cgbuf (pop 0) (Push [ilArrayType]) [ mkLdcInt32 (0); I_newarr (ILArrayShape.SingleDimensional,ilElementType); ] - else - let vtspec = cgbuf.mgbuf.GenerateRawDataValueType(eenv.cloc,bytes.Length) + if data.Length = 0 then + CG.EmitInstrs cgbuf (pop 0) (Push [ilArrayType]) [ mkLdcInt32 (0); I_newarr (ILArrayShape.SingleDimensional, ilElementType); ] + else + let vtspec = cgbuf.mgbuf.GenerateRawDataValueType(eenv.cloc, bytes.Length) let ilFieldName = CompilerGeneratedName ("field" + string(newUnique())) let fty = ILType.Value vtspec - let ilFieldDef = mkILStaticField (ilFieldName,fty, None, Some bytes, ILMemberAccess.Assembly) + let ilFieldDef = mkILStaticField (ilFieldName, fty, None, Some bytes, ILMemberAccess.Assembly) let ilFieldDef = ilFieldDef.With(customAttrs = mkILCustomAttrs [ cenv.g.DebuggerBrowsableNeverAttribute ]) - let fspec = mkILFieldSpecInTy (mkILTyForCompLoc eenv.cloc,ilFieldName, fty) + let fspec = mkILFieldSpecInTy (mkILTyForCompLoc eenv.cloc, ilFieldName, fty) CountStaticFieldDef() - cgbuf.mgbuf.AddFieldDef(fspec.DeclaringTypeRef,ilFieldDef) - CG.EmitInstrs cgbuf + cgbuf.mgbuf.AddFieldDef(fspec.DeclaringTypeRef, ilFieldDef) + CG.EmitInstrs cgbuf (pop 0) (Push [ ilArrayType; ilArrayType; cenv.g.iltyp_RuntimeFieldHandle ]) [ mkLdcInt32 data.Length - I_newarr (ILArrayShape.SingleDimensional,ilElementType) - AI_dup - I_ldtoken (ILToken.ILField fspec) ] - CG.EmitInstrs cgbuf + I_newarr (ILArrayShape.SingleDimensional, ilElementType) + AI_dup + I_ldtoken (ILToken.ILField fspec) ] + CG.EmitInstrs cgbuf (pop 2) Push0 [ mkNormalCall (mkInitializeArrayMethSpec cenv.g) ] @@ -1696,13 +1837,13 @@ let GenConstArray cenv (cgbuf:CodeGenBuffer) eenv ilElementType (data:'a[]) (wri //-------------------------------------------------------------------------- // We normally generate in the context of a "what to do next" continuation -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- -type sequel = - | EndFilter +type sequel = + | EndFilter /// Exit a 'handler' block - /// The integer says which local to save result in - | LeaveHandler of (bool (* finally? *) * int * Mark) + /// The integer says which local to save result in + | LeaveHandler of (bool (* finally? *) * int * Mark) /// Branch to the given mark | Br of Mark | CmpThenBrOrContinue of Pops * ILInstr list @@ -1712,9 +1853,9 @@ type sequel = | DiscardThen of sequel /// Return from the method | Return - /// End a scope of local variables. Used at end of 'let' and 'let rec' blocks to get tail recursive setting - /// of end-of-scope marks - | EndLocalScope of sequel * Mark + /// End a scope of local variables. Used at end of 'let' and 'let rec' blocks to get tail recursive setting + /// of end-of-scope marks + | EndLocalScope of sequel * Mark /// Return from a method whose return type is void | ReturnVoid @@ -1723,47 +1864,47 @@ let discardAndReturnVoid = DiscardThen ReturnVoid //------------------------------------------------------------------------- -// This is the main code generation routine. It is used to generate +// This is the main code generation routine. It is used to generate // the bodies of methods in a couple of places -//------------------------------------------------------------------------- - -let CodeGenThen cenv mgbuf (entryPointInfo,methodName,eenv,alreadyUsedArgs,codeGenFunction,m) = - let cgbuf = new CodeGenBuffer(m,mgbuf,methodName,alreadyUsedArgs) +//------------------------------------------------------------------------- + +let CodeGenThen cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, codeGenFunction, m) = + let cgbuf = new CodeGenBuffer(m, mgbuf, methodName, alreadyUsedArgs) let start = CG.GenerateMark cgbuf "mstart" - let innerVals = entryPointInfo |> List.map (fun (v,kind) -> (v,(kind,start))) + let innerVals = entryPointInfo |> List.map (fun (v, kind) -> (v, (kind, start))) (* Call the given code generator *) codeGenFunction cgbuf {eenv with withinSEH=false - liveLocals=IntMap.empty() + liveLocals=IntMap.empty() innerVals = innerVals} - let locals,maxStack,lab2pc,code,exnSpecs,hasSequencePoints = cgbuf.Close() - - let localDebugSpecs : ILLocalDebugInfo list = + let locals, maxStack, lab2pc, code, exnSpecs, hasSequencePoints = cgbuf.Close() + + let localDebugSpecs : ILLocalDebugInfo list = locals - |> List.mapi (fun i (nms,_,_isFixed) -> List.map (fun nm -> (i,nm)) nms) + |> List.mapi (fun i (nms, _, _isFixed) -> List.map (fun nm -> (i, nm)) nms) |> List.concat - |> List.map (fun (i,(nm,(start,finish))) -> + |> List.map (fun (i, (nm, (start, finish))) -> { Range=(start.CodeLabel, finish.CodeLabel) DebugMappings= [{ LocalIndex=i; LocalName=nm }] }) let ilLocals = locals |> List.map (fun (infos, ty, isFixed) -> - let loc = + let loc = // in interactive environment, attach name and range info to locals to improve debug experience if cenv.opts.isInteractive && cenv.opts.generateDebugSymbols then match infos with | [(nm, (start, finish))] -> mkILLocal ty (Some(nm, start.CodeLabel, finish.CodeLabel)) // REVIEW: what do these cases represent? | _ :: _ - | [] -> mkILLocal ty None + | [] -> mkILLocal ty None // if not interactive, don't bother adding this info else mkILLocal ty None if isFixed then { loc with IsPinned=true } else loc) - (ilLocals, + (ilLocals, maxStack, lab2pc, code, @@ -1771,35 +1912,35 @@ let CodeGenThen cenv mgbuf (entryPointInfo,methodName,eenv,alreadyUsedArgs,codeG localDebugSpecs, hasSequencePoints) -let CodeGenMethod cenv mgbuf (entryPointInfo,methodName,eenv,alreadyUsedArgs,codeGenFunction,m) = +let CodeGenMethod cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, codeGenFunction, m) = - let locals,maxStack,lab2pc,instrs,exns,localDebugSpecs,hasSequencePoints = - CodeGenThen cenv mgbuf (entryPointInfo,methodName,eenv,alreadyUsedArgs,codeGenFunction,m) + let locals, maxStack, lab2pc, instrs, exns, localDebugSpecs, hasSequencePoints = + CodeGenThen cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, codeGenFunction, m) let code = IL.buildILCode methodName lab2pc instrs exns localDebugSpecs - - // Attach a source range to the method. Only do this is it has some sequence points, because .NET 2.0/3.5 + + // Attach a source range to the method. Only do this is it has some sequence points, because .NET 2.0/3.5 // ILDASM has issues if you emit symbols with a source range but without any sequence points let sourceRange = if hasSequencePoints then GenPossibleILSourceMarker cenv m else None // The old union erasure phase increased maxstack by 2 since the code pushes some items, we do the same here let maxStack = maxStack + 2 - // Build an Abstract IL method - instrs, mkILMethodBody (true,locals,maxStack,code, sourceRange) + // Build an Abstract IL method + instrs, mkILMethodBody (true, locals, maxStack, code, sourceRange) let StartDelayedLocalScope nm cgbuf = - let startScope = CG.GenerateDelayMark cgbuf ("start_" + nm) + let startScope = CG.GenerateDelayMark cgbuf ("start_" + nm) let endScope = CG.GenerateDelayMark cgbuf ("end_" + nm) - startScope,endScope + startScope, endScope let StartLocalScope nm cgbuf = - let startScope = CG.GenerateMark cgbuf ("start_" + nm) + let startScope = CG.GenerateMark cgbuf ("start_" + nm) let endScope = CG.GenerateDelayMark cgbuf ("end_" + nm) - startScope,endScope - + startScope, endScope + let LocalScope nm cgbuf (f : (Mark * Mark) -> 'a) : 'a = - let _,endScope as scopeMarks = StartLocalScope nm cgbuf + let _, endScope as scopeMarks = StartLocalScope nm cgbuf let res = f scopeMarks CG.SetMarkToHere cgbuf endScope res @@ -1808,26 +1949,28 @@ let compileSequenceExpressions = true // try (System.Environment.GetEnvironmentV //------------------------------------------------------------------------- // Sequence Point Logic -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- -type EmitSequencePointState = +type EmitSequencePointState = /// Indicates that we need a sequence point at first opportunity. Used on entrance to a method /// and whenever we drop into an expression within the stepping control structure. - | SPAlways + | SPAlways + + /// Indicates we are not forced to emit a sequence point | SPSuppress /// Determines if any code at all will be emitted for a binding -let BindingEmitsNoCode g (TBind(vspec,_,_)) = IsValCompiledAsMethod g vspec +let BindingEmitsNoCode g (b: Binding) = IsFSharpValCompiledAsMethod g b.Var /// Determines what sequence point should be emitted when generating the r.h.s of a binding. /// For example, if the r.h.s is a lambda then no sequence point is emitted. /// /// Returns (isSticky, sequencePointForBind, sequencePointGenerationFlagForRhsOfBind) -let ComputeSequencePointInfoForBinding g (TBind(_,e,spBind) as bind) = - if BindingEmitsNoCode g bind then +let ComputeSequencePointInfoForBinding g (TBind(_, e, spBind) as bind) = + if BindingEmitsNoCode g bind then false, None, SPSuppress else - match spBind, stripExpr e with + match spBind, stripExpr e with | NoSequencePointAtInvisibleBinding, _ -> false, None, SPSuppress | NoSequencePointAtStickyBinding, _ -> true, None, SPSuppress | NoSequencePointAtDoBinding, _ -> false, None, SPAlways @@ -1835,111 +1978,111 @@ let ComputeSequencePointInfoForBinding g (TBind(_,e,spBind) as bind) = // Don't emit sequence points for lambdas. // SEQUENCE POINT REVIEW: don't emit for lazy either, nor any builder expressions, nor interface-implementing object expressions | _, (Expr.Lambda _ | Expr.TyLambda _) -> false, None, SPSuppress - | SequencePointAtBinding m,_ -> false, Some m, SPSuppress + | SequencePointAtBinding m, _ -> false, Some m, SPSuppress + - /// Determines if a sequence will be emitted when we generate the code for a binding. /// /// False for Lambdas, BindingEmitsNoCode, NoSequencePointAtStickyBinding, NoSequencePointAtInvisibleBinding, and NoSequencePointAtLetBinding. /// True for SequencePointAtBinding, NoSequencePointAtDoBinding. -let BindingEmitsSequencePoint g bind = +let BindingEmitsSequencePoint g bind = match ComputeSequencePointInfoForBinding g bind with - | _, None, SPSuppress -> false + | _, None, SPSuppress -> false | _ -> true -let BindingIsInvisible (TBind(_,_,spBind)) = - match spBind with - | NoSequencePointAtInvisibleBinding _ -> true +let BindingIsInvisible (TBind(_, _, spBind)) = + match spBind with + | NoSequencePointAtInvisibleBinding _ -> true | _ -> false - + /// Determines if the code generated for a binding is to be marked as hidden, e.g. the 'newobj' for a local function definition. -let BindingEmitsHiddenCode (TBind(_,e,spBind)) = - match spBind, stripExpr e with +let BindingEmitsHiddenCode (TBind(_, e, spBind)) = + match spBind, stripExpr e with | _, (Expr.Lambda _ | Expr.TyLambda _) -> true | _ -> false - + /// Determines if generating the code for a compound expression will emit a sequence point as the first instruction /// through the processing of the constituent parts. Used to prevent the generation of sequence points for /// compound expressions. -let rec FirstEmittedCodeWillBeSequencePoint g sp expr = - match sp with - | SPAlways -> - match stripExpr expr with - | Expr.Let (bind,body,_,_) -> - BindingEmitsSequencePoint g bind || - FirstEmittedCodeWillBeSequencePoint g sp bind.Expr || +let rec FirstEmittedCodeWillBeSequencePoint g sp expr = + match sp with + | SPAlways -> + match stripExpr expr with + | Expr.Let (bind, body, _, _) -> + BindingEmitsSequencePoint g bind || + FirstEmittedCodeWillBeSequencePoint g sp bind.Expr || (BindingEmitsNoCode g bind && FirstEmittedCodeWillBeSequencePoint g sp body) - | Expr.LetRec(binds,body,_,_) -> - binds |> List.exists (BindingEmitsSequencePoint g) || + | Expr.LetRec(binds, body, _, _) -> + binds |> List.exists (BindingEmitsSequencePoint g) || (binds |> List.forall (BindingEmitsNoCode g) && FirstEmittedCodeWillBeSequencePoint g sp body) - | Expr.Sequential (_, _, NormalSeq,spSeq,_) -> - match spSeq with + | Expr.Sequential (_, _, NormalSeq, spSeq, _) -> + match spSeq with | SequencePointsAtSeq -> true | SuppressSequencePointOnExprOfSequential -> true | SuppressSequencePointOnStmtOfSequential -> false - | Expr.Match (SequencePointAtBinding _,_,_,_,_,_) -> true - | Expr.Op(( TOp.TryCatch (SequencePointAtTry _,_) - | TOp.TryFinally (SequencePointAtTry _,_) - | TOp.For (SequencePointAtForLoop _,_) - | TOp.While (SequencePointAtWhileLoop _,_)),_,_,_) -> true + | Expr.Match (SequencePointAtBinding _, _, _, _, _, _) -> true + | Expr.Op(( TOp.TryCatch (SequencePointAtTry _, _) + | TOp.TryFinally (SequencePointAtTry _, _) + | TOp.For (SequencePointAtForLoop _, _) + | TOp.While (SequencePointAtWhileLoop _, _)), _, _, _) -> true | _ -> false - | SPSuppress -> - false + | SPSuppress -> + false /// Suppress sequence points for some compound expressions - though not all - even if "SPAlways" is set. /// /// Note this is only used when FirstEmittedCodeWillBeSequencePoint is false. -let EmitSequencePointForWholeExpr g sp expr = +let EmitSequencePointForWholeExpr g sp expr = assert (not (FirstEmittedCodeWillBeSequencePoint g sp expr)) - match sp with - | SPAlways -> - match stripExpr expr with - + match sp with + | SPAlways -> + match stripExpr expr with + // In some cases, we emit sequence points for the 'whole' of a 'let' expression. - // Specifically, when + // Specifically, when // + SPAlways (i.e. a sequence point is required as soon as meaningful) // + binding is NoSequencePointAtStickyBinding, or NoSequencePointAtLetBinding. // + not FirstEmittedCodeWillBeSequencePoint - // For example if we start with - // let someCode () = f x - // and by inlining 'f' the expression becomes + // For example if we start with + // let someCode () = f x + // and by inlining 'f' the expression becomes // let someCode () = (let sticky = x in y) // then we place the sequence point for the whole TAST expression 'let sticky = x in y', i.e. textual range 'f x' in the source code, but // _before_ the evaluation of 'x'. This will only happen for sticky 'let' introduced by inlining and other code generation // steps. We do _not_ do this for 'invisible' let which can be skipped. - | Expr.Let (bind,_,_,_) when BindingIsInvisible bind -> false - | Expr.LetRec(binds,_,_,_) when binds |> List.forall BindingIsInvisible -> false + | Expr.Let (bind, _, _, _) when BindingIsInvisible bind -> false + | Expr.LetRec(binds, _, _, _) when binds |> List.forall BindingIsInvisible -> false // If the binding is a lambda then we don't emit a sequence point. - | Expr.Let (bind,_,_,_) when BindingEmitsHiddenCode bind -> false - | Expr.LetRec(binds,_,_,_) when binds |> List.forall BindingEmitsHiddenCode -> false + | Expr.Let (bind, _, _, _) when BindingEmitsHiddenCode bind -> false + | Expr.LetRec(binds, _, _, _) when binds |> List.forall BindingEmitsHiddenCode -> false // If the binding is represented by a top-level generated constant value then we don't emit a sequence point. - | Expr.Let (bind,_,_,_) when BindingEmitsNoCode g bind -> false - | Expr.LetRec(binds,_,_,_) when binds |> List.forall (BindingEmitsNoCode g) -> false + | Expr.Let (bind, _, _, _) when BindingEmitsNoCode g bind -> false + | Expr.LetRec(binds, _, _, _) when binds |> List.forall (BindingEmitsNoCode g) -> false - // Suppress sequence points for the whole 'a;b' and do it at 'a' instead. + // Suppress sequence points for the whole 'a;b' and do it at 'a' instead. | Expr.Sequential _ -> false // Suppress sequence points at labels and gotos, it makes no sense to emit sequence points at these. We emit FeeFee instead - | Expr.Op(TOp.Label _,_,_,_) -> false - | Expr.Op(TOp.Goto _,_,_,_) -> false + | Expr.Op(TOp.Label _, _, _, _) -> false + | Expr.Op(TOp.Goto _, _, _, _) -> false // We always suppress at the whole 'match'/'try'/... expression because we do it at the individual parts. // - // These cases need documenting. For example, a typical 'match' gets compiled to + // These cases need documenting. For example, a typical 'match' gets compiled to // let tmp = expr // generates a sequence point, BEFORE tmp is evaluated // match tmp with // a match marked with NoSequencePointAtInvisibleLetBinding // So since the 'let tmp = expr' has a sequence point, then no sequence point is needed for the 'match'. But the processing // of the 'let' requests SPAlways for the body. | Expr.Match _ -> false - | Expr.Op(TOp.TryCatch _,_,_,_) -> false - | Expr.Op(TOp.TryFinally _,_,_,_) -> false - | Expr.Op(TOp.For _,_,_,_) -> false - | Expr.Op(TOp.While _,_,_,_) -> false + | Expr.Op(TOp.TryCatch _, _, _, _) -> false + | Expr.Op(TOp.TryFinally _, _, _, _) -> false + | Expr.Op(TOp.For _, _, _, _) -> false + | Expr.Op(TOp.While _, _, _, _) -> false | _ -> true - | SPSuppress -> + | SPSuppress -> false /// Emit hidden code markers for some compound expressions. Specifically, emit a hidden code marker for 'let f() = a in body' @@ -1947,69 +2090,69 @@ let EmitSequencePointForWholeExpr g sp expr = /// let someCode x = /// let f () = a /// body -let EmitHiddenCodeMarkerForWholeExpr g sp expr = +let EmitHiddenCodeMarkerForWholeExpr g sp expr = assert (not (FirstEmittedCodeWillBeSequencePoint g sp expr)) assert (not (EmitSequencePointForWholeExpr g sp expr)) - match sp with - | SPAlways -> - match stripExpr expr with - | Expr.Let (bind,_,_,_) when BindingEmitsHiddenCode bind -> true - | Expr.LetRec(binds,_,_,_) when binds |> List.exists BindingEmitsHiddenCode -> true + match sp with + | SPAlways -> + match stripExpr expr with + | Expr.Let (bind, _, _, _) when BindingEmitsHiddenCode bind -> true + | Expr.LetRec(binds, _, _, _) when binds |> List.exists BindingEmitsHiddenCode -> true | _ -> false - | SPSuppress -> + | SPSuppress -> false -/// Some expressions must emit some preparation code, then emit the actual code. -let rec RangeOfSequencePointForWholeExpr g expr = - match stripExpr expr with - | Expr.Let (bind,body,_,_) -> +/// Some expressions must emit some preparation code, then emit the actual code. +let rec RangeOfSequencePointForWholeExpr g expr = + match stripExpr expr with + | Expr.Let (bind, body, _, _) -> match ComputeSequencePointInfoForBinding g bind with // For sticky bindings, prefer the range of the overall expression. - | true, _, _ -> expr.Range - | _, None, SPSuppress -> RangeOfSequencePointForWholeExpr g body + | true, _, _ -> expr.Range + | _, None, SPSuppress -> RangeOfSequencePointForWholeExpr g body | _, Some m, _ -> m | _, None, SPAlways -> RangeOfSequencePointForWholeExpr g bind.Expr - | Expr.LetRec(_,body,_,_) -> RangeOfSequencePointForWholeExpr g body + | Expr.LetRec(_, body, _, _) -> RangeOfSequencePointForWholeExpr g body | Expr.Sequential (expr1, _, NormalSeq, _, _) -> RangeOfSequencePointForWholeExpr g expr1 | _ -> expr.Range /// Used to avoid emitting multiple sequence points in decision tree generation -let DoesGenExprStartWithSequencePoint g sp expr = - FirstEmittedCodeWillBeSequencePoint g sp expr || +let DoesGenExprStartWithSequencePoint g sp expr = + FirstEmittedCodeWillBeSequencePoint g sp expr || EmitSequencePointForWholeExpr g sp expr //------------------------------------------------------------------------- // Generate expressions -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- let rec GenExpr (cenv:cenv) (cgbuf:CodeGenBuffer) eenv sp expr sequel = let expr = stripExpr expr - if not (FirstEmittedCodeWillBeSequencePoint cenv.g sp expr) then - if EmitSequencePointForWholeExpr cenv.g sp expr then + if not (FirstEmittedCodeWillBeSequencePoint cenv.g sp expr) then + if EmitSequencePointForWholeExpr cenv.g sp expr then CG.EmitSeqPoint cgbuf (RangeOfSequencePointForWholeExpr cenv.g expr) elif EmitHiddenCodeMarkerForWholeExpr cenv.g sp expr then - cgbuf.EmitStartOfHiddenCode() + cgbuf.EmitStartOfHiddenCode() match (if compileSequenceExpressions then LowerCallsAndSeqs.LowerSeqExpr cenv.g cenv.amap expr else None) with | Some info -> GenSequenceExpr cenv cgbuf eenv info sequel | None -> - match expr with - | Expr.Const(c,m,ty) -> - GenConstant cenv cgbuf eenv (c,m,ty) sequel - | Expr.Match (spBind,exprm,tree,targets,m,ty) -> - GenMatch cenv cgbuf eenv (spBind,exprm,tree,targets,m,ty) sequel - | Expr.Sequential(e1,e2,dir,spSeq,m) -> - GenSequential cenv cgbuf eenv sp (e1,e2,dir,spSeq,m) sequel - | Expr.LetRec (binds,body,m,_) -> - GenLetRec cenv cgbuf eenv (binds,body,m) sequel - | Expr.Let (bind,body,_,_) -> - // This case implemented here to get a guaranteed tailcall + match expr with + | Expr.Const(c, m, ty) -> + GenConstant cenv cgbuf eenv (c, m, ty) sequel + | Expr.Match (spBind, exprm, tree, targets, m, ty) -> + GenMatch cenv cgbuf eenv (spBind, exprm, tree, targets, m, ty) sequel + | Expr.Sequential(e1, e2, dir, spSeq, m) -> + GenSequential cenv cgbuf eenv sp (e1, e2, dir, spSeq, m) sequel + | Expr.LetRec (binds, body, m, _) -> + GenLetRec cenv cgbuf eenv (binds, body, m) sequel + | Expr.Let (bind, body, _, _) -> + // This case implemented here to get a guaranteed tailcall // Make sure we generate the sequence point outside the scope of the variable - let startScope,endScope as scopeMarks = StartDelayedLocalScope "let" cgbuf + let startScope, endScope as scopeMarks = StartDelayedLocalScope "let" cgbuf let eenv = AllocStorageForBind cenv cgbuf scopeMarks eenv bind let spBind = GenSequencePointForBind cenv cgbuf bind GenBindingAfterSequencePoint cenv cgbuf eenv spBind bind (Some startScope) @@ -2017,25 +2160,25 @@ let rec GenExpr (cenv:cenv) (cgbuf:CodeGenBuffer) eenv sp expr sequel = // Work out if we need a sequence point for the body. For any "user" binding then the body gets SPAlways. // For invisible compiler-generated bindings we just use "sp", unless its body is another invisible binding // For sticky bindings arising from inlining we suppress any immediate sequence point in the body - let spBody = - match bind.SequencePointInfo with - | SequencePointAtBinding _ - | NoSequencePointAtLetBinding + let spBody = + match bind.SequencePointInfo with + | SequencePointAtBinding _ + | NoSequencePointAtLetBinding | NoSequencePointAtDoBinding -> SPAlways | NoSequencePointAtInvisibleBinding -> sp | NoSequencePointAtStickyBinding -> SPSuppress - + // Generate the body - GenExpr cenv cgbuf eenv spBody body (EndLocalScope(sequel,endScope)) + GenExpr cenv cgbuf eenv spBody body (EndLocalScope(sequel, endScope)) - | Expr.Lambda _ | Expr.TyLambda _ -> + | Expr.Lambda _ | Expr.TyLambda _ -> GenLambda cenv cgbuf eenv false None expr sequel - | Expr.App(Expr.Val(vref, _, m) as v, _, tyargs, [], _) when + | Expr.App(Expr.Val(vref, _, m) as v, _, tyargs, [], _) when List.forall (isMeasureTy cenv.g) tyargs && ( // inline only values that are stored in local variables - match StorageForValRef m vref eenv with - | ValStorage.Local _ -> true + match StorageForValRef m vref eenv with + | ValStorage.Local _ -> true | _ -> false ) -> // application of local type functions with type parameters = measure types and body = local value - inine the body @@ -2044,6 +2187,13 @@ let rec GenExpr (cenv:cenv) (cgbuf:CodeGenBuffer) eenv sp expr sequel = GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel | Expr.Val(v,_,m) -> GenGetVal cenv cgbuf eenv (v,m) sequel + + // Most generation of linear expressions is implemented routinely using tailcalls and the correct sequels. + // This is because the element of expansion happens to be the final thing generated in most cases. However + // for large lists we have to process the linearity separately + | LinearOpExpr _ -> + GenLinearExpr cenv cgbuf eenv expr sequel id |> ignore + | Expr.Op(op,tyargs,args,m) -> match op,args,tyargs with | TOp.ExnConstr(c),_,_ -> @@ -2112,78 +2262,78 @@ let rec GenExpr (cenv:cenv) (cgbuf:CodeGenBuffer) eenv sp expr sequel = GenConstArray cenv cgbuf eenv cenv.g.ilg.typ_Byte bytes (fun buf b -> buf.EmitByte b) GenSequel cenv eenv.cloc cgbuf sequel else - GenNewArraySimple cenv cgbuf eenv (List.ofArray (Array.map (mkByte cenv.g m) bytes),cenv.g.byte_ty,m) sequel - | TOp.UInt16s arr,[],[] -> - if cenv.opts.emitConstantArraysUsingStaticDataBlobs then + GenNewArraySimple cenv cgbuf eenv (List.ofArray (Array.map (mkByte cenv.g m) bytes), cenv.g.byte_ty, m) sequel + | TOp.UInt16s arr, [], [] -> + if cenv.opts.emitConstantArraysUsingStaticDataBlobs then GenConstArray cenv cgbuf eenv cenv.g.ilg.typ_UInt16 arr (fun buf b -> buf.EmitUInt16 b) GenSequel cenv eenv.cloc cgbuf sequel else - GenNewArraySimple cenv cgbuf eenv (List.ofArray (Array.map (mkUInt16 cenv.g m) arr),cenv.g.uint16_ty,m) sequel - | TOp.Goto(label),_,_ -> - if cgbuf.mgbuf.cenv.opts.generateDebugSymbols then + GenNewArraySimple cenv cgbuf eenv (List.ofArray (Array.map (mkUInt16 cenv.g m) arr), cenv.g.uint16_ty, m) sequel + | TOp.Goto(label), _, _ -> + if cgbuf.mgbuf.cenv.opts.generateDebugSymbols then cgbuf.EmitStartOfHiddenCode() CG.EmitInstr cgbuf (pop 0) Push0 AI_nop CG.EmitInstr cgbuf (pop 0) Push0 (I_br label) // NOTE: discard sequel - | TOp.Return,[e],_ -> + | TOp.Return, [e], _ -> GenExpr cenv cgbuf eenv SPSuppress e Return // NOTE: discard sequel - | TOp.Return,[],_ -> + | TOp.Return, [], _ -> GenSequel cenv eenv.cloc cgbuf ReturnVoid // NOTE: discard sequel - | TOp.Label(label),_,_ -> - cgbuf.SetMarkToHere (Mark label) + | TOp.Label(label), _, _ -> + cgbuf.SetMarkToHere (Mark label) GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel - | _ -> error(InternalError("Unexpected operator node expression",expr.Range)) - | Expr.StaticOptimization(constraints,e2,e3,m) -> - GenStaticOptimization cenv cgbuf eenv (constraints,e2,e3,m) sequel - | Expr.Obj(_,ty,_,_,[meth],[],m) when isDelegateTy cenv.g ty -> - GenDelegateExpr cenv cgbuf eenv expr (meth,m) sequel - | Expr.Obj(_,ty,basev,basecall,overrides,interfaceImpls,m) -> - GenObjectExpr cenv cgbuf eenv expr (ty,basev,basecall,overrides,interfaceImpls,m) sequel - - | Expr.Quote(ast,conv,_,m,ty) -> GenQuotation cenv cgbuf eenv (ast,conv,m,ty) sequel + | _ -> error(InternalError("Unexpected operator node expression", expr.Range)) + | Expr.StaticOptimization(constraints, e2, e3, m) -> + GenStaticOptimization cenv cgbuf eenv (constraints, e2, e3, m) sequel + | Expr.Obj(_, ty, _, _, [meth], [], m) when isDelegateTy cenv.g ty -> + GenDelegateExpr cenv cgbuf eenv expr (meth, m) sequel + | Expr.Obj(_, ty, basev, basecall, overrides, interfaceImpls, m) -> + GenObjectExpr cenv cgbuf eenv expr (ty, basev, basecall, overrides, interfaceImpls, m) sequel + + | Expr.Quote(ast, conv, _, m, ty) -> GenQuotation cenv cgbuf eenv (ast, conv, m, ty) sequel | Expr.Link _ -> failwith "Unexpected reclink" - | Expr.TyChoose (_,_,m) -> error(InternalError("Unexpected Expr.TyChoose",m)) + | Expr.TyChoose (_, _, m) -> error(InternalError("Unexpected Expr.TyChoose", m)) -and GenExprs cenv cgbuf eenv es = +and GenExprs cenv cgbuf eenv es = List.iter (fun e -> GenExpr cenv cgbuf eenv SPSuppress e Continue) es -and CodeGenMethodForExpr cenv mgbuf (spReq,entryPointInfo,methodName,eenv,alreadyUsedArgs,expr0,sequel0) = - let _,code = - CodeGenMethod cenv mgbuf (entryPointInfo,methodName,eenv,alreadyUsedArgs, +and CodeGenMethodForExpr cenv mgbuf (spReq, entryPointInfo, methodName, eenv, alreadyUsedArgs, expr0, sequel0) = + let _, code = + CodeGenMethod cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, (fun cgbuf eenv -> GenExpr cenv cgbuf eenv spReq expr0 sequel0), expr0.Range) - code + code //-------------------------------------------------------------------------- // Generate sequels -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- (* does the sequel discard its result, and if so what does it do next? *) -and sequelAfterDiscard sequel = - match sequel with +and sequelAfterDiscard sequel = + match sequel with | DiscardThen sequel -> Some(sequel) - | EndLocalScope(sq,mark) -> sequelAfterDiscard sq |> Option.map (fun sq -> EndLocalScope(sq,mark)) + | EndLocalScope(sq, mark) -> sequelAfterDiscard sq |> Option.map (fun sq -> EndLocalScope(sq, mark)) | _ -> None and sequelIgnoringEndScopesAndDiscard sequel = let sequel = sequelIgnoreEndScopes sequel - match sequelAfterDiscard sequel with + match sequelAfterDiscard sequel with | Some sq -> sq - | None -> sequel + | None -> sequel -and sequelIgnoreEndScopes sequel = - match sequel with - | EndLocalScope(sq,_) -> sequelIgnoreEndScopes sq +and sequelIgnoreEndScopes sequel = + match sequel with + | EndLocalScope(sq, _) -> sequelIgnoreEndScopes sq | sq -> sq (* commit any 'EndLocalScope' nodes in the sequel and return the residue *) and GenSequelEndScopes cgbuf sequel = - match sequel with - | EndLocalScope(sq,m) -> CG.SetMarkToHere cgbuf m; GenSequelEndScopes cgbuf sq + match sequel with + | EndLocalScope(sq, m) -> CG.SetMarkToHere cgbuf m; GenSequelEndScopes cgbuf sq | _ -> () and StringOfSequel sequel = @@ -2193,35 +2343,35 @@ and StringOfSequel sequel = | ReturnVoid -> "ReturnVoid" | CmpThenBrOrContinue _ -> "CmpThenBrOrContinue" | Return -> "Return" - | EndLocalScope (sq,Mark k) -> "EndLocalScope(" + StringOfSequel sq + "," + formatCodeLabel k + ")" + | EndLocalScope (sq, Mark k) -> "EndLocalScope(" + StringOfSequel sq + "," + formatCodeLabel k + ")" | Br (Mark x) -> sprintf "Br L%s" (formatCodeLabel x) | LeaveHandler _ -> "LeaveHandler" | EndFilter -> "EndFilter" and GenSequel cenv cloc cgbuf sequel = let sq = sequelIgnoreEndScopes sequel - (match sq with + (match sq with | Continue -> () - | DiscardThen sq -> + | DiscardThen sq -> CG.EmitInstr cgbuf (pop 1) Push0 AI_pop - GenSequel cenv cloc cgbuf sq + GenSequel cenv cloc cgbuf sq | ReturnVoid -> - CG.EmitInstr cgbuf (pop 0) Push0 I_ret - | CmpThenBrOrContinue(pops,bri) -> + CG.EmitInstr cgbuf (pop 0) Push0 I_ret + | CmpThenBrOrContinue(pops, bri) -> CG.EmitInstrs cgbuf pops Push0 bri - | Return -> - CG.EmitInstr cgbuf (pop 1) Push0 I_ret + | Return -> + CG.EmitInstr cgbuf (pop 1) Push0 I_ret | EndLocalScope _ -> failwith "EndLocalScope unexpected" - | Br x -> - // Emit a NOP in debug code in case the branch instruction gets eliminated + | Br x -> + // Emit a NOP in debug code in case the branch instruction gets eliminated // because it is a "branch to next instruction". This prevents two unrelated sequence points // (the one before the branch and the one after) being coalesced together - if cgbuf.mgbuf.cenv.opts.generateDebugSymbols then + if cgbuf.mgbuf.cenv.opts.generateDebugSymbols then cgbuf.EmitStartOfHiddenCode() CG.EmitInstr cgbuf (pop 0) Push0 AI_nop - CG.EmitInstr cgbuf (pop 0) Push0 (I_br x.CodeLabel) - | LeaveHandler (isFinally, whereToSaveResult,x) -> - if isFinally then + CG.EmitInstr cgbuf (pop 0) Push0 (I_br x.CodeLabel) + | LeaveHandler (isFinally, whereToSaveResult, x) -> + if isFinally then CG.EmitInstr cgbuf (pop 1) Push0 AI_pop else EmitSetLocal cgbuf whereToSaveResult @@ -2234,24 +2384,24 @@ and GenSequel cenv cloc cgbuf sequel = //-------------------------------------------------------------------------- // Generate constants -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- -and GenConstant cenv cgbuf eenv (c,m,ty) sequel = +and GenConstant cenv cgbuf eenv (c, m, ty) sequel = let ilTy = GenType cenv.amap m eenv.tyenv ty // Check if we need to generate the value at all - match sequelAfterDiscard sequel with - | None -> - match TryEliminateDesugaredConstants cenv.g m c with - | Some e -> + match sequelAfterDiscard sequel with + | None -> + match TryEliminateDesugaredConstants cenv.g m c with + | Some e -> GenExpr cenv cgbuf eenv SPSuppress e Continue | None -> - match c with + match c with | Const.Bool b -> CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_Bool]) (mkLdcInt32 (if b then 1 else 0)) | Const.SByte i -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdcInt32 (int32 i)) | Const.Int16 i -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdcInt32 (int32 i)) | Const.Int32 i -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdcInt32 i) - | Const.Int64 i -> - // see https://github.com/Microsoft/visualfsharp/pull/3620 + | Const.Int64 i -> + // see https://github.com/Microsoft/visualfsharp/pull/3620 if i >= int64 System.Int32.MinValue && i <= int64 System.Int32.MaxValue then CG.EmitInstrs cgbuf (pop 0) (Push [ilTy]) [ mkLdcInt32 (int32 i); AI_conv DT_I8 ] elif i >= int64 System.UInt32.MinValue && i <= int64 System.UInt32.MaxValue then @@ -2264,57 +2414,57 @@ and GenConstant cenv cgbuf eenv (c,m,ty) sequel = | Const.UInt32 i -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdcInt32 (int32 i)) | Const.UInt64 i -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (iLdcInt64 (int64 i)) | Const.UIntPtr i -> CG.EmitInstrs cgbuf (pop 0) (Push [ilTy]) [iLdcInt64 (int64 i); AI_conv DT_U ] - | Const.Double f -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (AI_ldc (DT_R8,ILConst.R8 f)) - | Const.Single f -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (AI_ldc (DT_R4,ILConst.R4 f)) + | Const.Double f -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (AI_ldc (DT_R8, ILConst.R8 f)) + | Const.Single f -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (AI_ldc (DT_R4, ILConst.R4 f)) | Const.Char(c) -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) ( mkLdcInt32 (int c)) | Const.String(s) -> GenString cenv cgbuf s | Const.Unit -> GenUnit cenv eenv m cgbuf - | Const.Zero -> GenDefaultValue cenv cgbuf eenv (ty,m) + | Const.Zero -> GenDefaultValue cenv cgbuf eenv (ty, m) | Const.Decimal _ -> failwith "unreachable" GenSequel cenv eenv.cloc cgbuf sequel - | Some sq -> - // Even if we didn't need to generate the value then maybe we still have to branch or return + | Some sq -> + // Even if we didn't need to generate the value then maybe we still have to branch or return GenSequel cenv eenv.cloc cgbuf sq -and GenUnitTy cenv eenv m = - match cenv.ilUnitTy with - | None -> - let res = GenType cenv.amap m eenv.tyenv cenv.g.unit_ty +and GenUnitTy cenv eenv m = + match cenv.ilUnitTy with + | None -> + let res = GenType cenv.amap m eenv.tyenv cenv.g.unit_ty cenv.ilUnitTy <- Some res res | Some res -> res -and GenUnit cenv eenv m cgbuf = +and GenUnit cenv eenv m cgbuf = CG.EmitInstr cgbuf (pop 0) (Push [GenUnitTy cenv eenv m]) AI_ldnull and GenUnitThenSequel cenv eenv m cloc cgbuf sequel = - match sequelAfterDiscard sequel with + match sequelAfterDiscard sequel with | Some(sq) -> GenSequel cenv cloc cgbuf sq | None -> GenUnit cenv eenv m cgbuf; GenSequel cenv cloc cgbuf sequel //-------------------------------------------------------------------------- // Generate simple data-related constructs -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- -and GenAllocTuple cenv cgbuf eenv (tupInfo, args,argtys,m) sequel = +and GenAllocTuple cenv cgbuf eenv (tupInfo, args, argtys, m) sequel = let tupInfo = evalTupInfoIsStruct tupInfo - let tcref, tys, args, newm = mkCompiledTuple cenv.g tupInfo (argtys,args,m) + let tcref, tys, args, newm = mkCompiledTuple cenv.g tupInfo (argtys, args, m) let ty = GenNamedTyApp cenv.amap newm eenv.tyenv tcref tys let ntyvars = if (tys.Length - 1) < goodTupleFields then (tys.Length - 1) else goodTupleFields let formalTyvars = [ for n in 0 .. ntyvars do yield mkILTyvarTy (uint16 n) ] GenExprs cenv cgbuf eenv args - // Generate a reference to the constructor + // Generate a reference to the constructor CG.EmitInstr cgbuf (pop args.Length) (Push [ty]) - (mkNormalNewobj - (mkILCtorMethSpecForTy (ty,formalTyvars))) + (mkNormalNewobj + (mkILCtorMethSpecForTy (ty, formalTyvars))) GenSequel cenv eenv.cloc cgbuf sequel -and GenGetTupleField cenv cgbuf eenv (tupInfo,e,tys,n,m) sequel = +and GenGetTupleField cenv cgbuf eenv (tupInfo, e, tys, n, m) sequel = let tupInfo = evalTupInfoIsStruct tupInfo - let rec getCompiledTupleItem g (e,tys:TTypes,n,m) = + let rec getCompiledTupleItem g (e, tys:TTypes, n, m) = let ar = tys.Length if ar <= 0 then failwith "getCompiledTupleItem" elif ar < maxTuple then @@ -2322,7 +2472,7 @@ and GenGetTupleField cenv cgbuf eenv (tupInfo,e,tys,n,m) sequel = let ty = GenNamedTyApp cenv.amap m eenv.tyenv tcr' tys mkGetTupleItemN g m n ty tupInfo e tys.[n] else - let tysA,tysB = List.splitAfter (goodTupleFields) tys + let tysA, tysB = List.splitAfter (goodTupleFields) tys let tyB = mkCompiledTupleTy g tupInfo tysB let tys' = tysA@[tyB] let tcr' = mkCompiledTupleTyconRef g tupInfo (List.length tys') @@ -2332,51 +2482,66 @@ and GenGetTupleField cenv cgbuf eenv (tupInfo,e,tys,n,m) sequel = if n < goodTupleFields then elast else - getCompiledTupleItem g (elast,tysB,n-goodTupleFields,m) - GenExpr cenv cgbuf eenv SPSuppress (getCompiledTupleItem cenv.g (e,tys,n,m)) sequel + getCompiledTupleItem g (elast, tysB, n-goodTupleFields, m) + GenExpr cenv cgbuf eenv SPSuppress (getCompiledTupleItem cenv.g (e, tys, n, m)) sequel -and GenAllocExn cenv cgbuf eenv (c,args,m) sequel = +and GenAllocExn cenv cgbuf eenv (c, args, m) sequel = GenExprs cenv cgbuf eenv args let ty = GenExnType cenv.amap m eenv.tyenv c let flds = recdFieldsOfExnDefRef c - let argtys = flds |> List.map (fun rfld -> GenType cenv.amap m eenv.tyenv rfld.FormalType) + let argtys = flds |> List.map (fun rfld -> GenType cenv.amap m eenv.tyenv rfld.FormalType) let mspec = mkILCtorMethSpecForTy (ty, argtys) CG.EmitInstr cgbuf (pop args.Length) (Push [ty]) - (mkNormalNewobj mspec) + (mkNormalNewobj mspec) GenSequel cenv eenv.cloc cgbuf sequel +and GenAllocUnionCaseCore cenv cgbuf eenv (c,tyargs,n,m) = + let cuspec,idx = GenUnionCaseSpec cenv.amap m eenv.tyenv c tyargs + CG.EmitInstrs cgbuf (pop n) (Push [cuspec.DeclaringType]) (EraseUnions.mkNewData cenv.g.ilg (cuspec, idx)) + and GenAllocUnionCase cenv cgbuf eenv (c,tyargs,args,m) sequel = GenExprs cenv cgbuf eenv args - let cuspec,idx = GenUnionCaseSpec cenv.amap m eenv.tyenv c tyargs - CG.EmitInstrs cgbuf (pop args.Length) (Push [cuspec.DeclaringType]) (EraseUnions.mkNewData cenv.g.ilg (cuspec, idx)) + GenAllocUnionCaseCore cenv cgbuf eenv (c,tyargs,args.Length,m) GenSequel cenv eenv.cloc cgbuf sequel +and GenLinearExpr cenv cgbuf eenv expr sequel (contf: FakeUnit -> FakeUnit) = + match expr with + | LinearOpExpr (TOp.UnionCase c, tyargs, argsFront, argLast, m) -> + GenExprs cenv cgbuf eenv argsFront + GenLinearExpr cenv cgbuf eenv argLast Continue (contf << (fun (Fake) -> + GenAllocUnionCaseCore cenv cgbuf eenv (c, tyargs, argsFront.Length + 1, m) + GenSequel cenv eenv.cloc cgbuf sequel + Fake)) + | _ -> + GenExpr cenv cgbuf eenv SPSuppress expr sequel + contf Fake + and GenAllocRecd cenv cgbuf eenv ctorInfo (tcref,argtys,args,m) sequel = let ty = GenNamedTyApp cenv.amap m eenv.tyenv tcref argtys - // Filter out fields with default initialization - let relevantFields = + // Filter out fields with default initialization + let relevantFields = tcref.AllInstanceFieldsAsList |> List.filter (fun f -> not f.IsZeroInit) |> List.filter (fun f -> not f.IsCompilerGenerated) - match ctorInfo with - | RecdExprIsObjInit -> - (args,relevantFields) ||> List.iter2 (fun e f -> - CG.EmitInstr cgbuf (pop 0) (Push (if tcref.IsStructOrEnumTycon then [ILType.Byref ty] else [ty])) mkLdarg0 + match ctorInfo with + | RecdExprIsObjInit -> + (args, relevantFields) ||> List.iter2 (fun e f -> + CG.EmitInstr cgbuf (pop 0) (Push (if tcref.IsStructOrEnumTycon then [ILType.Byref ty] else [ty])) mkLdarg0 GenExpr cenv cgbuf eenv SPSuppress e Continue - GenFieldStore false cenv cgbuf eenv (tcref.MakeNestedRecdFieldRef f,argtys,m) discard) - // Object construction doesn't generate a true value. - // Object constructions will always just get thrown away so this is safe + GenFieldStore false cenv cgbuf eenv (tcref.MakeNestedRecdFieldRef f, argtys, m) discard) + // Object construction doesn't generate a true value. + // Object constructions will always just get thrown away so this is safe GenSequel cenv eenv.cloc cgbuf sequel - | RecdExpr -> + | RecdExpr -> GenExprs cenv cgbuf eenv args - // generate a reference to the record constructor + // generate a reference to the record constructor let tyenvinner = TypeReprEnv.ForTyconRef tcref CG.EmitInstr cgbuf (pop args.Length) (Push [ty]) - (mkNormalNewobj - (mkILCtorMethSpecForTy (ty,relevantFields |> List.map (fun f -> GenType cenv.amap m tyenvinner f.FormalType) ))) + (mkNormalNewobj + (mkILCtorMethSpecForTy (ty, relevantFields |> List.map (fun f -> GenType cenv.amap m tyenvinner f.FormalType) ))) GenSequel cenv eenv.cloc cgbuf sequel and GenAllocAnonRecd cenv cgbuf eenv (anonInfo: AnonRecdTypeInfo, tyargs, args, m) sequel = @@ -2384,8 +2549,8 @@ and GenAllocAnonRecd cenv cgbuf eenv (anonInfo: AnonRecdTypeInfo, tyargs, args, let boxity = anonType.Boxity GenExprs cenv cgbuf eenv args let ilTypeArgs = GenTypeArgs cenv.amap m eenv.tyenv tyargs - let anonTypeWithInst = mkILTy boxity (mkILTySpec(anonType.TypeSpec.TypeRef,ilTypeArgs)) - CG.EmitInstr cgbuf (pop args.Length) (Push [anonTypeWithInst]) (mkNormalNewobj (mkILMethSpec(anonCtor,boxity,ilTypeArgs,[]))) + let anonTypeWithInst = mkILTy boxity (mkILTySpec(anonType.TypeSpec.TypeRef, ilTypeArgs)) + CG.EmitInstr cgbuf (pop args.Length) (Push [anonTypeWithInst]) (mkNormalNewobj (mkILMethSpec(anonCtor, boxity, ilTypeArgs, []))) GenSequel cenv eenv.cloc cgbuf sequel and GenGetAnonRecdField cenv cgbuf eenv (anonInfo: AnonRecdTypeInfo, e, tyargs, n, m) sequel = @@ -2394,81 +2559,81 @@ and GenGetAnonRecdField cenv cgbuf eenv (anonInfo: AnonRecdTypeInfo, e, tyargs, let ilTypeArgs = GenTypeArgs cenv.amap m eenv.tyenv tyargs let anonMethod = anonMethods.[n] let anonFieldType = ilTypeArgs.[n] - GenExpr cenv cgbuf eenv SPSuppress e Continue - CG.EmitInstr cgbuf (pop 1) (Push [anonFieldType]) (mkNormalCall (mkILMethSpec(anonMethod,boxity,ilTypeArgs,[]))) + GenExpr cenv cgbuf eenv SPSuppress e Continue + CG.EmitInstr cgbuf (pop 1) (Push [anonFieldType]) (mkNormalCall (mkILMethSpec(anonMethod, boxity, ilTypeArgs, []))) GenSequel cenv eenv.cloc cgbuf sequel -and GenNewArraySimple cenv cgbuf eenv (elems,elemTy,m) sequel = +and GenNewArraySimple cenv cgbuf eenv (elems, elemTy, m) sequel = let ilElemTy = GenType cenv.amap m eenv.tyenv elemTy let ilArrTy = mkILArr1DTy ilElemTy - - CG.EmitInstrs cgbuf (pop 0) (Push [ilArrTy]) [ (AI_ldc (DT_I4,ILConst.I4 (elems.Length))); I_newarr (ILArrayShape.SingleDimensional,ilElemTy) ] - elems |> List.iteri (fun i e -> - CG.EmitInstrs cgbuf (pop 0) (Push [ilArrTy; cenv.g.ilg.typ_Int32]) [ AI_dup; (AI_ldc (DT_I4,ILConst.I4 i)) ] - GenExpr cenv cgbuf eenv SPSuppress e Continue - CG.EmitInstr cgbuf (pop 3) Push0 (I_stelem_any (ILArrayShape.SingleDimensional,ilElemTy))) - + + CG.EmitInstrs cgbuf (pop 0) (Push [ilArrTy]) [ (AI_ldc (DT_I4, ILConst.I4 (elems.Length))); I_newarr (ILArrayShape.SingleDimensional, ilElemTy) ] + elems |> List.iteri (fun i e -> + CG.EmitInstrs cgbuf (pop 0) (Push [ilArrTy; cenv.g.ilg.typ_Int32]) [ AI_dup; (AI_ldc (DT_I4, ILConst.I4 i)) ] + GenExpr cenv cgbuf eenv SPSuppress e Continue + CG.EmitInstr cgbuf (pop 3) Push0 (I_stelem_any (ILArrayShape.SingleDimensional, ilElemTy))) + GenSequel cenv eenv.cloc cgbuf sequel -and GenNewArray cenv cgbuf eenv (elems: Expr list,elemTy,m) sequel = +and GenNewArray cenv cgbuf eenv (elems: Expr list, elemTy, m) sequel = // REVIEW: The restriction against enum types here has to do with Dev10/Dev11 bug 872799 // GenConstArray generates a call to RuntimeHelpers.InitializeArray. On CLR 2.0/x64 and CLR 4.0/x64/x86, // InitializeArray is a JIT intrinsic that will result in invalid runtime CodeGen when initializing an array // of enum types. Until bug 872799 is fixed, we'll need to generate arrays the "simple" way for enum types // Also note - C# never uses InitializeArray for enum types, so this change puts us on equal footing with them. - if elems.Length <= 5 || not cenv.opts.emitConstantArraysUsingStaticDataBlobs || (isEnumTy cenv.g elemTy) then - GenNewArraySimple cenv cgbuf eenv (elems,elemTy,m) sequel + if elems.Length <= 5 || not cenv.opts.emitConstantArraysUsingStaticDataBlobs || (isEnumTy cenv.g elemTy) then + GenNewArraySimple cenv cgbuf eenv (elems, elemTy, m) sequel else - // Try to emit a constant byte-blob array + // Try to emit a constant byte-blob array let elems' = Array.ofList elems - let test,write = - match elems'.[0] with - | Expr.Const(Const.Bool _,_,_) -> - (function Const.Bool _ -> true | _ -> false), + let test, write = + match elems'.[0] with + | Expr.Const(Const.Bool _, _, _) -> + (function Const.Bool _ -> true | _ -> false), (fun (buf: ByteBuffer) -> function Const.Bool b -> buf.EmitBoolAsByte b | _ -> failwith "unreachable") - | Expr.Const(Const.Char _,_,_) -> - (function Const.Char _ -> true | _ -> false), + | Expr.Const(Const.Char _, _, _) -> + (function Const.Char _ -> true | _ -> false), (fun buf -> function Const.Char b -> buf.EmitInt32AsUInt16 (int b) | _ -> failwith "unreachable") - | Expr.Const(Const.Byte _,_,_) -> - (function Const.Byte _ -> true | _ -> false), + | Expr.Const(Const.Byte _, _, _) -> + (function Const.Byte _ -> true | _ -> false), (fun buf -> function Const.Byte b -> buf.EmitByte b | _ -> failwith "unreachable") - | Expr.Const(Const.UInt16 _,_,_) -> - (function Const.UInt16 _ -> true | _ -> false), + | Expr.Const(Const.UInt16 _, _, _) -> + (function Const.UInt16 _ -> true | _ -> false), (fun buf -> function Const.UInt16 b -> buf.EmitUInt16 b | _ -> failwith "unreachable") - | Expr.Const(Const.UInt32 _,_,_) -> - (function Const.UInt32 _ -> true | _ -> false), + | Expr.Const(Const.UInt32 _, _, _) -> + (function Const.UInt32 _ -> true | _ -> false), (fun buf -> function Const.UInt32 b -> buf.EmitInt32 (int32 b) | _ -> failwith "unreachable") - | Expr.Const(Const.UInt64 _,_,_) -> - (function Const.UInt64 _ -> true | _ -> false), + | Expr.Const(Const.UInt64 _, _, _) -> + (function Const.UInt64 _ -> true | _ -> false), (fun buf -> function Const.UInt64 b -> buf.EmitInt64 (int64 b) | _ -> failwith "unreachable") - | Expr.Const(Const.SByte _,_,_) -> - (function Const.SByte _ -> true | _ -> false), + | Expr.Const(Const.SByte _, _, _) -> + (function Const.SByte _ -> true | _ -> false), (fun buf -> function Const.SByte b -> buf.EmitByte (byte b) | _ -> failwith "unreachable") - | Expr.Const(Const.Int16 _,_,_) -> - (function Const.Int16 _ -> true | _ -> false), + | Expr.Const(Const.Int16 _, _, _) -> + (function Const.Int16 _ -> true | _ -> false), (fun buf -> function Const.Int16 b -> buf.EmitUInt16 (uint16 b) | _ -> failwith "unreachable") - | Expr.Const(Const.Int32 _,_,_) -> - (function Const.Int32 _ -> true | _ -> false), + | Expr.Const(Const.Int32 _, _, _) -> + (function Const.Int32 _ -> true | _ -> false), (fun buf -> function Const.Int32 b -> buf.EmitInt32 b | _ -> failwith "unreachable") - | Expr.Const(Const.Int64 _,_,_) -> - (function Const.Int64 _ -> true | _ -> false), - (fun buf -> function Const.Int64 b -> buf.EmitInt64 b | _ -> failwith "unreachable") + | Expr.Const(Const.Int64 _, _, _) -> + (function Const.Int64 _ -> true | _ -> false), + (fun buf -> function Const.Int64 b -> buf.EmitInt64 b | _ -> failwith "unreachable") | _ -> (function _ -> false), (fun _ _ -> failwith "unreachable") - if elems' |> Array.forall (function Expr.Const(c,_,_) -> test c | _ -> false) then + if elems' |> Array.forall (function Expr.Const(c, _, _) -> test c | _ -> false) then let ilElemTy = GenType cenv.amap m eenv.tyenv elemTy - GenConstArray cenv cgbuf eenv ilElemTy elems' (fun buf -> function Expr.Const(c,_,_) -> write buf c | _ -> failwith "unreachable") + GenConstArray cenv cgbuf eenv ilElemTy elems' (fun buf -> function Expr.Const(c, _, _) -> write buf c | _ -> failwith "unreachable") GenSequel cenv eenv.cloc cgbuf sequel else - GenNewArraySimple cenv cgbuf eenv (elems,elemTy,m) sequel + GenNewArraySimple cenv cgbuf eenv (elems, elemTy, m) sequel -and GenCoerce cenv cgbuf eenv (e,tgty,m,srcty) sequel = - // Is this an upcast? +and GenCoerce cenv cgbuf eenv (e, tgty, m, srcty) sequel = + // Is this an upcast? if TypeRelations.TypeDefinitelySubsumesTypeNoCoercion 0 cenv.g cenv.amap m tgty srcty && - // Do an extra check - should not be needed + // Do an extra check - should not be needed TypeRelations.TypeFeasiblySubsumesType 0 cenv.g cenv.amap m tgty TypeRelations.NoCoerce srcty then - begin + begin if (isInterfaceTy cenv.g tgty) then ( GenExpr cenv cgbuf eenv SPSuppress e Continue let ilToTy = GenType cenv.amap m eenv.tyenv tgty @@ -2479,18 +2644,18 @@ and GenCoerce cenv cgbuf eenv (e,tgty,m,srcty) sequel = ) else ( GenExpr cenv cgbuf eenv SPSuppress e sequel ) - end - else - GenExpr cenv cgbuf eenv SPSuppress e Continue - if not (isObjTy cenv.g srcty) then + end + else + GenExpr cenv cgbuf eenv SPSuppress e Continue + if not (isObjTy cenv.g srcty) then let ilFromTy = GenType cenv.amap m eenv.tyenv srcty CG.EmitInstrs cgbuf (pop 1) (Push [cenv.g.ilg.typ_Object]) [ I_box ilFromTy ] - if not (isObjTy cenv.g tgty) then + if not (isObjTy cenv.g tgty) then let ilToTy = GenType cenv.amap m eenv.tyenv tgty CG.EmitInstrs cgbuf (pop 1) (Push [ilToTy]) [ I_unbox_any ilToTy ] GenSequel cenv eenv.cloc cgbuf sequel -and GenReraise cenv cgbuf eenv (rtnty,m) sequel = +and GenReraise cenv cgbuf eenv (rtnty, m) sequel = let ilReturnTy = GenType cenv.amap m eenv.tyenv rtnty CG.EmitInstrs cgbuf (pop 0) Push0 [I_rethrow] // [See comment related to I_throw]. @@ -2499,7 +2664,7 @@ and GenReraise cenv cgbuf eenv (rtnty,m) sequel = CG.EmitInstrs cgbuf (pop 0) (Push [ilReturnTy]) [AI_ldnull; I_unbox_any ilReturnTy ] GenSequel cenv eenv.cloc cgbuf sequel -and GenGetExnField cenv cgbuf eenv (e,ecref,fieldNum,m) sequel = +and GenGetExnField cenv cgbuf eenv (e, ecref, fieldNum, m) sequel = GenExpr cenv cgbuf eenv SPSuppress e Continue let exnc = stripExnEqns ecref let ty = GenExnType cenv.amap m eenv.tyenv ecref @@ -2508,12 +2673,12 @@ and GenGetExnField cenv cgbuf eenv (e,ecref,fieldNum,m) sequel = let fld = List.item fieldNum exnc.TrueInstanceFieldsAsList let ftyp = GenType cenv.amap m eenv.tyenv fld.FormalType - let mspec = mkILNonGenericInstanceMethSpecInTy (ty,"get_" + fld.Name, [], ftyp) + let mspec = mkILNonGenericInstanceMethSpecInTy (ty, "get_" + fld.Name, [], ftyp) CG.EmitInstr cgbuf (pop 1) (Push [ftyp]) (mkNormalCall mspec) GenSequel cenv eenv.cloc cgbuf sequel -and GenSetExnField cenv cgbuf eenv (e,ecref,fieldNum,e2,m) sequel = +and GenSetExnField cenv cgbuf eenv (e, ecref, fieldNum, e2, m) sequel = GenExpr cenv cgbuf eenv SPSuppress e Continue let exnc = stripExnEqns ecref let ty = GenExnType cenv.amap m eenv.tyenv ecref @@ -2522,49 +2687,49 @@ and GenSetExnField cenv cgbuf eenv (e,ecref,fieldNum,e2,m) sequel = let ftyp = GenType cenv.amap m eenv.tyenv fld.FormalType let ilFieldName = ComputeFieldName exnc fld GenExpr cenv cgbuf eenv SPSuppress e2 Continue - CG.EmitInstr cgbuf (pop 2) Push0 (mkNormalStfld(mkILFieldSpecInTy (ty,ilFieldName,ftyp))) + CG.EmitInstr cgbuf (pop 2) Push0 (mkNormalStfld(mkILFieldSpecInTy (ty, ilFieldName, ftyp))) GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel -and UnionCodeGen (cgbuf: CodeGenBuffer) = - { new EraseUnions.ICodeGen with +and UnionCodeGen (cgbuf: CodeGenBuffer) = + { new EraseUnions.ICodeGen with member __.CodeLabel(m) = m.CodeLabel member __.GenerateDelayMark() = CG.GenerateDelayMark cgbuf "unionCodeGenMark" - member __.GenLocal(ilty) = cgbuf.AllocLocal([],ilty,false) |> uint16 + member __.GenLocal(ilty) = cgbuf.AllocLocal([], ilty, false) |> uint16 member __.SetMarkToHere(m) = CG.SetMarkToHere cgbuf m member __.MkInvalidCastExnNewobj () = mkInvalidCastExnNewobj cgbuf.mgbuf.cenv.g member __.EmitInstr x = CG.EmitInstr cgbuf (pop 0) (Push []) x member __.EmitInstrs xs = CG.EmitInstrs cgbuf (pop 0) (Push []) xs } -and GenUnionCaseProof cenv cgbuf eenv (e,ucref,tyargs,m) sequel = +and GenUnionCaseProof cenv cgbuf eenv (e, ucref, tyargs, m) sequel = GenExpr cenv cgbuf eenv SPSuppress e Continue - let cuspec,idx = GenUnionCaseSpec cenv.amap m eenv.tyenv ucref tyargs - let fty = EraseUnions.GetILTypeForAlternative cuspec idx + let cuspec, idx = GenUnionCaseSpec cenv.amap m eenv.tyenv ucref tyargs + let fty = EraseUnions.GetILTypeForAlternative cuspec idx let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib ucref.TyconRef - EraseUnions.emitCastData cenv.g.ilg (UnionCodeGen cgbuf) (false,avoidHelpers,cuspec,idx) + EraseUnions.emitCastData cenv.g.ilg (UnionCodeGen cgbuf) (false, avoidHelpers, cuspec, idx) CG.EmitInstrs cgbuf (pop 1) (Push [fty]) [ ] // push/pop to match the line above GenSequel cenv eenv.cloc cgbuf sequel -and GenGetUnionCaseField cenv cgbuf eenv (e,ucref,tyargs,n,m) sequel = +and GenGetUnionCaseField cenv cgbuf eenv (e, ucref, tyargs, n, m) sequel = assert (ucref.Tycon.IsStructOrEnumTycon || isProvenUnionCaseTy (tyOfExpr cenv.g e)) - + GenExpr cenv cgbuf eenv SPSuppress e Continue - let cuspec,idx = GenUnionCaseSpec cenv.amap m eenv.tyenv ucref tyargs + let cuspec, idx = GenUnionCaseSpec cenv.amap m eenv.tyenv ucref tyargs let fty = actualTypOfIlxUnionField cuspec idx n let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib ucref.TyconRef CG.EmitInstrs cgbuf (pop 1) (Push [fty]) (EraseUnions.mkLdData (avoidHelpers, cuspec, idx, n)) GenSequel cenv eenv.cloc cgbuf sequel -and GenGetUnionCaseFieldAddr cenv cgbuf eenv (e,ucref,tyargs,n,m) sequel = +and GenGetUnionCaseFieldAddr cenv cgbuf eenv (e, ucref, tyargs, n, m) sequel = assert (ucref.Tycon.IsStructOrEnumTycon || isProvenUnionCaseTy (tyOfExpr cenv.g e)) - + GenExpr cenv cgbuf eenv SPSuppress e Continue - let cuspec,idx = GenUnionCaseSpec cenv.amap m eenv.tyenv ucref tyargs + let cuspec, idx = GenUnionCaseSpec cenv.amap m eenv.tyenv ucref tyargs let fty = actualTypOfIlxUnionField cuspec idx n let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib ucref.TyconRef CG.EmitInstrs cgbuf (pop 1) (Push [ILType.Byref fty]) (EraseUnions.mkLdDataAddr (avoidHelpers, cuspec, idx, n)) GenSequel cenv eenv.cloc cgbuf sequel -and GenGetUnionCaseTag cenv cgbuf eenv (e,tcref,tyargs,m) sequel = +and GenGetUnionCaseTag cenv cgbuf eenv (e, tcref, tyargs, m) sequel = GenExpr cenv cgbuf eenv SPSuppress e Continue let cuspec = GenUnionSpec cenv.amap m eenv.tyenv tcref tyargs let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib tcref @@ -2572,95 +2737,95 @@ and GenGetUnionCaseTag cenv cgbuf eenv (e,tcref,tyargs,m) sequel = CG.EmitInstrs cgbuf (pop 1) (Push [cenv.g.ilg.typ_Int32]) [ ] // push/pop to match the line above GenSequel cenv eenv.cloc cgbuf sequel -and GenSetUnionCaseField cenv cgbuf eenv (e,ucref,tyargs,n,e2,m) sequel = +and GenSetUnionCaseField cenv cgbuf eenv (e, ucref, tyargs, n, e2, m) sequel = GenExpr cenv cgbuf eenv SPSuppress e Continue - let cuspec,idx = GenUnionCaseSpec cenv.amap m eenv.tyenv ucref tyargs + let cuspec, idx = GenUnionCaseSpec cenv.amap m eenv.tyenv ucref tyargs let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib ucref.TyconRef - EraseUnions.emitCastData cenv.g.ilg (UnionCodeGen cgbuf) (false,avoidHelpers,cuspec,idx) + EraseUnions.emitCastData cenv.g.ilg (UnionCodeGen cgbuf) (false, avoidHelpers, cuspec, idx) CG.EmitInstrs cgbuf (pop 1) (Push [cuspec.DeclaringType]) [ ] // push/pop to match the line above GenExpr cenv cgbuf eenv SPSuppress e2 Continue CG.EmitInstrs cgbuf (pop 2) Push0 (EraseUnions.mkStData (cuspec, idx, n)) GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel -and GenGetRecdFieldAddr cenv cgbuf eenv (e,f,tyargs,m) sequel = +and GenGetRecdFieldAddr cenv cgbuf eenv (e, f, tyargs, m) sequel = GenExpr cenv cgbuf eenv SPSuppress e Continue let fref = GenRecdFieldRef m cenv eenv.tyenv f tyargs - CG.EmitInstrs cgbuf (pop 1) (Push [ILType.Byref fref.ActualType]) [ I_ldflda fref ] + CG.EmitInstrs cgbuf (pop 1) (Push [ILType.Byref fref.ActualType]) [ I_ldflda fref ] GenSequel cenv eenv.cloc cgbuf sequel - -and GenGetStaticFieldAddr cenv cgbuf eenv (f,tyargs,m) sequel = + +and GenGetStaticFieldAddr cenv cgbuf eenv (f, tyargs, m) sequel = let fspec = GenRecdFieldRef m cenv eenv.tyenv f tyargs - CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref fspec.ActualType]) [ I_ldsflda fspec ] + CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref fspec.ActualType]) [ I_ldsflda fspec ] GenSequel cenv eenv.cloc cgbuf sequel - -and GenGetRecdField cenv cgbuf eenv (e,f,tyargs,m) sequel = + +and GenGetRecdField cenv cgbuf eenv (e, f, tyargs, m) sequel = GenExpr cenv cgbuf eenv SPSuppress e Continue - GenFieldGet false cenv cgbuf eenv (f,tyargs,m) + GenFieldGet false cenv cgbuf eenv (f, tyargs, m) GenSequel cenv eenv.cloc cgbuf sequel - -and GenSetRecdField cenv cgbuf eenv (e1,f,tyargs,e2,m) sequel = + +and GenSetRecdField cenv cgbuf eenv (e1, f, tyargs, e2, m) sequel = GenExpr cenv cgbuf eenv SPSuppress e1 Continue GenExpr cenv cgbuf eenv SPSuppress e2 Continue - GenFieldStore false cenv cgbuf eenv (f,tyargs,m) sequel - -and GenGetStaticField cenv cgbuf eenv (f,tyargs,m) sequel = - GenFieldGet true cenv cgbuf eenv (f,tyargs,m) + GenFieldStore false cenv cgbuf eenv (f, tyargs, m) sequel + +and GenGetStaticField cenv cgbuf eenv (f, tyargs, m) sequel = + GenFieldGet true cenv cgbuf eenv (f, tyargs, m) GenSequel cenv eenv.cloc cgbuf sequel - -and GenSetStaticField cenv cgbuf eenv (f,tyargs,e2,m) sequel = + +and GenSetStaticField cenv cgbuf eenv (f, tyargs, e2, m) sequel = GenExpr cenv cgbuf eenv SPSuppress e2 Continue - GenFieldStore true cenv cgbuf eenv (f,tyargs,m) sequel + GenFieldStore true cenv cgbuf eenv (f, tyargs, m) sequel and mk_field_pops isStatic n = if isStatic then pop n else pop (n+1) -and GenFieldGet isStatic cenv cgbuf eenv (rfref:RecdFieldRef,tyargs,m) = +and GenFieldGet isStatic cenv cgbuf eenv (rfref:RecdFieldRef, tyargs, m) = let fspec = GenRecdFieldRef m cenv eenv.tyenv rfref tyargs let vol = if rfref.RecdField.IsVolatile then Volatile else Nonvolatile - if useGenuineField rfref.Tycon rfref.RecdField || entityRefInThisAssembly cenv.g.compilingFslib rfref.TyconRef then + if useGenuineField rfref.Tycon rfref.RecdField || entityRefInThisAssembly cenv.g.compilingFslib rfref.TyconRef then let instr = if isStatic then I_ldsfld(vol, fspec) else I_ldfld (ILAlignment.Aligned, vol, fspec) - CG.EmitInstrs cgbuf (mk_field_pops isStatic 0) (Push [fspec.ActualType]) [ instr ] + CG.EmitInstrs cgbuf (mk_field_pops isStatic 0) (Push [fspec.ActualType]) [ instr ] else let cconv = if isStatic then ILCallingConv.Static else ILCallingConv.Instance - let mspec = mkILMethSpecInTy (fspec.DeclaringType,cconv, "get_" + rfref.RecdField.rfield_id.idText, [], fspec.FormalType, []) + let mspec = mkILMethSpecInTy (fspec.DeclaringType, cconv, "get_" + rfref.RecdField.rfield_id.idText, [], fspec.FormalType, []) CG.EmitInstr cgbuf (mk_field_pops isStatic 0) (Push [fspec.ActualType]) (mkNormalCall mspec) -and GenFieldStore isStatic cenv cgbuf eenv (rfref:RecdFieldRef,tyargs,m) sequel = +and GenFieldStore isStatic cenv cgbuf eenv (rfref:RecdFieldRef, tyargs, m) sequel = let fspec = GenRecdFieldRef m cenv eenv.tyenv rfref tyargs let fld = rfref.RecdField if fld.IsMutable && not (useGenuineField rfref.Tycon fld) then let cconv = if isStatic then ILCallingConv.Static else ILCallingConv.Instance - let mspec = mkILMethSpecInTy (fspec.DeclaringType, cconv, "set_" + fld.rfield_id.idText, [fspec.FormalType],ILType.Void,[]) + let mspec = mkILMethSpecInTy (fspec.DeclaringType, cconv, "set_" + fld.rfield_id.idText, [fspec.FormalType], ILType.Void, []) CG.EmitInstr cgbuf (mk_field_pops isStatic 1) Push0 (mkNormalCall mspec) else let vol = if rfref.RecdField.IsVolatile then Volatile else Nonvolatile let instr = if isStatic then I_stsfld (vol, fspec) else I_stfld (ILAlignment.Aligned, vol, fspec) - CG.EmitInstr cgbuf (mk_field_pops isStatic 1) Push0 instr + CG.EmitInstr cgbuf (mk_field_pops isStatic 1) Push0 instr GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel //-------------------------------------------------------------------------- // Generate arguments to calls -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- /// Generate arguments to a call, unless the argument is the single lone "unit" value /// to a method or value compiled as a method taking no arguments and GenUntupledArgsDiscardingLoneUnit cenv cgbuf eenv m numObjArgs curriedArgInfos args = - match curriedArgInfos ,args with + match curriedArgInfos , args with // Type.M() // new C() - | [[]],[arg] when numObjArgs = 0 -> + | [[]], [arg] when numObjArgs = 0 -> assert isUnitTy cenv.g (tyOfExpr cenv.g arg) GenExpr cenv cgbuf eenv SPSuppress arg discard // obj.M() - | [[_];[]],[arg1;arg2] when numObjArgs = 1 -> - assert isUnitTy cenv.g (tyOfExpr cenv.g arg2) + | [[_];[]], [arg1;arg2] when numObjArgs = 1 -> + assert isUnitTy cenv.g (tyOfExpr cenv.g arg2) GenExpr cenv cgbuf eenv SPSuppress arg1 Continue GenExpr cenv cgbuf eenv SPSuppress arg2 discard - | _ -> - (curriedArgInfos,args) ||> List.iter2 (fun argInfos x -> - GenUntupledArgExpr cenv cgbuf eenv m argInfos x Continue) + | _ -> + (curriedArgInfos, args) ||> List.iter2 (fun argInfos x -> + GenUntupledArgExpr cenv cgbuf eenv m argInfos x Continue) -/// Codegen arguments +/// Codegen arguments and GenUntupledArgExpr cenv cgbuf eenv m argInfos expr sequel = let numRequiredExprs = List.length argInfos assert (numRequiredExprs >= 1) @@ -2668,84 +2833,84 @@ and GenUntupledArgExpr cenv cgbuf eenv m argInfos expr sequel = GenExpr cenv cgbuf eenv SPSuppress expr sequel elif isRefTupleExpr expr then let es = tryDestRefTupleExpr expr - if es.Length <> numRequiredExprs then error(InternalError("GenUntupledArgExpr (2)",m)); - es |> List.iter (fun x -> GenExpr cenv cgbuf eenv SPSuppress x Continue); + if es.Length <> numRequiredExprs then error(InternalError("GenUntupledArgExpr (2)", m)) + es |> List.iter (fun x -> GenExpr cenv cgbuf eenv SPSuppress x Continue) GenSequel cenv eenv.cloc cgbuf sequel else let ty = tyOfExpr cenv.g expr - let locv,loce = mkCompGenLocal m "arg" ty + let locv, loce = mkCompGenLocal m "arg" ty let bind = mkCompGenBind locv expr LocalScope "untuple" cgbuf (fun scopeMarks -> let eenvinner = AllocStorageForBind cenv cgbuf scopeMarks eenv bind - GenBinding cenv cgbuf eenvinner bind; + GenBinding cenv cgbuf eenvinner bind let tys = destRefTupleTy cenv.g ty assert (tys.Length = numRequiredExprs) // TODO - tupInfoRef - argInfos |> List.iteri (fun i _ -> GenGetTupleField cenv cgbuf eenvinner (tupInfoRef (* TODO *),loce,tys,i,m) Continue); + argInfos |> List.iteri (fun i _ -> GenGetTupleField cenv cgbuf eenvinner (tupInfoRef (* TODO *), loce, tys, i, m) Continue) GenSequel cenv eenv.cloc cgbuf sequel ) //-------------------------------------------------------------------------- // Generate calls (try to detect direct calls) -//-------------------------------------------------------------------------- - -and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = - match (f,tyargs,args) with +//-------------------------------------------------------------------------- + +and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = + match (f, tyargs, args) with (* Look for tailcall to turn into branch *) - | (Expr.Val(v,_,_),_,_) when + | (Expr.Val(v, _, _), _, _) when match ListAssoc.tryFind cenv.g.valRefEq v eenv.innerVals with - | Some (kind,_) -> + | Some (kind, _) -> (not v.IsConstructor && (* when branch-calling methods we must have the right type parameters *) (match kind with | BranchCallClosure _ -> true - | BranchCallMethod (_,_,tps,_,_) -> + | BranchCallMethod (_, _, tps, _, _) -> (List.lengthsEqAndForall2 (fun ty tp -> typeEquiv cenv.g ty (mkTyparTy tp)) tyargs tps)) && (* must be exact #args, ignoring tupling - we untuple if needed below *) - (let arityInfo = + (let arityInfo = match kind with | BranchCallClosure arityInfo - | BranchCallMethod (arityInfo,_,_,_,_) -> arityInfo + | BranchCallMethod (arityInfo, _, _, _, _) -> arityInfo arityInfo.Length = args.Length ) && (* no tailcall out of exception handler, etc. *) (match sequelIgnoringEndScopesAndDiscard sequel with Return | ReturnVoid -> true | _ -> false)) | None -> false - -> - let (kind,mark) = ListAssoc.find cenv.g.valRefEq v eenv.innerVals // already checked above in when guard - let ntmargs = + -> + let (kind, mark) = ListAssoc.find cenv.g.valRefEq v eenv.innerVals // already checked above in when guard + let ntmargs = match kind with | BranchCallClosure arityInfo -> let ntmargs = List.foldBack (+) arityInfo 0 GenExprs cenv cgbuf eenv args ntmargs - | BranchCallMethod (arityInfo,curriedArgInfos,_,ntmargs,numObjArgs) -> + | BranchCallMethod (arityInfo, curriedArgInfos, _, ntmargs, numObjArgs) -> assert (curriedArgInfos.Length = arityInfo.Length ) assert (curriedArgInfos.Length = args.Length) //assert (curriedArgInfos.Length = ntmargs ) GenUntupledArgsDiscardingLoneUnit cenv cgbuf eenv m numObjArgs curriedArgInfos args if v.IsExtensionMember then match curriedArgInfos, args with - | [[]],[_] when numObjArgs = 0 -> (ntmargs-1) - | [[_];[]],[_;_] when numObjArgs = 1 -> (ntmargs-1) - | _ -> ntmargs + | [[]], [_] when numObjArgs = 0 -> (ntmargs-1) + | [[_];[]], [_;_] when numObjArgs = 1 -> (ntmargs-1) + | _ -> ntmargs else ntmargs - for i = ntmargs - 1 downto 0 do + for i = ntmargs - 1 downto 0 do CG.EmitInstrs cgbuf (pop 1) Push0 [ I_starg (uint16 (i+cgbuf.PreallocatedArgCount)) ] CG.EmitInstrs cgbuf (pop 0) Push0 [ I_br mark.CodeLabel ] GenSequelEndScopes cgbuf sequel - + // PhysicalEquality becomes cheap reference equality once // a nominal type is known. We can't replace it for variable types since // a "ceq" instruction can't be applied to variable type values. - | (Expr.Val(v,_,_),[ty],[arg1;arg2]) when - (valRefEq cenv.g v cenv.g.reference_equality_inner_vref) + | (Expr.Val(v, _, _), [ty], [arg1;arg2]) when + (valRefEq cenv.g v cenv.g.reference_equality_inner_vref) && isAppTy cenv.g ty -> - + GenExpr cenv cgbuf eenv SPSuppress arg1 Continue GenExpr cenv cgbuf eenv SPSuppress arg2 Continue CG.EmitInstr cgbuf (pop 2) (Push [cenv.g.ilg.typ_Bool]) AI_ceq @@ -2754,206 +2919,206 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = // Emit "methodhandleof" calls as ldtoken instructions // // The token for the "GenericMethodDefinition" is loaded - | Expr.Val(v,_,m),_,[arg] when valRefEq cenv.g v cenv.g.methodhandleof_vref -> - let (|OptionalCoerce|) = function Expr.Op(TOp.Coerce _,_,[arg],_) -> arg | x -> x - let (|OptionalTyapp|) = function Expr.App(f,_,[_],[],_) -> f | x -> x - match arg with - // Generate ldtoken instruction for "methodhandleof(fun (a,b,c) -> f(a,b,c))" + | Expr.Val(v, _, m), _, [arg] when valRefEq cenv.g v cenv.g.methodhandleof_vref -> + let (|OptionalCoerce|) = function Expr.Op(TOp.Coerce _, _, [arg], _) -> arg | x -> x + let (|OptionalTyapp|) = function Expr.App(f, _, [_], [], _) -> f | x -> x + match arg with + // Generate ldtoken instruction for "methodhandleof(fun (a, b, c) -> f(a, b, c))" // where f is an F# function value or F# method - | Expr.Lambda(_,_,_,_,Expr.App(OptionalCoerce(OptionalTyapp(Expr.Val(vref,_,_))),_,_,_,_),_,_) -> - + | Expr.Lambda(_, _, _, _, Expr.App(OptionalCoerce(OptionalTyapp(Expr.Val(vref, _, _))), _, _, _, _), _, _) -> + let storage = StorageForValRef m vref eenv - match storage with - | Method (_,_,mspec,_,_,_,_) -> + match storage with + | Method (_, _, mspec, _, _, _, _) -> CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.iltyp_RuntimeMethodHandle]) (I_ldtoken (ILToken.ILMethod mspec)) - | _ -> - errorR(Error(FSComp.SR.ilxgenUnexpectedArgumentToMethodHandleOfDuringCodegen(), m)) - - // Generate ldtoken instruction for "methodhandleof(fun (a,b,c) -> obj.M(a,b,c))" + | _ -> + errorR(Error(FSComp.SR.ilxgenUnexpectedArgumentToMethodHandleOfDuringCodegen(), m)) + + // Generate ldtoken instruction for "methodhandleof(fun (a, b, c) -> obj.M(a, b, c))" // where M is an IL method. - | Expr.Lambda(_,_,_,_,Expr.Op(TOp.ILCall(_,_,valu,_,_,_,_,ilMethRef,actualTypeInst,actualMethInst,_),_,_,_),_,_) -> - + | Expr.Lambda(_, _, _, _, Expr.Op(TOp.ILCall(_, _, valu, _, _, _, _, ilMethRef, actualTypeInst, actualMethInst, _), _, _, _), _, _) -> + let boxity = (if valu then AsValue else AsObject) - let mkFormalParams gparams = gparams |> DropErasedTyargs |> List.mapi (fun n _gf -> mkILTyvarTy (uint16 n)) + let mkFormalParams gparams = gparams |> DropErasedTyargs |> List.mapi (fun n _gf -> mkILTyvarTy (uint16 n)) let ilGenericMethodSpec = IL.mkILMethSpec (ilMethRef, boxity, mkFormalParams actualTypeInst, mkFormalParams actualMethInst) let i = I_ldtoken (ILToken.ILMethod ilGenericMethodSpec) - CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.iltyp_RuntimeMethodHandle]) i + CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.iltyp_RuntimeMethodHandle]) i - | _ -> - System.Diagnostics.Debug.Assert(false,sprintf "Break for invalid methodhandleof argument expression") + | _ -> + System.Diagnostics.Debug.Assert(false, sprintf "Break for invalid methodhandleof argument expression") //System.Diagnostics.Debugger.Break() - errorR(Error(FSComp.SR.ilxgenUnexpectedArgumentToMethodHandleOfDuringCodegen(), m)) + errorR(Error(FSComp.SR.ilxgenUnexpectedArgumentToMethodHandleOfDuringCodegen(), m)) GenSequel cenv eenv.cloc cgbuf sequel - // Optimize calls to top methods when given "enough" arguments. - | Expr.Val(vref,valUseFlags,_),_,_ + // Optimize calls to top methods when given "enough" arguments. + | Expr.Val(vref, valUseFlags, _), _, _ when (let storage = StorageForValRef m vref eenv - match storage with - | Method (topValInfo,vref,_,_,_,_,_) -> - (let tps,argtys,_,_ = GetTopValTypeInFSharpForm cenv.g topValInfo vref.Type m - tps.Length = tyargs.Length && + match storage with + | Method (topValInfo, vref, _, _, _, _, _) -> + (let tps, argtys, _, _ = GetTopValTypeInFSharpForm cenv.g topValInfo vref.Type m + tps.Length = tyargs.Length && argtys.Length <= args.Length) | _ -> false) -> let storage = StorageForValRef m vref eenv - match storage with - | Method (topValInfo,vref,mspec,_,_,_,_) -> - let nowArgs,laterArgs = - let _,curriedArgInfos,_,_ = GetTopValTypeInFSharpForm cenv.g topValInfo vref.Type m + match storage with + | Method (topValInfo, vref, mspec, _, _, _, _) -> + let nowArgs, laterArgs = + let _, curriedArgInfos, _, _ = GetTopValTypeInFSharpForm cenv.g topValInfo vref.Type m List.splitAt curriedArgInfos.Length args - let actualRetTy = applyTys cenv.g vref.Type (tyargs,nowArgs) - let _,curriedArgInfos,returnTy,_ = GetTopValTypeInCompiledForm cenv.g topValInfo vref.Type m + let actualRetTy = applyTys cenv.g vref.Type (tyargs, nowArgs) + let _, curriedArgInfos, returnTy, _ = GetTopValTypeInCompiledForm cenv.g topValInfo vref.Type m let ilTyArgs = GenTypeArgs cenv.amap m eenv.tyenv tyargs - + - // For instance method calls chop off some type arguments, which are already - // carried by the class. Also work out if it's a virtual call. - let _,virtualCall,newobj,isSuperInit,isSelfInit,_,_,_ = GetMemberCallInfo cenv.g (vref,valUseFlags) in + // For instance method calls chop off some type arguments, which are already + // carried by the class. Also work out if it's a virtual call. + let _, virtualCall, newobj, isSuperInit, isSelfInit, _, _, _ = GetMemberCallInfo cenv.g (vref, valUseFlags) in // numEnclILTypeArgs will include unit-of-measure args, unfortunately. For now, just cut-and-paste code from GetMemberCallInfo - // @REVIEW: refactor this - let numEnclILTypeArgs = - match vref.MemberInfo with - | Some _ when not (vref.IsExtensionMember) -> - List.length(vref.MemberApparentEntity.TyparsNoRange |> DropErasedTypars) + // @REVIEW: refactor this + let numEnclILTypeArgs = + match vref.MemberInfo with + | Some _ when not (vref.IsExtensionMember) -> + List.length(vref.MemberApparentEntity.TyparsNoRange |> DropErasedTypars) | _ -> 0 - let (ilEnclArgTys,ilMethArgTys) = - if ilTyArgs.Length < numEnclILTypeArgs then error(InternalError("length mismatch",m)) + let (ilEnclArgTys, ilMethArgTys) = + if ilTyArgs.Length < numEnclILTypeArgs then error(InternalError("length mismatch", m)) List.splitAt numEnclILTypeArgs ilTyArgs let boxity = mspec.DeclaringType.Boxity - let mspec = mkILMethSpec (mspec.MethodRef, boxity,ilEnclArgTys,ilMethArgTys) - - // "Unit" return types on static methods become "void" + let mspec = mkILMethSpec (mspec.MethodRef, boxity, ilEnclArgTys, ilMethArgTys) + + // "Unit" return types on static methods become "void" let mustGenerateUnitAfterCall = Option.isNone returnTy - - let ccallInfo = + + let ccallInfo = match valUseFlags with | PossibleConstrainedCall ty -> Some ty | _ -> None - + let isBaseCall = match valUseFlags with VSlotDirectCall -> true | _ -> false - let isTailCall = - if isNil laterArgs && not isSelfInit then + let isTailCall = + if isNil laterArgs && not isSelfInit then let isDllImport = IsValRefIsDllImport cenv.g vref let hasByrefArg = mspec.FormalArgTypes |> List.exists (function ILType.Byref _ -> true | _ -> false) - let makesNoCriticalTailcalls = vref.MakesNoCriticalTailcalls - CanTailcall((boxity=AsValue), ccallInfo, eenv.withinSEH, hasByrefArg,mustGenerateUnitAfterCall, isDllImport, isSelfInit, makesNoCriticalTailcalls, sequel) - else + let makesNoCriticalTailcalls = vref.MakesNoCriticalTailcalls + CanTailcall((boxity=AsValue), ccallInfo, eenv.withinSEH, hasByrefArg, mustGenerateUnitAfterCall, isDllImport, isSelfInit, makesNoCriticalTailcalls, sequel) + else Normalcall - - let useICallVirt = virtualCall || useCallVirt cenv boxity mspec isBaseCall - let callInstr = + let useICallVirt = virtualCall || useCallVirt cenv boxity mspec isBaseCall + + let callInstr = match valUseFlags with - | PossibleConstrainedCall ty -> + | PossibleConstrainedCall ty -> let ilThisTy = GenType cenv.amap m eenv.tyenv ty - I_callconstraint ( isTailCall, ilThisTy,mspec,None) - | _ -> - if newobj then I_newobj (mspec, None) - elif useICallVirt then I_callvirt (isTailCall, mspec, None) + I_callconstraint ( isTailCall, ilThisTy, mspec, None) + | _ -> + if newobj then I_newobj (mspec, None) + elif useICallVirt then I_callvirt (isTailCall, mspec, None) else I_call (isTailCall, mspec, None) - // ok, now we're ready to generate - if isSuperInit || isSelfInit then - CG.EmitInstrs cgbuf (pop 0) (Push [mspec.DeclaringType ]) [ mkLdarg0 ] + // ok, now we're ready to generate + if isSuperInit || isSelfInit then + CG.EmitInstrs cgbuf (pop 0) (Push [mspec.DeclaringType ]) [ mkLdarg0 ] GenUntupledArgsDiscardingLoneUnit cenv cgbuf eenv m vref.NumObjArgs curriedArgInfos nowArgs // Generate laterArgs (for effects) and save LocalScope "callstack" cgbuf (fun scopeMarks -> - let whereSaved,eenv = - (eenv,laterArgs) ||> List.mapFold (fun eenv laterArg -> + let whereSaved, eenv = + (eenv, laterArgs) ||> List.mapFold (fun eenv laterArg -> // Only save arguments that have effects - if Optimizer.ExprHasEffect cenv.g laterArg then + if Optimizer.ExprHasEffect cenv.g laterArg then let ilTy = laterArg |> tyOfExpr cenv.g |> GenType cenv.amap m eenv.tyenv - let locName = ilxgenGlobalNng.FreshCompilerGeneratedName ("arg",m), ilTy, false + let locName = ilxgenGlobalNng.FreshCompilerGeneratedName ("arg", m), ilTy, false let loc, _realloc, eenv = AllocLocal cenv cgbuf eenv true locName scopeMarks GenExpr cenv cgbuf eenv SPSuppress laterArg Continue EmitSetLocal cgbuf loc - Choice1Of2 (ilTy,loc),eenv + Choice1Of2 (ilTy, loc), eenv else - Choice2Of2 laterArg, eenv) + Choice2Of2 laterArg, eenv) let nargs = mspec.FormalArgTypes.Length let pushes = if mustGenerateUnitAfterCall || isSuperInit || isSelfInit then Push0 else (Push [(GenType cenv.amap m eenv.tyenv actualRetTy)]) CG.EmitInstr cgbuf (pop (nargs + (if mspec.CallingConv.IsStatic || newobj then 0 else 1))) pushes callInstr - // For isSuperInit, load the 'this' pointer as the pretend 'result' of the operation. It will be popped again in most cases - if isSuperInit then CG.EmitInstrs cgbuf (pop 0) (Push [mspec.DeclaringType]) [ mkLdarg0 ] + // For isSuperInit, load the 'this' pointer as the pretend 'result' of the operation. It will be popped again in most cases + if isSuperInit then CG.EmitInstrs cgbuf (pop 0) (Push [mspec.DeclaringType]) [ mkLdarg0 ] // When generating debug code, generate a 'nop' after a 'call' that returns 'void' // This is what C# does, as it allows the call location to be maintained correctly in the stack frame - if cenv.opts.generateDebugSymbols && mustGenerateUnitAfterCall && (isTailCall = Normalcall) then + if cenv.opts.generateDebugSymbols && mustGenerateUnitAfterCall && (isTailCall = Normalcall) then CG.EmitInstrs cgbuf (pop 0) Push0 [ AI_nop ] - if isNil laterArgs then - assert isNil whereSaved - // Generate the "unit" value if necessary - CommitCallSequel cenv eenv m eenv.cloc cgbuf mustGenerateUnitAfterCall sequel - else + if isNil laterArgs then + assert isNil whereSaved + // Generate the "unit" value if necessary + CommitCallSequel cenv eenv m eenv.cloc cgbuf mustGenerateUnitAfterCall sequel + else //printfn "%d EXTRA ARGS IN TOP APP at %s" laterArgs.Length (stringOfRange m) - whereSaved |> List.iter (function - | Choice1Of2 (ilTy,loc) -> EmitGetLocal cgbuf ilTy loc + whereSaved |> List.iter (function + | Choice1Of2 (ilTy, loc) -> EmitGetLocal cgbuf ilTy loc | Choice2Of2 expr -> GenExpr cenv cgbuf eenv SPSuppress expr Continue) - GenIndirectCall cenv cgbuf eenv (actualRetTy,[],laterArgs,m) sequel) - + GenIndirectCall cenv cgbuf eenv (actualRetTy, [], laterArgs, m) sequel) + | _ -> failwith "??" - - // This case is for getting/calling a value, when we can't call it directly. - // However, we know the type instantiation for the value. - // In this case we can often generate a type-specific local expression for the value. - // This reduces the number of dynamic type applications. - | (Expr.Val(vref,_,_),_,_) -> - GenGetValRefAndSequel cenv cgbuf eenv m vref (Some (tyargs,args,m,sequel)) - + + // This case is for getting/calling a value, when we can't call it directly. + // However, we know the type instantiation for the value. + // In this case we can often generate a type-specific local expression for the value. + // This reduces the number of dynamic type applications. + | (Expr.Val(vref, _, _), _, _) -> + GenGetValRefAndSequel cenv cgbuf eenv m vref (Some (tyargs, args, m, sequel)) + | _ -> (* worst case: generate a first-class function value and call *) GenExpr cenv cgbuf eenv SPSuppress f Continue - GenArgsAndIndirectCall cenv cgbuf eenv (fty,tyargs,args,m) sequel - -and CanTailcall (hasStructObjArg, ccallInfo, withinSEH, hasByrefArg, mustGenerateUnitAfterCall, isDllImport, isSelfInit, makesNoCriticalTailcalls, sequel) = + GenArgsAndIndirectCall cenv cgbuf eenv (fty, tyargs, args, m) sequel + +and CanTailcall (hasStructObjArg, ccallInfo, withinSEH, hasByrefArg, mustGenerateUnitAfterCall, isDllImport, isSelfInit, makesNoCriticalTailcalls, sequel) = // Can't tailcall with a struct object arg since it involves a byref // Can't tailcall with a .NET 2.0 generic constrained call since it involves a byref - if not hasStructObjArg && Option.isNone ccallInfo && not withinSEH && not hasByrefArg && + if not hasStructObjArg && Option.isNone ccallInfo && not withinSEH && not hasByrefArg && not isDllImport && not isSelfInit && not makesNoCriticalTailcalls && - // We can tailcall even if we need to generate "unit", as long as we're about to throw the value away anyway as par of the return. - // We can tailcall if we don't need to generate "unit", as long as we're about to return. - (match sequelIgnoreEndScopes sequel with + // We can tailcall even if we need to generate "unit", as long as we're about to throw the value away anyway as par of the return. + // We can tailcall if we don't need to generate "unit", as long as we're about to return. + (match sequelIgnoreEndScopes sequel with | ReturnVoid | Return -> not mustGenerateUnitAfterCall | DiscardThen ReturnVoid -> mustGenerateUnitAfterCall - | _ -> false) - then Tailcall + | _ -> false) + then Tailcall else Normalcall - -and GenNamedLocalTyFuncCall cenv (cgbuf: CodeGenBuffer) eenv ty cloinfo tyargs m = - let ilContractClassTyargs = - cloinfo.localTypeFuncContractFreeTypars - |> List.map mkTyparTy +and GenNamedLocalTyFuncCall cenv (cgbuf: CodeGenBuffer) eenv ty cloinfo tyargs m = + + let ilContractClassTyargs = + cloinfo.localTypeFuncContractFreeTypars + |> List.map mkTyparTy |> GenTypeArgs cenv.amap m eenv.tyenv let ilTyArgs = tyargs |> GenTypeArgs cenv.amap m eenv.tyenv - let _,(ilContractMethTyargs: ILGenericParameterDefs),(ilContractCloTySpec:ILTypeSpec),ilContractFormalRetTy = + let _, (ilContractMethTyargs: ILGenericParameterDefs), (ilContractCloTySpec:ILTypeSpec), ilContractFormalRetTy = GenNamedLocalTypeFuncContractInfo cenv eenv m cloinfo let ilContractTy = mkILBoxedTy ilContractCloTySpec.TypeRef ilContractClassTyargs - - if not (ilContractMethTyargs.Length = ilTyArgs.Length) then errorR(Error(FSComp.SR.ilIncorrectNumberOfTypeArguments(),m)) + + if not (ilContractMethTyargs.Length = ilTyArgs.Length) then errorR(Error(FSComp.SR.ilIncorrectNumberOfTypeArguments(), m)) // Local TyFunc are represented as a $contract type. they currently get stored in a value of type object // Recover result (value or reference types) via unbox_any. CG.EmitInstrs cgbuf (pop 1) (Push [ilContractTy]) [I_unbox_any ilContractTy] - let actualRetTy = applyTys cenv.g ty (tyargs,[]) + let actualRetTy = applyTys cenv.g ty (tyargs, []) let ilDirectInvokeMethSpec = mkILInstanceMethSpecInTy(ilContractTy, "DirectInvoke", [], ilContractFormalRetTy, ilTyArgs) let ilActualRetTy = GenType cenv.amap m eenv.tyenv actualRetTy @@ -2961,56 +3126,56 @@ and GenNamedLocalTyFuncCall cenv (cgbuf: CodeGenBuffer) eenv ty cloinfo tyargs m CG.EmitInstr cgbuf (pop 1) (Push [ilActualRetTy]) (mkNormalCallvirt ilDirectInvokeMethSpec) actualRetTy - + /// Generate an indirect call, converting to an ILX callfunc instruction -and GenArgsAndIndirectCall cenv cgbuf eenv (functy,tyargs,args,m) sequel = +and GenArgsAndIndirectCall cenv cgbuf eenv (functy, tyargs, args, m) sequel = // Generate the arguments to the indirect call GenExprs cenv cgbuf eenv args - GenIndirectCall cenv cgbuf eenv (functy,tyargs,args,m) sequel + GenIndirectCall cenv cgbuf eenv (functy, tyargs, args, m) sequel /// Generate an indirect call, converting to an ILX callfunc instruction -and GenIndirectCall cenv cgbuf eenv (functy,tyargs,args,m) sequel = - - // Fold in the new types into the environment as we generate the formal types. - let ilxClosureApps = +and GenIndirectCall cenv cgbuf eenv (functy, tyargs, args, m) sequel = + + // Fold in the new types into the environment as we generate the formal types. + let ilxClosureApps = // keep only non-erased type arguments when computing indirect call - let tyargs = DropErasedTyargs tyargs + let tyargs = DropErasedTyargs tyargs let typars, formalFuncTy = tryDestForallTy cenv.g functy let feenv = eenv.tyenv.Add typars // This does two phases: REVIEW: the code is too complex for what it's achieving and should be rewritten - let formalRetTy,appBuilder = - List.fold - (fun (formalFuncTy,sofar) _ -> - let dty,rty = destFunTy cenv.g formalFuncTy - (rty,(fun acc -> sofar (Apps_app(GenType cenv.amap m feenv dty,acc))))) - (formalFuncTy,id) + let formalRetTy, appBuilder = + List.fold + (fun (formalFuncTy, sofar) _ -> + let dty, rty = destFunTy cenv.g formalFuncTy + (rty, (fun acc -> sofar (Apps_app(GenType cenv.amap m feenv dty, acc))))) + (formalFuncTy, id) args let ilxRetApps = Apps_done (GenType cenv.amap m feenv formalRetTy) - List.foldBack (fun tyarg acc -> Apps_tyapp(GenType cenv.amap m eenv.tyenv tyarg,acc)) tyargs (appBuilder ilxRetApps) + List.foldBack (fun tyarg acc -> Apps_tyapp(GenType cenv.amap m eenv.tyenv tyarg, acc)) tyargs (appBuilder ilxRetApps) let actualRetTy = applyTys cenv.g functy (tyargs, args) let ilActualRetTy = GenType cenv.amap m eenv.tyenv actualRetTy // Check if any byrefs are involved to make sure we don't tailcall - let hasByrefArg = - let rec check x = - match x with - | Apps_tyapp(_,apps) -> check apps - | Apps_app(arg,apps) -> IsILTypeByref arg || check apps + let hasByrefArg = + let rec check x = + match x with + | Apps_tyapp(_, apps) -> check apps + | Apps_app(arg, apps) -> IsILTypeByref arg || check apps | _ -> false check ilxClosureApps - - let isTailCall = CanTailcall(false,None,eenv.withinSEH,hasByrefArg,false,false,false,false,sequel) + + let isTailCall = CanTailcall(false, None, eenv.withinSEH, hasByrefArg, false, false, false, false, sequel) CountCallFuncInstructions() // Generate the code code an ILX callfunc operation - let instrs = EraseClosures.mkCallFunc cenv.g.ilxPubCloEnv (fun ty -> cgbuf.AllocLocal([], ty,false) |> uint16) eenv.tyenv.Count isTailCall ilxClosureApps + let instrs = EraseClosures.mkCallFunc cenv.g.ilxPubCloEnv (fun ty -> cgbuf.AllocLocal([], ty, false) |> uint16) eenv.tyenv.Count isTailCall ilxClosureApps CG.EmitInstrs cgbuf (pop (1+args.Length)) (Push [ilActualRetTy]) instrs // Done compiling indirect call... @@ -3018,64 +3183,64 @@ and GenIndirectCall cenv cgbuf eenv (functy,tyargs,args,m) sequel = //-------------------------------------------------------------------------- // Generate try expressions -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- -and GenTry cenv cgbuf eenv scopeMarks (e1,m,resty,spTry) = - let sp = - match spTry with +and GenTry cenv cgbuf eenv scopeMarks (e1, m, resty, spTry) = + let sp = + match spTry with | SequencePointAtTry m -> CG.EmitSeqPoint cgbuf m; SPAlways | SequencePointInBodyOfTry -> SPAlways | NoSequencePointAtTry -> SPSuppress - - let stack,eenvinner = EmitSaveStack cenv cgbuf eenv m scopeMarks + + let stack, eenvinner = EmitSaveStack cenv cgbuf eenv m scopeMarks let startTryMark = CG.GenerateMark cgbuf "startTryMark" let endTryMark = CG.GenerateDelayMark cgbuf "endTryMark" let afterHandler = CG.GenerateDelayMark cgbuf "afterHandler" let eenvinner = {eenvinner with withinSEH = true} let ilResultTy = GenType cenv.amap m eenvinner.tyenv resty - let whereToSave, _realloc, eenvinner = - AllocLocal cenv cgbuf eenvinner true (ilxgenGlobalNng.FreshCompilerGeneratedName ("tryres",m),ilResultTy, false) (startTryMark,endTryMark) + let whereToSave, _realloc, eenvinner = + AllocLocal cenv cgbuf eenvinner true (ilxgenGlobalNng.FreshCompilerGeneratedName ("tryres", m), ilResultTy, false) (startTryMark, endTryMark) // Generate the body of the try. In the normal case (SequencePointAtTry) we generate a sequence point // both on the 'try' keyword and on the start of the expression in the 'try'. For inlined code and - // compiler generated 'try' blocks (i.e. NoSequencePointAtTry, used for the try/finally implicit + // compiler generated 'try' blocks (i.e. NoSequencePointAtTry, used for the try/finally implicit // in a 'use' or 'foreach'), we suppress the sequence point - GenExpr cenv cgbuf eenvinner sp e1 (LeaveHandler (false, whereToSave,afterHandler)) + GenExpr cenv cgbuf eenvinner sp e1 (LeaveHandler (false, whereToSave, afterHandler)) CG.SetMarkToHere cgbuf endTryMark let tryMarks = (startTryMark.CodeLabel, endTryMark.CodeLabel) - whereToSave,eenvinner,stack,tryMarks,afterHandler,ilResultTy + whereToSave, eenvinner, stack, tryMarks, afterHandler, ilResultTy -and GenTryCatch cenv cgbuf eenv (e1,vf:Val,ef,vh:Val,eh,m,resty,spTry,spWith) sequel = - // Save the stack - gross because IL flushes the stack at the exn. handler - // note: eenvinner notes spill vars are live - LocalScope "trystack" cgbuf (fun scopeMarks -> - let whereToSave,eenvinner,stack,tryMarks,afterHandler,ilResultTy = GenTry cenv cgbuf eenv scopeMarks (e1,m,resty,spTry) +and GenTryCatch cenv cgbuf eenv (e1, vf:Val, ef, vh:Val, eh, m, resty, spTry, spWith) sequel = + // Save the stack - gross because IL flushes the stack at the exn. handler + // note: eenvinner notes spill vars are live + LocalScope "trystack" cgbuf (fun scopeMarks -> + let whereToSave, eenvinner, stack, tryMarks, afterHandler, ilResultTy = GenTry cenv cgbuf eenv scopeMarks (e1, m, resty, spTry) - // Now the filter and catch blocks + // Now the filter and catch blocks - let seh = - if cenv.opts.generateFilterBlocks then - let startOfFilter = CG.GenerateMark cgbuf "startOfFilter" + let seh = + if cenv.opts.generateFilterBlocks then + let startOfFilter = CG.GenerateMark cgbuf "startOfFilter" let afterFilter = CG.GenerateDelayMark cgbuf "afterFilter" - let (sequelOnBranches,afterJoin,stackAfterJoin,sequelAfterJoin) = GenJoinPoint cenv cgbuf "filter" eenv cenv.g.int_ty m EndFilter + let (sequelOnBranches, afterJoin, stackAfterJoin, sequelAfterJoin) = GenJoinPoint cenv cgbuf "filter" eenv cenv.g.int_ty m EndFilter begin // We emit the sequence point for the 'with' keyword span on the start of the filter // block. However the targets of the filter block pattern matching should not get any // sequence points (they will be 'true'/'false' values indicating if the exception has been // caught or not). // - // The targets of the handler block DO get sequence points. Thus the expected behaviour + // The targets of the handler block DO get sequence points. Thus the expected behaviour // for a try/with with a complex pattern is that we hit the "with" before the filter is run // and then jump to the handler for the successful catch (or continue with exception handling // if the filter fails) - match spWith with + match spWith with | SequencePointAtWith m -> CG.EmitSeqPoint cgbuf m - | NoSequencePointAtWith -> () + | NoSequencePointAtWith -> () CG.SetStack cgbuf [cenv.g.ilg.typ_Object] - let _,eenvinner = AllocLocalVal cenv cgbuf vf eenvinner None (startOfFilter,afterFilter) + let _, eenvinner = AllocLocalVal cenv cgbuf vf eenvinner None (startOfFilter, afterFilter) CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.iltyp_Exception]) (I_castclass cenv.g.iltyp_Exception) GenStoreVal cgbuf eenvinner vf.Range vf @@ -3091,32 +3256,32 @@ and GenTryCatch cenv cgbuf eenv (e1,vf:Val,ef,vh:Val,eh,m,resty,spTry,spWith) se let filterMarks = (startOfFilter.CodeLabel, endOfFilter.CodeLabel) CG.SetMarkToHere cgbuf afterFilter - let startOfHandler = CG.GenerateMark cgbuf "startOfHandler" + let startOfHandler = CG.GenerateMark cgbuf "startOfHandler" begin CG.SetStack cgbuf [cenv.g.ilg.typ_Object] - let _,eenvinner = AllocLocalVal cenv cgbuf vh eenvinner None (startOfHandler,afterHandler) + let _, eenvinner = AllocLocalVal cenv cgbuf vh eenvinner None (startOfHandler, afterHandler) CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.iltyp_Exception]) (I_castclass cenv.g.iltyp_Exception) GenStoreVal cgbuf eenvinner vh.Range vh - GenExpr cenv cgbuf eenvinner SPAlways eh (LeaveHandler (false, whereToSave,afterHandler)) + GenExpr cenv cgbuf eenvinner SPAlways eh (LeaveHandler (false, whereToSave, afterHandler)) end let endOfHandler = CG.GenerateMark cgbuf "endOfHandler" let handlerMarks = (startOfHandler.CodeLabel, endOfHandler.CodeLabel) ILExceptionClause.FilterCatch(filterMarks, handlerMarks) - else - let startOfHandler = CG.GenerateMark cgbuf "startOfHandler" + else + let startOfHandler = CG.GenerateMark cgbuf "startOfHandler" begin - match spWith with + match spWith with | SequencePointAtWith m -> CG.EmitSeqPoint cgbuf m - | NoSequencePointAtWith -> () + | NoSequencePointAtWith -> () CG.SetStack cgbuf [cenv.g.ilg.typ_Object] - let _,eenvinner = AllocLocalVal cenv cgbuf vh eenvinner None (startOfHandler,afterHandler) + let _, eenvinner = AllocLocalVal cenv cgbuf vh eenvinner None (startOfHandler, afterHandler) CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.iltyp_Exception]) (I_castclass cenv.g.iltyp_Exception) GenStoreVal cgbuf eenvinner m vh - GenExpr cenv cgbuf eenvinner SPAlways eh (LeaveHandler (false, whereToSave,afterHandler)) + GenExpr cenv cgbuf eenvinner SPAlways eh (LeaveHandler (false, whereToSave, afterHandler)) end let endOfHandler = CG.GenerateMark cgbuf "endOfHandler" let handlerMarks = (startOfHandler.CodeLabel, endOfHandler.CodeLabel) @@ -3124,7 +3289,7 @@ and GenTryCatch cenv cgbuf eenv (e1,vf:Val,ef,vh:Val,eh,m,resty,spTry,spWith) se cgbuf.EmitExceptionClause { Clause = seh - Range= tryMarks } + Range= tryMarks } CG.SetMarkToHere cgbuf afterHandler CG.SetStack cgbuf [] @@ -3136,47 +3301,47 @@ and GenTryCatch cenv cgbuf eenv (e1,vf:Val,ef,vh:Val,eh,m,resty,spTry,spWith) se EmitGetLocal cgbuf ilResultTy whereToSave GenSequel cenv eenv.cloc cgbuf sequel - ) + ) -and GenTryFinally cenv cgbuf eenv (bodyExpr,handlerExpr,m,resty,spTry,spFinally) sequel = - // Save the stack - needed because IL flushes the stack at the exn. handler - // note: eenvinner notes spill vars are live - LocalScope "trystack" cgbuf (fun scopeMarks -> +and GenTryFinally cenv cgbuf eenv (bodyExpr, handlerExpr, m, resty, spTry, spFinally) sequel = + // Save the stack - needed because IL flushes the stack at the exn. handler + // note: eenvinner notes spill vars are live + LocalScope "trystack" cgbuf (fun scopeMarks -> - let whereToSave,eenvinner,stack,tryMarks,afterHandler,ilResultTy = GenTry cenv cgbuf eenv scopeMarks (bodyExpr,m,resty,spTry) + let whereToSave, eenvinner, stack, tryMarks, afterHandler, ilResultTy = GenTry cenv cgbuf eenv scopeMarks (bodyExpr, m, resty, spTry) - // Now the catch/finally block - let startOfHandler = CG.GenerateMark cgbuf "startOfHandler" + // Now the catch/finally block + let startOfHandler = CG.GenerateMark cgbuf "startOfHandler" CG.SetStack cgbuf [] - - let sp = - match spFinally with + + let sp = + match spFinally with | SequencePointAtFinally m -> CG.EmitSeqPoint cgbuf m; SPAlways | NoSequencePointAtFinally -> SPSuppress - GenExpr cenv cgbuf eenvinner sp handlerExpr (LeaveHandler (true, whereToSave,afterHandler)) + GenExpr cenv cgbuf eenvinner sp handlerExpr (LeaveHandler (true, whereToSave, afterHandler)) let endOfHandler = CG.GenerateMark cgbuf "endOfHandler" let handlerMarks = (startOfHandler.CodeLabel, endOfHandler.CodeLabel) cgbuf.EmitExceptionClause { Clause = ILExceptionClause.Finally(handlerMarks) - Range = tryMarks } + Range = tryMarks } CG.SetMarkToHere cgbuf afterHandler CG.SetStack cgbuf [] - // Restore the stack and load the result + // Restore the stack and load the result cgbuf.EmitStartOfHiddenCode() - EmitRestoreStack cgbuf stack + EmitRestoreStack cgbuf stack EmitGetLocal cgbuf ilResultTy whereToSave GenSequel cenv eenv.cloc cgbuf sequel - ) + ) //-------------------------------------------------------------------------- // Generate for-loop -//-------------------------------------------------------------------------- - -and GenForLoop cenv cgbuf eenv (spFor,v,e1,dir,e2,loopBody,m) sequel = +//-------------------------------------------------------------------------- + +and GenForLoop cenv cgbuf eenv (spFor, v, e1, dir, e2, loopBody, m) sequel = // The JIT/NGen eliminate array-bounds checks for C# loops of form: // for(int i=0; i < (#ldlen arr#); i++) { ... arr[i] ... } // Here @@ -3184,40 +3349,40 @@ and GenForLoop cenv cgbuf eenv (spFor,v,e1,dir,e2,loopBody,m) sequel = // dir = BI_ble indicates a normal F# for loop that evaluates its argument only once // // It is also important that we follow C# IL-layout exactly "prefix, jmp test, body, test, finish" for JIT/NGEN. - let start = CG.GenerateMark cgbuf "for_start" + let start = CG.GenerateMark cgbuf "for_start" let finish = CG.GenerateDelayMark cgbuf "for_finish" let inner = CG.GenerateDelayMark cgbuf "for_inner" let test = CG.GenerateDelayMark cgbuf "for_test" - let stack,eenvinner = EmitSaveStack cenv cgbuf eenv m (start,finish) + let stack, eenvinner = EmitSaveStack cenv cgbuf eenv m (start, finish) let isUp = (match dir with | FSharpForLoopUp | CSharpForLoopUp -> true | FSharpForLoopDown -> false) let isFSharpStyle = (match dir with FSharpForLoopUp | FSharpForLoopDown -> true | CSharpForLoopUp -> false) - - let finishIdx,eenvinner = - if isFSharpStyle then - let v, _realloc, eenvinner = AllocLocal cenv cgbuf eenvinner true (ilxgenGlobalNng.FreshCompilerGeneratedName ("endLoop",m), cenv.g.ilg.typ_Int32, false) (start,finish) + + let finishIdx, eenvinner = + if isFSharpStyle then + let v, _realloc, eenvinner = AllocLocal cenv cgbuf eenvinner true (ilxgenGlobalNng.FreshCompilerGeneratedName ("endLoop", m), cenv.g.ilg.typ_Int32, false) (start, finish) v, eenvinner else - -1,eenvinner + -1, eenvinner - let _, eenvinner = AllocLocalVal cenv cgbuf v eenvinner None (start,finish) (* note: eenvStack noted stack spill vars are live *) - match spFor with + let _, eenvinner = AllocLocalVal cenv cgbuf v eenvinner None (start, finish) (* note: eenvStack noted stack spill vars are live *) + match spFor with | SequencePointAtForLoop(spStart) -> CG.EmitSeqPoint cgbuf spStart | NoSequencePointAtForLoop -> () GenExpr cenv cgbuf eenv SPSuppress e1 Continue GenStoreVal cgbuf eenvinner m v - if isFSharpStyle then + if isFSharpStyle then GenExpr cenv cgbuf eenvinner SPSuppress e2 Continue EmitSetLocal cgbuf finishIdx EmitGetLocal cgbuf cenv.g.ilg.typ_Int32 finishIdx - GenGetLocalVal cenv cgbuf eenvinner e2.Range v None - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp ((if isUp then BI_blt else BI_bgt),finish.CodeLabel)) - + GenGetLocalVal cenv cgbuf eenvinner e2.Range v None + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp ((if isUp then BI_blt else BI_bgt), finish.CodeLabel)) + else CG.EmitInstr cgbuf (pop 0) Push0 (I_br test.CodeLabel) - // .inner + // .inner CG.SetMarkToHere cgbuf inner // GenExpr cenv cgbuf eenvinner SPAlways loopBody discard @@ -3228,22 +3393,22 @@ and GenForLoop cenv cgbuf eenv (spFor,v,e1,dir,e2,loopBody,m) sequel = CG.EmitInstr cgbuf (pop 1) Push0 (if isUp then AI_add else AI_sub) GenStoreVal cgbuf eenvinner m v - // .text + // .text CG.SetMarkToHere cgbuf test // FSharpForLoopUp: if v <> e2 + 1 then goto .inner // FSharpForLoopDown: if v <> e2 - 1 then goto .inner // CSharpStyle: if v < e2 then goto .inner - match spFor with + match spFor with | SequencePointAtForLoop(spStart) -> CG.EmitSeqPoint cgbuf spStart | NoSequencePointAtForLoop -> () //CG.EmitSeqPoint cgbuf e2.Range - + GenGetLocalVal cenv cgbuf eenvinner e2.Range v None let cmp = match dir with FSharpForLoopUp | FSharpForLoopDown -> BI_bne_un | CSharpForLoopUp -> BI_blt - let e2Sequel = (CmpThenBrOrContinue (pop 2, [ I_brcmp(cmp,inner.CodeLabel) ])) + let e2Sequel = (CmpThenBrOrContinue (pop 2, [ I_brcmp(cmp, inner.CodeLabel) ])) - if isFSharpStyle then + if isFSharpStyle then EmitGetLocal cgbuf cenv.g.ilg.typ_Int32 finishIdx CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_Int32]) (mkLdcInt32 1) CG.EmitInstr cgbuf (pop 1) Push0 (if isUp then AI_add else AI_sub) @@ -3251,50 +3416,50 @@ and GenForLoop cenv cgbuf eenv (spFor,v,e1,dir,e2,loopBody,m) sequel = else GenExpr cenv cgbuf eenv SPSuppress e2 e2Sequel - // .finish - loop-exit here + // .finish - loop-exit here CG.SetMarkToHere cgbuf finish - // Restore the stack and load the result + // Restore the stack and load the result EmitRestoreStack cgbuf stack GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel //-------------------------------------------------------------------------- -// Generate while-loop -//-------------------------------------------------------------------------- - -and GenWhileLoop cenv cgbuf eenv (spWhile,e1,e2,m) sequel = - let finish = CG.GenerateDelayMark cgbuf "while_finish" +// Generate while-loop +//-------------------------------------------------------------------------- + +and GenWhileLoop cenv cgbuf eenv (spWhile, e1, e2, m) sequel = + let finish = CG.GenerateDelayMark cgbuf "while_finish" let startTest = CG.GenerateMark cgbuf "startTest" - - match spWhile with + + match spWhile with | SequencePointAtWhileLoop(spStart) -> CG.EmitSeqPoint cgbuf spStart | NoSequencePointAtWhileLoop -> () - // SEQUENCE POINTS: Emit a sequence point to cover all of 'while e do' - GenExpr cenv cgbuf eenv SPSuppress e1 (CmpThenBrOrContinue (pop 1, [ I_brcmp(BI_brfalse,finish.CodeLabel) ])) - + // SEQUENCE POINTS: Emit a sequence point to cover all of 'while e do' + GenExpr cenv cgbuf eenv SPSuppress e1 (CmpThenBrOrContinue (pop 1, [ I_brcmp(BI_brfalse, finish.CodeLabel) ])) + GenExpr cenv cgbuf eenv SPAlways e2 (DiscardThen (Br startTest)) - CG.SetMarkToHere cgbuf finish + CG.SetMarkToHere cgbuf finish - // SEQUENCE POINTS: Emit a sequence point to cover 'done' if present + // SEQUENCE POINTS: Emit a sequence point to cover 'done' if present GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel //-------------------------------------------------------------------------- // Generate seq -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- -and GenSequential cenv cgbuf eenv spIn (e1,e2,specialSeqFlag,spSeq,_m) sequel = - - // Compiler generated sequential executions result in suppressions of sequence points on both +and GenSequential cenv cgbuf eenv spIn (e1, e2, specialSeqFlag, spSeq, _m) sequel = + + // Compiler generated sequential executions result in suppressions of sequence points on both // left and right of the sequence - let spAction,spExpr = - (match spSeq with - | SequencePointsAtSeq -> SPAlways,SPAlways - | SuppressSequencePointOnExprOfSequential -> SPSuppress,spIn - | SuppressSequencePointOnStmtOfSequential -> spIn,SPSuppress) - match specialSeqFlag with - | NormalSeq -> - GenExpr cenv cgbuf eenv spAction e1 discard + let spAction, spExpr = + (match spSeq with + | SequencePointsAtSeq -> SPAlways, SPAlways + | SuppressSequencePointOnExprOfSequential -> SPSuppress, spIn + | SuppressSequencePointOnStmtOfSequential -> spIn, SPSuppress) + match specialSeqFlag with + | NormalSeq -> + GenExpr cenv cgbuf eenv spAction e1 discard GenExpr cenv cgbuf eenv spExpr e2 sequel | ThenDoSeq -> GenExpr cenv cgbuf eenv spExpr e1 Continue @@ -3304,86 +3469,86 @@ and GenSequential cenv cgbuf eenv spIn (e1,e2,specialSeqFlag,spSeq,_m) sequel = //-------------------------------------------------------------------------- // Generate IL assembly code. // Polymorphic IL/ILX instructions may be instantiated when polymorphic code is inlined. -// We must implement this for the few uses of polymorphic instructions -// in the standard libarary. -//-------------------------------------------------------------------------- +// We must implement this for the few uses of polymorphic instructions +// in the standard libarary. +//-------------------------------------------------------------------------- -and GenAsmCode cenv cgbuf eenv (il,tyargs,args,returnTys,m) sequel = +and GenAsmCode cenv cgbuf eenv (il, tyargs, args, returnTys, m) sequel = let ilTyArgs = GenTypesPermitVoid cenv.amap m eenv.tyenv tyargs let ilReturnTys = GenTypesPermitVoid cenv.amap m eenv.tyenv returnTys - let ilAfterInst = + let ilAfterInst = il |> List.filter (function AI_nop -> false | _ -> true) - |> List.map (fun i -> - let err s = - errorR(InternalError(sprintf "%s: bad instruction: %A" s i,m)) + |> List.map (fun i -> + let err s = + errorR(InternalError(sprintf "%s: bad instruction: %A" s i, m)) - let modFieldSpec fspec = - if isNil ilTyArgs then - fspec + let modFieldSpec fspec = + if isNil ilTyArgs then + fspec else - {fspec with DeclaringType= + {fspec with DeclaringType= let ty = fspec.DeclaringType let tspec = ty.TypeSpec - mkILTy ty.Boxity (mkILTySpec(tspec.TypeRef, ilTyArgs)) } - match i,ilTyArgs with - | I_unbox_any (ILType.TypeVar _) ,[tyarg] -> I_unbox_any (tyarg) - | I_box (ILType.TypeVar _) ,[tyarg] -> I_box (tyarg) - | I_isinst (ILType.TypeVar _) ,[tyarg] -> I_isinst (tyarg) - | I_castclass (ILType.TypeVar _) ,[tyarg] -> I_castclass (tyarg) - | I_newarr (shape,ILType.TypeVar _) ,[tyarg] -> I_newarr (shape,tyarg) - | I_ldelem_any (shape,ILType.TypeVar _) ,[tyarg] -> I_ldelem_any (shape,tyarg) - | I_ldelema (ro,_,shape,ILType.TypeVar _) ,[tyarg] -> I_ldelema (ro,false,shape,tyarg) - | I_stelem_any (shape,ILType.TypeVar _) ,[tyarg] -> I_stelem_any (shape,tyarg) - | I_ldobj (a,b,ILType.TypeVar _) ,[tyarg] -> I_ldobj (a,b,tyarg) - | I_stobj (a,b,ILType.TypeVar _) ,[tyarg] -> I_stobj (a,b,tyarg) - | I_ldtoken (ILToken.ILType (ILType.TypeVar _)),[tyarg] -> I_ldtoken (ILToken.ILType (tyarg)) - | I_sizeof (ILType.TypeVar _) ,[tyarg] -> I_sizeof (tyarg) + mkILTy ty.Boxity (mkILTySpec(tspec.TypeRef, ilTyArgs)) } + match i, ilTyArgs with + | I_unbox_any (ILType.TypeVar _) , [tyarg] -> I_unbox_any (tyarg) + | I_box (ILType.TypeVar _) , [tyarg] -> I_box (tyarg) + | I_isinst (ILType.TypeVar _) , [tyarg] -> I_isinst (tyarg) + | I_castclass (ILType.TypeVar _) , [tyarg] -> I_castclass (tyarg) + | I_newarr (shape, ILType.TypeVar _) , [tyarg] -> I_newarr (shape, tyarg) + | I_ldelem_any (shape, ILType.TypeVar _) , [tyarg] -> I_ldelem_any (shape, tyarg) + | I_ldelema (ro, _, shape, ILType.TypeVar _) , [tyarg] -> I_ldelema (ro, false, shape, tyarg) + | I_stelem_any (shape, ILType.TypeVar _) , [tyarg] -> I_stelem_any (shape, tyarg) + | I_ldobj (a, b, ILType.TypeVar _) , [tyarg] -> I_ldobj (a, b, tyarg) + | I_stobj (a, b, ILType.TypeVar _) , [tyarg] -> I_stobj (a, b, tyarg) + | I_ldtoken (ILToken.ILType (ILType.TypeVar _)), [tyarg] -> I_ldtoken (ILToken.ILType (tyarg)) + | I_sizeof (ILType.TypeVar _) , [tyarg] -> I_sizeof (tyarg) // currently unused, added for forward compat, see https://visualfsharp.codeplex.com/SourceControl/network/forks/jackpappas/fsharpcontrib/contribution/7134 - | I_cpobj (ILType.TypeVar _) ,[tyarg] -> I_cpobj (tyarg) - | I_initobj (ILType.TypeVar _) ,[tyarg] -> I_initobj (tyarg) - | I_ldfld (al,vol,fspec) ,_ -> I_ldfld (al,vol,modFieldSpec fspec) - | I_ldflda (fspec) ,_ -> I_ldflda (modFieldSpec fspec) - | I_stfld (al,vol,fspec) ,_ -> I_stfld (al,vol,modFieldSpec fspec) - | I_stsfld (vol,fspec) ,_ -> I_stsfld (vol,modFieldSpec fspec) - | I_ldsfld (vol,fspec) ,_ -> I_ldsfld (vol,modFieldSpec fspec) - | I_ldsflda (fspec) ,_ -> I_ldsflda (modFieldSpec fspec) - | EI_ilzero(ILType.TypeVar _) ,[tyarg] -> EI_ilzero(tyarg) - | AI_nop,_ -> i - // These are embedded in the IL for a an initonly ldfld, i.e. - // here's the relevant comment from tc.fs - // "Add an I_nop if this is an initonly field to make sure we never recognize it as an lvalue. See mkExprAddrOfExpr." - - | _ -> - if not (isNil tyargs) then err "Bad polymorphic IL instruction" + | I_cpobj (ILType.TypeVar _) , [tyarg] -> I_cpobj (tyarg) + | I_initobj (ILType.TypeVar _) , [tyarg] -> I_initobj (tyarg) + | I_ldfld (al, vol, fspec) , _ -> I_ldfld (al, vol, modFieldSpec fspec) + | I_ldflda (fspec) , _ -> I_ldflda (modFieldSpec fspec) + | I_stfld (al, vol, fspec) , _ -> I_stfld (al, vol, modFieldSpec fspec) + | I_stsfld (vol, fspec) , _ -> I_stsfld (vol, modFieldSpec fspec) + | I_ldsfld (vol, fspec) , _ -> I_ldsfld (vol, modFieldSpec fspec) + | I_ldsflda (fspec) , _ -> I_ldsflda (modFieldSpec fspec) + | EI_ilzero(ILType.TypeVar _) , [tyarg] -> EI_ilzero(tyarg) + | AI_nop, _ -> i + // These are embedded in the IL for a an initonly ldfld, i.e. + // here's the relevant comment from tc.fs + // "Add an I_nop if this is an initonly field to make sure we never recognize it as an lvalue. See mkExprAddrOfExpr." + + | _ -> + if not (isNil tyargs) then err "Bad polymorphic IL instruction" i) - match ilAfterInst,args,sequel,ilReturnTys with + match ilAfterInst, args, sequel, ilReturnTys with - | [ EI_ilzero _ ], _, _, _ -> - match tyargs with - | [ty] -> - GenDefaultValue cenv cgbuf eenv (ty,m) + | [ EI_ilzero _ ], _, _, _ -> + match tyargs with + | [ty] -> + GenDefaultValue cenv cgbuf eenv (ty, m) GenSequel cenv eenv.cloc cgbuf sequel - | _ -> failwith "Bad polymorphic IL instruction" + | _ -> failwith "Bad polymorphic IL instruction" // Strip off any ("ceq" x false) when the sequel is a comparison branch and change the BI_brfalse to a BI_brtrue - // This is the instruction sequence for "not" - // For these we can just generate the argument and change the test (from a brfalse to a brtrue and vice versa) + // This is the instruction sequence for "not" + // For these we can just generate the argument and change the test (from a brfalse to a brtrue and vice versa) | ([ AI_ceq ], - [arg1; Expr.Const((Const.Bool false | Const.SByte 0y| Const.Int16 0s | Const.Int32 0 | Const.Int64 0L | Const.Byte 0uy| Const.UInt16 0us | Const.UInt32 0u | Const.UInt64 0UL),_,_) ], - CmpThenBrOrContinue(1, [I_brcmp (((BI_brfalse | BI_brtrue) as bi),label1) ]), + [arg1; Expr.Const((Const.Bool false | Const.SByte 0y| Const.Int16 0s | Const.Int32 0 | Const.Int64 0L | Const.Byte 0uy| Const.UInt16 0us | Const.UInt32 0u | Const.UInt64 0UL), _, _) ], + CmpThenBrOrContinue(1, [I_brcmp (((BI_brfalse | BI_brtrue) as bi), label1) ]), _) -> let bi = match bi with BI_brtrue -> BI_brfalse | _ -> BI_brtrue - GenExpr cenv cgbuf eenv SPSuppress arg1 (CmpThenBrOrContinue(pop 1, [ I_brcmp (bi,label1) ])) + GenExpr cenv cgbuf eenv SPSuppress arg1 (CmpThenBrOrContinue(pop 1, [ I_brcmp (bi, label1) ])) // Query; when do we get a 'ret' in IL assembly code? - | [ I_ret ], [arg1],sequel,[_ilRetTy] -> + | [ I_ret ], [arg1], sequel, [_ilRetTy] -> GenExpr cenv cgbuf eenv SPSuppress arg1 Continue CG.EmitInstr cgbuf (pop 1) Push0 I_ret GenSequelEndScopes cgbuf sequel // Query; when do we get a 'ret' in IL assembly code? - | [ I_ret ], [],sequel,[_ilRetTy] -> + | [ I_ret ], [], sequel, [_ilRetTy] -> CG.EmitInstr cgbuf (pop 1) Push0 I_ret GenSequelEndScopes cgbuf sequel @@ -3393,116 +3558,116 @@ and GenAsmCode cenv cgbuf eenv (il,tyargs,args,returnTys,m) sequel = // (nb. a fake value can always be generated by a "ldnull unbox.any ty" sequence *) // So in the worst case we generate a fake (never-taken) branch to a piece of code to generate *) // the fake value *) - | [ I_throw ], [arg1],sequel,[ilRetTy] -> - match sequelIgnoreEndScopes sequel with - | s when IsSequelImmediate s -> + | [ I_throw ], [arg1], sequel, [ilRetTy] -> + match sequelIgnoreEndScopes sequel with + | s when IsSequelImmediate s -> (* In most cases we can avoid doing this... *) GenExpr cenv cgbuf eenv SPSuppress arg1 Continue CG.EmitInstr cgbuf (pop 1) Push0 I_throw GenSequelEndScopes cgbuf sequel - | _ -> + | _ -> let after1 = CG.GenerateDelayMark cgbuf ("fake_join") let after2 = CG.GenerateDelayMark cgbuf ("fake_join") let after3 = CG.GenerateDelayMark cgbuf ("fake_join") - CG.EmitInstrs cgbuf (pop 0) Push0 [mkLdcInt32 0; I_brcmp (BI_brfalse,after2.CodeLabel) ] + CG.EmitInstrs cgbuf (pop 0) Push0 [mkLdcInt32 0; I_brcmp (BI_brfalse, after2.CodeLabel) ] CG.SetMarkToHere cgbuf after1 CG.EmitInstrs cgbuf (pop 0) (Push [ilRetTy]) [AI_ldnull; I_unbox_any ilRetTy; I_br after3.CodeLabel ] - + CG.SetMarkToHere cgbuf after2 GenExpr cenv cgbuf eenv SPSuppress arg1 Continue CG.EmitInstr cgbuf (pop 1) Push0 I_throw CG.SetMarkToHere cgbuf after3 GenSequel cenv eenv.cloc cgbuf sequel - | _ -> + | _ -> // float or float32 or float<_> or float32<_> - let g = cenv.g in - let anyfpType ty = typeEquivAux EraseMeasures g g.float_ty ty || typeEquivAux EraseMeasures g g.float32_ty ty + let g = cenv.g in + let anyfpType ty = typeEquivAux EraseMeasures g g.float_ty ty || typeEquivAux EraseMeasures g g.float32_ty ty - // Otherwise generate the arguments, and see if we can use a I_brcmp rather than a comparison followed by an I_brfalse/I_brtrue + // Otherwise generate the arguments, and see if we can use a I_brcmp rather than a comparison followed by an I_brfalse/I_brtrue GenExprs cenv cgbuf eenv args - match ilAfterInst,sequel with + match ilAfterInst, sequel with - // NOTE: THESE ARE NOT VALID ON FLOATING POINT DUE TO NaN. Hence INLINE ASM ON FP. MUST BE CAREFULLY WRITTEN + // NOTE: THESE ARE NOT VALID ON FLOATING POINT DUE TO NaN. Hence INLINE ASM ON FP. MUST BE CAREFULLY WRITTEN - | [ AI_clt ], CmpThenBrOrContinue(1,[ I_brcmp (BI_brfalse, label1) ]) when not (anyfpType (tyOfExpr g args.Head)) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bge,label1)) - | [ AI_cgt ], CmpThenBrOrContinue(1,[ I_brcmp (BI_brfalse, label1) ]) when not (anyfpType (tyOfExpr g args.Head)) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_ble,label1)) - | [ AI_clt_un ], CmpThenBrOrContinue(1,[ I_brcmp (BI_brfalse, label1) ]) when not (anyfpType (tyOfExpr g args.Head)) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bge_un,label1)) + | [ AI_clt ], CmpThenBrOrContinue(1, [ I_brcmp (BI_brfalse, label1) ]) when not (anyfpType (tyOfExpr g args.Head)) -> + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bge, label1)) + | [ AI_cgt ], CmpThenBrOrContinue(1, [ I_brcmp (BI_brfalse, label1) ]) when not (anyfpType (tyOfExpr g args.Head)) -> + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_ble, label1)) + | [ AI_clt_un ], CmpThenBrOrContinue(1, [ I_brcmp (BI_brfalse, label1) ]) when not (anyfpType (tyOfExpr g args.Head)) -> + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bge_un, label1)) | [ AI_cgt_un ], CmpThenBrOrContinue(1, [I_brcmp (BI_brfalse, label1) ]) when not (anyfpType (tyOfExpr g args.Head)) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_ble_un,label1)) - | [ AI_ceq ], CmpThenBrOrContinue(1,[ I_brcmp (BI_brfalse, label1) ]) when not (anyfpType (tyOfExpr g args.Head)) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bne_un,label1)) - - // THESE ARE VALID ON FP w.r.t. NaN - - | [ AI_clt ], CmpThenBrOrContinue(1,[ I_brcmp (BI_brtrue, label1) ]) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_blt,label1)) - | [ AI_cgt ], CmpThenBrOrContinue(1,[ I_brcmp (BI_brtrue, label1) ]) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bgt,label1)) - | [ AI_clt_un ], CmpThenBrOrContinue(1,[ I_brcmp (BI_brtrue, label1) ]) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_blt_un,label1)) - | [ AI_cgt_un ], CmpThenBrOrContinue(1,[ I_brcmp (BI_brtrue, label1) ]) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bgt_un,label1)) + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_ble_un, label1)) + | [ AI_ceq ], CmpThenBrOrContinue(1, [ I_brcmp (BI_brfalse, label1) ]) when not (anyfpType (tyOfExpr g args.Head)) -> + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bne_un, label1)) + + // THESE ARE VALID ON FP w.r.t. NaN + + | [ AI_clt ], CmpThenBrOrContinue(1, [ I_brcmp (BI_brtrue, label1) ]) -> + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_blt, label1)) + | [ AI_cgt ], CmpThenBrOrContinue(1, [ I_brcmp (BI_brtrue, label1) ]) -> + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bgt, label1)) + | [ AI_clt_un ], CmpThenBrOrContinue(1, [ I_brcmp (BI_brtrue, label1) ]) -> + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_blt_un, label1)) + | [ AI_cgt_un ], CmpThenBrOrContinue(1, [ I_brcmp (BI_brtrue, label1) ]) -> + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_bgt_un, label1)) | [ AI_ceq ], CmpThenBrOrContinue(1, [ I_brcmp (BI_brtrue, label1) ]) -> - CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_beq,label1)) - | _ -> - // Failing that, generate the real IL leaving value(s) on the stack + CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp(BI_beq, label1)) + | _ -> + // Failing that, generate the real IL leaving value(s) on the stack CG.EmitInstrs cgbuf (pop args.Length) (Push ilReturnTys) ilAfterInst - // If no return values were specified generate a "unit" - if isNil returnTys then + // If no return values were specified generate a "unit" + if isNil returnTys then GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel - else + else GenSequel cenv eenv.cloc cgbuf sequel //-------------------------------------------------------------------------- // Generate expression quotations -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- -and GenQuotation cenv cgbuf eenv (ast,conv,m,ety) sequel = +and GenQuotation cenv cgbuf eenv (ast, conv, m, ety) sequel = - let referencedTypeDefs, spliceTypes, spliceArgExprs, astSpec = - match !conv with + let referencedTypeDefs, spliceTypes, spliceArgExprs, astSpec = + match !conv with | Some res -> res - | None -> - try + | None -> + try let qscope = QuotationTranslator.QuotationGenerationScope.Create (cenv.g, cenv.amap, cenv.viewCcu, QuotationTranslator.IsReflectedDefinition.No) - let astSpec = QuotationTranslator.ConvExprPublic qscope QuotationTranslator.QuotationTranslationEnv.Empty ast + let astSpec = QuotationTranslator.ConvExprPublic qscope QuotationTranslator.QuotationTranslationEnv.Empty ast let referencedTypeDefs, spliceTypes, spliceArgExprs = qscope.Close() referencedTypeDefs, List.map fst spliceTypes, List.map fst spliceArgExprs, astSpec - with + with QuotationTranslator.InvalidQuotedTerm e -> error(e) let astSerializedBytes = QuotationPickler.pickle astSpec let someTypeInModuleExpr = mkTypeOfExpr cenv m eenv.someTypeInThisAssembly - let rawTy = mkRawQuotedExprTy cenv.g - let spliceTypeExprs = List.map (GenType cenv.amap m eenv.tyenv >> (mkTypeOfExpr cenv m)) spliceTypes + let rawTy = mkRawQuotedExprTy cenv.g + let spliceTypeExprs = List.map (GenType cenv.amap m eenv.tyenv >> (mkTypeOfExpr cenv m)) spliceTypes - let bytesExpr = Expr.Op(TOp.Bytes(astSerializedBytes),[],[],m) + let bytesExpr = Expr.Op(TOp.Bytes(astSerializedBytes), [], [], m) - let deserializeExpr = + let deserializeExpr = match QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat cenv.g with | QuotationTranslator.QuotationSerializationFormat.FSharp_40_Plus -> let referencedTypeDefExprs = List.map (mkILNonGenericBoxedTy >> mkTypeOfExpr cenv m) referencedTypeDefs - let referencedTypeDefsExpr = mkArray (cenv.g.system_Type_ty, referencedTypeDefExprs, m) + let referencedTypeDefsExpr = mkArray (cenv.g.system_Type_ty, referencedTypeDefExprs, m) let spliceTypesExpr = mkArray (cenv.g.system_Type_ty, spliceTypeExprs, m) let spliceArgsExpr = mkArray (rawTy, spliceArgExprs, m) mkCallDeserializeQuotationFSharp40Plus cenv.g m someTypeInModuleExpr referencedTypeDefsExpr spliceTypesExpr spliceArgsExpr bytesExpr | QuotationTranslator.QuotationSerializationFormat.FSharp_20_Plus -> let mkList ty els = List.foldBack (mkCons cenv.g ty) els (mkNil cenv.g m ty) - let spliceTypesExpr = mkList cenv.g.system_Type_ty spliceTypeExprs - let spliceArgsExpr = mkList rawTy spliceArgExprs + let spliceTypesExpr = mkList cenv.g.system_Type_ty spliceTypeExprs + let spliceArgsExpr = mkList rawTy spliceArgExprs mkCallDeserializeQuotationFSharp20Plus cenv.g m someTypeInModuleExpr spliceTypesExpr spliceArgsExpr bytesExpr - let afterCastExpr = + let afterCastExpr = // Detect a typed quotation and insert the cast if needed. The cast should not fail but does // unfortunately involve a "typeOf" computation over a quotation tree. - if tyconRefEq cenv.g (tcrefOfAppTy cenv.g ety) cenv.g.expr_tcr then + if tyconRefEq cenv.g (tcrefOfAppTy cenv.g ety) cenv.g.expr_tcr then mkCallCastQuotation cenv.g m (List.head (argsOfAppTy cenv.g ety)) deserializeExpr else deserializeExpr @@ -3510,9 +3675,9 @@ and GenQuotation cenv cgbuf eenv (ast,conv,m,ety) sequel = //-------------------------------------------------------------------------- // Generate calls to IL methods -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- -and GenILCall cenv cgbuf eenv (virt,valu,newobj,valUseFlags,isDllImport,ilMethRef:ILMethodRef,enclArgTys,methArgTys,argExprs,returnTys,m) sequel = +and GenILCall cenv cgbuf eenv (virt, valu, newobj, valUseFlags, isDllImport, ilMethRef:ILMethodRef, enclArgTys, methArgTys, argExprs, returnTys, m) sequel = let hasByrefArg = ilMethRef.ArgTypes |> List.exists IsILTypeByref let isSuperInit = match valUseFlags with CtorValUsedAsSuperInit -> true | _ -> false let isBaseCall = match valUseFlags with VSlotDirectCall -> true | _ -> false @@ -3520,38 +3685,38 @@ and GenILCall cenv cgbuf eenv (virt,valu,newobj,valUseFlags,isDllImport,ilMethRe let boxity = (if valu then AsValue else AsObject) let mustGenerateUnitAfterCall = isNil returnTys let makesNoCriticalTailcalls = (newobj || not virt) // Don't tailcall for 'newobj', or 'call' to IL code - let tail = CanTailcall(valu,ccallInfo,eenv.withinSEH,hasByrefArg,mustGenerateUnitAfterCall,isDllImport,false,makesNoCriticalTailcalls,sequel) - + let tail = CanTailcall(valu, ccallInfo, eenv.withinSEH, hasByrefArg, mustGenerateUnitAfterCall, isDllImport, false, makesNoCriticalTailcalls, sequel) + let ilEnclArgTys = GenTypeArgs cenv.amap m eenv.tyenv enclArgTys let ilMethArgTys = GenTypeArgs cenv.amap m eenv.tyenv methArgTys let ilReturnTys = GenTypes cenv.amap m eenv.tyenv returnTys - let ilMethSpec = mkILMethSpec (ilMethRef,boxity,ilEnclArgTys,ilMethArgTys) + let ilMethSpec = mkILMethSpec (ilMethRef, boxity, ilEnclArgTys, ilMethArgTys) let useICallVirt = virt || useCallVirt cenv boxity ilMethSpec isBaseCall - // Load the 'this' pointer to pass to the superclass constructor. This argument is not - // in the expression tree since it can't be treated like an ordinary value - if isSuperInit then CG.EmitInstrs cgbuf (pop 0) (Push [ilMethSpec.DeclaringType]) [ mkLdarg0 ] + // Load the 'this' pointer to pass to the superclass constructor. This argument is not + // in the expression tree since it can't be treated like an ordinary value + if isSuperInit then CG.EmitInstrs cgbuf (pop 0) (Push [ilMethSpec.DeclaringType]) [ mkLdarg0 ] GenExprs cenv cgbuf eenv argExprs - let il = - if newobj then [ I_newobj(ilMethSpec,None) ] - else - match ccallInfo with - | Some objArgTy -> + let il = + if newobj then [ I_newobj(ilMethSpec, None) ] + else + match ccallInfo with + | Some objArgTy -> let ilObjArgTy = GenType cenv.amap m eenv.tyenv objArgTy - [ I_callconstraint(tail,ilObjArgTy,ilMethSpec,None) ] - | None -> - if useICallVirt then [ I_callvirt(tail,ilMethSpec,None) ] - else [ I_call(tail,ilMethSpec,None) ] + [ I_callconstraint(tail, ilObjArgTy, ilMethSpec, None) ] + | None -> + if useICallVirt then [ I_callvirt(tail, ilMethSpec, None) ] + else [ I_call(tail, ilMethSpec, None) ] CG.EmitInstrs cgbuf (pop (argExprs.Length + (if isSuperInit then 1 else 0))) (if isSuperInit then Push0 else Push ilReturnTys) il - // Load the 'this' pointer as the pretend 'result' of the isSuperInit operation. - // It will be immediately popped in most cases, but may also be used as the target of some "property set" operations. - if isSuperInit then CG.EmitInstrs cgbuf (pop 0) (Push [ilMethSpec.DeclaringType]) [ mkLdarg0 ] + // Load the 'this' pointer as the pretend 'result' of the isSuperInit operation. + // It will be immediately popped in most cases, but may also be used as the target of some "property set" operations. + if isSuperInit then CG.EmitInstrs cgbuf (pop 0) (Push [ilMethSpec.DeclaringType]) [ mkLdarg0 ] CommitCallSequel cenv eenv m eenv.cloc cgbuf mustGenerateUnitAfterCall sequel and CommitCallSequel cenv eenv m cloc cgbuf mustGenerateUnitAfterCall sequel = - if mustGenerateUnitAfterCall + if mustGenerateUnitAfterCall then GenUnitThenSequel cenv eenv m cloc cgbuf sequel else GenSequel cenv cloc cgbuf sequel @@ -3560,28 +3725,28 @@ and MakeNotSupportedExnExpr cenv eenv (argExpr, m) = let ety = mkAppTy (cenv.g.FindSysTyconRef ["System"] "NotSupportedException") [] let ilty = GenType cenv.amap m eenv.tyenv ety let mref = mkILCtorMethSpecForTy(ilty, [cenv.g.ilg.typ_String]).MethodRef - Expr.Op(TOp.ILCall(false,false,false,true,NormalValUse,false,false,mref,[],[],[ety]),[],[argExpr],m) + Expr.Op(TOp.ILCall(false, false, false, true, NormalValUse, false, false, mref, [], [], [ety]), [], [argExpr], m) and GenTraitCall cenv cgbuf eenv (traitInfo, argExprs, m) expr sequel = let minfoOpt = CommitOperationResult (ConstraintSolver.CodegenWitnessThatTypeSupportsTraitConstraint cenv.TcVal cenv.g cenv.amap m traitInfo argExprs) - match minfoOpt with - | None -> + match minfoOpt with + | None -> let exnArg = mkString cenv.g m (FSComp.SR.ilDynamicInvocationNotSupported(traitInfo.MemberName)) let exnExpr = MakeNotSupportedExnExpr cenv eenv (exnArg, m) let replacementExpr = mkThrow m (tyOfExpr cenv.g expr) exnExpr GenExpr cenv cgbuf eenv SPSuppress replacementExpr sequel - | Some expr -> + | Some expr -> let expr = cenv.optimizeDuringCodeGen expr - GenExpr cenv cgbuf eenv SPSuppress expr sequel + GenExpr cenv cgbuf eenv SPSuppress expr sequel //-------------------------------------------------------------------------- // Generate byref-related operations -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- -and GenGetAddrOfRefCellField cenv cgbuf eenv (e,ty,m) sequel = +and GenGetAddrOfRefCellField cenv cgbuf eenv (e, ty, m) sequel = GenExpr cenv cgbuf eenv SPSuppress e Continue let fref = GenRecdFieldRef m cenv eenv.tyenv (mkRefCellContentsRef cenv.g) [ty] - CG.EmitInstrs cgbuf (pop 1) (Push [ILType.Byref fref.ActualType]) [ I_ldflda fref ] + CG.EmitInstrs cgbuf (pop 1) (Push [ILType.Byref fref.ActualType]) [ I_ldflda fref ] GenSequel cenv eenv.cloc cgbuf sequel and GenGetValAddr cenv cgbuf eenv (v: ValRef, m) sequel = @@ -3589,71 +3754,71 @@ and GenGetValAddr cenv cgbuf eenv (v: ValRef, m) sequel = let ilTy = GenTypeOfVal cenv eenv vspec let storage = StorageForValRef m v eenv - match storage with + match storage with | Local (idx, _, None) -> - CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref ilTy]) [ I_ldloca (uint16 idx) ] + CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref ilTy]) [ I_ldloca (uint16 idx) ] | Arg idx -> - CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref ilTy]) [ I_ldarga (uint16 idx) ] + CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref ilTy]) [ I_ldarga (uint16 idx) ] - | StaticField (fspec, _vref, hasLiteralAttr, _ilTyForProperty, _, ilTy, _, _, _) -> - if hasLiteralAttr then errorR(Error(FSComp.SR.ilAddressOfLiteralFieldIsInvalid(),m)) + | StaticField (fspec, _vref, hasLiteralAttr, _ilTyForProperty, _, ilTy, _, _, _) -> + if hasLiteralAttr then errorR(Error(FSComp.SR.ilAddressOfLiteralFieldIsInvalid(), m)) let ilTy = if ilTy.IsNominal && ilTy.Boxity = ILBoxity.AsValue then ILType.Byref ilTy else ilTy EmitGetStaticFieldAddr cgbuf ilTy fspec - | Env (_,_,ilField,_) -> - CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref ilTy]) [ mkLdarg0; mkNormalLdflda ilField ] + | Env (_, _, ilField, _) -> + CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref ilTy]) [ mkLdarg0; mkNormalLdflda ilField ] - | Local (_, _, Some _) | StaticProperty _ | Method _ | Env _ | Null -> - errorR(Error(FSComp.SR.ilAddressOfValueHereIsInvalid(v.DisplayName),m)) - CG.EmitInstrs cgbuf (pop 1) (Push [ILType.Byref ilTy]) [ I_ldarga (uint16 669 (* random value for post-hoc diagnostic analysis on generated tree *) ) ] ; + | Local (_, _, Some _) | StaticProperty _ | Method _ | Env _ | Null -> + errorR(Error(FSComp.SR.ilAddressOfValueHereIsInvalid(v.DisplayName), m)) + CG.EmitInstrs cgbuf (pop 1) (Push [ILType.Byref ilTy]) [ I_ldarga (uint16 669 (* random value for post-hoc diagnostic analysis on generated tree *) ) ] GenSequel cenv eenv.cloc cgbuf sequel -and GenGetByref cenv cgbuf eenv (v:ValRef,m) sequel = +and GenGetByref cenv cgbuf eenv (v:ValRef, m) sequel = GenGetLocalVRef cenv cgbuf eenv m v None let ilty = GenType cenv.amap m eenv.tyenv (destByrefTy cenv.g v.Type) CG.EmitInstrs cgbuf (pop 1) (Push [ilty]) [ mkNormalLdobj ilty ] GenSequel cenv eenv.cloc cgbuf sequel -and GenSetByref cenv cgbuf eenv (v:ValRef,e,m) sequel = +and GenSetByref cenv cgbuf eenv (v:ValRef, e, m) sequel = GenGetLocalVRef cenv cgbuf eenv m v None GenExpr cenv cgbuf eenv SPSuppress e Continue let ilty = GenType cenv.amap m eenv.tyenv (destByrefTy cenv.g v.Type) CG.EmitInstrs cgbuf (pop 2) Push0 [ mkNormalStobj ilty ] GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel -and GenDefaultValue cenv cgbuf eenv (ty,m) = +and GenDefaultValue cenv cgbuf eenv (ty, m) = let ilTy = GenType cenv.amap m eenv.tyenv ty - if isRefTy cenv.g ty then + if isRefTy cenv.g ty then CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) AI_ldnull else - match tryDestAppTy cenv.g ty with - | ValueSome tcref when (tyconRefEq cenv.g cenv.g.system_SByte_tcref tcref || - tyconRefEq cenv.g cenv.g.system_Int16_tcref tcref || - tyconRefEq cenv.g cenv.g.system_Int32_tcref tcref || - tyconRefEq cenv.g cenv.g.system_Bool_tcref tcref || - tyconRefEq cenv.g cenv.g.system_Byte_tcref tcref || - tyconRefEq cenv.g cenv.g.system_Char_tcref tcref || - tyconRefEq cenv.g cenv.g.system_UInt16_tcref tcref || + match tryDestAppTy cenv.g ty with + | ValueSome tcref when (tyconRefEq cenv.g cenv.g.system_SByte_tcref tcref || + tyconRefEq cenv.g cenv.g.system_Int16_tcref tcref || + tyconRefEq cenv.g cenv.g.system_Int32_tcref tcref || + tyconRefEq cenv.g cenv.g.system_Bool_tcref tcref || + tyconRefEq cenv.g cenv.g.system_Byte_tcref tcref || + tyconRefEq cenv.g cenv.g.system_Char_tcref tcref || + tyconRefEq cenv.g cenv.g.system_UInt16_tcref tcref || tyconRefEq cenv.g cenv.g.system_UInt32_tcref tcref) -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) iLdcZero - | ValueSome tcref when (tyconRefEq cenv.g cenv.g.system_Int64_tcref tcref || + | ValueSome tcref when (tyconRefEq cenv.g cenv.g.system_Int64_tcref tcref || tyconRefEq cenv.g cenv.g.system_UInt64_tcref tcref) -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (iLdcInt64 0L) | ValueSome tcref when (tyconRefEq cenv.g cenv.g.system_Single_tcref tcref) -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (iLdcSingle 0.0f) | ValueSome tcref when (tyconRefEq cenv.g cenv.g.system_Double_tcref tcref) -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (iLdcDouble 0.0) - | _ -> + | _ -> let ilTy = GenType cenv.amap m eenv.tyenv ty LocalScope "ilzero" cgbuf (fun scopeMarks -> - let locIdx, realloc, _ = AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("default",m), ilTy, false) scopeMarks - // "initobj" (Generated by EmitInitLocal) doesn't work on byref types - // But ilzero(&ty) only gets generated in the built-in get-address function so - // we can just rely on zeroinit of all IL locals. - if realloc then - match ilTy with + let locIdx, realloc, _ = AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("default", m), ilTy, false) scopeMarks + // "initobj" (Generated by EmitInitLocal) doesn't work on byref types + // But ilzero(&ty) only gets generated in the built-in get-address function so + // we can just rely on zeroinit of all IL locals. + if realloc then + match ilTy with | ILType.Byref _ -> () | _ -> EmitInitLocal cgbuf ilTy locIdx EmitGetLocal cgbuf ilTy locIdx @@ -3661,169 +3826,171 @@ and GenDefaultValue cenv cgbuf eenv (ty,m) = //-------------------------------------------------------------------------- // Generate generic parameters -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- -and GenGenericParam cenv eenv (tp:Typar) = - let subTypeConstraints = - tp.Constraints - |> List.choose (function | TyparConstraint.CoercesTo(ty,_) -> Some(ty) | _ -> None) +and GenGenericParam cenv eenv (tp:Typar) = + let subTypeConstraints = + tp.Constraints + |> List.choose (function | TyparConstraint.CoercesTo(ty, _) -> Some(ty) | _ -> None) |> List.map (GenTypeAux cenv.amap tp.Range eenv.tyenv VoidNotOK PtrTypesNotOK) - let refTypeConstraint = - tp.Constraints + let refTypeConstraint = + tp.Constraints |> List.exists (function TyparConstraint.IsReferenceType _ -> true | TyparConstraint.SupportsNull _ -> true | _ -> false) - let notNullableValueTypeConstraint = + let notNullableValueTypeConstraint = tp.Constraints |> List.exists (function TyparConstraint.IsNonNullableStruct _ -> true | _ -> false) - let defaultConstructorConstraint = + let defaultConstructorConstraint = tp.Constraints |> List.exists (function TyparConstraint.RequiresDefaultConstructor _ -> true | _ -> false) - { Name= - + let tpName = // use the CompiledName if given // Inference variables get given an IL name "TA, TB" etc. - let nm = - match tp.ILName with - | None -> tp.Name + let nm = + match tp.ILName with + | None -> tp.Name | Some nm -> nm // Some special rules apply when compiling Fsharp.Core.dll to avoid a proliferation of [] attributes on type parameters - if cenv.g.compilingFslib then - match nm with + if cenv.g.compilingFslib then + match nm with | "U" -> "TResult" | "U1" -> "TResult1" | "U2" -> "TResult2" - | _ -> - if nm.TrimEnd([| '0' .. '9' |]).Length = 1 then nm + | _ -> + if nm.TrimEnd([| '0' .. '9' |]).Length = 1 then nm elif nm.Length >= 1 && nm.[0] = 'T' && (nm.Length = 1 || not (System.Char.IsLower nm.[1])) then nm else "T" + (String.capitalize nm) - else - nm + else + nm + + let tpAttrs = mkILCustomAttrs (GenAttrs cenv eenv tp.Attribs) + { Name = tpName Constraints = subTypeConstraints - Variance=NonVariant - CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs (GenAttrs cenv eenv tp.Attribs)) + Variance = NonVariant + CustomAttrsStored = storeILCustomAttrs tpAttrs MetadataIndex = NoMetadataIdx - HasReferenceTypeConstraint=refTypeConstraint - HasNotNullableValueTypeConstraint=notNullableValueTypeConstraint - HasDefaultConstructorConstraint= defaultConstructorConstraint } + HasReferenceTypeConstraint = refTypeConstraint + HasNotNullableValueTypeConstraint = notNullableValueTypeConstraint + HasDefaultConstructorConstraint = defaultConstructorConstraint } //-------------------------------------------------------------------------- // Generate object expressions as ILX "closures" -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- /// Generates the data used for parameters at definitions of abstract method slots such as interface methods or override methods. -and GenSlotParam m cenv eenv (TSlotParam(nm,ty,inFlag,outFlag,optionalFlag,attribs)) : ILParameter = +and GenSlotParam m cenv eenv (TSlotParam(nm, ty, inFlag, outFlag, optionalFlag, attribs)) : ILParameter = let ilTy = GenParamType cenv.amap m eenv.tyenv true ty - let inFlag2,outFlag2,optionalFlag2,defaultParamValue,paramMarshal2,attribs = GenParamAttribs cenv ty attribs - + let inFlag2, outFlag2, optionalFlag2, defaultParamValue, paramMarshal2, attribs = GenParamAttribs cenv ty attribs + let ilAttribs = GenAttrs cenv eenv attribs - - let ilAttribs = - match GenReadOnlyAttributeIfNecessary cenv.g ty with + + let ilAttribs = + match GenReadOnlyAttributeIfNecessary cenv.g ty with | Some attr -> ilAttribs @ [attr] | None -> ilAttribs - + { Name=nm Type= ilTy - Default=defaultParamValue - Marshal=paramMarshal2 + Default=defaultParamValue + Marshal=paramMarshal2 IsIn=inFlag || inFlag2 IsOut=outFlag || outFlag2 IsOptional=optionalFlag || optionalFlag2 CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs ilAttribs) MetadataIndex = NoMetadataIdx } - -and GenFormalSlotsig m cenv eenv (TSlotSig(_,ty,ctps,mtps,paraml,returnTy)) = + +and GenFormalSlotsig m cenv eenv (TSlotSig(_, ty, ctps, mtps, paraml, returnTy)) = let paraml = List.concat paraml let ilTy = GenType cenv.amap m eenv.tyenv ty let eenvForSlotSig = EnvForTypars (ctps @ mtps) eenv - let ilParams = paraml |> List.map (GenSlotParam m cenv eenvForSlotSig) + let ilParams = paraml |> List.map (GenSlotParam m cenv eenvForSlotSig) let ilRetTy = GenReturnType cenv.amap m eenvForSlotSig.tyenv returnTy let ilRet = mkILReturn ilRetTy - let ilRet = - match returnTy with + let ilRet = + match returnTy with | None -> ilRet - | Some ty -> - match GenReadOnlyAttributeIfNecessary cenv.g ty with + | Some ty -> + match GenReadOnlyAttributeIfNecessary cenv.g ty with | Some attr -> ilRet.WithCustomAttrs (mkILCustomAttrs (ilRet.CustomAttrs.AsList @ [attr])) | None -> ilRet ilTy, ilParams, ilRet -and instSlotParam inst (TSlotParam(nm,ty,inFlag,fl2,fl3,attrs)) = TSlotParam(nm,instType inst ty,inFlag,fl2,fl3,attrs) +and instSlotParam inst (TSlotParam(nm, ty, inFlag, fl2, fl3, attrs)) = TSlotParam(nm, instType inst ty, inFlag, fl2, fl3, attrs) -and GenActualSlotsig m cenv eenv (TSlotSig(_,ty,ctps,mtps,ilSlotParams,ilSlotRetTy)) methTyparsOfOverridingMethod (methodParams: Val list) = +and GenActualSlotsig m cenv eenv (TSlotSig(_, ty, ctps, mtps, ilSlotParams, ilSlotRetTy)) methTyparsOfOverridingMethod (methodParams: Val list) = let ilSlotParams = List.concat ilSlotParams let instForSlotSig = mkTyparInst (ctps@mtps) (argsOfAppTy cenv.g ty @ generalizeTypars methTyparsOfOverridingMethod) - let ilParams = ilSlotParams |> List.map (instSlotParam instForSlotSig >> GenSlotParam m cenv eenv) + let ilParams = ilSlotParams |> List.map (instSlotParam instForSlotSig >> GenSlotParam m cenv eenv) // Use the better names if available - let ilParams = - if ilParams.Length = methodParams.Length then - (ilParams, methodParams) ||> List.map2 (fun p pv -> { p with Name = Some (nameOfVal pv) }) + let ilParams = + if ilParams.Length = methodParams.Length then + (ilParams, methodParams) ||> List.map2 (fun p pv -> { p with Name = Some (nameOfVal pv) }) else ilParams let ilRetTy = GenReturnType cenv.amap m eenv.tyenv (Option.map (instType instForSlotSig) ilSlotRetTy) let iLRet = mkILReturn ilRetTy - ilParams,iLRet + ilParams, iLRet -and GenNameOfOverridingMethod cenv (useMethodImpl,(TSlotSig(nameOfOverridenMethod,enclTypOfOverridenMethod,_,_,_,_))) = +and GenNameOfOverridingMethod cenv (useMethodImpl, (TSlotSig(nameOfOverridenMethod, enclTypOfOverridenMethod, _, _, _, _))) = if useMethodImpl then qualifiedMangledNameOfTyconRef (tcrefOfAppTy cenv.g enclTypOfOverridenMethod) nameOfOverridenMethod else nameOfOverridenMethod -and GenMethodImpl cenv eenv (useMethodImpl,(TSlotSig(nameOfOverridenMethod,_,_,_,_,_) as slotsig)) m = - let ilOverrideTy,ilOverrideParams,ilOverrideRet = GenFormalSlotsig m cenv eenv slotsig +and GenMethodImpl cenv eenv (useMethodImpl, (TSlotSig(nameOfOverridenMethod, _, _, _, _, _) as slotsig)) m = + let ilOverrideTy, ilOverrideParams, ilOverrideRet = GenFormalSlotsig m cenv eenv slotsig - let nameOfOverridingMethod = GenNameOfOverridingMethod cenv (useMethodImpl,slotsig) - nameOfOverridingMethod, - (fun (ilTyForOverriding,methTyparsOfOverridingMethod) -> + let nameOfOverridingMethod = GenNameOfOverridingMethod cenv (useMethodImpl, slotsig) + nameOfOverridingMethod, + (fun (ilTyForOverriding, methTyparsOfOverridingMethod) -> let ilOverrideTyRef = ilOverrideTy.TypeRef let ilOverrideMethRef = mkILMethRef(ilOverrideTyRef, ILCallingConv.Instance, nameOfOverridenMethod, List.length (DropErasedTypars methTyparsOfOverridingMethod), typesOfILParams ilOverrideParams, ilOverrideRet.Type) - let eenvForOverrideBy = AddTyparsToEnv methTyparsOfOverridingMethod eenv - let ilParamsOfOverridingMethod,ilReturnOfOverridingMethod = GenActualSlotsig m cenv eenvForOverrideBy slotsig methTyparsOfOverridingMethod [] - let ilOverrideMethGenericParams = GenGenericParams cenv eenvForOverrideBy methTyparsOfOverridingMethod + let eenvForOverrideBy = AddTyparsToEnv methTyparsOfOverridingMethod eenv + let ilParamsOfOverridingMethod, ilReturnOfOverridingMethod = GenActualSlotsig m cenv eenvForOverrideBy slotsig methTyparsOfOverridingMethod [] + let ilOverrideMethGenericParams = GenGenericParams cenv eenvForOverrideBy methTyparsOfOverridingMethod let ilOverrideMethGenericArgs = mkILFormalGenericArgs 0 ilOverrideMethGenericParams let ilOverrideBy = mkILInstanceMethSpecInTy(ilTyForOverriding, nameOfOverridingMethod, typesOfILParams ilParamsOfOverridingMethod, ilReturnOfOverridingMethod.Type, ilOverrideMethGenericArgs) - { Overrides = OverridesSpec(ilOverrideMethRef,ilOverrideTy) + { Overrides = OverridesSpec(ilOverrideMethRef, ilOverrideTy) OverrideBy = ilOverrideBy }) -and bindBaseOrThisVarOpt cenv eenv baseValOpt = - match baseValOpt with +and bindBaseOrThisVarOpt cenv eenv baseValOpt = + match baseValOpt with | None -> eenv - | Some basev -> AddStorageForVal cenv.g (basev,notlazy (Arg 0)) eenv + | Some basev -> AddStorageForVal cenv.g (basev, notlazy (Arg 0)) eenv -and fixupVirtualSlotFlags (mdef:ILMethodDef) = +and fixupVirtualSlotFlags (mdef:ILMethodDef) = mdef.WithHideBySig() -and renameMethodDef nameOfOverridingMethod (mdef : ILMethodDef) = +and renameMethodDef nameOfOverridingMethod (mdef : ILMethodDef) = mdef.With(name=nameOfOverridingMethod) -and fixupMethodImplFlags (mdef:ILMethodDef) = +and fixupMethodImplFlags (mdef:ILMethodDef) = mdef.WithAccess(ILMemberAccess.Private).WithHideBySig().WithFinal(true).WithNewSlot and GenObjectMethod cenv eenvinner (cgbuf:CodeGenBuffer) useMethodImpl tmethod = // Check if we're compiling the property as a .NET event - let (TObjExprMethod(slotsig,attribs,methTyparsOfOverridingMethod,methodParams,methodBodyExpr,m)) = tmethod - let (TSlotSig(nameOfOverridenMethod,_,_,_,_,_)) = slotsig - if CompileAsEvent cenv.g attribs then + let (TObjExprMethod(slotsig, attribs, methTyparsOfOverridingMethod, methodParams, methodBodyExpr, m)) = tmethod + let (TSlotSig(nameOfOverridenMethod, _, _, _, _, _)) = slotsig + if CompileAsEvent cenv.g attribs then [] else let eenvUnderTypars = AddTyparsToEnv methTyparsOfOverridingMethod eenvinner let methodParams = List.concat methodParams let methodParamsNonSelf = match methodParams with [] -> [] | _::t -> t // drop the 'this' arg when computing better argument names for IL parameters - let ilParamsOfOverridingMethod,ilReturnOfOverridingMethod = - GenActualSlotsig m cenv eenvUnderTypars slotsig methTyparsOfOverridingMethod methodParamsNonSelf + let ilParamsOfOverridingMethod, ilReturnOfOverridingMethod = + GenActualSlotsig m cenv eenvUnderTypars slotsig methTyparsOfOverridingMethod methodParamsNonSelf let ilAttribs = GenAttrs cenv eenvinner attribs // Args are stored starting at #1 - let eenvForMeth = AddStorageForLocalVals cenv.g (methodParams |> List.mapi (fun i v -> (v,Arg i))) eenvUnderTypars + let eenvForMeth = AddStorageForLocalVals cenv.g (methodParams |> List.mapi (fun i v -> (v, Arg i))) eenvUnderTypars let sequel = (if slotSigHasVoidReturnTy slotsig then discardAndReturnVoid else Return) - let ilMethodBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways,[],nameOfOverridenMethod,eenvForMeth,0,methodBodyExpr,sequel) + let ilMethodBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, [], nameOfOverridenMethod, eenvForMeth, 0, methodBodyExpr, sequel) - let nameOfOverridingMethod,methodImplGenerator = GenMethodImpl cenv eenvinner (useMethodImpl,slotsig) methodBodyExpr.Range + let nameOfOverridingMethod, methodImplGenerator = GenMethodImpl cenv eenvinner (useMethodImpl, slotsig) methodBodyExpr.Range - let mdef = + let mdef = mkILGenericVirtualMethod (nameOfOverridingMethod, ILMemberAccess.Public, @@ -3831,20 +3998,20 @@ and GenObjectMethod cenv eenvinner (cgbuf:CodeGenBuffer) useMethodImpl tmethod = ilParamsOfOverridingMethod, ilReturnOfOverridingMethod, MethodBody.IL ilMethodBody) - // fixup attributes to generate a method impl + // fixup attributes to generate a method impl let mdef = if useMethodImpl then fixupMethodImplFlags mdef else mdef let mdef = fixupVirtualSlotFlags mdef let mdef = mdef.With(customAttrs = mkILCustomAttrs ilAttribs) - [(useMethodImpl,methodImplGenerator,methTyparsOfOverridingMethod),mdef] + [(useMethodImpl, methodImplGenerator, methTyparsOfOverridingMethod), mdef] -and GenObjectExpr cenv cgbuf eenvouter expr (baseType,baseValOpt,basecall,overrides,interfaceImpls,m) sequel = - let cloinfo,_,eenvinner = GetIlxClosureInfo cenv m false None eenvouter expr +and GenObjectExpr cenv cgbuf eenvouter expr (baseType, baseValOpt, basecall, overrides, interfaceImpls, m) sequel = + let cloinfo, _, eenvinner = GetIlxClosureInfo cenv m false None eenvouter expr let cloAttribs = cloinfo.cloAttribs let cloFreeVars = cloinfo.cloFreeVars let ilCloLambdas = cloinfo.ilCloLambdas let cloName = cloinfo.cloName - + let ilxCloSpec = cloinfo.cloSpec let ilCloFreeVars = cloinfo.cloILFreeVars let ilCloGenericFormals = cloinfo.cloILGenericParams @@ -3855,52 +4022,52 @@ and GenObjectExpr cenv cgbuf eenvouter expr (baseType,baseValOpt,basecall,overri let ilTyForOverriding = mkILBoxedTy ilCloTypeRef ilCloGenericActuals let eenvinner = bindBaseOrThisVarOpt cenv eenvinner baseValOpt - let ilCtorBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways,[],cloName,eenvinner,1,basecall,discardAndReturnVoid) + let ilCtorBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, [], cloName, eenvinner, 1, basecall, discardAndReturnVoid) - let genMethodAndOptionalMethodImpl tmethod useMethodImpl = - [ for ((useMethodImpl,methodImplGeneratorFunction,methTyparsOfOverridingMethod),mdef) in GenObjectMethod cenv eenvinner cgbuf useMethodImpl tmethod do - let mimpl = (if useMethodImpl then Some(methodImplGeneratorFunction (ilTyForOverriding,methTyparsOfOverridingMethod)) else None) - yield (mimpl,mdef) ] + let genMethodAndOptionalMethodImpl tmethod useMethodImpl = + [ for ((useMethodImpl, methodImplGeneratorFunction, methTyparsOfOverridingMethod), mdef) in GenObjectMethod cenv eenvinner cgbuf useMethodImpl tmethod do + let mimpl = (if useMethodImpl then Some(methodImplGeneratorFunction (ilTyForOverriding, methTyparsOfOverridingMethod)) else None) + yield (mimpl, mdef) ] - let mimpls,mdefs = - [ for ov in overrides do + let mimpls, mdefs = + [ for ov in overrides do yield! genMethodAndOptionalMethodImpl ov (isInterfaceTy cenv.g baseType) - for (_,tmethods) in interfaceImpls do - for tmethod in tmethods do + for (_, tmethods) in interfaceImpls do + for tmethod in tmethods do yield! genMethodAndOptionalMethodImpl tmethod true ] - |> List.unzip + |> List.unzip let mimpls = mimpls |> List.choose id // choose the ones that actually have method impls - let interfaceTys = interfaceImpls |> List.map (fst >> GenType cenv.amap m eenvinner.tyenv) + let interfaceTys = interfaceImpls |> List.map (fst >> GenType cenv.amap m eenvinner.tyenv) let attrs = GenAttrs cenv eenvinner cloAttribs let super = (if isInterfaceTy cenv.g baseType then cenv.g.ilg.typ_Object else ilCloRetTy) let interfaceTys = interfaceTys @ (if isInterfaceTy cenv.g baseType then [ilCloRetTy] else []) - let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef,ilCloGenericFormals,attrs,ilCloFreeVars,ilCloLambdas,ilCtorBody,mdefs,mimpls,super,interfaceTys) + let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, ilCloGenericFormals, attrs, ilCloFreeVars, ilCloLambdas, ilCtorBody, mdefs, mimpls, super, interfaceTys) - for cloTypeDef in cloTypeDefs do + for cloTypeDef in cloTypeDefs do cgbuf.mgbuf.AddTypeDef(ilCloTypeRef, cloTypeDef, false, false, None) CountClosure() GenGetLocalVals cenv cgbuf eenvouter m cloFreeVars - CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ EraseClosures.mkTyOfLambdas cenv.g.ilxPubCloEnv ilCloLambdas]) (I_newobj (ilxCloSpec.Constructor,None)) + CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ EraseClosures.mkTyOfLambdas cenv.g.ilxPubCloEnv ilCloLambdas]) (I_newobj (ilxCloSpec.Constructor, None)) GenSequel cenv eenvouter.cloc cgbuf sequel -and GenSequenceExpr - cenv - (cgbuf:CodeGenBuffer) - eenvouter +and GenSequenceExpr + cenv + (cgbuf:CodeGenBuffer) + eenvouter (nextEnumeratorValRef:ValRef, pcvref:ValRef, currvref:ValRef, stateVars, generateNextExpr, closeExpr, checkCloseExpr:Expr, seqElemTy, m) sequel = let stateVars = [ pcvref; currvref ] @ stateVars - let stateVarsSet = stateVars |> List.map (fun vref -> vref.Deref) |> Zset.ofList valOrder + let stateVarsSet = stateVars |> List.map (fun vref -> vref.Deref) |> Zset.ofList valOrder // pretend that the state variables are bound - let eenvouter = + let eenvouter = eenvouter |> AddStorageForLocalVals cenv.g (stateVars |> List.map (fun v -> v.Deref, Local(0, false, None))) - + // Get the free variables. Make a lambda to pretend that the 'nextEnumeratorValRef' is bound (it is an argument to GenerateNext) - let (cloAttribs,_,_,cloFreeTyvars,cloFreeVars,ilCloTypeRef:ILTypeRef,ilCloFreeVars,eenvinner) = + let (cloAttribs, _, _, cloFreeTyvars, cloFreeVars, ilCloTypeRef:ILTypeRef, ilCloFreeVars, eenvinner) = GetIlxClosureFreeVars cenv m None eenvouter [] (mkLambda m nextEnumeratorValRef.Deref (generateNextExpr, cenv.g.int32_ty)) let ilCloSeqElemTy = GenType cenv.amap m eenvinner.tyenv seqElemTy @@ -3909,92 +4076,92 @@ and GenSequenceExpr let ilCloRetTyOuter = GenType cenv.amap m eenvouter.tyenv cloRetTy let ilCloEnumeratorTy = GenType cenv.amap m eenvinner.tyenv (mkIEnumeratorTy cenv.g seqElemTy) let ilCloEnumerableTy = GenType cenv.amap m eenvinner.tyenv (mkSeqTy cenv.g seqElemTy) - let ilCloBaseTy = GenType cenv.amap m eenvinner.tyenv (mkAppTy cenv.g.seq_base_tcr [seqElemTy]) + let ilCloBaseTy = GenType cenv.amap m eenvinner.tyenv (mkAppTy cenv.g.seq_base_tcr [seqElemTy]) let ilCloGenericParams = GenGenericParams cenv eenvinner cloFreeTyvars - // Create a new closure class with a single "MoveNext" method that implements the iterator. + // Create a new closure class with a single "MoveNext" method that implements the iterator. let ilCloTyInner = mkILFormalBoxedTy ilCloTypeRef ilCloGenericParams - let ilCloLambdas = Lambdas_return ilCloRetTyInner + let ilCloLambdas = Lambdas_return ilCloRetTyInner let cloref = IlxClosureRef(ilCloTypeRef, ilCloLambdas, ilCloFreeVars) let ilxCloSpec = IlxClosureSpec.Create(cloref, GenGenericArgs m eenvouter.tyenv cloFreeTyvars) let formalClospec = IlxClosureSpec.Create(cloref, mkILFormalGenericArgs 0 ilCloGenericParams) - let getFreshMethod = - let _,mbody = - CodeGenMethod cenv cgbuf.mgbuf - ([],"GetFreshEnumerator",eenvinner,1, - (fun cgbuf eenv -> - for fv in cloFreeVars do + let getFreshMethod = + let _, mbody = + CodeGenMethod cenv cgbuf.mgbuf + ([], "GetFreshEnumerator", eenvinner, 1, + (fun cgbuf eenv -> + for fv in cloFreeVars do /// State variables always get zero-initialized - if stateVarsSet.Contains fv then - GenDefaultValue cenv cgbuf eenv (fv.Type,m) + if stateVarsSet.Contains fv then + GenDefaultValue cenv cgbuf eenv (fv.Type, m) else GenGetLocalVal cenv cgbuf eenv m fv None - CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ilCloRetTyInner]) (I_newobj (formalClospec.Constructor,None)) + CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ilCloRetTyInner]) (I_newobj (formalClospec.Constructor, None)) GenSequel cenv eenv.cloc cgbuf Return), m) - mkILNonGenericVirtualMethod("GetFreshEnumerator",ILMemberAccess.Public, [], mkILReturn ilCloEnumeratorTy, MethodBody.IL mbody) + mkILNonGenericVirtualMethod("GetFreshEnumerator", ILMemberAccess.Public, [], mkILReturn ilCloEnumeratorTy, MethodBody.IL mbody) |> AddNonUserCompilerGeneratedAttribs cenv.g - let closeMethod = + let closeMethod = // Note: We suppress the first sequence point in the body of this method since it is the initial state machine jump let spReq = SPSuppress - let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (spReq,[],"Close",eenvinner,1,closeExpr,discardAndReturnVoid) - mkILNonGenericVirtualMethod("Close",ILMemberAccess.Public, [], mkILReturn ILType.Void, MethodBody.IL ilCode) + let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (spReq, [], "Close", eenvinner, 1, closeExpr, discardAndReturnVoid) + mkILNonGenericVirtualMethod("Close", ILMemberAccess.Public, [], mkILReturn ILType.Void, MethodBody.IL ilCode) - let checkCloseMethod = + let checkCloseMethod = // Note: We suppress the first sequence point in the body of this method since it is the initial state machine jump let spReq = SPSuppress - let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (spReq,[],"get_CheckClose",eenvinner,1,checkCloseExpr,Return) - mkILNonGenericVirtualMethod("get_CheckClose",ILMemberAccess.Public, [], mkILReturn cenv.g.ilg.typ_Bool, MethodBody.IL ilCode) + let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (spReq, [], "get_CheckClose", eenvinner, 1, checkCloseExpr, Return) + mkILNonGenericVirtualMethod("get_CheckClose", ILMemberAccess.Public, [], mkILReturn cenv.g.ilg.typ_Bool, MethodBody.IL ilCode) - let generateNextMethod = + let generateNextMethod = // Note: We suppress the first sequence point in the body of this method since it is the initial state machine jump let spReq = SPSuppress - // the 'next enumerator' byref arg is at arg position 1 + // the 'next enumerator' byref arg is at arg position 1 let eenvinner = eenvinner |> AddStorageForLocalVals cenv.g [ (nextEnumeratorValRef.Deref, Arg 1) ] - let ilParams = [mkILParamNamed("next",ILType.Byref ilCloEnumerableTy)] + let ilParams = [mkILParamNamed("next", ILType.Byref ilCloEnumerableTy)] let ilReturn = mkILReturn cenv.g.ilg.typ_Int32 - let ilCode = MethodBody.IL (CodeGenMethodForExpr cenv cgbuf.mgbuf (spReq,[],"GenerateNext",eenvinner,2,generateNextExpr,Return)) - mkILNonGenericVirtualMethod("GenerateNext",ILMemberAccess.Public, ilParams, ilReturn, ilCode) + let ilCode = MethodBody.IL (CodeGenMethodForExpr cenv cgbuf.mgbuf (spReq, [], "GenerateNext", eenvinner, 2, generateNextExpr, Return)) + mkILNonGenericVirtualMethod("GenerateNext", ILMemberAccess.Public, ilParams, ilReturn, ilCode) - let lastGeneratedMethod = - let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPSuppress,[],"get_LastGenerated",eenvinner,1,exprForValRef m currvref,Return) - mkILNonGenericVirtualMethod("get_LastGenerated",ILMemberAccess.Public, [], mkILReturn ilCloSeqElemTy, MethodBody.IL ilCode) + let lastGeneratedMethod = + let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPSuppress, [], "get_LastGenerated", eenvinner, 1, exprForValRef m currvref, Return) + mkILNonGenericVirtualMethod("get_LastGenerated", ILMemberAccess.Public, [], mkILReturn ilCloSeqElemTy, MethodBody.IL ilCode) |> AddNonUserCompilerGeneratedAttribs cenv.g - let ilCtorBody = + let ilCtorBody = mkILSimpleStorageCtor(None, Some ilCloBaseTy.TypeSpec, ilCloTyInner, [], [], ILMemberAccess.Assembly).MethodBody let attrs = GenAttrs cenv eenvinner cloAttribs - let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, ilCloGenericParams, attrs, ilCloFreeVars, ilCloLambdas, ilCtorBody, [generateNextMethod;closeMethod;checkCloseMethod;lastGeneratedMethod;getFreshMethod],[],ilCloBaseTy,[]) + let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, ilCloGenericParams, attrs, ilCloFreeVars, ilCloLambdas, ilCtorBody, [generateNextMethod;closeMethod;checkCloseMethod;lastGeneratedMethod;getFreshMethod], [], ilCloBaseTy, []) - for cloTypeDef in cloTypeDefs do + for cloTypeDef in cloTypeDefs do cgbuf.mgbuf.AddTypeDef(ilCloTypeRef, cloTypeDef, false, false, None) CountClosure() - for fv in cloFreeVars do + for fv in cloFreeVars do /// State variables always get zero-initialized - if stateVarsSet.Contains fv then - GenDefaultValue cenv cgbuf eenvouter (fv.Type,m) + if stateVarsSet.Contains fv then + GenDefaultValue cenv cgbuf eenvouter (fv.Type, m) else GenGetLocalVal cenv cgbuf eenvouter m fv None - - CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ilCloRetTyOuter]) (I_newobj (ilxCloSpec.Constructor,None)) + + CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ilCloRetTyOuter]) (I_newobj (ilxCloSpec.Constructor, None)) GenSequel cenv eenvouter.cloc cgbuf sequel /// Generate the class for a closure type definition -and GenClosureTypeDefs cenv (tref:ILTypeRef, ilGenParams, attrs, ilCloFreeVars, ilCloLambdas, ilCtorBody, mdefs, mimpls,ext, ilIntfTys) = +and GenClosureTypeDefs cenv (tref:ILTypeRef, ilGenParams, attrs, ilCloFreeVars, ilCloLambdas, ilCtorBody, mdefs, mimpls, ext, ilIntfTys) = - let cloInfo = + let cloInfo = { cloFreeVars=ilCloFreeVars cloStructure=ilCloLambdas cloCode=notlazy ilCtorBody } - let tdef = + let tdef = ILTypeDef(name = tref.Name, layout = ILTypeDefLayout.Auto, attributes = enum 0, @@ -4019,36 +4186,39 @@ and GenClosureTypeDefs cenv (tref:ILTypeRef, ilGenParams, attrs, ilCloFreeVars, let tdefs = EraseClosures.convIlxClosureDef cenv.g.ilxPubCloEnv tref.Enclosing tdef cloInfo tdefs - -and GenGenericParams cenv eenv tps = tps |> DropErasedTypars |> List.map (GenGenericParam cenv eenv) -and GenGenericArgs m (tyenv:TypeReprEnv) tps = tps |> DropErasedTypars |> List.map (fun c -> (mkILTyvarTy tyenv.[c,m])) + +and GenGenericParams cenv eenv tps = + tps |> DropErasedTypars |> List.map (GenGenericParam cenv eenv) -/// Generate the closure class for a function -and GenLambdaClosure cenv (cgbuf:CodeGenBuffer) eenv isLocalTypeFunc selfv expr = - match expr with - | Expr.Lambda (_,_,_,_,_,m,_) - | Expr.TyLambda(_,_,_,m,_) -> - - let cloinfo,body,eenvinner = GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenv expr - - let entryPointInfo = - match selfv with +and GenGenericArgs m (tyenv:TypeReprEnv) tps = + tps |> DropErasedTypars |> List.map (fun c -> (mkILTyvarTy tyenv.[c, m])) + +/// Generate the closure class for a function +and GenLambdaClosure cenv (cgbuf: CodeGenBuffer) eenv isLocalTypeFunc selfv expr = + match expr with + | Expr.Lambda (_, _, _, _, _, m, _) + | Expr.TyLambda(_, _, _, m, _) -> + + let cloinfo, body, eenvinner = GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenv expr + + let entryPointInfo = + match selfv with | Some v -> [(v, BranchCallClosure (cloinfo.cloArityInfo))] | _ -> [] - let ilCloBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways,entryPointInfo,cloinfo.cloName,eenvinner,1,body,Return) + let ilCloBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, entryPointInfo, cloinfo.cloName, eenvinner, 1, body, Return) let ilCloTypeRef = cloinfo.cloSpec.TypeRef - let cloTypeDefs = - if isLocalTypeFunc then + let cloTypeDefs = + if isLocalTypeFunc then // Work out the contract type and generate a class with an abstract method for this type - let (ilContractGenericParams,ilContractMethTyargs,ilContractTySpec:ILTypeSpec,ilContractFormalRetTy) = GenNamedLocalTypeFuncContractInfo cenv eenv m cloinfo + let (ilContractGenericParams, ilContractMethTyargs, ilContractTySpec:ILTypeSpec, ilContractFormalRetTy) = GenNamedLocalTypeFuncContractInfo cenv eenv m cloinfo let ilContractTypeRef = ilContractTySpec.TypeRef let ilContractTy = mkILFormalBoxedTy ilContractTypeRef ilContractGenericParams let ilContractCtor = mkILNonGenericEmptyCtor None cenv.g.ilg.typ_Object - let ilContractMeths = [ilContractCtor; mkILGenericVirtualMethod("DirectInvoke",ILMemberAccess.Assembly,ilContractMethTyargs,[],mkILReturn ilContractFormalRetTy, MethodBody.Abstract) ] - let ilContractTypeDef = + let ilContractMeths = [ilContractCtor; mkILGenericVirtualMethod("DirectInvoke", ILMemberAccess.Assembly, ilContractMethTyargs, [], mkILReturn ilContractFormalRetTy, MethodBody.Abstract) ] + let ilContractTypeDef = ILTypeDef(name = ilContractTypeRef.Name, layout = ILTypeDefLayout.Auto, attributes = enum 0, @@ -4065,7 +4235,7 @@ and GenLambdaClosure cenv (cgbuf:CodeGenBuffer) eenv isLocalTypeFunc selfv expr securityDecls= emptyILSecurityDecls) // the contract type is an abstract type and not sealed - let ilContractTypeDef = + let ilContractTypeDef = ilContractTypeDef .WithAbstract(true) .WithAccess(ComputeTypeAccess ilContractTypeRef true) @@ -4073,88 +4243,89 @@ and GenLambdaClosure cenv (cgbuf:CodeGenBuffer) eenv isLocalTypeFunc selfv expr .WithSpecialName(true) .WithLayout(ILTypeDefLayout.Auto) .WithInitSemantics(ILTypeInit.BeforeField) - .WithEncoding(ILDefaultPInvokeEncoding.Auto) + .WithEncoding(ILDefaultPInvokeEncoding.Auto) cgbuf.mgbuf.AddTypeDef(ilContractTypeRef, ilContractTypeDef, false, false, None) - - let ilCtorBody = mkILMethodBody (true,[],8,nonBranchingInstrsToCode (mkCallBaseConstructor(ilContractTy,[])), None ) - let cloMethods = [ mkILGenericVirtualMethod("DirectInvoke",ILMemberAccess.Assembly,cloinfo.localTypeFuncDirectILGenericParams,[],mkILReturn (cloinfo.cloILFormalRetTy), MethodBody.IL ilCloBody) ] - let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef,cloinfo.cloILGenericParams,[],cloinfo.cloILFreeVars,cloinfo.ilCloLambdas,ilCtorBody,cloMethods,[],ilContractTy,[]) + + let ilCtorBody = mkILMethodBody (true, [], 8, nonBranchingInstrsToCode (mkCallBaseConstructor(ilContractTy, [])), None ) + let cloMethods = [ mkILGenericVirtualMethod("DirectInvoke", ILMemberAccess.Assembly, cloinfo.localTypeFuncDirectILGenericParams, [], mkILReturn (cloinfo.cloILFormalRetTy), MethodBody.IL ilCloBody) ] + let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, cloinfo.cloILGenericParams, [], cloinfo.cloILFreeVars, cloinfo.ilCloLambdas, ilCtorBody, cloMethods, [], ilContractTy, []) cloTypeDefs - - else - GenClosureTypeDefs cenv (ilCloTypeRef,cloinfo.cloILGenericParams,[],cloinfo.cloILFreeVars,cloinfo.ilCloLambdas,ilCloBody,[],[],cenv.g.ilg.typ_Object,[]) + + else + GenClosureTypeDefs cenv (ilCloTypeRef, cloinfo.cloILGenericParams, [], cloinfo.cloILFreeVars, cloinfo.ilCloLambdas, ilCloBody, [], [], cenv.g.ilg.typ_Object, []) CountClosure() - for cloTypeDef in cloTypeDefs do + for cloTypeDef in cloTypeDefs do cgbuf.mgbuf.AddTypeDef(ilCloTypeRef, cloTypeDef, false, false, None) - cloinfo,m + cloinfo, m + | _ -> failwith "GenLambda: not a lambda" - -and GenLambdaVal cenv (cgbuf:CodeGenBuffer) eenv (cloinfo,m) = + +and GenLambdaVal cenv (cgbuf:CodeGenBuffer) eenv (cloinfo, m) = GenGetLocalVals cenv cgbuf eenv m cloinfo.cloFreeVars - CG.EmitInstr cgbuf - (pop cloinfo.cloILFreeVars.Length) - (Push [EraseClosures.mkTyOfLambdas cenv.g.ilxPubCloEnv cloinfo.ilCloLambdas]) - (I_newobj (cloinfo.cloSpec.Constructor,None)) + CG.EmitInstr cgbuf + (pop cloinfo.cloILFreeVars.Length) + (Push [EraseClosures.mkTyOfLambdas cenv.g.ilxPubCloEnv cloinfo.ilCloLambdas]) + (I_newobj (cloinfo.cloSpec.Constructor, None)) and GenLambda cenv cgbuf eenv isLocalTypeFunc selfv expr sequel = - let cloinfo,m = GenLambdaClosure cenv cgbuf eenv isLocalTypeFunc selfv expr - GenLambdaVal cenv cgbuf eenv (cloinfo,m) + let cloinfo, m = GenLambdaClosure cenv cgbuf eenv isLocalTypeFunc selfv expr + GenLambdaVal cenv cgbuf eenv (cloinfo, m) GenSequel cenv eenv.cloc cgbuf sequel -and GenTypeOfVal cenv eenv (v:Val) = +and GenTypeOfVal cenv eenv (v:Val) = GenType cenv.amap v.Range eenv.tyenv v.Type -and GenFreevar cenv m eenvouter tyenvinner (fv:Val) = - match StorageForVal m fv eenvouter with +and GenFreevar cenv m eenvouter tyenvinner (fv:Val) = + match StorageForVal m fv eenvouter with // Local type functions - | Local(_, _, Some _) | Env(_,_,_,Some _) -> cenv.g.ilg.typ_Object + | Local(_, _, Some _) | Env(_, _, _, Some _) -> cenv.g.ilg.typ_Object #if DEBUG // Check for things that should never make it into the free variable set. Only do this in debug for performance reasons - | (StaticField _ | StaticProperty _ | Method _ | Null) -> error(InternalError("GenFreevar: compiler error: unexpected unrealized value",fv.Range)) + | (StaticField _ | StaticProperty _ | Method _ | Null) -> error(InternalError("GenFreevar: compiler error: unexpected unrealized value", fv.Range)) #endif | _ -> GenType cenv.amap m tyenvinner fv.Type and GetIlxClosureFreeVars cenv m selfv eenvouter takenNames expr = // Choose a base name for the closure - let basename = - let boundv = eenvouter.letBoundVars |> List.tryFind (fun v -> not v.IsCompilerGenerated) + let basename = + let boundv = eenvouter.letBoundVars |> List.tryFind (fun v -> not v.IsCompilerGenerated) match boundv with | Some v -> v.CompiledName | None -> "clo" // Get a unique stamp for the closure. This must be stable for things that can be part of a let rec. - let uniq = - match expr with - | Expr.Obj (uniq,_,_,_,_,_,_) - | Expr.Lambda (uniq,_,_,_,_,_,_) - | Expr.TyLambda(uniq,_,_,_,_) -> uniq + let uniq = + match expr with + | Expr.Obj (uniq, _, _, _, _, _, _) + | Expr.Lambda (uniq, _, _, _, _, _, _) + | Expr.TyLambda(uniq, _, _, _, _) -> uniq | _ -> newUnique() // Choose a name for the closure - let ilCloTypeRef = + let ilCloTypeRef = // FSharp 1.0 bug 3404: System.Reflection doesn't like '.' and '`' in type names let basenameSafeForUseAsTypename = CleanUpGeneratedTypeName basename let suffixmark = expr.Range - let cloName = globalStableNameGenerator.GetUniqueCompilerGeneratedName(basenameSafeForUseAsTypename,suffixmark,uniq) + let cloName = globalStableNameGenerator.GetUniqueCompilerGeneratedName(basenameSafeForUseAsTypename, suffixmark, uniq) NestedTypeRefForCompLoc eenvouter.cloc cloName // Collect the free variables of the closure let cloFreeVarResults = freeInExpr CollectTyparsAndLocals expr - // Partition the free variables when some can be accessed from places besides the immediate environment - // Also filter out the current value being bound, if any, as it is available from the "this" - // pointer which gives the current closure itself. This is in the case e.g. let rec f = ... f ... - let cloFreeVars = + // Partition the free variables when some can be accessed from places besides the immediate environment + // Also filter out the current value being bound, if any, as it is available from the "this" + // pointer which gives the current closure itself. This is in the case e.g. let rec f = ... f ... + let cloFreeVars = cloFreeVarResults.FreeLocals - |> Zset.elements - |> List.filter (fun fv -> - match StorageForVal m fv eenvouter with + |> Zset.elements + |> List.filter (fun fv -> + match StorageForVal m fv eenvouter with | (StaticField _ | StaticProperty _ | Method _ | Null) -> false - | _ -> - match selfv with - | Some v -> not (valRefEq cenv.g (mkLocalValRef fv) v) + | _ -> + match selfv with + | Some v -> not (valRefEq cenv.g (mkLocalValRef fv) v) | _ -> true) // The general shape is: @@ -4163,102 +4334,101 @@ and GetIlxClosureFreeVars cenv m selfv eenvouter takenNames expr = // internal-typars = free-typars - contract-typars // // In other words, the free type variables get divided into two sets - // -- "contract" ones, which are part of the return type. We separate these to enable use to + // -- "contract" ones, which are part of the return type. We separate these to enable use to // bake our own function base contracts for local type functions // // -- "internal" ones, which get used internally in the implementation - let cloContractFreeTyvarSet = (freeInType CollectTypars (tyOfExpr cenv.g expr)).FreeTypars - + let cloContractFreeTyvarSet = (freeInType CollectTypars (tyOfExpr cenv.g expr)).FreeTypars + let cloInternalFreeTyvars = Zset.diff cloFreeVarResults.FreeTyvars.FreeTypars cloContractFreeTyvarSet |> Zset.elements let cloContractFreeTyvars = cloContractFreeTyvarSet |> Zset.elements - + let cloFreeTyvars = cloContractFreeTyvars @ cloInternalFreeTyvars - + let cloAttribs = [] let eenvinner = eenvouter |> EnvForTypars cloFreeTyvars - let ilCloTyInner = + let ilCloTyInner = let ilCloGenericParams = GenGenericParams cenv eenvinner cloFreeTyvars mkILFormalBoxedTy ilCloTypeRef ilCloGenericParams - // If generating a named closure, add the closure itself as a var, available via "arg0" . - // The latter doesn't apply for the delegate implementation of closures. + // If generating a named closure, add the closure itself as a var, available via "arg0" . + // The latter doesn't apply for the delegate implementation of closures. // Build the environment that is active inside the closure itself let eenvinner = eenvinner |> AddStorageForLocalVals cenv.g (match selfv with | Some v -> [(v.Deref, Arg 0)] | _ -> []) - let ilCloFreeVars = - let ilCloFreeVarNames = ChooseFreeVarNames takenNames (List.map nameOfVal cloFreeVars) - let ilCloFreeVars = (cloFreeVars,ilCloFreeVarNames) ||> List.map2 (fun fv nm -> mkILFreeVar (nm,fv.IsCompilerGenerated, GenFreevar cenv m eenvouter eenvinner.tyenv fv)) + let ilCloFreeVars = + let ilCloFreeVarNames = ChooseFreeVarNames takenNames (List.map nameOfVal cloFreeVars) + let ilCloFreeVars = (cloFreeVars, ilCloFreeVarNames) ||> List.map2 (fun fv nm -> mkILFreeVar (nm, fv.IsCompilerGenerated, GenFreevar cenv m eenvouter eenvinner.tyenv fv)) ilCloFreeVars - let ilCloFreeVarStorage = - (cloFreeVars,ilCloFreeVars) ||> List.mapi2 (fun i v fv -> - let localCloInfo = - match StorageForVal m v eenvouter with - | Local(_, _, localCloInfo) - | Env(_,_,_,localCloInfo) -> localCloInfo + let ilCloFreeVarStorage = + (cloFreeVars, ilCloFreeVars) ||> List.mapi2 (fun i v fv -> + let localCloInfo = + match StorageForVal m v eenvouter with + | Local(_, _, localCloInfo) + | Env(_, _, _, localCloInfo) -> localCloInfo | _ -> None - let ilField = mkILFieldSpecInTy (ilCloTyInner,fv.fvName,fv.fvType) + let ilField = mkILFieldSpecInTy (ilCloTyInner, fv.fvName, fv.fvType) - (v,Env(ilCloTyInner,i,ilField,localCloInfo))) + (v, Env(ilCloTyInner, i, ilField, localCloInfo))) let eenvinner = eenvinner |> AddStorageForLocalVals cenv.g ilCloFreeVarStorage - // Return a various results - (cloAttribs,cloInternalFreeTyvars,cloContractFreeTyvars,cloFreeTyvars,cloFreeVars,ilCloTypeRef,Array.ofList ilCloFreeVars,eenvinner) + (cloAttribs, cloInternalFreeTyvars, cloContractFreeTyvars, cloFreeTyvars, cloFreeVars, ilCloTypeRef, Array.ofList ilCloFreeVars, eenvinner) and GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenvouter expr = - let returnTy = - match expr with - | Expr.Lambda (_,_,_,_,_,_,returnTy) | Expr.TyLambda(_,_,_,_,returnTy) -> returnTy - | Expr.Obj(_,ty,_,_,_,_,_) -> ty + let returnTy = + match expr with + | Expr.Lambda (_, _, _, _, _, _, returnTy) | Expr.TyLambda(_, _, _, _, returnTy) -> returnTy + | Expr.Obj(_, ty, _, _, _, _, _) -> ty | _ -> failwith "GetIlxClosureInfo: not a lambda expression" // Determine the structure of the closure. We do this before analyzing free variables to // determine the taken argument names. - let tvsl, vs, body, returnTy = - let rec getCallStructure tvacc vacc (e,ety) = - match e with - | Expr.TyLambda(_,tvs,body,_m,bty) -> - getCallStructure ((DropErasedTypars tvs) :: tvacc) vacc (body,bty) - | Expr.Lambda (_,_,_,vs,body,_,bty) when not isLocalTypeFunc -> - // Transform a lambda taking untupled arguments into one - // taking only a single tupled argument if necessary. REVIEW: do this earlier - let tupledv, body = MultiLambdaToTupledLambda cenv.g vs body - getCallStructure tvacc (tupledv :: vacc) (body,bty) - | _ -> + let tvsl, vs, body, returnTy = + let rec getCallStructure tvacc vacc (e, ety) = + match e with + | Expr.TyLambda(_, tvs, body, _m, bty) -> + getCallStructure ((DropErasedTypars tvs) :: tvacc) vacc (body, bty) + | Expr.Lambda (_, _, _, vs, body, _, bty) when not isLocalTypeFunc -> + // Transform a lambda taking untupled arguments into one + // taking only a single tupled argument if necessary. REVIEW: do this earlier + let tupledv, body = MultiLambdaToTupledLambda cenv.g vs body + getCallStructure tvacc (tupledv :: vacc) (body, bty) + | _ -> (List.rev tvacc, List.rev vacc, e, ety) - getCallStructure [] [] (expr,returnTy) + getCallStructure [] [] (expr, returnTy) let takenNames = vs |> List.map (fun v -> v.CompiledName) // Get the free variables and the information about the closure, add the free variables to the environment - let (cloAttribs,cloInternalFreeTyvars,cloContractFreeTyvars,_,cloFreeVars,ilCloTypeRef,ilCloFreeVars,eenvinner) = GetIlxClosureFreeVars cenv m selfv eenvouter takenNames expr + let (cloAttribs, cloInternalFreeTyvars, cloContractFreeTyvars, _, cloFreeVars, ilCloTypeRef, ilCloFreeVars, eenvinner) = GetIlxClosureFreeVars cenv m selfv eenvouter takenNames expr // Put the type and value arguments into the environment - let rec getClosureArgs eenv ntmargs tvsl (vs:Val list) = - match tvsl, vs with - | tvs :: rest, _ -> + let rec getClosureArgs eenv ntmargs tvsl (vs:Val list) = + match tvsl, vs with + | tvs :: rest, _ -> let eenv = AddTyparsToEnv tvs eenv - let l,eenv = getClosureArgs eenv ntmargs rest vs - let lambdas = (tvs, l) ||> List.foldBack (fun tv sofar -> Lambdas_forall(GenGenericParam cenv eenv tv,sofar)) - lambdas,eenv - | [], v :: rest -> + let l, eenv = getClosureArgs eenv ntmargs rest vs + let lambdas = (tvs, l) ||> List.foldBack (fun tv sofar -> Lambdas_forall(GenGenericParam cenv eenv tv, sofar)) + lambdas, eenv + | [], v :: rest -> let nm = v.CompiledName - let l,eenv = - let eenv = AddStorageForVal cenv.g (v,notlazy (Arg ntmargs)) eenv + let l, eenv = + let eenv = AddStorageForVal cenv.g (v, notlazy (Arg ntmargs)) eenv getClosureArgs eenv (ntmargs+1) [] rest - let lambdas = Lambdas_lambda (mkILParamNamed(nm,GenTypeOfVal cenv eenv v),l) - lambdas,eenv - | _ -> + let lambdas = Lambdas_lambda (mkILParamNamed(nm, GenTypeOfVal cenv eenv v), l) + lambdas, eenv + | _ -> let returnTy' = GenType cenv.amap m eenv.tyenv returnTy Lambdas_return returnTy', eenv // start at arg number 1 as "this" pointer holds the current closure - let ilCloLambdas,eenvinner = getClosureArgs eenvinner 1 tvsl vs + let ilCloLambdas, eenvinner = getClosureArgs eenvinner 1 tvsl vs // Arity info: one argument at each position let narginfo = vs |> List.map (fun _ -> 1) @@ -4291,9 +4461,9 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenvouter expr = // class FunctionImplementation : overall-type { // override Invoke(..) { expr } // } - + // In other words, the free type variables get divided into two sets - // -- "contract" ones, which are part of the return type. We separate these to enable use to + // -- "contract" ones, which are part of the return type. We separate these to enable use to // bake our own function base contracts for local type functions // // -- "internal" ones, which get used internally in the implementation @@ -4311,21 +4481,20 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenvouter expr = let ilCloGenericFormals = ilContractGenericParams @ ilInternalGenericParams let ilCloGenericActuals = ilContractGenericActuals @ ilInternalGenericActuals - - let ilDirectGenericParams,ilReturnTy,ilCloLambdas = - if isLocalTypeFunc then - let rec strip lambdas acc = - match lambdas with - | Lambdas_forall(gp,r) -> strip r (gp::acc) - | Lambdas_return returnTy -> List.rev acc,returnTy,lambdas + let ilDirectGenericParams, ilReturnTy, ilCloLambdas = + if isLocalTypeFunc then + let rec strip lambdas acc = + match lambdas with + | Lambdas_forall(gp, r) -> strip r (gp::acc) + | Lambdas_return returnTy -> List.rev acc, returnTy, lambdas | _ -> failwith "AdjustNamedLocalTypeFuncIlxClosureInfo: local functions can currently only be type functions" strip ilCloLambdas [] - else - [],ilReturnTy,ilCloLambdas - + else + [], ilReturnTy, ilCloLambdas + let ilxCloSpec = IlxClosureSpec.Create(IlxClosureRef(ilCloTypeRef, ilCloLambdas, ilCloFreeVars), ilCloGenericActuals) - let cloinfo = + let cloinfo = { cloExpr=expr cloName=ilCloTypeRef.Name cloArityInfo =narginfo @@ -4337,66 +4506,66 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenvouter expr = cloFreeVars=cloFreeVars cloAttribs=cloAttribs localTypeFuncContractFreeTypars = cloContractFreeTyvars - localTypeFuncInternalFreeTypars = cloInternalFreeTyvars + localTypeFuncInternalFreeTypars = cloInternalFreeTyvars localTypeFuncILGenericArgs = ilContractGenericActuals localTypeFuncDirectILGenericParams = ilDirectGenericParams } - cloinfo,body,eenvinner + cloinfo, body, eenvinner //-------------------------------------------------------------------------- // Named local type functions -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- and IsNamedLocalTypeFuncVal g (v:Val) expr = not v.IsCompiledAsTopLevel && - IsGenericValWithGenericContraints g v && + IsGenericValWithGenericContraints g v && (match stripExpr expr with Expr.TyLambda _ -> true | _ -> false) - + /// Generate the information relevant to the contract portion of a named local type function -and GenNamedLocalTypeFuncContractInfo cenv eenv m cloinfo = +and GenNamedLocalTypeFuncContractInfo cenv eenv m cloinfo = let ilCloTypeRef = cloinfo.cloSpec.TypeRef - let ilContractTypeRef = ILTypeRef.Create(scope=ilCloTypeRef.Scope,enclosing=ilCloTypeRef.Enclosing,name=ilCloTypeRef.Name + "$contract") + let ilContractTypeRef = ILTypeRef.Create(scope=ilCloTypeRef.Scope, enclosing=ilCloTypeRef.Enclosing, name=ilCloTypeRef.Name + "$contract") let eenvForContract = EnvForTypars cloinfo.localTypeFuncContractFreeTypars eenv let ilContractGenericParams = GenGenericParams cenv eenv cloinfo.localTypeFuncContractFreeTypars - let tvs,contractRetTy = - match cloinfo.cloExpr with - | Expr.TyLambda(_,tvs,_,_,bty) -> tvs, bty + let tvs, contractRetTy = + match cloinfo.cloExpr with + | Expr.TyLambda(_, tvs, _, _, bty) -> tvs, bty | e -> [], tyOfExpr cenv.g e - let eenvForContract = AddTyparsToEnv tvs eenvForContract + let eenvForContract = AddTyparsToEnv tvs eenvForContract let ilContractMethTyargs = GenGenericParams cenv eenvForContract tvs let ilContractFormalRetTy = GenType cenv.amap m eenvForContract.tyenv contractRetTy - ilContractGenericParams,ilContractMethTyargs,mkILTySpec(ilContractTypeRef,cloinfo.localTypeFuncILGenericArgs),ilContractFormalRetTy + ilContractGenericParams, ilContractMethTyargs, mkILTySpec(ilContractTypeRef, cloinfo.localTypeFuncILGenericArgs), ilContractFormalRetTy /// Generate a new delegate construction including a closure class if necessary. This is a lot like generating function closures /// and object expression closures, and most of the code is shared. -and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod((TSlotSig(_,delegateTy, _,_,_, _) as slotsig),_attribs,methTyparsOfOverridingMethod,tmvs,body,_),m) sequel = - // Get the instantiation of the delegate type +and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod((TSlotSig(_, delegateTy, _, _, _, _) as slotsig), _attribs, methTyparsOfOverridingMethod, tmvs, body, _), m) sequel = + // Get the instantiation of the delegate type let ilCtxtDelTy = GenType cenv.amap m eenvouter.tyenv delegateTy let tmvs = List.concat tmvs - // Yuck. TLBIMP.EXE generated APIs use UIntPtr for the delegate ctor. - let useUIntPtrForDelegateCtor = - try - if isILAppTy cenv.g delegateTy then + // Yuck. TLBIMP.EXE generated APIs use UIntPtr for the delegate ctor. + let useUIntPtrForDelegateCtor = + try + if isILAppTy cenv.g delegateTy then let tcref = tcrefOfAppTy cenv.g delegateTy let tdef = tcref.ILTyconRawMetadata - match tdef.Methods.FindByName ".ctor" with - | [ctorMDef] -> - match ctorMDef.Parameters with + match tdef.Methods.FindByName ".ctor" with + | [ctorMDef] -> + match ctorMDef.Parameters with | [ _;p2 ] -> (p2.Type.TypeSpec.Name = "System.UIntPtr") | _ -> false | _ -> false - else - false - with _ -> + else + false + with _ -> false - - // Work out the free type variables for the morphing thunk + + // Work out the free type variables for the morphing thunk let takenNames = List.map nameOfVal tmvs - let (cloAttribs,_,_,cloFreeTyvars,cloFreeVars,ilDelegeeTypeRef,ilCloFreeVars,eenvinner) = GetIlxClosureFreeVars cenv m None eenvouter takenNames expr + let (cloAttribs, _, _, cloFreeTyvars, cloFreeVars, ilDelegeeTypeRef, ilCloFreeVars, eenvinner) = GetIlxClosureFreeVars cenv m None eenvouter takenNames expr let ilDelegeeGenericParams = GenGenericParams cenv eenvinner cloFreeTyvars let ilDelegeeGenericActualsInner = mkILFormalGenericArgs 0 ilDelegeeGenericParams - // Create a new closure class with a single "delegee" method that implements the delegate. + // Create a new closure class with a single "delegee" method that implements the delegate. let delegeeMethName = "Invoke" let ilDelegeeTyInner = mkILBoxedTy ilDelegeeTypeRef ilDelegeeGenericActualsInner @@ -4405,16 +4574,16 @@ and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod((TSlotSig(_,delega let numthis = 1 let tmvs, body = BindUnitVars cenv.g (tmvs, List.replicate (List.concat slotsig.FormalParams).Length ValReprInfo.unnamedTopArg1, body) - // The slot sig contains a formal instantiation. When creating delegates we're only - // interested in the actual instantiation since we don't have to emit a method impl. - let ilDelegeeParams,ilDelegeeRet = GenActualSlotsig m cenv envForDelegeeUnderTypars slotsig methTyparsOfOverridingMethod tmvs + // The slot sig contains a formal instantiation. When creating delegates we're only + // interested in the actual instantiation since we don't have to emit a method impl. + let ilDelegeeParams, ilDelegeeRet = GenActualSlotsig m cenv envForDelegeeUnderTypars slotsig methTyparsOfOverridingMethod tmvs - let envForDelegeeMeth = AddStorageForLocalVals cenv.g (List.mapi (fun i v -> (v,Arg (i+numthis))) tmvs) envForDelegeeUnderTypars - let ilMethodBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways,[],delegeeMethName,envForDelegeeMeth,1,body,(if slotSigHasVoidReturnTy slotsig then discardAndReturnVoid else Return)) + let envForDelegeeMeth = AddStorageForLocalVals cenv.g (List.mapi (fun i v -> (v, Arg (i+numthis))) tmvs) envForDelegeeUnderTypars + let ilMethodBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, [], delegeeMethName, envForDelegeeMeth, 1, body, (if slotSigHasVoidReturnTy slotsig then discardAndReturnVoid else Return)) let delegeeInvokeMeth = mkILNonGenericInstanceMethod - (delegeeMethName,ILMemberAccess.Assembly, - ilDelegeeParams, + (delegeeMethName, ILMemberAccess.Assembly, + ilDelegeeParams, ilDelegeeRet, MethodBody.IL ilMethodBody) let delegeeCtorMeth = mkILSimpleStorageCtor(None, Some cenv.g.ilg.typ_Object.TypeSpec, ilDelegeeTyInner, [], [], ILMemberAccess.Assembly) @@ -4422,40 +4591,36 @@ and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod((TSlotSig(_,delega let ilCloLambdas = Lambdas_return ilCtxtDelTy let ilAttribs = GenAttrs cenv eenvinner cloAttribs - let cloTypeDefs = GenClosureTypeDefs cenv (ilDelegeeTypeRef,ilDelegeeGenericParams,ilAttribs,ilCloFreeVars,ilCloLambdas,ilCtorBody,[delegeeInvokeMeth],[],cenv.g.ilg.typ_Object,[]) - for cloTypeDef in cloTypeDefs do + let cloTypeDefs = GenClosureTypeDefs cenv (ilDelegeeTypeRef, ilDelegeeGenericParams, ilAttribs, ilCloFreeVars, ilCloLambdas, ilCtorBody, [delegeeInvokeMeth], [], cenv.g.ilg.typ_Object, []) + for cloTypeDef in cloTypeDefs do cgbuf.mgbuf.AddTypeDef(ilDelegeeTypeRef, cloTypeDef, false, false, None) CountClosure() let ctxtGenericArgsForDelegee = GenGenericArgs m eenvouter.tyenv cloFreeTyvars let ilxCloSpec = IlxClosureSpec.Create(IlxClosureRef(ilDelegeeTypeRef, ilCloLambdas, ilCloFreeVars), ctxtGenericArgsForDelegee) GenGetLocalVals cenv cgbuf eenvouter m cloFreeVars - CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [EraseClosures.mkTyOfLambdas cenv.g.ilxPubCloEnv ilCloLambdas]) (I_newobj (ilxCloSpec.Constructor,None)) + CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [EraseClosures.mkTyOfLambdas cenv.g.ilxPubCloEnv ilCloLambdas]) (I_newobj (ilxCloSpec.Constructor, None)) let ilDelegeeTyOuter = mkILBoxedTy ilDelegeeTypeRef ctxtGenericArgsForDelegee - let ilDelegeeInvokeMethOuter = mkILNonGenericInstanceMethSpecInTy (ilDelegeeTyOuter,"Invoke",typesOfILParams ilDelegeeParams, ilDelegeeRet.Type) - let ilDelegeeCtorMethOuter = mkCtorMethSpecForDelegate cenv.g.ilg (ilCtxtDelTy,useUIntPtrForDelegateCtor) + let ilDelegeeInvokeMethOuter = mkILNonGenericInstanceMethSpecInTy (ilDelegeeTyOuter, "Invoke", typesOfILParams ilDelegeeParams, ilDelegeeRet.Type) + let ilDelegeeCtorMethOuter = mkCtorMethSpecForDelegate cenv.g.ilg (ilCtxtDelTy, useUIntPtrForDelegateCtor) CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_IntPtr]) (I_ldftn ilDelegeeInvokeMethOuter) - CG.EmitInstr cgbuf (pop 2) (Push [ilCtxtDelTy]) (I_newobj(ilDelegeeCtorMethOuter,None)) + CG.EmitInstr cgbuf (pop 2) (Push [ilCtxtDelTy]) (I_newobj(ilDelegeeCtorMethOuter, None)) GenSequel cenv eenvouter.cloc cgbuf sequel -//------------------------------------------------------------------------- -// Generate statically-resolved conditionals used for type-directed optimizations. -//------------------------------------------------------------------------- - -and GenStaticOptimization cenv cgbuf eenv (constraints,e2,e3,_m) sequel = - let e = - if DecideStaticOptimizations cenv.g constraints = StaticOptimizationAnswer.Yes then e2 +/// Generate statically-resolved conditionals used for type-directed optimizations. +and GenStaticOptimization cenv cgbuf eenv (constraints, e2, e3, _m) sequel = + let e = + if DecideStaticOptimizations cenv.g constraints = StaticOptimizationAnswer.Yes then e2 else e3 GenExpr cenv cgbuf eenv SPSuppress e sequel - //------------------------------------------------------------------------- // Generate discrimination trees -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- -and IsSequelImmediate sequel = - match sequel with +and IsSequelImmediate sequel = + match sequel with (* All of these can be done at the end of each branch - we don't need a real join point *) | Return | ReturnVoid | Br _ | LeaveHandler _ -> true | DiscardThen sequel -> IsSequelImmediate sequel @@ -4463,43 +4628,43 @@ and IsSequelImmediate sequel = /// Generate a point where several branches of control flow can merge back together, e.g. after a conditional /// or 'match'. -and GenJoinPoint cenv cgbuf pos eenv ty m sequel = +and GenJoinPoint cenv cgbuf pos eenv ty m sequel = // What the join point does depends on the contents of the sequel. For example, if the sequal is "return" then // each branch can just return and no true join point is needed. - match sequel with - // All of these can be done at the end of each branch - we don't need a real join point - | _ when IsSequelImmediate sequel -> + match sequel with + // All of these can be done at the end of each branch - we don't need a real join point + | _ when IsSequelImmediate sequel -> let stackAfterJoin = cgbuf.GetCurrentStack() - let afterJoin = CG.GenerateDelayMark cgbuf (pos + "_join") - sequel,afterJoin,stackAfterJoin,Continue + let afterJoin = CG.GenerateDelayMark cgbuf (pos + "_join") + sequel, afterJoin, stackAfterJoin, Continue - // We end scopes at the join point, if any - | EndLocalScope(sq,mark) -> - let sequelNow,afterJoin,stackAfterJoin,sequelAfterJoin = GenJoinPoint cenv cgbuf pos eenv ty m sq - sequelNow,afterJoin,stackAfterJoin,EndLocalScope(sequelAfterJoin,mark) + // We end scopes at the join point, if any + | EndLocalScope(sq, mark) -> + let sequelNow, afterJoin, stackAfterJoin, sequelAfterJoin = GenJoinPoint cenv cgbuf pos eenv ty m sq + sequelNow, afterJoin, stackAfterJoin, EndLocalScope(sequelAfterJoin, mark) - // If something non-trivial happens after a discard then generate a join point, but first discard the value (often this means we won't generate it at all) - | DiscardThen sequel -> + // If something non-trivial happens after a discard then generate a join point, but first discard the value (often this means we won't generate it at all) + | DiscardThen sequel -> let stackAfterJoin = cgbuf.GetCurrentStack() - let afterJoin = CG.GenerateDelayMark cgbuf (pos + "_join") - DiscardThen (Br afterJoin),afterJoin,stackAfterJoin,sequel - - // The others (e.g. Continue, LeaveFilter and CmpThenBrOrContinue) can't be done at the end of each branch. We must create a join point. - | _ -> + let afterJoin = CG.GenerateDelayMark cgbuf (pos + "_join") + DiscardThen (Br afterJoin), afterJoin, stackAfterJoin, sequel + + // The others (e.g. Continue, LeaveFilter and CmpThenBrOrContinue) can't be done at the end of each branch. We must create a join point. + | _ -> let pushed = GenType cenv.amap m eenv.tyenv ty let stackAfterJoin = (pushed :: (cgbuf.GetCurrentStack())) - let afterJoin = CG.GenerateDelayMark cgbuf (pos + "_join") - // go to the join point - Br afterJoin, afterJoin,stackAfterJoin,sequel - -and GenMatch cenv cgbuf eenv (spBind,_exprm,tree,targets,m,ty) sequel = + let afterJoin = CG.GenerateDelayMark cgbuf (pos + "_join") + // go to the join point + Br afterJoin, afterJoin, stackAfterJoin, sequel + +and GenMatch cenv cgbuf eenv (spBind, _exprm, tree, targets, m, ty) sequel = - match spBind with + match spBind with | SequencePointAtBinding m -> CG.EmitSeqPoint cgbuf m | NoSequencePointAtDoBinding | NoSequencePointAtLetBinding - | NoSequencePointAtInvisibleBinding + | NoSequencePointAtInvisibleBinding | NoSequencePointAtStickyBinding -> () // The target of branch needs a sequence point. @@ -4509,28 +4674,28 @@ and GenMatch cenv cgbuf eenv (spBind,_exprm,tree,targets,m,ty) sequel = // // NOTE: sadly this causes multiple sequence points to appear for the "initial" location of an if/then/else or match. let activeSP = cgbuf.GetLastSequencePoint() - let repeatSP() = - match activeSP with - | None -> () - | Some src -> - if activeSP <> cgbuf.GetLastSequencePoint() then + let repeatSP() = + match activeSP with + | None -> () + | Some src -> + if activeSP <> cgbuf.GetLastSequencePoint() then CG.EmitSeqPoint cgbuf src - // First try the common cases where we don't need a join point. - match tree with - | TDSuccess _ -> + // First try the common cases where we don't need a join point. + match tree with + | TDSuccess _ -> failwith "internal error: matches that immediately succeed should have been normalized using mkAndSimplifyMatch" - | _ -> - // Create a join point - let stackAtTargets = cgbuf.GetCurrentStack() // the stack at the target of each clause - let (sequelOnBranches,afterJoin,stackAfterJoin,sequelAfterJoin) = GenJoinPoint cenv cgbuf "match" eenv ty m sequel + | _ -> + // Create a join point + let stackAtTargets = cgbuf.GetCurrentStack() // the stack at the target of each clause + let (sequelOnBranches, afterJoin, stackAfterJoin, sequelAfterJoin) = GenJoinPoint cenv cgbuf "match" eenv ty m sequel // Stack: "stackAtTargets" is "stack prior to any match-testing" and also "stack at the start of each branch-RHS". // match-testing (dtrees) should not contribute to the stack. // Each branch-RHS (targets) may contribute to the stack, leaving it in the "stackAfterJoin" state, for the join point. // Since code is branching and joining, the cgbuf stack is maintained manually. - GenDecisionTreeAndTargets cenv cgbuf stackAtTargets eenv tree targets repeatSP sequelOnBranches + GenDecisionTreeAndTargets cenv cgbuf stackAtTargets eenv tree targets repeatSP sequelOnBranches CG.SetMarkToHere cgbuf afterJoin //assert(cgbuf.GetCurrentStack() = stackAfterJoin) // REVIEW: Since gen_dtree* now sets stack, stack should be stackAfterJoin at this point... @@ -4546,116 +4711,116 @@ and GenMatch cenv cgbuf eenv (spBind,_exprm,tree,targets,m,ty) sequel = // // In both cases, any instructions that come after this point will be falsely associated with the last branch of the control // prior to the join point. This is base, e.g. see FSharp 1.0 bug 5155 - if not (isNil stackAfterJoin) then + if not (isNil stackAfterJoin) then cgbuf.EmitStartOfHiddenCode() GenSequel cenv eenv.cloc cgbuf sequelAfterJoin // Accumulate the decision graph as we go -and GenDecisionTreeAndTargets cenv cgbuf stackAtTargets eenv tree targets repeatSP sequel = +and GenDecisionTreeAndTargets cenv cgbuf stackAtTargets eenv tree targets repeatSP sequel = let targetInfos = GenDecisionTreeAndTargetsInner cenv cgbuf None stackAtTargets eenv tree targets repeatSP (IntMap.empty()) sequel GenPostponedDecisionTreeTargets cenv cgbuf stackAtTargets targetInfos sequel - -and TryFindTargetInfo targetInfos n = - match IntMap.tryFind n targetInfos with - | Some (targetInfo,_) -> Some targetInfo + +and TryFindTargetInfo targetInfos n = + match IntMap.tryFind n targetInfos with + | Some (targetInfo, _) -> Some targetInfo | None -> None /// When inplabOpt is None, we are assuming a branch or fallthrough to the current code location /// /// When inplabOpt is "Some inplab", we are assuming an existing branch to "inplab" and can optionally -/// set inplab to point to another location if no codegen is required. -and GenDecisionTreeAndTargetsInner cenv cgbuf inplabOpt stackAtTargets eenv tree targets repeatSP targetInfos sequel = +/// set inplab to point to another location if no codegen is required. +and GenDecisionTreeAndTargetsInner cenv cgbuf inplabOpt stackAtTargets eenv tree targets repeatSP targetInfos sequel = CG.SetStack cgbuf stackAtTargets // Set the expected initial stack. - match tree with - | TDBind(bind,rest) -> + match tree with + | TDBind(bind, rest) -> match inplabOpt with Some inplab -> CG.SetMarkToHere cgbuf inplab | None -> () - let startScope,endScope as scopeMarks = StartDelayedLocalScope "dtreeBind" cgbuf + let startScope, endScope as scopeMarks = StartDelayedLocalScope "dtreeBind" cgbuf let eenv = AllocStorageForBind cenv cgbuf scopeMarks eenv bind let sp = GenSequencePointForBind cenv cgbuf bind GenBindingAfterSequencePoint cenv cgbuf eenv sp bind (Some startScope) - // We don't get the scope marks quite right for dtree-bound variables. This is because - // we effectively lose an EndLocalScope for all dtrees that go to the same target - // So we just pretend that the variable goes out of scope here. + // We don't get the scope marks quite right for dtree-bound variables. This is because + // we effectively lose an EndLocalScope for all dtrees that go to the same target + // So we just pretend that the variable goes out of scope here. CG.SetMarkToHere cgbuf endScope GenDecisionTreeAndTargetsInner cenv cgbuf None stackAtTargets eenv rest targets repeatSP targetInfos sequel - | TDSuccess (es,targetIdx) -> - GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx targets repeatSP targetInfos sequel + | TDSuccess (es, targetIdx) -> + GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx targets repeatSP targetInfos sequel - | TDSwitch(e, cases, dflt,m) -> - GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases dflt m targets repeatSP targetInfos sequel + | TDSwitch(e, cases, dflt, m) -> + GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases dflt m targets repeatSP targetInfos sequel and GetTarget (targets:_[]) n = if n >= targets.Length then failwith "GetTarget: target not found in decision tree" targets.[n] -and GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx targets repeatSP targetInfos sequel = - let (TTarget(vs,successExpr,spTarget)) = GetTarget targets targetIdx +and GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx targets repeatSP targetInfos sequel = + let (TTarget(vs, successExpr, spTarget)) = GetTarget targets targetIdx match TryFindTargetInfo targetInfos targetIdx with - | Some (_,targetMarkAfterBinds:Mark,eenvAtTarget,_,_,_,_,_,_,_) -> - - // If not binding anything we can go directly to the targetMarkAfterBinds point - // This is useful to avoid lots of branches e.g. in match A | B | C -> e - // In this case each case will just go straight to "e" - if isNil vs then - match inplabOpt with - | None -> CG.EmitInstr cgbuf (pop 0) Push0 (I_br targetMarkAfterBinds.CodeLabel) + | Some (_, targetMarkAfterBinds:Mark, eenvAtTarget, _, _, _, _, _, _, _) -> + + // If not binding anything we can go directly to the targetMarkAfterBinds point + // This is useful to avoid lots of branches e.g. in match A | B | C -> e + // In this case each case will just go straight to "e" + if isNil vs then + match inplabOpt with + | None -> CG.EmitInstr cgbuf (pop 0) Push0 (I_br targetMarkAfterBinds.CodeLabel) | Some inplab -> CG.SetMark cgbuf inplab targetMarkAfterBinds - else + else match inplabOpt with None -> () | Some inplab -> CG.SetMarkToHere cgbuf inplab repeatSP() // It would be better not to emit any expressions here, and instead push these assignments into the postponed target // However not all targets are currently postponed (we only postpone in debug code), pending further testing of the performance // impact of postponing. - (vs,es) ||> List.iter2 (GenBindingRhs cenv cgbuf eenv SPSuppress) - vs |> List.rev |> List.iter (fun v -> GenStoreVal cgbuf eenvAtTarget v.Range v) - CG.EmitInstr cgbuf (pop 0) Push0 (I_br targetMarkAfterBinds.CodeLabel) + (vs, es) ||> List.iter2 (GenBindingRhs cenv cgbuf eenv SPSuppress) + vs |> List.rev |> List.iter (fun v -> GenStoreVal cgbuf eenvAtTarget v.Range v) + CG.EmitInstr cgbuf (pop 0) Push0 (I_br targetMarkAfterBinds.CodeLabel) targetInfos - | None -> + | None -> match inplabOpt with None -> () | Some inplab -> CG.SetMarkToHere cgbuf inplab let targetMarkBeforeBinds = CG.GenerateDelayMark cgbuf "targetBeforeBinds" let targetMarkAfterBinds = CG.GenerateDelayMark cgbuf "targetAfterBinds" - let startScope,endScope as scopeMarks = StartDelayedLocalScope "targetBinds" cgbuf + let startScope, endScope as scopeMarks = StartDelayedLocalScope "targetBinds" cgbuf let binds = mkInvisibleBinds vs es let eenvAtTarget = AllocStorageForBinds cenv cgbuf scopeMarks eenv binds - let targetInfo = (targetMarkBeforeBinds,targetMarkAfterBinds,eenvAtTarget,successExpr,spTarget,repeatSP,vs,binds,startScope,endScope) - + let targetInfo = (targetMarkBeforeBinds, targetMarkAfterBinds, eenvAtTarget, successExpr, spTarget, repeatSP, vs, binds, startScope, endScope) + // In debug mode push all decision tree targets to after the switching - let isTargetPostponed = - if cenv.opts.localOptimizationsAreOn then + let isTargetPostponed = + if cenv.opts.localOptimizationsAreOn then GenDecisionTreeTarget cenv cgbuf stackAtTargets targetIdx targetInfo sequel false else CG.EmitInstr cgbuf (pop 0) Push0 (I_br targetMarkBeforeBinds.CodeLabel) - true + true - let targetInfos = IntMap.add targetIdx (targetInfo,isTargetPostponed) targetInfos + let targetInfos = IntMap.add targetIdx (targetInfo, isTargetPostponed) targetInfos targetInfos -and GenPostponedDecisionTreeTargets cenv cgbuf stackAtTargets targetInfos sequel = - let targetInfos = targetInfos |> Seq.sortBy (fun (KeyValue(targetIdx,_)) -> targetIdx) - for (KeyValue(targetIdx,(targetInfo,isTargetPostponed))) in targetInfos do - if isTargetPostponed then +and GenPostponedDecisionTreeTargets cenv cgbuf stackAtTargets targetInfos sequel = + let targetInfos = targetInfos |> Seq.sortBy (fun (KeyValue(targetIdx, _)) -> targetIdx) + for (KeyValue(targetIdx, (targetInfo, isTargetPostponed))) in targetInfos do + if isTargetPostponed then GenDecisionTreeTarget cenv cgbuf stackAtTargets targetIdx targetInfo sequel -and GenDecisionTreeTarget cenv cgbuf stackAtTargets _targetIdx (targetMarkBeforeBinds,targetMarkAfterBinds,eenvAtTarget,successExpr,spTarget,repeatSP,vs,binds,startScope,endScope) sequel = +and GenDecisionTreeTarget cenv cgbuf stackAtTargets _targetIdx (targetMarkBeforeBinds, targetMarkAfterBinds, eenvAtTarget, successExpr, spTarget, repeatSP, vs, binds, startScope, endScope) sequel = CG.SetMarkToHere cgbuf targetMarkBeforeBinds let spExpr = (match spTarget with SequencePointAtTarget -> SPAlways | SuppressSequencePointAtTarget _ -> SPSuppress) // Repeat the sequence point to make sure each target branch has some sequence point (instead of inheriting - // a random sequence point from the previously generated IL code from the previous block. See comment on + // a random sequence point from the previously generated IL code from the previous block. See comment on // repeatSP() above. // // Only repeat the sequence point if we really have to, i.e. if the target expression doesn't start with a // sequence point anyway - if isNil vs && DoesGenExprStartWithSequencePoint cenv.g spExpr successExpr then - () - else - match spTarget with + if isNil vs && DoesGenExprStartWithSequencePoint cenv.g spExpr successExpr then + () + else + match spTarget with | SequencePointAtTarget -> repeatSP() | SuppressSequencePointAtTarget -> cgbuf.EmitStartOfHiddenCode() @@ -4663,30 +4828,30 @@ and GenDecisionTreeTarget cenv cgbuf stackAtTargets _targetIdx (targetMarkBefore GenBindings cenv cgbuf eenvAtTarget binds CG.SetMarkToHere cgbuf targetMarkAfterBinds CG.SetStack cgbuf stackAtTargets - GenExpr cenv cgbuf eenvAtTarget spExpr successExpr (EndLocalScope(sequel,endScope)) + GenExpr cenv cgbuf eenvAtTarget spExpr successExpr (EndLocalScope(sequel, endScope)) -and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defaultTargetOpt switchm targets repeatSP targetInfos sequel = +and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defaultTargetOpt switchm targets repeatSP targetInfos sequel = let m = e.Range match inplabOpt with None -> () | Some inplab -> CG.SetMarkToHere cgbuf inplab repeatSP() - match cases with - // optimize a test against a boolean value, i.e. the all-important if-then-else - | TCase(DecisionTreeTest.Const(Const.Bool b), successTree) :: _ -> + match cases with + // optimize a test against a boolean value, i.e. the all-important if-then-else + | TCase(DecisionTreeTest.Const(Const.Bool b), successTree) :: _ -> let failureTree = (match defaultTargetOpt with None -> cases.Tail.Head.CaseTree | Some d -> d) - GenDecisionTreeTest cenv eenv.cloc cgbuf stackAtTargets e None eenv (if b then successTree else failureTree) (if b then failureTree else successTree) targets repeatSP targetInfos sequel + GenDecisionTreeTest cenv eenv.cloc cgbuf stackAtTargets e None eenv (if b then successTree else failureTree) (if b then failureTree else successTree) targets repeatSP targetInfos sequel // // Remove a single test for a union case . Union case tests are always exa - //| [ TCase(DecisionTreeTest.UnionCase _, successTree) ] when (defaultTargetOpt.IsNone) -> + //| [ TCase(DecisionTreeTest.UnionCase _, successTree) ] when (defaultTargetOpt.IsNone) -> // GenDecisionTreeAndTargetsInner cenv cgbuf inplabOpt stackAtTargets eenv successTree targets repeatSP targetInfos sequel // //GenDecisionTree cenv eenv.cloc cgbuf stackAtTargets e (Some (pop 1, Push [cenv.g.ilg.typ_Bool], Choice1Of2 (avoidHelpers, cuspec, idx))) eenv successTree failureTree targets repeatSP targetInfos sequel - // Optimize a single test for a union case to an "isdata" test - much - // more efficient code, and this case occurs in the generated equality testers where perf is important - | TCase(DecisionTreeTest.UnionCase(c,tyargs), successTree) :: rest when rest.Length = (match defaultTargetOpt with None -> 1 | Some _ -> 0) -> - let failureTree = - match defaultTargetOpt with + // Optimize a single test for a union case to an "isdata" test - much + // more efficient code, and this case occurs in the generated equality testers where perf is important + | TCase(DecisionTreeTest.UnionCase(c, tyargs), successTree) :: rest when rest.Length = (match defaultTargetOpt with None -> 1 | Some _ -> 0) -> + let failureTree = + match defaultTargetOpt with | None -> rest.Head.CaseTree | Some tg -> tg let cuspec = GenUnionSpec cenv.amap m eenv.tyenv c.TyconRef tyargs @@ -4694,137 +4859,137 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib c.TyconRef GenDecisionTreeTest cenv eenv.cloc cgbuf stackAtTargets e (Some (pop 1, Push [cenv.g.ilg.typ_Bool], Choice1Of2 (avoidHelpers, cuspec, idx))) eenv successTree failureTree targets repeatSP targetInfos sequel - | _ -> + | _ -> let caseLabels = List.map (fun _ -> CG.GenerateDelayMark cgbuf "switch_case") cases let firstDiscrim = cases.Head.Discriminator - match firstDiscrim with + match firstDiscrim with // Iterated tests, e.g. exception constructors, nulltests, typetests and active patterns. - // These should always have one positive and one negative branch - | DecisionTreeTest.IsInst _ + // These should always have one positive and one negative branch + | DecisionTreeTest.IsInst _ | DecisionTreeTest.ArrayLength _ - | DecisionTreeTest.IsNull - | DecisionTreeTest.Const(Const.Zero) -> + | DecisionTreeTest.IsNull + | DecisionTreeTest.Const(Const.Zero) -> if not (isSingleton cases) || Option.isNone defaultTargetOpt then failwith "internal error: GenDecisionTreeSwitch: DecisionTreeTest.IsInst/isnull/query" - let bi = - match firstDiscrim with + let bi = + match firstDiscrim with | DecisionTreeTest.Const(Const.Zero) -> - GenExpr cenv cgbuf eenv SPSuppress e Continue + GenExpr cenv cgbuf eenv SPSuppress e Continue BI_brfalse - | DecisionTreeTest.IsNull -> - GenExpr cenv cgbuf eenv SPSuppress e Continue + | DecisionTreeTest.IsNull -> + GenExpr cenv cgbuf eenv SPSuppress e Continue let srcTy = tyOfExpr cenv.g e - if isTyparTy cenv.g srcTy then + if isTyparTy cenv.g srcTy then let ilFromTy = GenType cenv.amap m eenv.tyenv srcTy CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.ilg.typ_Object]) (I_box ilFromTy) BI_brfalse - | DecisionTreeTest.IsInst (_srcty,tgty) -> + | DecisionTreeTest.IsInst (_srcty, tgty) -> let e = mkCallTypeTest cenv.g m tgty e GenExpr cenv cgbuf eenv SPSuppress e Continue BI_brtrue | _ -> failwith "internal error: GenDecisionTreeSwitch" - CG.EmitInstr cgbuf (pop 1) Push0 (I_brcmp (bi,(List.head caseLabels).CodeLabel)) + CG.EmitInstr cgbuf (pop 1) Push0 (I_brcmp (bi, (List.head caseLabels).CodeLabel)) GenDecisionTreeCases cenv cgbuf stackAtTargets eenv targets repeatSP targetInfos defaultTargetOpt caseLabels cases sequel - - | DecisionTreeTest.ActivePatternCase _ -> error(InternalError("internal error in codegen: DecisionTreeTest.ActivePatternCase",switchm)) - | DecisionTreeTest.UnionCase (hdc,tyargs) -> + + | DecisionTreeTest.ActivePatternCase _ -> error(InternalError("internal error in codegen: DecisionTreeTest.ActivePatternCase", switchm)) + | DecisionTreeTest.UnionCase (hdc, tyargs) -> GenExpr cenv cgbuf eenv SPSuppress e Continue let cuspec = GenUnionSpec cenv.amap m eenv.tyenv hdc.TyconRef tyargs - let dests = + let dests = if cases.Length <> caseLabels.Length then failwith "internal error: DecisionTreeTest.UnionCase" (cases , caseLabels) ||> List.map2 (fun case label -> - match case with - | TCase(DecisionTreeTest.UnionCase (c,_),_) -> (c.Index, label.CodeLabel) - | _ -> failwith "error: mixed constructor/const test?") - + match case with + | TCase(DecisionTreeTest.UnionCase (c, _), _) -> (c.Index, label.CodeLabel) + | _ -> failwith "error: mixed constructor/const test?") + let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib hdc.TyconRef - EraseUnions.emitDataSwitch cenv.g.ilg (UnionCodeGen cgbuf) (avoidHelpers,cuspec,dests) + EraseUnions.emitDataSwitch cenv.g.ilg (UnionCodeGen cgbuf) (avoidHelpers, cuspec, dests) CG.EmitInstrs cgbuf (pop 1) Push0 [ ] // push/pop to match the line above GenDecisionTreeCases cenv cgbuf stackAtTargets eenv targets repeatSP targetInfos defaultTargetOpt caseLabels cases sequel - + | DecisionTreeTest.Const c -> GenExpr cenv cgbuf eenv SPSuppress e Continue - match c with + match c with | Const.Bool _ -> failwith "should have been done earlier" - | Const.SByte _ - | Const.Int16 _ - | Const.Int32 _ - | Const.Byte _ - | Const.UInt16 _ + | Const.SByte _ + | Const.Int16 _ + | Const.Int32 _ + | Const.Byte _ + | Const.UInt16 _ | Const.UInt32 _ | Const.Char _ -> if List.length cases <> List.length caseLabels then failwith "internal error: " - let dests = - (cases,caseLabels) ||> List.map2 (fun case label -> - let i = - match case.Discriminator with + let dests = + (cases, caseLabels) ||> List.map2 (fun case label -> + let i = + match case.Discriminator with DecisionTreeTest.Const c' -> - match c' with + match c' with | Const.SByte i -> int32 i | Const.Int16 i -> int32 i | Const.Int32 i -> i | Const.Byte i -> int32 i | Const.UInt16 i -> int32 i | Const.UInt32 i -> int32 i - | Const.Char c -> int32 c - | _ -> failwith "internal error: badly formed const test" + | Const.Char c -> int32 c + | _ -> failwith "internal error: badly formed const test" - | _ -> failwith "internal error: badly formed const test" - (i,label.CodeLabel)) + | _ -> failwith "internal error: badly formed const test" + (i, label.CodeLabel)) let mn = List.foldBack (fst >> Operators.min) dests (fst(List.head dests)) let mx = List.foldBack (fst >> Operators.max) dests (fst(List.head dests)) - // Check if it's worth using a switch - // REVIEW: this is using switches even for single integer matches! + // Check if it's worth using a switch + // REVIEW: this is using switches even for single integer matches! if mx - mn = (List.length dests - 1) then - let destinationLabels = dests |> List.sortBy fst |> List.map snd - if mn <> 0 then + let destinationLabels = dests |> List.sortBy fst |> List.map snd + if mn <> 0 then CG.EmitInstrs cgbuf (pop 0) (Push [cenv.g.ilg.typ_Int32]) [ mkLdcInt32 mn] CG.EmitInstrs cgbuf (pop 1) Push0 [ AI_sub ] CG.EmitInstr cgbuf (pop 1) Push0 (I_switch destinationLabels) else - error(InternalError("non-dense integer matches not implemented in codegen - these should have been removed by the pattern match compiler",switchm)) + error(InternalError("non-dense integer matches not implemented in codegen - these should have been removed by the pattern match compiler", switchm)) GenDecisionTreeCases cenv cgbuf stackAtTargets eenv targets repeatSP targetInfos defaultTargetOpt caseLabels cases sequel - | _ -> error(InternalError("these matches should never be needed",switchm)) + | _ -> error(InternalError("these matches should never be needed", switchm)) and GenDecisionTreeCases cenv cgbuf stackAtTargets eenv targets repeatSP targetInfos defaultTargetOpt caseLabels cases sequel = assert(cgbuf.GetCurrentStack() = stackAtTargets) // cgbuf stack should be unchanged over tests. [bug://1750]. - let targetInfos = - match defaultTargetOpt with + let targetInfos = + match defaultTargetOpt with | Some defaultTarget -> GenDecisionTreeAndTargetsInner cenv cgbuf None stackAtTargets eenv defaultTarget targets repeatSP targetInfos sequel | None -> targetInfos - let targetInfos = - (targetInfos, caseLabels, cases) |||> List.fold2 (fun targetInfos caseLabel (TCase(_,caseTree)) -> + let targetInfos = + (targetInfos, caseLabels, cases) |||> List.fold2 (fun targetInfos caseLabel (TCase(_, caseTree)) -> GenDecisionTreeAndTargetsInner cenv cgbuf (Some caseLabel) stackAtTargets eenv caseTree targets repeatSP targetInfos sequel) - targetInfos + targetInfos // Used for the peephole optimization below -and (|BoolExpr|_|) = function Expr.Const(Const.Bool b1,_,_) -> Some(b1) | _ -> None +and (|BoolExpr|_|) = function Expr.Const(Const.Bool b1, _, _) -> Some(b1) | _ -> None and GenDecisionTreeTest cenv cloc cgbuf stackAtTargets e tester eenv successTree failureTree targets repeatSP targetInfos sequel = - match successTree,failureTree with + match successTree, failureTree with - // Peephole: if generating a boolean value or its negation then just leave it on the stack - // This comes up in the generated equality functions. REVIEW: do this as a peephole optimization elsewhere - | TDSuccess(es1,n1), - TDSuccess(es2,n2) when + // Peephole: if generating a boolean value or its negation then just leave it on the stack + // This comes up in the generated equality functions. REVIEW: do this as a peephole optimization elsewhere + | TDSuccess(es1, n1), + TDSuccess(es2, n2) when isNil es1 && isNil es2 && - (match GetTarget targets n1, GetTarget targets n2 with - | TTarget(_,BoolExpr(b1),_),TTarget(_,BoolExpr(b2),_) -> b1 = not b2 + (match GetTarget targets n1, GetTarget targets n2 with + | TTarget(_, BoolExpr(b1), _), TTarget(_, BoolExpr(b2), _) -> b1 = not b2 | _ -> false) -> - match GetTarget targets n1, GetTarget targets n2 with + match GetTarget targets n1, GetTarget targets n2 with - | TTarget(_,BoolExpr(b1),_),_ -> + | TTarget(_, BoolExpr(b1), _), _ -> GenExpr cenv cgbuf eenv SPSuppress e Continue - match tester with - | Some (pops,pushes,i) -> - match i with - | Choice1Of2 (avoidHelpers,cuspec,idx) -> CG.EmitInstrs cgbuf pops pushes (EraseUnions.mkIsData cenv.g.ilg (avoidHelpers, cuspec, idx)) + match tester with + | Some (pops, pushes, i) -> + match i with + | Choice1Of2 (avoidHelpers, cuspec, idx) -> CG.EmitInstrs cgbuf pops pushes (EraseUnions.mkIsData cenv.g.ilg (avoidHelpers, cuspec, idx)) | Choice2Of2 i -> CG.EmitInstr cgbuf pops pushes i | _ -> () - if not b1 then + if not b1 then CG.EmitInstrs cgbuf (pop 0) (Push [cenv.g.ilg.typ_Bool]) [mkLdcInt32 (0) ] CG.EmitInstrs cgbuf (pop 1) Push0 [AI_ceq] GenSequel cenv cloc cgbuf sequel @@ -4834,101 +4999,98 @@ and GenDecisionTreeTest cenv cloc cgbuf stackAtTargets e tester eenv successTree | _ -> let failure = CG.GenerateDelayMark cgbuf "testFailure" - match tester with - | None -> - // generate the expression, then test it for "false" + match tester with + | None -> + // generate the expression, then test it for "false" GenExpr cenv cgbuf eenv SPSuppress e (CmpThenBrOrContinue(pop 1, [ I_brcmp (BI_brfalse, failure.CodeLabel) ])) - // Turn 'isdata' tests that branch into EI_brisdata tests - | Some (_,_,Choice1Of2 (avoidHelpers,cuspec,idx)) -> - GenExpr cenv cgbuf eenv SPSuppress e (CmpThenBrOrContinue(pop 1, EraseUnions.mkBrIsData cenv.g.ilg false (avoidHelpers,cuspec, idx, failure.CodeLabel))) + // Turn 'isdata' tests that branch into EI_brisdata tests + | Some (_, _, Choice1Of2 (avoidHelpers, cuspec, idx)) -> + GenExpr cenv cgbuf eenv SPSuppress e (CmpThenBrOrContinue(pop 1, EraseUnions.mkBrIsData cenv.g.ilg false (avoidHelpers, cuspec, idx, failure.CodeLabel))) - | Some (pops,pushes,i) -> + | Some (pops, pushes, i) -> GenExpr cenv cgbuf eenv SPSuppress e Continue - match i with - | Choice1Of2 (avoidHelpers,cuspec,idx) -> CG.EmitInstrs cgbuf pops pushes (EraseUnions.mkIsData cenv.g.ilg (avoidHelpers, cuspec, idx)) + match i with + | Choice1Of2 (avoidHelpers, cuspec, idx) -> CG.EmitInstrs cgbuf pops pushes (EraseUnions.mkIsData cenv.g.ilg (avoidHelpers, cuspec, idx)) | Choice2Of2 i -> CG.EmitInstr cgbuf pops pushes i CG.EmitInstr cgbuf (pop 1) Push0 (I_brcmp (BI_brfalse, failure.CodeLabel)) let targetInfos = GenDecisionTreeAndTargetsInner cenv cgbuf None stackAtTargets eenv successTree targets repeatSP targetInfos sequel - GenDecisionTreeAndTargetsInner cenv cgbuf (Some failure) stackAtTargets eenv failureTree targets repeatSP targetInfos sequel - -//------------------------------------------------------------------------- -// Generate letrec bindings -//------------------------------------------------------------------------- + GenDecisionTreeAndTargetsInner cenv cgbuf (Some failure) stackAtTargets eenv failureTree targets repeatSP targetInfos sequel -and GenLetRecFixup cenv cgbuf eenv (ilxCloSpec:IlxClosureSpec,e,ilField:ILFieldSpec,e2,_m) = +/// Generate fixups for letrec bindings +and GenLetRecFixup cenv cgbuf eenv (ilxCloSpec:IlxClosureSpec, e, ilField:ILFieldSpec, e2, _m) = GenExpr cenv cgbuf eenv SPSuppress e Continue CG.EmitInstrs cgbuf (pop 0) Push0 [ I_castclass ilxCloSpec.ILType ] GenExpr cenv cgbuf eenv SPSuppress e2 Continue - CG.EmitInstrs cgbuf (pop 2) Push0 [ mkNormalStfld (mkILFieldSpec(ilField.FieldRef,ilxCloSpec.ILType)) ] + CG.EmitInstrs cgbuf (pop 2) Push0 [ mkNormalStfld (mkILFieldSpec(ilField.FieldRef, ilxCloSpec.ILType)) ] -and GenLetRecBindings cenv (cgbuf:CodeGenBuffer) eenv (allBinds: Bindings,m) = +/// Generate letrec bindings +and GenLetRecBindings cenv (cgbuf:CodeGenBuffer) eenv (allBinds: Bindings, m) = // Fix up recursion for non-toplevel recursive bindings - let bindsPossiblyRequiringFixup = - allBinds |> List.filter (fun b -> - match (StorageForVal m b.Var eenv) with + let bindsPossiblyRequiringFixup = + allBinds |> List.filter (fun b -> + match (StorageForVal m b.Var eenv) with | StaticProperty _ - | Method _ - // Note: Recursive data stored in static fields may require fixups e.g. let x = C(x) - // | StaticField _ - | Null -> false + | Method _ + // Note: Recursive data stored in static fields may require fixups e.g. let x = C(x) + // | StaticField _ + | Null -> false | _ -> true) let computeFixupsForOneRecursiveVar boundv forwardReferenceSet fixups selfv access set e = - match e with - | Expr.Lambda _ | Expr.TyLambda _ | Expr.Obj _ -> + match e with + | Expr.Lambda _ | Expr.TyLambda _ | Expr.Obj _ -> let isLocalTypeFunc = Option.isSome selfv && (IsNamedLocalTypeFuncVal cenv.g (Option.get selfv) e) let selfv = (match e with Expr.Obj _ -> None | _ when isLocalTypeFunc -> None | _ -> Option.map mkLocalValRef selfv) - let clo,_,eenvclo = GetIlxClosureInfo cenv m isLocalTypeFunc selfv {eenv with letBoundVars=(mkLocalValRef boundv)::eenv.letBoundVars} e - clo.cloFreeVars |> List.iter (fun fv -> - if Zset.contains fv forwardReferenceSet then + let clo, _, eenvclo = GetIlxClosureInfo cenv m isLocalTypeFunc selfv {eenv with letBoundVars=(mkLocalValRef boundv)::eenv.letBoundVars} e + clo.cloFreeVars |> List.iter (fun fv -> + if Zset.contains fv forwardReferenceSet then match StorageForVal m fv eenvclo with - | Env (_,_,ilField,_) -> fixups := (boundv, fv, (fun () -> GenLetRecFixup cenv cgbuf eenv (clo.cloSpec,access,ilField,exprForVal m fv,m))) :: !fixups - | _ -> error (InternalError("GenLetRec: " + fv.LogicalName + " was not in the environment",m)) ) - - | Expr.Val (vref,_,_) -> + | Env (_, _, ilField, _) -> fixups := (boundv, fv, (fun () -> GenLetRecFixup cenv cgbuf eenv (clo.cloSpec, access, ilField, exprForVal m fv, m))) :: !fixups + | _ -> error (InternalError("GenLetRec: " + fv.LogicalName + " was not in the environment", m)) ) + + | Expr.Val (vref, _, _) -> let fv = vref.Deref let needsFixup = Zset.contains fv forwardReferenceSet - if needsFixup then fixups := (boundv, fv,(fun () -> GenExpr cenv cgbuf eenv SPSuppress (set e) discard)) :: !fixups + if needsFixup then fixups := (boundv, fv, (fun () -> GenExpr cenv cgbuf eenv SPSuppress (set e) discard)) :: !fixups | _ -> failwith "compute real fixup vars" let fixups = ref [] let recursiveVars = Zset.addList (bindsPossiblyRequiringFixup |> List.map (fun v -> v.Var)) (Zset.empty valOrder) - let _ = + let _ = (recursiveVars, bindsPossiblyRequiringFixup) ||> List.fold (fun forwardReferenceSet (bind:Binding) -> - // Compute fixups - bind.Expr |> IterateRecursiveFixups cenv.g (Some bind.Var) - (computeFixupsForOneRecursiveVar bind.Var forwardReferenceSet fixups) - (exprForVal m bind.Var, + // Compute fixups + bind.Expr |> IterateRecursiveFixups cenv.g (Some bind.Var) + (computeFixupsForOneRecursiveVar bind.Var forwardReferenceSet fixups) + (exprForVal m bind.Var, (fun _ -> failwith ("internal error: should never need to set non-delayed recursive val: " + bind.Var.LogicalName))) // Record the variable as defined let forwardReferenceSet = Zset.remove bind.Var forwardReferenceSet forwardReferenceSet) // Generate the actual bindings - let _ = + let _ = (recursiveVars, allBinds) ||> List.fold (fun forwardReferenceSet (bind:Binding) -> GenBinding cenv cgbuf eenv bind // Record the variable as defined let forwardReferenceSet = Zset.remove bind.Var forwardReferenceSet - // Execute and discard any fixups that can now be committed + // Execute and discard any fixups that can now be committed fixups := !fixups |> List.filter (fun (boundv, fv, action) -> if (Zset.contains boundv forwardReferenceSet || Zset.contains fv forwardReferenceSet) then true else (action(); false)) forwardReferenceSet) () - -and GenLetRec cenv cgbuf eenv (binds,body,m) sequel = - let _,endScope as scopeMarks = StartLocalScope "letrec" cgbuf +and GenLetRec cenv cgbuf eenv (binds, body, m) sequel = + let _, endScope as scopeMarks = StartLocalScope "letrec" cgbuf let eenv = AllocStorageForBinds cenv cgbuf scopeMarks eenv binds GenLetRecBindings cenv cgbuf eenv (binds, m) - GenExpr cenv cgbuf eenv SPAlways body (EndLocalScope(sequel,endScope)) + GenExpr cenv cgbuf eenv SPAlways body (EndLocalScope(sequel, endScope)) //------------------------------------------------------------------------- // Generate simple bindings -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- and GenSequencePointForBind cenv cgbuf bind = let _, pt, sp = ComputeSequencePointInfoForBinding cenv.g bind @@ -4938,27 +5100,27 @@ and GenSequencePointForBind cenv cgbuf bind = and GenBinding cenv cgbuf eenv bind = let sp = GenSequencePointForBind cenv cgbuf bind GenBindingAfterSequencePoint cenv cgbuf eenv sp bind None - + and ComputeMemberAccessRestrictedBySig eenv vspec = - let isHidden = - IsHiddenVal eenv.sigToImplRemapInfo vspec || // anything hidden by a signature gets assembly visibility + let isHidden = + IsHiddenVal eenv.sigToImplRemapInfo vspec || // anything hidden by a signature gets assembly visibility not vspec.IsMemberOrModuleBinding || // anything that's not a module or member binding gets assembly visibility vspec.IsIncrClassGeneratedMember // compiler generated members for class function 'let' bindings get assembly visibility ComputeMemberAccess isHidden + and ComputeMethodAccessRestrictedBySig eenv vspec = - let isHidden = - IsHiddenVal eenv.sigToImplRemapInfo vspec || // anything hidden by a signature gets assembly visibility + let isHidden = + IsHiddenVal eenv.sigToImplRemapInfo vspec || // anything hidden by a signature gets assembly visibility not vspec.IsMemberOrModuleBinding || // anything that's not a module or member binding gets assembly visibility vspec.IsIncrClassGeneratedMember // compiler generated members for class function 'let' bindings get assembly visibility ComputeMemberAccess isHidden +and GenBindingAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) startScopeMarkOpt = -and GenBindingAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec,rhsExpr,_)) startScopeMarkOpt = - - // Record the closed reflection definition if publishing + // Record the closed reflection definition if publishing // There is no real reason we're doing this so late in the day - match vspec.PublicPath, vspec.ReflectedDefinition with - | Some _, Some e -> cgbuf.mgbuf.AddReflectedDefinition(vspec,e) + match vspec.PublicPath, vspec.ReflectedDefinition with + | Some _, Some e -> cgbuf.mgbuf.AddReflectedDefinition(vspec, e) | _ -> () let eenv = {eenv with letBoundVars= (mkLocalValRef vspec) :: eenv.letBoundVars} @@ -4966,39 +5128,39 @@ and GenBindingAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec,rhsExpr,_)) sta let access = ComputeMethodAccessRestrictedBySig eenv vspec // Workaround for .NET and Visual Studio restriction w.r.t debugger type proxys - // Mark internal constructors in internal classes as public. - let access = - if access = ILMemberAccess.Assembly && vspec.IsConstructor && IsHiddenTycon eenv.sigToImplRemapInfo vspec.MemberApparentEntity.Deref then + // Mark internal constructors in internal classes as public. + let access = + if access = ILMemberAccess.Assembly && vspec.IsConstructor && IsHiddenTycon eenv.sigToImplRemapInfo vspec.MemberApparentEntity.Deref then ILMemberAccess.Public else access - + let m = vspec.Range - match StorageForVal m vspec eenv with + match StorageForVal m vspec eenv with - | Null -> + | Null -> GenExpr cenv cgbuf eenv SPSuppress rhsExpr discard CommitStartScope cgbuf startScopeMarkOpt // The initialization code for static 'let' and 'do' bindings gets compiled into the initialization .cctor for the whole file | _ when vspec.IsClassConstructor && isNil vspec.TopValDeclaringEntity.TyparsNoRange -> - let tps,_,_,_,cctorBody,_ = IteratedAdjustArityOfLambda cenv.g cenv.amap vspec.ValReprInfo.Value rhsExpr + let tps, _, _, _, cctorBody, _ = IteratedAdjustArityOfLambda cenv.g cenv.amap vspec.ValReprInfo.Value rhsExpr let eenv = EnvForTypars tps eenv CommitStartScope cgbuf startScopeMarkOpt GenExpr cenv cgbuf eenv SPSuppress cctorBody discard - - | Method (topValInfo,_,mspec,_,paramInfos,methodArgTys,retInfo) -> - let tps,ctorThisValOpt,baseValOpt,vsl,body',bodyty = IteratedAdjustArityOfLambda cenv.g cenv.amap topValInfo rhsExpr + + | Method (topValInfo, _, mspec, _, paramInfos, methodArgTys, retInfo) -> + let tps, ctorThisValOpt, baseValOpt, vsl, body', bodyty = IteratedAdjustArityOfLambda cenv.g cenv.amap topValInfo rhsExpr let methodVars = List.concat vsl CommitStartScope cgbuf startScopeMarkOpt - GenMethodForBinding cenv cgbuf eenv (vspec,mspec,access,paramInfos,retInfo) (topValInfo,ctorThisValOpt,baseValOpt,tps,methodVars, methodArgTys, body', bodyty) + GenMethodForBinding cenv cgbuf eenv (vspec, mspec, access, paramInfos, retInfo) (topValInfo, ctorThisValOpt, baseValOpt, tps, methodVars, methodArgTys, body', bodyty) - | StaticProperty (ilGetterMethSpec, optShadowLocal) -> + | StaticProperty (ilGetterMethSpec, optShadowLocal) -> let ilAttribs = GenAttrs cenv eenv vspec.Attribs let ilTy = ilGetterMethSpec.FormalReturnType - let ilPropDef = + let ilPropDef = ILPropertyDef(name = PrettyNaming.ChopPropertyName ilGetterMethSpec.Name, attributes = PropertyAttributes.None, setMethod = None, @@ -5008,9 +5170,9 @@ and GenBindingAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec,rhsExpr,_)) sta init = None, args = [], customAttrs = mkILCustomAttrs ilAttribs) - cgbuf.mgbuf.AddOrMergePropertyDef(ilGetterMethSpec.MethodRef.DeclaringTypeRef, ilPropDef,m) + cgbuf.mgbuf.AddOrMergePropertyDef(ilGetterMethSpec.MethodRef.DeclaringTypeRef, ilPropDef, m) - let ilMethodDef = + let ilMethodDef = let ilMethodBody = MethodBody.IL(CodeGenMethodForExpr cenv cgbuf.mgbuf (SPSuppress, [], ilGetterMethSpec.Name, eenv, 0, rhsExpr, Return)) (mkILStaticMethod ([], ilGetterMethSpec.Name, access, [], mkILReturn ilTy, ilMethodBody)).WithSpecialName |> AddNonUserCompilerGeneratedAttribs cenv.g @@ -5021,35 +5183,35 @@ and GenBindingAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec,rhsExpr,_)) sta CommitStartScope cgbuf startScopeMarkOpt match optShadowLocal with | NoShadowLocal -> () - | ShadowLocal storage -> + | ShadowLocal storage -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (I_call (Normalcall, ilGetterMethSpec, None)) GenSetStorage m cgbuf storage - | StaticField (fspec, vref, hasLiteralAttr, ilTyForProperty, ilPropName, fty, ilGetterMethRef, ilSetterMethRef, optShadowLocal) -> + | StaticField (fspec, vref, hasLiteralAttr, ilTyForProperty, ilPropName, fty, ilGetterMethRef, ilSetterMethRef, optShadowLocal) -> let mut = vspec.IsMutable - + let canTarget(targets, goal : System.AttributeTargets) = match targets with | None -> true | Some tgts -> 0 <> int(tgts &&& goal) /// Generate a static field definition... - let ilFieldDefs = + let ilFieldDefs = let access = ComputeMemberAccess (not hasLiteralAttr || IsHiddenVal eenv.sigToImplRemapInfo vspec) let ilFieldDef = mkILStaticField (fspec.Name, fty, None, None, access) let ilFieldDef = - match vref.LiteralValue with + match vref.LiteralValue with | Some konst -> ilFieldDef.WithLiteralDefaultValue( Some (GenFieldInit m konst) ) - | None -> ilFieldDef - - let ilFieldDef = + | None -> ilFieldDef + + let ilFieldDef = let isClassInitializer = (cgbuf.MethodName = ".cctor") ilFieldDef.WithInitOnly(not (mut || cenv.opts.isInteractiveItExpr || not isClassInitializer || hasLiteralAttr)) - let ilAttribs = + let ilAttribs = if not hasLiteralAttr then - vspec.Attribs - |> List.filter (fun (Attrib(_,_,_,_,_,targets,_)) -> canTarget(targets, System.AttributeTargets.Field)) + vspec.Attribs + |> List.filter (fun (Attrib(_, _, _, _, _, targets, _)) -> canTarget(targets, System.AttributeTargets.Field)) |> GenAttrs cenv eenv // backing field only gets attributes that target fields else GenAttrs cenv eenv vspec.Attribs // literals have no property, so preserve all the attributes on the field itself @@ -5057,20 +5219,20 @@ and GenBindingAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec,rhsExpr,_)) sta let ilFieldDef = ilFieldDef.With(customAttrs = mkILCustomAttrs (ilAttribs @ [ cenv.g.DebuggerBrowsableNeverAttribute ])) [ (fspec.DeclaringTypeRef, ilFieldDef) ] - + let ilTypeRefForProperty = ilTyForProperty.TypeRef - for (tref,ilFieldDef) in ilFieldDefs do - cgbuf.mgbuf.AddFieldDef(tref,ilFieldDef) + for (tref, ilFieldDef) in ilFieldDefs do + cgbuf.mgbuf.AddFieldDef(tref, ilFieldDef) CountStaticFieldDef() - // ... and the get/set properties to access it. - if not hasLiteralAttr then - let ilAttribs = - vspec.Attribs - |> List.filter (fun (Attrib(_,_,_,_,_,targets,_)) -> canTarget(targets, System.AttributeTargets.Property)) + // ... and the get/set properties to access it. + if not hasLiteralAttr then + let ilAttribs = + vspec.Attribs + |> List.filter (fun (Attrib(_, _, _, _, _, targets, _)) -> canTarget(targets, System.AttributeTargets.Property)) |> GenAttrs cenv eenv // property only gets attributes that target properties - let ilPropDef = + let ilPropDef = ILPropertyDef(name=ilPropName, attributes = PropertyAttributes.None, setMethod=(if mut || cenv.opts.isInteractiveItExpr then Some ilSetterMethRef else None), @@ -5080,24 +5242,24 @@ and GenBindingAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec,rhsExpr,_)) sta init=None, args = [], customAttrs=mkILCustomAttrs (ilAttribs @ [mkCompilationMappingAttr cenv.g (int SourceConstructFlags.Value)])) - cgbuf.mgbuf.AddOrMergePropertyDef(ilTypeRefForProperty,ilPropDef,m) - - let getterMethod = - mkILStaticMethod([],ilGetterMethRef.Name,access,[],mkILReturn fty, - mkMethodBody(true,[],2,nonBranchingInstrsToCode [ mkNormalLdsfld fspec ],None)).WithSpecialName - cgbuf.mgbuf.AddMethodDef(ilTypeRefForProperty,getterMethod) - if mut || cenv.opts.isInteractiveItExpr then - let setterMethod = - mkILStaticMethod([],ilSetterMethRef.Name,access,[mkILParamNamed("value",fty)],mkILReturn ILType.Void, - mkMethodBody(true,[],2,nonBranchingInstrsToCode [ mkLdarg0;mkNormalStsfld fspec],None)).WithSpecialName - cgbuf.mgbuf.AddMethodDef(ilTypeRefForProperty,setterMethod) + cgbuf.mgbuf.AddOrMergePropertyDef(ilTypeRefForProperty, ilPropDef, m) + + let getterMethod = + mkILStaticMethod([], ilGetterMethRef.Name, access, [], mkILReturn fty, + mkMethodBody(true, [], 2, nonBranchingInstrsToCode [ mkNormalLdsfld fspec ], None)).WithSpecialName + cgbuf.mgbuf.AddMethodDef(ilTypeRefForProperty, getterMethod) + if mut || cenv.opts.isInteractiveItExpr then + let setterMethod = + mkILStaticMethod([], ilSetterMethRef.Name, access, [mkILParamNamed("value", fty)], mkILReturn ILType.Void, + mkMethodBody(true, [], 2, nonBranchingInstrsToCode [ mkLdarg0;mkNormalStsfld fspec], None)).WithSpecialName + cgbuf.mgbuf.AddMethodDef(ilTypeRefForProperty, setterMethod) GenBindingRhs cenv cgbuf eenv sp vspec rhsExpr match optShadowLocal with - | NoShadowLocal -> + | NoShadowLocal -> CommitStartScope cgbuf startScopeMarkOpt EmitSetStaticField cgbuf fspec - | ShadowLocal storage-> + | ShadowLocal storage-> CommitStartScope cgbuf startScopeMarkOpt CG.EmitInstr cgbuf (pop 0) (Push [fty]) AI_dup EmitSetStaticField cgbuf fspec @@ -5105,24 +5267,24 @@ and GenBindingAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec,rhsExpr,_)) sta | _ -> let storage = StorageForVal m vspec eenv - match storage, rhsExpr with - // locals are zero-init, no need to initialize them - | Local (_, realloc, _), Expr.Const(Const.Zero,_,_) when not realloc -> + match storage, rhsExpr with + // locals are zero-init, no need to initialize them + | Local (_, realloc, _), Expr.Const(Const.Zero, _, _) when not realloc -> CommitStartScope cgbuf startScopeMarkOpt - | _ -> + | _ -> GenBindingRhs cenv cgbuf eenv SPSuppress vspec rhsExpr CommitStartScope cgbuf startScopeMarkOpt GenStoreVal cgbuf eenv vspec.Range vspec //------------------------------------------------------------------------- // Generate method bindings -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- -/// Spectacularly gross table encoding P/Invoke and COM marshalling information -and GenMarshal cenv attribs = - let otherAttribs = +/// Generate encoding P/Invoke and COM marshalling information +and GenMarshal cenv attribs = + let otherAttribs = // For IlReflect backend, we rely on Reflection.Emit API to emit the pseudo-custom attributes - // correctly, so we do not filter them out. + // correctly, so we do not filter them out. // For IlWriteBackend, we filter MarshalAs attributes match cenv.opts.ilxBackend with | IlReflectBackend -> attribs @@ -5130,11 +5292,11 @@ and GenMarshal cenv attribs = attribs |> List.filter (IsMatchingFSharpAttributeOpt cenv.g cenv.g.attrib_MarshalAsAttribute >> not) match TryFindFSharpAttributeOpt cenv.g cenv.g.attrib_MarshalAsAttribute attribs with - | Some (Attrib(_,_,[ AttribInt32Arg unmanagedType ],namedArgs,_,_,m)) -> + | Some (Attrib(_, _, [ AttribInt32Arg unmanagedType ], namedArgs, _, _, m)) -> let decoder = AttributeDecoder namedArgs - let rec decodeUnmanagedType unmanagedType = - (* enumeration values for System.Runtime.InteropServices.UnmanagedType taken from mscorlib.il *) - match unmanagedType with + let rec decodeUnmanagedType unmanagedType = + // enumeration values for System.Runtime.InteropServices.UnmanagedType taken from mscorlib.il + match unmanagedType with | 0x0 -> ILNativeType.Empty | 0x01 -> ILNativeType.Void | 0x02 -> ILNativeType.Bool @@ -5158,58 +5320,58 @@ and GenMarshal cenv attribs = | 0x1A -> ILNativeType.IDispatch | 0x1B -> ILNativeType.Struct | 0x1C -> ILNativeType.Interface - | 0x1D -> - let safeArraySubType = - match decoder.FindInt32 "SafeArraySubType" 0x0 with + | 0x1D -> + let safeArraySubType = + match decoder.FindInt32 "SafeArraySubType" 0x0 with (* enumeration values for System.Runtime.InteropServices.VarType taken from mscorlib.il *) | 0x0 -> ILNativeVariant.Empty - | 0x1 -> ILNativeVariant.Null - | 0x02 -> ILNativeVariant.Int16 - | 0x03 -> ILNativeVariant.Int32 - | 0x0C -> ILNativeVariant.Variant - | 0x04 -> ILNativeVariant.Single - | 0x05 -> ILNativeVariant.Double - | 0x06 -> ILNativeVariant.Currency - | 0x07 -> ILNativeVariant.Date - | 0x08 -> ILNativeVariant.BSTR - | 0x09 -> ILNativeVariant.IDispatch - | 0x0a -> ILNativeVariant.Error - | 0x0b -> ILNativeVariant.Bool - | 0x0d -> ILNativeVariant.IUnknown - | 0x0e -> ILNativeVariant.Decimal - | 0x10 -> ILNativeVariant.Int8 - | 0x11 -> ILNativeVariant.UInt8 - | 0x12 -> ILNativeVariant.UInt16 - | 0x13 -> ILNativeVariant.UInt32 - | 0x15 -> ILNativeVariant.UInt64 - | 0x16 -> ILNativeVariant.Int - | 0x17 -> ILNativeVariant.UInt - | 0x18 -> ILNativeVariant.Void - | 0x19 -> ILNativeVariant.HRESULT - | 0x1a -> ILNativeVariant.PTR - | 0x1c -> ILNativeVariant.CArray - | 0x1d -> ILNativeVariant.UserDefined - | 0x1e -> ILNativeVariant.LPSTR - | 0x1B -> ILNativeVariant.SafeArray - | 0x1f -> ILNativeVariant.LPWSTR - | 0x24 -> ILNativeVariant.Record - | 0x40 -> ILNativeVariant.FileTime - | 0x41 -> ILNativeVariant.Blob - | 0x42 -> ILNativeVariant.Stream - | 0x43 -> ILNativeVariant.Storage - | 0x44 -> ILNativeVariant.StreamedObject - | 0x45 -> ILNativeVariant.StoredObject - | 0x46 -> ILNativeVariant.BlobObject - | 0x47 -> ILNativeVariant.CF - | 0x48 -> ILNativeVariant.CLSID - | 0x14 -> ILNativeVariant.Int64 + | 0x1 -> ILNativeVariant.Null + | 0x02 -> ILNativeVariant.Int16 + | 0x03 -> ILNativeVariant.Int32 + | 0x0C -> ILNativeVariant.Variant + | 0x04 -> ILNativeVariant.Single + | 0x05 -> ILNativeVariant.Double + | 0x06 -> ILNativeVariant.Currency + | 0x07 -> ILNativeVariant.Date + | 0x08 -> ILNativeVariant.BSTR + | 0x09 -> ILNativeVariant.IDispatch + | 0x0a -> ILNativeVariant.Error + | 0x0b -> ILNativeVariant.Bool + | 0x0d -> ILNativeVariant.IUnknown + | 0x0e -> ILNativeVariant.Decimal + | 0x10 -> ILNativeVariant.Int8 + | 0x11 -> ILNativeVariant.UInt8 + | 0x12 -> ILNativeVariant.UInt16 + | 0x13 -> ILNativeVariant.UInt32 + | 0x15 -> ILNativeVariant.UInt64 + | 0x16 -> ILNativeVariant.Int + | 0x17 -> ILNativeVariant.UInt + | 0x18 -> ILNativeVariant.Void + | 0x19 -> ILNativeVariant.HRESULT + | 0x1a -> ILNativeVariant.PTR + | 0x1c -> ILNativeVariant.CArray + | 0x1d -> ILNativeVariant.UserDefined + | 0x1e -> ILNativeVariant.LPSTR + | 0x1B -> ILNativeVariant.SafeArray + | 0x1f -> ILNativeVariant.LPWSTR + | 0x24 -> ILNativeVariant.Record + | 0x40 -> ILNativeVariant.FileTime + | 0x41 -> ILNativeVariant.Blob + | 0x42 -> ILNativeVariant.Stream + | 0x43 -> ILNativeVariant.Storage + | 0x44 -> ILNativeVariant.StreamedObject + | 0x45 -> ILNativeVariant.StoredObject + | 0x46 -> ILNativeVariant.BlobObject + | 0x47 -> ILNativeVariant.CF + | 0x48 -> ILNativeVariant.CLSID + | 0x14 -> ILNativeVariant.Int64 | _ -> ILNativeVariant.Empty let safeArrayUserDefinedSubType = // the argument is a System.Type obj, but it's written to MD as a UTF8 string - match decoder.FindTypeName "SafeArrayUserDefinedSubType" "" with + match decoder.FindTypeName "SafeArrayUserDefinedSubType" "" with | "" -> None | res -> if (safeArraySubType = ILNativeVariant.IDispatch) || (safeArraySubType = ILNativeVariant.IUnknown) then Some(res) else None - ILNativeType.SafeArray(safeArraySubType,safeArrayUserDefinedSubType) + ILNativeType.SafeArray(safeArraySubType, safeArrayUserDefinedSubType) | 0x1E -> ILNativeType.FixedArray (decoder.FindInt32 "SizeConst" 0x0) | 0x1F -> ILNativeType.Int | 0x20 -> ILNativeType.UInt @@ -5219,131 +5381,136 @@ and GenMarshal cenv attribs = | 0x25 -> ILNativeType.VariantBool | 0x26 -> ILNativeType.Method | 0x28 -> ILNativeType.AsAny - | 0x2A -> - let sizeParamIndex = - match decoder.FindInt16 "SizeParamIndex" -1s with + | 0x2A -> + let sizeParamIndex = + match decoder.FindInt16 "SizeParamIndex" -1s with | -1s -> None - | res -> Some ((int)res,None) - let arraySubType = - match decoder.FindInt32 "ArraySubType" -1 with + | res -> Some ((int)res, None) + let arraySubType = + match decoder.FindInt32 "ArraySubType" -1 with | -1 -> None | res -> Some (decodeUnmanagedType res) - ILNativeType.Array(arraySubType,sizeParamIndex) + ILNativeType.Array(arraySubType, sizeParamIndex) | 0x2B -> ILNativeType.LPSTRUCT - | 0x2C -> - error(Error(FSComp.SR.ilCustomMarshallersCannotBeUsedInFSharp(),m)) - (* ILNativeType.Custom of bytes * string * string * bytes (* GUID,nativeTypeName,custMarshallerName,cookieString *) *) - //ILNativeType.Error + | 0x2C -> + error(Error(FSComp.SR.ilCustomMarshallersCannotBeUsedInFSharp(), m)) + (* ILNativeType.Custom of bytes * string * string * bytes (* GUID, nativeTypeName, custMarshallerName, cookieString *) *) + //ILNativeType.Error | 0x2D -> ILNativeType.Error | 0x30 -> ILNativeType.LPUTF8STR | _ -> ILNativeType.Empty Some(decodeUnmanagedType unmanagedType), otherAttribs - | Some (Attrib(_,_,_,_,_,_,m)) -> - errorR(Error(FSComp.SR.ilMarshalAsAttributeCannotBeDecoded(),m)) - None, attribs - | _ -> + | Some (Attrib(_, _, _, _, _, _, m)) -> + errorR(Error(FSComp.SR.ilMarshalAsAttributeCannotBeDecoded(), m)) + None, attribs + | _ -> // No MarshalAs detected - None, attribs + None, attribs +/// Generate special attributes on an IL parameter and GenParamAttribs cenv paramTy attribs = let inFlag = HasFSharpAttribute cenv.g cenv.g.attrib_InAttribute attribs || isInByrefTy cenv.g paramTy let outFlag = HasFSharpAttribute cenv.g cenv.g.attrib_OutAttribute attribs || isOutByrefTy cenv.g paramTy let optionalFlag = HasFSharpAttributeOpt cenv.g cenv.g.attrib_OptionalAttribute attribs - - let defaultValue = TryFindFSharpAttributeOpt cenv.g cenv.g.attrib_DefaultParameterValueAttribute attribs + + let defaultValue = TryFindFSharpAttributeOpt cenv.g cenv.g.attrib_DefaultParameterValueAttribute attribs |> Option.bind OptionalArgInfo.FieldInitForDefaultParameterValueAttrib - // Return the filtered attributes. Do not generate In, Out, Optional or DefaultParameterValue attributes + // Return the filtered attributes. Do not generate In, Out, Optional or DefaultParameterValue attributes // as custom attributes in the code - they are implicit from the IL bits for these - let attribs = - attribs + let attribs = + attribs |> List.filter (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_InAttribute >> not) |> List.filter (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_OutAttribute >> not) |> List.filter (IsMatchingFSharpAttributeOpt cenv.g cenv.g.attrib_OptionalAttribute >> not) |> List.filter (IsMatchingFSharpAttributeOpt cenv.g cenv.g.attrib_DefaultParameterValueAttribute >> not) - let Marshal,attribs = GenMarshal cenv attribs - inFlag,outFlag,optionalFlag,defaultValue,Marshal,attribs + let Marshal, attribs = GenMarshal cenv attribs + inFlag, outFlag, optionalFlag, defaultValue, Marshal, attribs +/// Generate IL parameters and GenParams cenv eenv (mspec:ILMethodSpec) (attribs:ArgReprInfo list) methodArgTys (implValsOpt: Val list option) = let ilArgTys = mspec.FormalArgTypes - let argInfosAndTypes = + let argInfosAndTypes = if List.length attribs = List.length ilArgTys then List.zip ilArgTys attribs - else ilArgTys |> List.map (fun ilArgTy -> ilArgTy,ValReprInfo.unnamedTopArg1) + else ilArgTys |> List.map (fun ilArgTy -> ilArgTy, ValReprInfo.unnamedTopArg1) - let argInfosAndTypes = - match implValsOpt with + let argInfosAndTypes = + match implValsOpt with | Some(implVals) when (implVals.Length = ilArgTys.Length) -> - List.map2 (fun x y -> x,Some y) argInfosAndTypes implVals - | _ -> - List.map (fun x -> x,None) argInfosAndTypes + List.map2 (fun x y -> x, Some y) argInfosAndTypes implVals + | _ -> + List.map (fun x -> x, None) argInfosAndTypes - (Set.empty,List.zip methodArgTys argInfosAndTypes) - ||> List.mapFold (fun takenNames (methodArgTy, ((ilArgTy,topArgInfo),implValOpt)) -> - let inFlag,outFlag,optionalFlag,defaultParamValue,Marshal,attribs = GenParamAttribs cenv methodArgTy topArgInfo.Attribs - - let idOpt = (match topArgInfo.Name with - | Some v -> Some v - | None -> match implValOpt with + (Set.empty, List.zip methodArgTys argInfosAndTypes) + ||> List.mapFold (fun takenNames (methodArgTy, ((ilArgTy, topArgInfo), implValOpt)) -> + let inFlag, outFlag, optionalFlag, defaultParamValue, Marshal, attribs = GenParamAttribs cenv methodArgTy topArgInfo.Attribs + + let idOpt = (match topArgInfo.Name with + | Some v -> Some v + | None -> match implValOpt with | Some v -> Some v.Id | None -> None) - let nmOpt,takenNames = - match idOpt with - | Some id -> + let nmOpt, takenNames = + match idOpt with + | Some id -> let nm = if takenNames.Contains(id.idText) then globalNng.FreshCompilerGeneratedName (id.idText, id.idRange) else id.idText Some nm, takenNames.Add(nm) - | None -> + | None -> None, takenNames - - - let ilAttribs = GenAttrs cenv eenv attribs - let ilAttribs = - match GenReadOnlyAttributeIfNecessary cenv.g methodArgTy with + + let ilAttribs = GenAttrs cenv eenv attribs + + let ilAttribs = + match GenReadOnlyAttributeIfNecessary cenv.g methodArgTy with | Some attr -> ilAttribs @ [attr] | None -> ilAttribs - - let param : ILParameter = + + let param : ILParameter = { Name=nmOpt - Type= ilArgTy + Type= ilArgTy Default=defaultParamValue - Marshal=Marshal - IsIn=inFlag - IsOut=outFlag - IsOptional=optionalFlag + Marshal=Marshal + IsIn=inFlag + IsOut=outFlag + IsOptional=optionalFlag CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs ilAttribs) MetadataIndex = NoMetadataIdx } param, takenNames) |> fst - + +/// Generate IL method return information and GenReturnInfo cenv eenv ilRetTy (retInfo : ArgReprInfo) : ILReturn = - let marshal,attribs = GenMarshal cenv retInfo.Attribs + let marshal, attribs = GenMarshal cenv retInfo.Attribs { Type=ilRetTy Marshal=marshal CustomAttrsStored= storeILCustomAttrs (mkILCustomAttrs (GenAttrs cenv eenv attribs)) MetadataIndex = NoMetadataIdx } - -and GenPropertyForMethodDef compileAsInstance tref mdef (v:Val) (memberInfo:ValMemberInfo) ilArgTys ilPropTy ilAttrs compiledName = + +/// Generate an IL property for a member +and GenPropertyForMethodDef compileAsInstance tref mdef (v: Val) (memberInfo: ValMemberInfo) ilArgTys ilPropTy ilAttrs compiledName = let name = match compiledName with | Some n -> n | _ -> v.PropertyName in (* chop "get_" *) - + ILPropertyDef(name = name, attributes = PropertyAttributes.None, - setMethod = (if memberInfo.MemberFlags.MemberKind= MemberKind.PropertySet then Some(mkRefToILMethod(tref,mdef)) else None), - getMethod = (if memberInfo.MemberFlags.MemberKind= MemberKind.PropertyGet then Some(mkRefToILMethod(tref,mdef)) else None), + setMethod = (if memberInfo.MemberFlags.MemberKind= MemberKind.PropertySet then Some(mkRefToILMethod(tref, mdef)) else None), + getMethod = (if memberInfo.MemberFlags.MemberKind= MemberKind.PropertyGet then Some(mkRefToILMethod(tref, mdef)) else None), callingConv = (if compileAsInstance then ILThisConvention.Instance else ILThisConvention.Static), propertyType = ilPropTy, init = None, args = ilArgTys, customAttrs = ilAttrs) +/// Generate an ILEventDef for a [] member and GenEventForProperty cenv eenvForMeth (mspec:ILMethodSpec) (v:Val) ilAttrsThatGoOnPrimaryItem m returnTy = let evname = v.PropertyName let delegateTy = Infos.FindDelegateTypeOfPropertyEvent cenv.g cenv.amap evname m returnTy let ilDelegateTy = GenType cenv.amap m eenvForMeth.tyenv delegateTy let ilThisTy = mspec.DeclaringType - let addMethRef = mkILMethRef (ilThisTy.TypeRef,mspec.CallingConv,"add_" + evname,0,[ilDelegateTy],ILType.Void) - let removeMethRef = mkILMethRef (ilThisTy.TypeRef,mspec.CallingConv,"remove_" + evname,0,[ilDelegateTy],ILType.Void) + let addMethRef = mkILMethRef (ilThisTy.TypeRef, mspec.CallingConv, "add_" + evname, 0, [ilDelegateTy], ILType.Void) + let removeMethRef = mkILMethRef (ilThisTy.TypeRef, mspec.CallingConv, "remove_" + evname, 0, [ilDelegateTy], ILType.Void) ILEventDef(eventType = Some ilDelegateTy, name= evname, attributes = EventAttributes.None, @@ -5353,16 +5520,15 @@ and GenEventForProperty cenv eenvForMeth (mspec:ILMethodSpec) (v:Val) ilAttrsTha otherMethods= [], customAttrs = mkILCustomAttrs ilAttrsThatGoOnPrimaryItem) - -and ComputeFlagFixupsForMemberBinding cenv (v:Val,memberInfo:ValMemberInfo) = - if isNil memberInfo.ImplementedSlotSigs then +and ComputeFlagFixupsForMemberBinding cenv (v:Val, memberInfo:ValMemberInfo) = + if isNil memberInfo.ImplementedSlotSigs then [fixupVirtualSlotFlags] - else - memberInfo.ImplementedSlotSigs |> List.map (fun slotsig -> + else + memberInfo.ImplementedSlotSigs |> List.map (fun slotsig -> let oty = slotsig.ImplementedType let otcref = tcrefOfAppTy cenv.g oty let tcref = v.MemberApparentEntity - + let useMethodImpl = // REVIEW: it would be good to get rid of this special casing of Compare and GetHashCode during code generation isInterfaceTy cenv.g oty && @@ -5370,12 +5536,12 @@ and ComputeFlagFixupsForMemberBinding cenv (v:Val,memberInfo:ValMemberInfo) = Option.isSome tcref.GeneratedCompareToValues && (typeEquiv cenv.g oty cenv.g.mk_IComparable_ty || tyconRefEq cenv.g cenv.g.system_GenericIComparable_tcref otcref) - + not isCompare) && (let isGenericEquals = Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues && tyconRefEq cenv.g cenv.g.system_GenericIEquatable_tcref otcref - + not isGenericEquals) && (let isStructural = (Option.isSome tcref.GeneratedCompareToWithComparerValues && typeEquiv cenv.g oty cenv.g.mk_IStructuralComparable_ty) || @@ -5383,32 +5549,32 @@ and ComputeFlagFixupsForMemberBinding cenv (v:Val,memberInfo:ValMemberInfo) = not isStructural) - let nameOfOverridingMethod = GenNameOfOverridingMethod cenv (useMethodImpl,slotsig) + let nameOfOverridingMethod = GenNameOfOverridingMethod cenv (useMethodImpl, slotsig) - if useMethodImpl then + if useMethodImpl then fixupMethodImplFlags >> renameMethodDef nameOfOverridingMethod - else + else fixupVirtualSlotFlags >> renameMethodDef nameOfOverridingMethod) - + and ComputeMethodImplAttribs cenv (_v:Val) attrs = - let implflags = + let implflags = match TryFindFSharpAttribute cenv.g cenv.g.attrib_MethodImplAttribute attrs with - | Some (Attrib(_,_,[ AttribInt32Arg flags ],_,_,_,_)) -> flags + | Some (Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> flags | _ -> 0x0 - let hasPreserveSigAttr = + let hasPreserveSigAttr = match TryFindFSharpAttributeOpt cenv.g cenv.g.attrib_PreserveSigAttribute attrs with | Some _ -> true | _ -> false - - // strip the MethodImpl pseudo-custom attribute + + // strip the MethodImpl pseudo-custom attribute // The following method implementation flags are used here // 0x80 - hasPreserveSigImplFlag // 0x20 - synchronize - // (See ECMA 335, Partition II, section 23.1.11 - Flags for methods [MethodImplAttributes]) - let attrs = - attrs - |> List.filter (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_MethodImplAttribute >> not) + // (See ECMA 335, Partition II, section 23.1.11 - Flags for methods [MethodImplAttributes]) + let attrs = + attrs + |> List.filter (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_MethodImplAttribute >> not) |> List.filter (IsMatchingFSharpAttributeOpt cenv.g cenv.g.attrib_PreserveSigAttribute >> not) let hasPreserveSigImplFlag = ((implflags &&& 0x80) <> 0x0) || hasPreserveSigAttr @@ -5416,61 +5582,61 @@ and ComputeMethodImplAttribs cenv (_v:Val) attrs = let hasNoInliningImplFlag = (implflags &&& 0x08) <> 0x0 let hasAggressiveInliningImplFlag = (implflags &&& 0x0100) <> 0x0 hasPreserveSigImplFlag, hasSynchronizedImplFlag, hasNoInliningImplFlag, hasAggressiveInliningImplFlag, attrs - -and GenMethodForBinding - cenv cgbuf eenv - (v:Val,mspec,access,paramInfos,retInfo) - (topValInfo,ctorThisValOpt,baseValOpt,tps,methodVars, methodArgTys, body, returnTy) = - + +and GenMethodForBinding + cenv cgbuf eenv + (v:Val, mspec, access, paramInfos, retInfo) + (topValInfo, ctorThisValOpt, baseValOpt, tps, methodVars, methodArgTys, body, returnTy) = + let m = v.Range - let selfMethodVars,nonSelfMethodVars,compileAsInstance = - match v.MemberInfo with - | Some _ when ValSpecIsCompiledAsInstance cenv.g v -> - match methodVars with - | [] -> error(InternalError("Internal error: empty argument list for instance method",v.Range)) - | h::t -> [h],t,true - | _ -> [],methodVars,false - - let nonUnitNonSelfMethodVars,body = BindUnitVars cenv.g (nonSelfMethodVars,paramInfos,body) + let selfMethodVars, nonSelfMethodVars, compileAsInstance = + match v.MemberInfo with + | Some _ when ValSpecIsCompiledAsInstance cenv.g v -> + match methodVars with + | [] -> error(InternalError("Internal error: empty argument list for instance method", v.Range)) + | h::t -> [h], t, true + | _ -> [], methodVars, false + + let nonUnitNonSelfMethodVars, body = BindUnitVars cenv.g (nonSelfMethodVars, paramInfos, body) let nonUnitMethodVars = selfMethodVars@nonUnitNonSelfMethodVars - let cmtps,curriedArgInfos,_,_ = GetTopValTypeInCompiledForm cenv.g topValInfo v.Type v.Range - + let cmtps, curriedArgInfos, _, _ = GetTopValTypeInCompiledForm cenv.g topValInfo v.Type v.Range + let eenv = bindBaseOrThisVarOpt cenv eenv ctorThisValOpt let eenv = bindBaseOrThisVarOpt cenv eenv baseValOpt - // The type parameters of the method's type are different to the type parameters - // for the big lambda ("tlambda") of the implementation of the method. + // The type parameters of the method's type are different to the type parameters + // for the big lambda ("tlambda") of the implementation of the method. let eenvUnderMethLambdaTypars = EnvForTypars tps eenv let eenvUnderMethTypeTypars = EnvForTypars cmtps eenv - // Add the arguments to the environment. We add an implicit 'this' argument to constructors - let isCtor = v.IsConstructor - let eenvForMeth = + // Add the arguments to the environment. We add an implicit 'this' argument to constructors + let isCtor = v.IsConstructor + let eenvForMeth = let eenvForMeth = eenvUnderMethLambdaTypars let numImplicitArgs = if isCtor then 1 else 0 - let eenvForMeth = AddStorageForLocalVals cenv.g (List.mapi (fun i v -> (v,Arg (numImplicitArgs+i))) nonUnitMethodVars) eenvForMeth + let eenvForMeth = AddStorageForLocalVals cenv.g (List.mapi (fun i v -> (v, Arg (numImplicitArgs+i))) nonUnitMethodVars) eenvForMeth eenvForMeth - let tailCallInfo = [(mkLocalValRef v,BranchCallMethod (topValInfo.AritiesOfArgs,curriedArgInfos,tps,nonUnitMethodVars.Length,v.NumObjArgs))] + let tailCallInfo = [(mkLocalValRef v, BranchCallMethod (topValInfo.AritiesOfArgs, curriedArgInfos, tps, nonUnitMethodVars.Length, v.NumObjArgs))] - // Discard the result on a 'void' return type. For a constructor just return 'void' - let sequel = - if isUnitTy cenv.g returnTy then discardAndReturnVoid - elif isCtor then ReturnVoid + // Discard the result on a 'void' return type. For a constructor just return 'void' + let sequel = + if isUnitTy cenv.g returnTy then discardAndReturnVoid + elif isCtor then ReturnVoid else Return // Now generate the code. - - let hasPreserveSigNamedArg,ilMethodBody,hasDllImport = + let hasPreserveSigNamedArg, ilMethodBody, hasDllImport = match TryFindFSharpAttributeOpt cenv.g cenv.g.attrib_DllImportAttribute v.Attribs with - | Some (Attrib(_,_,[ AttribStringArg(dll) ],namedArgs,_,_,m)) -> - if not (isNil tps) then error(Error(FSComp.SR.ilSignatureForExternalFunctionContainsTypeParameters(),m)) - let hasPreserveSigNamedArg, mbody = GenPInvokeMethod (v.CompiledName,dll,namedArgs) + | Some (Attrib(_, _, [ AttribStringArg(dll) ], namedArgs, _, _, m)) -> + if not (isNil tps) then error(Error(FSComp.SR.ilSignatureForExternalFunctionContainsTypeParameters(), m)) + let hasPreserveSigNamedArg, mbody = GenPInvokeMethod (v.CompiledName, dll, namedArgs) hasPreserveSigNamedArg, mbody, true - | Some (Attrib(_,_,_,_,_,_,m)) -> - error(Error(FSComp.SR.ilDllImportAttributeCouldNotBeDecoded(),m)) - | _ -> + | Some (Attrib(_, _, _, _, _, _, m)) -> + error(Error(FSComp.SR.ilDllImportAttributeCouldNotBeDecoded(), m)) + + | _ -> // Replace the body of ValInline.PseudoVal "must inline" methods with a 'throw' // However still generate the code for reflection etc. let bodyExpr = @@ -5478,41 +5644,41 @@ and GenMethodForBinding let exnArg = mkString cenv.g m (FSComp.SR.ilDynamicInvocationNotSupported(v.CompiledName)) let exnExpr = MakeNotSupportedExnExpr cenv eenv (exnArg, m) mkThrow m returnTy exnExpr - else - body + else + body + + let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, tailCallInfo, mspec.Name, eenvForMeth, 0, bodyExpr, sequel) - // This is the main code generation for most methods - false, - MethodBody.IL(CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways,tailCallInfo, mspec.Name, eenvForMeth, 0, bodyExpr, sequel)), - false + // This is the main code generation for most methods + false, MethodBody.IL ilCode, false // Do not generate DllImport attributes into the code - they are implicit from the P/Invoke - let attrs = - v.Attribs + let attrs = + v.Attribs |> List.filter (IsMatchingFSharpAttributeOpt cenv.g cenv.g.attrib_DllImportAttribute >> not) |> List.filter (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_CompiledNameAttribute >> not) - - let attrsAppliedToGetterOrSetter, attrs = - List.partition (fun (Attrib(_,_,_,_,isAppliedToGetterOrSetter,_,_)) -> isAppliedToGetterOrSetter) attrs - - let sourceNameAttribs,compiledName = - match v.Attribs |> List.tryFind (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_CompiledNameAttribute) with - | Some (Attrib(_,_,[ AttribStringArg(b) ],_,_,_,_)) -> [ mkCompilationSourceNameAttr cenv.g v.LogicalName ], Some b - | _ -> [],None - + + let attrsAppliedToGetterOrSetter, attrs = + List.partition (fun (Attrib(_, _, _, _, isAppliedToGetterOrSetter, _, _)) -> isAppliedToGetterOrSetter) attrs + + let sourceNameAttribs, compiledName = + match v.Attribs |> List.tryFind (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_CompiledNameAttribute) with + | Some (Attrib(_, _, [ AttribStringArg(b) ], _, _, _, _)) -> [ mkCompilationSourceNameAttr cenv.g v.LogicalName ], Some b + | _ -> [], None + // check if the hasPreserveSigNamedArg and hasSynchronizedImplFlag implementation flags have been specified let hasPreserveSigImplFlag, hasSynchronizedImplFlag, hasNoInliningFlag, hasAggressiveInliningImplFlag, attrs = ComputeMethodImplAttribs cenv v attrs - - let securityAttributes,attrs = attrs |> List.partition (fun a -> IsSecurityAttribute cenv.g cenv.amap cenv.casApplied a m) + let securityAttributes, attrs = attrs |> List.partition (fun a -> IsSecurityAttribute cenv.g cenv.amap cenv.casApplied a m) + let permissionSets = CreatePermissionSets cenv eenv securityAttributes - + let secDecls = if List.isEmpty securityAttributes then emptyILSecurityDecls else mkILSecurityDecls permissionSets - - // Do not push the attributes to the method for events and properties + + // Do not push the attributes to the method for events and properties let ilAttrsCompilerGenerated = if v.IsCompilerGenerated then [ cenv.g.CompilerGeneratedAttribute ] else [] - let ilAttrsThatGoOnPrimaryItem = + let ilAttrsThatGoOnPrimaryItem = [ yield! GenAttrs cenv eenv attrs yield! GenCompilationArgumentCountsAttr cenv v ] @@ -5522,11 +5688,11 @@ and GenMethodForBinding let methName = mspec.Name let tref = mspec.MethodRef.DeclaringTypeRef - let EmitTheMethodDef (mdef:ILMethodDef) = - // Does the function have an explicit [] attribute? + let EmitTheMethodDef (mdef:ILMethodDef) = + // Does the function have an explicit [] attribute? let isExplicitEntryPoint = HasFSharpAttribute cenv.g cenv.g.attrib_EntryPointAttribute attrs - let mdef = + let mdef = mdef .WithSecurity(not (List.isEmpty securityAttributes)) .WithPInvoke(hasDllImport) @@ -5536,128 +5702,126 @@ and GenMethodForBinding .WithAggressiveInlining(hasAggressiveInliningImplFlag) .With(isEntryPoint=isExplicitEntryPoint, securityDecls=secDecls) - let mdef = + let mdef = if // operator names - mdef.Name.StartsWithOrdinal("op_") || + mdef.Name.StartsWithOrdinal("op_") || // active pattern names mdef.Name.StartsWithOrdinal("|") || // event add/remove method v.val_flags.IsGeneratedEventVal then mdef.WithSpecialName - else + else mdef CountMethodDef() - cgbuf.mgbuf.AddMethodDef(tref,mdef) - + cgbuf.mgbuf.AddMethodDef(tref, mdef) + - match v.MemberInfo with - // don't generate unimplemented abstracts - | Some(memberInfo) when memberInfo.MemberFlags.IsDispatchSlot && not memberInfo.IsImplemented -> + match v.MemberInfo with + // don't generate unimplemented abstracts + | Some(memberInfo) when memberInfo.MemberFlags.IsDispatchSlot && not memberInfo.IsImplemented -> // skipping unimplemented abstract method - () - | Some(memberInfo) when not v.IsExtensionMember -> + () + | Some(memberInfo) when not v.IsExtensionMember -> let ilMethTypars = ilTypars |> List.drop mspec.DeclaringType.GenericArgs.Length - if memberInfo.MemberFlags.MemberKind = MemberKind.Constructor then + if memberInfo.MemberFlags.MemberKind = MemberKind.Constructor then assert (isNil ilMethTypars) - let mdef = mkILCtor (access,ilParams,ilMethodBody) + let mdef = mkILCtor (access, ilParams, ilMethodBody) let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) EmitTheMethodDef mdef - elif memberInfo.MemberFlags.MemberKind = MemberKind.ClassConstructor then + elif memberInfo.MemberFlags.MemberKind = MemberKind.ClassConstructor then assert (isNil ilMethTypars) - let mdef = mkILClassCtor ilMethodBody + let mdef = mkILClassCtor ilMethodBody let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) EmitTheMethodDef mdef // Generate virtual/override methods + method-impl information if needed else - let mdef = - if not compileAsInstance then - mkILStaticMethod (ilMethTypars,v.CompiledName,access,ilParams,ilReturn,ilMethodBody) + let mdef = + if not compileAsInstance then + mkILStaticMethod (ilMethTypars, v.CompiledName, access, ilParams, ilReturn, ilMethodBody) - elif (memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) || - memberInfo.MemberFlags.IsOverrideOrExplicitImpl then + elif (memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) || + memberInfo.MemberFlags.IsOverrideOrExplicitImpl then - let flagFixups = ComputeFlagFixupsForMemberBinding cenv (v,memberInfo) - let mdef = mkILGenericVirtualMethod (v.CompiledName,ILMemberAccess.Public,ilMethTypars,ilParams,ilReturn,ilMethodBody) + let flagFixups = ComputeFlagFixupsForMemberBinding cenv (v, memberInfo) + let mdef = mkILGenericVirtualMethod (v.CompiledName, ILMemberAccess.Public, ilMethTypars, ilParams, ilReturn, ilMethodBody) let mdef = List.fold (fun mdef f -> f mdef) mdef flagFixups // fixup can potentially change name of reflected definition that was already recorded - patch it if necessary cgbuf.mgbuf.ReplaceNameOfReflectedDefinition(v, mdef.Name) mdef - else - mkILGenericNonVirtualMethod (v.CompiledName,access,ilMethTypars,ilParams,ilReturn,ilMethodBody) + else + mkILGenericNonVirtualMethod (v.CompiledName, access, ilMethTypars, ilParams, ilReturn, ilMethodBody) - let isAbstract = - memberInfo.MemberFlags.IsDispatchSlot && + let isAbstract = + memberInfo.MemberFlags.IsDispatchSlot && let tcref = v.MemberApparentEntity not tcref.Deref.IsFSharpDelegateTycon - let mdef = - if mdef.IsVirtual then + let mdef = + if mdef.IsVirtual then mdef.WithFinal(memberInfo.MemberFlags.IsFinal).WithAbstract(isAbstract) else mdef - match memberInfo.MemberFlags.MemberKind with - + match memberInfo.MemberFlags.MemberKind with + | (MemberKind.PropertySet | MemberKind.PropertyGet) -> - if not (isNil ilMethTypars) then - error(InternalError("A property may not be more generic than the enclosing type - constrain the polymorphism in the expression",v.Range)) - + if not (isNil ilMethTypars) then + error(InternalError("A property may not be more generic than the enclosing type - constrain the polymorphism in the expression", v.Range)) + // Check if we're compiling the property as a .NET event - if CompileAsEvent cenv.g v.Attribs then + if CompileAsEvent cenv.g v.Attribs then // Emit the pseudo-property as an event, but not if its a private method impl - if mdef.Access <> ILMemberAccess.Private then - let edef = GenEventForProperty cenv eenvForMeth mspec v ilAttrsThatGoOnPrimaryItem m returnTy - cgbuf.mgbuf.AddEventDef(tref,edef) + if mdef.Access <> ILMemberAccess.Private then + let edef = GenEventForProperty cenv eenvForMeth mspec v ilAttrsThatGoOnPrimaryItem m returnTy + cgbuf.mgbuf.AddEventDef(tref, edef) // The method def is dropped on the floor here - + else // Emit the property, but not if its a private method impl - if mdef.Access <> ILMemberAccess.Private then + if mdef.Access <> ILMemberAccess.Private then let vtyp = ReturnTypeOfPropertyVal cenv.g v let ilPropTy = GenType cenv.amap m eenvUnderMethTypeTypars.tyenv vtyp - let ilArgTys = v |> ArgInfosOfPropertyVal cenv.g |> List.map fst |> GenTypes cenv.amap m eenvUnderMethTypeTypars.tyenv + let ilArgTys = v |> ArgInfosOfPropertyVal cenv.g |> List.map fst |> GenTypes cenv.amap m eenvUnderMethTypeTypars.tyenv let ilPropDef = GenPropertyForMethodDef compileAsInstance tref mdef v memberInfo ilArgTys ilPropTy (mkILCustomAttrs ilAttrsThatGoOnPrimaryItem) compiledName - cgbuf.mgbuf.AddOrMergePropertyDef(tref,ilPropDef,m) + cgbuf.mgbuf.AddOrMergePropertyDef(tref, ilPropDef, m) - // Add the special name flag for all properties + // Add the special name flag for all properties let mdef = mdef.WithSpecialName.With(customAttrs= mkILCustomAttrs ((GenAttrs cenv eenv attrsAppliedToGetterOrSetter) @ sourceNameAttribs @ ilAttrsCompilerGenerated)) EmitTheMethodDef mdef - | _ -> + | _ -> let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) EmitTheMethodDef mdef - | _ -> - let mdef = mkILStaticMethod (ilTypars, methName, access,ilParams,ilReturn,ilMethodBody) + | _ -> + let mdef = mkILStaticMethod (ilTypars, methName, access, ilParams, ilReturn, ilMethodBody) // For extension properties, also emit attrsAppliedToGetterOrSetter on the getter or setter method - let ilAttrs = - match v.MemberInfo with - | Some memberInfo when v.IsExtensionMember -> - match memberInfo.MemberFlags.MemberKind with + let ilAttrs = + match v.MemberInfo with + | Some memberInfo when v.IsExtensionMember -> + match memberInfo.MemberFlags.MemberKind with | (MemberKind.PropertySet | MemberKind.PropertyGet) -> ilAttrsThatGoOnPrimaryItem @ GenAttrs cenv eenv attrsAppliedToGetterOrSetter - | _ -> ilAttrsThatGoOnPrimaryItem - | _ -> ilAttrsThatGoOnPrimaryItem + | _ -> ilAttrsThatGoOnPrimaryItem + | _ -> ilAttrsThatGoOnPrimaryItem let ilCustomAttrs = mkILCustomAttrs (ilAttrs @ sourceNameAttribs @ ilAttrsCompilerGenerated) let mdef = mdef.With(customAttrs= ilCustomAttrs) EmitTheMethodDef mdef - - - -and GenPInvokeMethod (nm,dll,namedArgs) = - let decoder = AttributeDecoder namedArgs +and GenPInvokeMethod (nm, dll, namedArgs) = + let decoder = AttributeDecoder namedArgs + let hasPreserveSigNamedArg = decoder.FindBool "PreserveSig" true hasPreserveSigNamedArg, - MethodBody.PInvoke + MethodBody.PInvoke { Where=mkSimpleModRef dll Name=decoder.FindString "EntryPoint" nm CallingConv= - match decoder.FindInt32 "CallingConvention" 0 with + match decoder.FindInt32 "CallingConvention" 0 with | 1 -> PInvokeCallingConvention.WinApi | 2 -> PInvokeCallingConvention.Cdecl | 3 -> PInvokeCallingConvention.Stdcall @@ -5665,7 +5829,7 @@ and GenPInvokeMethod (nm,dll,namedArgs) = | 5 -> PInvokeCallingConvention.Fastcall | _ -> PInvokeCallingConvention.WinApi CharEncoding= - match decoder.FindInt32 "CharSet" 0 with + match decoder.FindInt32 "CharSet" 0 with | 1 -> PInvokeCharEncoding.None | 2 -> PInvokeCharEncoding.Ansi | 3 -> PInvokeCharEncoding.Unicode @@ -5675,157 +5839,161 @@ and GenPInvokeMethod (nm,dll,namedArgs) = LastError= decoder.FindBool "SetLastError" false ThrowOnUnmappableChar= if (decoder.FindBool "ThrowOnUnmappableChar" false) then PInvokeThrowOnUnmappableChar.Enabled else PInvokeThrowOnUnmappableChar.UseAssembly CharBestFit=if (decoder.FindBool "BestFitMapping" false) then PInvokeCharBestFit.Enabled else PInvokeCharBestFit.UseAssembly } - - + and GenBindings cenv cgbuf eenv binds = List.iter (GenBinding cenv cgbuf eenv) binds //------------------------------------------------------------------------- // Generate locals and other storage of values -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- -and GenSetVal cenv cgbuf eenv (vref,e,m) sequel = +and GenSetVal cenv cgbuf eenv (vref, e, m) sequel = let storage = StorageForValRef m vref eenv match storage with - | Env (ilCloTy,_,_,_) -> - CG.EmitInstr cgbuf (pop 0) (Push [ilCloTy]) mkLdarg0 - | _ -> + | Env (ilCloTy, _, _, _) -> + CG.EmitInstr cgbuf (pop 0) (Push [ilCloTy]) mkLdarg0 + | _ -> () GenExpr cenv cgbuf eenv SPSuppress e Continue GenSetStorage vref.Range cgbuf storage GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel - + and GenGetValRefAndSequel cenv cgbuf eenv m (v:ValRef) fetchSequel = let ty = v.Type GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv.amap m eenv.tyenv ty) (StorageForValRef m v eenv) fetchSequel -and GenGetVal cenv cgbuf eenv (v:ValRef,m) sequel = +and GenGetVal cenv cgbuf eenv (v:ValRef, m) sequel = GenGetValRefAndSequel cenv cgbuf eenv m v None GenSequel cenv eenv.cloc cgbuf sequel - -and GenBindingRhs cenv cgbuf eenv sp (vspec:Val) e = - match e with - | Expr.TyLambda _ | Expr.Lambda _ -> + +and GenBindingRhs cenv cgbuf eenv sp (vspec:Val) e = + match e with + | Expr.TyLambda _ | Expr.Lambda _ -> let isLocalTypeFunc = IsNamedLocalTypeFuncVal cenv.g vspec e - + match e with - | Expr.TyLambda(_, tyargs, body, _, ttype) when + | Expr.TyLambda(_, tyargs, body, _, ttype) when ( tyargs |> List.forall (fun tp -> tp.IsErased) && - (match StorageForVal vspec.Range vspec eenv with Local _ -> true | _ -> false) && - (isLocalTypeFunc || - (match ttype with - TType_var(typar) -> match typar.Solution with Some(TType_app(t,_))-> t.IsStructOrEnumTycon | _ -> false + (match StorageForVal vspec.Range vspec eenv with Local _ -> true | _ -> false) && + (isLocalTypeFunc || + (match ttype with + TType_var(typar) -> match typar.Solution with Some(TType_app(t, _))-> t.IsStructOrEnumTycon | _ -> false | _ -> false)) ) -> // type lambda with erased type arguments that is stored as local variable (not method or property)- inline body GenExpr cenv cgbuf eenv sp body Continue | _ -> let selfv = if isLocalTypeFunc then None else Some (mkLocalValRef vspec) - GenLambda cenv cgbuf eenv isLocalTypeFunc selfv e Continue - | _ -> + GenLambda cenv cgbuf eenv isLocalTypeFunc selfv e Continue + | _ -> GenExpr cenv cgbuf eenv sp e Continue -and CommitStartScope cgbuf startScopeMarkOpt = - match startScopeMarkOpt with +and CommitStartScope cgbuf startScopeMarkOpt = + match startScopeMarkOpt with | None -> () | Some ss -> cgbuf.SetMarkToHere(ss) - + and EmitInitLocal cgbuf ty idx = CG.EmitInstrs cgbuf (pop 0) Push0 [I_ldloca (uint16 idx); (I_initobj ty) ] + and EmitSetLocal cgbuf idx = CG.EmitInstr cgbuf (pop 1) Push0 (mkStloc (uint16 idx)) + and EmitGetLocal cgbuf ty idx = CG.EmitInstr cgbuf (pop 0) (Push [ty]) (mkLdloc (uint16 idx)) + and EmitSetStaticField cgbuf fspec = CG.EmitInstr cgbuf (pop 1) Push0 (mkNormalStsfld fspec) + and EmitGetStaticFieldAddr cgbuf ty fspec = CG.EmitInstr cgbuf (pop 0) (Push [ty]) (I_ldsflda fspec) + and EmitGetStaticField cgbuf ty fspec = CG.EmitInstr cgbuf (pop 0) (Push [ty]) (mkNormalLdsfld fspec) -and GenSetStorage m cgbuf storage = - match storage with +and GenSetStorage m cgbuf storage = + match storage with | Local (idx, _, _) -> EmitSetLocal cgbuf idx - | StaticField (_, _, hasLiteralAttr, ilContainerTy, _, _, _, ilSetterMethRef, _) -> - if hasLiteralAttr then errorR(Error(FSComp.SR.ilLiteralFieldsCannotBeSet(),m)) - CG.EmitInstr cgbuf (pop 1) Push0 (I_call(Normalcall,mkILMethSpecForMethRefInTy(ilSetterMethRef,ilContainerTy,[]),None)) + | StaticField (_, _, hasLiteralAttr, ilContainerTy, _, _, _, ilSetterMethRef, _) -> + if hasLiteralAttr then errorR(Error(FSComp.SR.ilLiteralFieldsCannotBeSet(), m)) + CG.EmitInstr cgbuf (pop 1) Push0 (I_call(Normalcall, mkILMethSpecForMethRefInTy(ilSetterMethRef, ilContainerTy, []), None)) - | StaticProperty (ilGetterMethSpec,_) -> - error(Error(FSComp.SR.ilStaticMethodIsNotLambda(ilGetterMethSpec.Name),m)) + | StaticProperty (ilGetterMethSpec, _) -> + error(Error(FSComp.SR.ilStaticMethodIsNotLambda(ilGetterMethSpec.Name), m)) - | Method (_,_,mspec,m,_,_,_) -> - error(Error(FSComp.SR.ilStaticMethodIsNotLambda(mspec.Name),m)) + | Method (_, _, mspec, m, _, _, _) -> + error(Error(FSComp.SR.ilStaticMethodIsNotLambda(mspec.Name), m)) - | Null -> + | Null -> CG.EmitInstr cgbuf (pop 1) Push0 AI_pop - | Arg _ -> - error(Error(FSComp.SR.ilMutableVariablesCannotEscapeMethod(),m)) + | Arg _ -> + error(Error(FSComp.SR.ilMutableVariablesCannotEscapeMethod(), m)) - | Env (_,_,ilField,_) -> + | Env (_, _, ilField, _) -> // Note: ldarg0 has already been emitted in GenSetVal CG.EmitInstr cgbuf (pop 2) Push0 (mkNormalStfld ilField) -and CommitGetStorageSequel cenv cgbuf eenv m ty localCloInfo storeSequel = - match localCloInfo,storeSequel with - | Some {contents =NamedLocalIlxClosureInfoGenerator _cloinfo},_ -> error(InternalError("Unexpected generator",m)) - | Some {contents =NamedLocalIlxClosureInfoGenerated cloinfo},Some (tyargs,args,m,sequel) when not (isNil tyargs) -> +and CommitGetStorageSequel cenv cgbuf eenv m ty localCloInfo storeSequel = + match localCloInfo, storeSequel with + | Some {contents =NamedLocalIlxClosureInfoGenerator _cloinfo}, _ -> error(InternalError("Unexpected generator", m)) + | Some {contents =NamedLocalIlxClosureInfoGenerated cloinfo}, Some (tyargs, args, m, sequel) when not (isNil tyargs) -> let actualRetTy = GenNamedLocalTyFuncCall cenv cgbuf eenv ty cloinfo tyargs m - CommitGetStorageSequel cenv cgbuf eenv m actualRetTy None (Some ([],args,m,sequel)) + CommitGetStorageSequel cenv cgbuf eenv m actualRetTy None (Some ([], args, m, sequel)) | _, None -> () - | _,Some ([],[],_,sequel) -> - GenSequel cenv eenv.cloc cgbuf sequel - | _,Some (tyargs,args,m,sequel) -> - GenArgsAndIndirectCall cenv cgbuf eenv (ty,tyargs,args,m) sequel + | _, Some ([], [], _, sequel) -> + GenSequel cenv eenv.cloc cgbuf sequel + | _, Some (tyargs, args, m, sequel) -> + GenArgsAndIndirectCall cenv cgbuf eenv (ty, tyargs, args, m) sequel -and GenGetStorageAndSequel cenv cgbuf eenv m (ty,ilTy) storage storeSequel = - match storage with +and GenGetStorageAndSequel cenv cgbuf eenv m (ty, ilTy) storage storeSequel = + match storage with | Local (idx, _, localCloInfo) -> EmitGetLocal cgbuf ilTy idx CommitGetStorageSequel cenv cgbuf eenv m ty localCloInfo storeSequel - | StaticField (fspec, _, hasLiteralAttr, ilContainerTy, _, _, ilGetterMethRef, _, _) -> + | StaticField (fspec, _, hasLiteralAttr, ilContainerTy, _, _, ilGetterMethRef, _, _) -> // References to literals go directly to the field - no property is used - if hasLiteralAttr then + if hasLiteralAttr then EmitGetStaticField cgbuf ilTy fspec else CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (I_call(Normalcall, mkILMethSpecForMethRefInTy (ilGetterMethRef, ilContainerTy, []), None)) CommitGetStorageSequel cenv cgbuf eenv m ty None storeSequel - | StaticProperty (ilGetterMethSpec, _) -> + | StaticProperty (ilGetterMethSpec, _) -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (I_call (Normalcall, ilGetterMethSpec, None)) CommitGetStorageSequel cenv cgbuf eenv m ty None storeSequel - | Method (topValInfo,vref,mspec,_,_,_,_) -> - // Get a toplevel value as a first-class value. - // We generate a lambda expression and that simply calls - // the toplevel method. However we optimize the case where we are - // immediately applying the value anyway (to insufficient arguments). + | Method (topValInfo, vref, mspec, _, _, _, _) -> + // Get a toplevel value as a first-class value. + // We generate a lambda expression and that simply calls + // the toplevel method. However we optimize the case where we are + // immediately applying the value anyway (to insufficient arguments). - // First build a lambda expression for the saturated use of the toplevel value... - // REVIEW: we should NOT be doing this in the backend... - let expr,exprty = AdjustValForExpectedArity cenv.g m vref NormalValUse topValInfo + // First build a lambda expression for the saturated use of the toplevel value... + // REVIEW: we should NOT be doing this in the backend... + let expr, exprty = AdjustValForExpectedArity cenv.g m vref NormalValUse topValInfo - // Then reduce out any arguments (i.e. apply the sequel immediately if we can...) - match storeSequel with - | None -> + // Then reduce out any arguments (i.e. apply the sequel immediately if we can...) + match storeSequel with + | None -> GenLambda cenv cgbuf eenv false None expr Continue - | Some (tyargs',args,m,sequel) -> - let specializedExpr = + | Some (tyargs', args, m, sequel) -> + let specializedExpr = if isNil args && isNil tyargs' then failwith ("non-lambda at use of method " + mspec.Name) - MakeApplicationAndBetaReduce cenv.g (expr,exprty,[tyargs'],args,m) + MakeApplicationAndBetaReduce cenv.g (expr, exprty, [tyargs'], args, m) GenExpr cenv cgbuf eenv SPSuppress specializedExpr sequel - | Null -> - CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (AI_ldnull) + | Null -> + CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (AI_ldnull) CommitGetStorageSequel cenv cgbuf eenv m ty None storeSequel - | Arg i -> - CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdarg (uint16 i)) + | Arg i -> + CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdarg (uint16 i)) CommitGetStorageSequel cenv cgbuf eenv m ty None storeSequel - | Env (_,_,ilField,localCloInfo) -> + | Env (_, _, ilField, localCloInfo) -> // Note: ldarg 0 is emitted in 'cu_erase' erasure of the ldenv instruction CG.EmitInstrs cgbuf (pop 0) (Push [ilTy]) [ mkLdarg0; mkNormalLdfld ilField ] CommitGetStorageSequel cenv cgbuf eenv m ty localCloInfo storeSequel -and GenGetLocalVals cenv cgbuf eenvouter m fvs = +and GenGetLocalVals cenv cgbuf eenvouter m fvs = List.iter (fun v -> GenGetLocalVal cenv cgbuf eenvouter m v None) fvs and GenGetLocalVal cenv cgbuf eenv m (vspec:Val) fetchSequel = @@ -5837,93 +6005,93 @@ and GenGetLocalVRef cenv cgbuf eenv m (vref:ValRef) fetchSequel = and GenStoreVal cgbuf eenv m (vspec:Val) = GenSetStorage vspec.Range cgbuf (StorageForVal m vspec eenv) -//-------------------------------------------------------------------------- -// Allocate locals for values -//-------------------------------------------------------------------------- - -and AllocLocal cenv cgbuf eenv compgen (v,ty,isFixed) (scopeMarks: Mark * Mark) = +/// Allocate IL locals +and AllocLocal cenv cgbuf eenv compgen (v, ty, isFixed) (scopeMarks: Mark * Mark) = // The debug range for the local - let ranges = if compgen then [] else [(v,scopeMarks)] + let ranges = if compgen then [] else [(v, scopeMarks)] // Get an index for the local - let j, realloc = - if cenv.opts.localOptimizationsAreOn then - cgbuf.ReallocLocal((fun i (_,ty',isFixed') -> not isFixed' && not isFixed && not (IntMap.mem i eenv.liveLocals) && (ty = ty')),ranges,ty,isFixed) - else - cgbuf.AllocLocal(ranges,ty,isFixed), false + let j, realloc = + if cenv.opts.localOptimizationsAreOn then + cgbuf.ReallocLocal((fun i (_, ty', isFixed') -> not isFixed' && not isFixed && not (IntMap.mem i eenv.liveLocals) && (ty = ty')), ranges, ty, isFixed) + else + cgbuf.AllocLocal(ranges, ty, isFixed), false j, realloc, { eenv with liveLocals = IntMap.add j () eenv.liveLocals } -and AllocLocalVal cenv cgbuf v eenv repr scopeMarks = - let repr,eenv = +/// Decide storage for local value and if necessary allocate an ILLocal for it +and AllocLocalVal cenv cgbuf v eenv repr scopeMarks = + let repr, eenv = let ty = v.Type - if isUnitTy cenv.g ty && not v.IsMutable then Null,eenv - elif Option.isSome repr && IsNamedLocalTypeFuncVal cenv.g v (Option.get repr) then - (* known, named, non-escaping type functions *) - let cloinfoGenerate eenv = - let eenvinner = - {eenv with - letBoundVars=(mkLocalValRef v)::eenv.letBoundVars} - let cloinfo,_,_ = GetIlxClosureInfo cenv v.Range true None eenvinner (Option.get repr) - cloinfo - - let idx, realloc, eenv = AllocLocal cenv cgbuf eenv v.IsCompilerGenerated (v.CompiledName, cenv.g.ilg.typ_Object, false) scopeMarks - Local (idx, realloc, Some(ref (NamedLocalIlxClosureInfoGenerator cloinfoGenerate))),eenv + if isUnitTy cenv.g ty && not v.IsMutable then Null, eenv else - (* normal local *) - let idx, realloc, eenv = AllocLocal cenv cgbuf eenv v.IsCompilerGenerated (v.CompiledName, GenTypeOfVal cenv eenv v, v.IsFixed) scopeMarks - Local (idx,realloc, None),eenv - let eenv = AddStorageForVal cenv.g (v,notlazy repr) eenv + match repr with + | Some r when IsNamedLocalTypeFuncVal cenv.g v r -> + // known, named, non-escaping type functions + let cloinfoGenerate eenv = + let eenvinner = + {eenv with + letBoundVars=(mkLocalValRef v)::eenv.letBoundVars} + let cloinfo, _, _ = GetIlxClosureInfo cenv v.Range true None eenvinner (Option.get repr) + cloinfo + + let idx, realloc, eenv = AllocLocal cenv cgbuf eenv v.IsCompilerGenerated (v.CompiledName, cenv.g.ilg.typ_Object, false) scopeMarks + Local (idx, realloc, Some(ref (NamedLocalIlxClosureInfoGenerator cloinfoGenerate))), eenv + | _ -> + // normal local + let idx, realloc, eenv = AllocLocal cenv cgbuf eenv v.IsCompilerGenerated (v.CompiledName, GenTypeOfVal cenv eenv v, v.IsFixed) scopeMarks + Local (idx, realloc, None), eenv + let eenv = AddStorageForVal cenv.g (v, notlazy repr) eenv Some repr, eenv -and AllocStorageForBind cenv cgbuf scopeMarks eenv bind = +and AllocStorageForBind cenv cgbuf scopeMarks eenv bind = AllocStorageForBinds cenv cgbuf scopeMarks eenv [bind] -and AllocStorageForBinds cenv cgbuf scopeMarks eenv binds = - // phase 1 - decide representations - most are very simple. - let reps, eenv = List.mapFold (AllocValForBind cenv cgbuf scopeMarks) eenv binds - - // Phase 2 - run the cloinfo generators for NamedLocalClosure values against the environment recording the - // representation choices. - reps |> List.iter (fun reprOpt -> - match reprOpt with - | Some repr -> - match repr with - | Local(_, _, Some g) - | Env(_,_,_,Some g) -> - match !g with - | NamedLocalIlxClosureInfoGenerator f -> g := NamedLocalIlxClosureInfoGenerated (f eenv) +and AllocStorageForBinds cenv cgbuf scopeMarks eenv binds = + // phase 1 - decide representations - most are very simple. + let reps, eenv = List.mapFold (AllocValForBind cenv cgbuf scopeMarks) eenv binds + + // Phase 2 - run the cloinfo generators for NamedLocalClosure values against the environment recording the + // representation choices. + reps |> List.iter (fun reprOpt -> + match reprOpt with + | Some repr -> + match repr with + | Local(_, _, Some g) + | Env(_, _, _, Some g) -> + match !g with + | NamedLocalIlxClosureInfoGenerator f -> g := NamedLocalIlxClosureInfoGenerated (f eenv) | NamedLocalIlxClosureInfoGenerated _ -> () | _ -> () | _ -> ()) eenv - -and AllocValForBind cenv cgbuf (scopeMarks: Mark * Mark) eenv (TBind(v,repr,_)) = - match v.ValReprInfo with - | None -> + +and AllocValForBind cenv cgbuf (scopeMarks: Mark * Mark) eenv (TBind(v, repr, _)) = + match v.ValReprInfo with + | None -> AllocLocalVal cenv cgbuf v eenv (Some repr) scopeMarks - | Some _ -> - None,AllocTopValWithinExpr cenv cgbuf eenv.cloc scopeMarks v eenv + | Some _ -> + None, AllocTopValWithinExpr cenv cgbuf eenv.cloc scopeMarks v eenv and AllocTopValWithinExpr cenv cgbuf cloc scopeMarks v eenv = // decide whether to use a shadow local or not - let useShadowLocal = - cenv.opts.generateDebugSymbols && + let useShadowLocal = + cenv.opts.generateDebugSymbols && not cenv.opts.localOptimizationsAreOn && not v.IsCompilerGenerated && not v.IsMutable && // Don't use shadow locals for things like functions which are not compiled as static values/properties IsCompiledAsStaticProperty cenv.g v - let optShadowLocal,eenv = - if useShadowLocal then - let storageOpt, eenv = AllocLocalVal cenv cgbuf v eenv None scopeMarks - match storageOpt with - | None -> NoShadowLocal,eenv - | Some storage -> ShadowLocal storage,eenv - - else - NoShadowLocal,eenv + let optShadowLocal, eenv = + if useShadowLocal then + let storageOpt, eenv = AllocLocalVal cenv cgbuf v eenv None scopeMarks + match storageOpt with + | None -> NoShadowLocal, eenv + | Some storage -> ShadowLocal storage, eenv + + else + NoShadowLocal, eenv ComputeAndAddStorageForLocalTopVal (cenv.amap, cenv.g, cenv.intraAssemblyInfo, cenv.opts.isInteractive, optShadowLocal) cloc v eenv @@ -5931,44 +6099,44 @@ and AllocTopValWithinExpr cenv cgbuf cloc scopeMarks v eenv = //-------------------------------------------------------------------------- // Generate stack save/restore and assertions - pulled into letrec by alloc* -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- /// Save the stack /// - [gross] because IL flushes the stack at the exn. handler /// - and because IL requires empty stack following a forward br (jump). and EmitSaveStack cenv cgbuf eenv m scopeMarks = let savedStack = (cgbuf.GetCurrentStack()) - let savedStackLocals,eenvinner = - (eenv, savedStack) ||> List.mapFold (fun eenv ty -> - let idx, _realloc, eenv = AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("spill",m), ty, false) scopeMarks - idx, eenv) + let savedStackLocals, eenvinner = + (eenv, savedStack) ||> List.mapFold (fun eenv ty -> + let idx, _realloc, eenv = AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("spill", m), ty, false) scopeMarks + idx, eenv) List.iter (EmitSetLocal cgbuf) savedStackLocals cgbuf.AssertEmptyStack() - (savedStack,savedStackLocals),eenvinner (* need to return, it marks locals "live" *) + (savedStack, savedStackLocals), eenvinner (* need to return, it marks locals "live" *) -/// Restore the stack and load the result -and EmitRestoreStack cgbuf (savedStack,savedStackLocals) = +/// Restore the stack and load the result +and EmitRestoreStack cgbuf (savedStack, savedStackLocals) = cgbuf.AssertEmptyStack() List.iter2 (EmitGetLocal cgbuf) (List.rev savedStack) (List.rev savedStackLocals) //------------------------------------------------------------------------- //GenAttr: custom attribute generation -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- -and GenAttribArg amap g eenv x (ilArgTy:ILType) = +and GenAttribArg amap g eenv x (ilArgTy:ILType) = - match x,ilArgTy with + match x, ilArgTy with // Detect 'null' used for an array argument - | Expr.Const(Const.Zero,_,_),ILType.Array _ -> + | Expr.Const(Const.Zero, _, _), ILType.Array _ -> ILAttribElem.Null - // Detect standard constants - | Expr.Const(c,m,_),_ -> + // Detect standard constants + | Expr.Const(c, m, _), _ -> let tynm = ilArgTy.TypeSpec.Name let isobj = (tynm = "System.Object") - match c with + match c with | Const.Bool b -> ILAttribElem.Bool b | Const.Int32 i when isobj || tynm = "System.Int32" -> ILAttribElem.Int32 ( i) | Const.Int32 i when tynm = "System.SByte" -> ILAttribElem.SByte (sbyte i) @@ -5976,11 +6144,11 @@ and GenAttribArg amap g eenv x (ilArgTy:ILType) = | Const.Int32 i when tynm = "System.Byte" -> ILAttribElem.Byte (byte i) | Const.Int32 i when tynm = "System.UInt16" ->ILAttribElem.UInt16 (uint16 i) | Const.Int32 i when tynm = "System.UInt32" ->ILAttribElem.UInt32 (uint32 i) - | Const.Int32 i when tynm = "System.UInt64" ->ILAttribElem.UInt64 (uint64 (int64 i)) + | Const.Int32 i when tynm = "System.UInt64" ->ILAttribElem.UInt64 (uint64 (int64 i)) | Const.SByte i -> ILAttribElem.SByte i | Const.Int16 i -> ILAttribElem.Int16 i | Const.Int32 i -> ILAttribElem.Int32 i - | Const.Int64 i -> ILAttribElem.Int64 i + | Const.Int64 i -> ILAttribElem.Int64 i | Const.Byte i -> ILAttribElem.Byte i | Const.UInt16 i -> ILAttribElem.UInt16 i | Const.UInt32 i -> ILAttribElem.UInt32 i @@ -5992,193 +6160,193 @@ and GenAttribArg amap g eenv x (ilArgTy:ILType) = | Const.Zero when tynm = "System.String" -> ILAttribElem.String None | Const.Zero when tynm = "System.Type" -> ILAttribElem.Type None | Const.String i when isobj || tynm = "System.String" -> ILAttribElem.String (Some i) - | _ -> error (InternalError ( "The type '" + tynm + "' may not be used as a custom attribute value",m)) + | _ -> error (InternalError ( "The type '" + tynm + "' may not be used as a custom attribute value", m)) - // Detect '[| ... |]' nodes - | Expr.Op(TOp.Array,[elemTy],args,m),_ -> + // Detect '[| ... |]' nodes + | Expr.Op(TOp.Array, [elemTy], args, m), _ -> let ilElemTy = GenType amap m eenv.tyenv elemTy ILAttribElem.Array (ilElemTy, List.map (fun arg -> GenAttribArg amap g eenv arg ilElemTy) args) - // Detect 'typeof' calls + // Detect 'typeof' calls | TypeOfExpr g ty, _ -> ILAttribElem.Type (Some (GenType amap x.Range eenv.tyenv ty)) - // Detect 'typedefof' calls + // Detect 'typedefof' calls | TypeDefOfExpr g ty, _ -> - ILAttribElem.TypeRef (Some (GenType amap x.Range eenv.tyenv ty).TypeRef) - - // Ignore upcasts - | Expr.Op(TOp.Coerce,_,[arg2],_),_ -> + ILAttribElem.TypeRef (Some (GenType amap x.Range eenv.tyenv ty).TypeRef) + + // Ignore upcasts + | Expr.Op(TOp.Coerce, _, [arg2], _), _ -> GenAttribArg amap g eenv arg2 ilArgTy - // Detect explicit enum values + // Detect explicit enum values | EnumExpr g arg1, _ -> GenAttribArg amap g eenv arg1 ilArgTy - + // Detect bitwise or of attribute flags: one case of constant folding (a more general treatment is needed) - - | AttribBitwiseOrExpr g (arg1,arg2),_ -> - let v1 = GenAttribArg amap g eenv arg1 ilArgTy - let v2 = GenAttribArg amap g eenv arg2 ilArgTy - match v1,v2 with - | ILAttribElem.SByte i1, ILAttribElem.SByte i2 -> ILAttribElem.SByte (i1 ||| i2) + + | AttribBitwiseOrExpr g (arg1, arg2), _ -> + let v1 = GenAttribArg amap g eenv arg1 ilArgTy + let v2 = GenAttribArg amap g eenv arg2 ilArgTy + match v1, v2 with + | ILAttribElem.SByte i1, ILAttribElem.SByte i2 -> ILAttribElem.SByte (i1 ||| i2) | ILAttribElem.Int16 i1, ILAttribElem.Int16 i2-> ILAttribElem.Int16 (i1 ||| i2) | ILAttribElem.Int32 i1, ILAttribElem.Int32 i2-> ILAttribElem.Int32 (i1 ||| i2) | ILAttribElem.Int64 i1, ILAttribElem.Int64 i2-> ILAttribElem.Int64 (i1 ||| i2) | ILAttribElem.Byte i1, ILAttribElem.Byte i2-> ILAttribElem.Byte (i1 ||| i2) - | ILAttribElem.UInt16 i1, ILAttribElem.UInt16 i2-> ILAttribElem.UInt16 (i1 ||| i2) - | ILAttribElem.UInt32 i1, ILAttribElem.UInt32 i2-> ILAttribElem.UInt32 (i1 ||| i2) + | ILAttribElem.UInt16 i1, ILAttribElem.UInt16 i2-> ILAttribElem.UInt16 (i1 ||| i2) + | ILAttribElem.UInt32 i1, ILAttribElem.UInt32 i2-> ILAttribElem.UInt32 (i1 ||| i2) | ILAttribElem.UInt64 i1, ILAttribElem.UInt64 i2-> ILAttribElem.UInt64 (i1 ||| i2) - | _ -> error (InternalError ("invalid custom attribute value (not a valid constant): " + showL (exprL x),x.Range)) + | _ -> error (InternalError ("invalid custom attribute value (not a valid constant): " + showL (exprL x), x.Range)) // Other expressions are not valid custom attribute values - | _ -> - error (InternalError ("invalid custom attribute value (not a constant): " + showL (exprL x),x.Range)) + | _ -> + error (InternalError ("invalid custom attribute value (not a constant): " + showL (exprL x), x.Range)) -and GenAttr amap g eenv (Attrib(_,k,args,props,_,_,_)) = - let props = - props |> List.map (fun (AttribNamedArg(s,ty,fld,AttribExpr(_,expr))) -> +and GenAttr amap g eenv (Attrib(_, k, args, props, _, _, _)) = + let props = + props |> List.map (fun (AttribNamedArg(s, ty, fld, AttribExpr(_, expr))) -> let m = expr.Range let ilTy = GenType amap m eenv.tyenv ty let cval = GenAttribArg amap g eenv expr ilTy - (s,ilTy,fld,cval)) - let mspec = - match k with - | ILAttrib(mref) -> mkILMethSpec(mref,AsObject,[],[]) - | FSAttrib(vref) -> - assert(vref.IsMember) - let mspec,_,_,_,_,_ = GetMethodSpecForMemberVal amap g (Option.get vref.MemberInfo) vref + (s, ilTy, fld, cval)) + let mspec = + match k with + | ILAttrib(mref) -> mkILMethSpec(mref, AsObject, [], []) + | FSAttrib(vref) -> + assert(vref.IsMember) + let mspec, _, _, _, _, _ = GetMethodSpecForMemberVal amap g (Option.get vref.MemberInfo) vref mspec - let ilArgs = List.map2 (fun (AttribExpr(_,vexpr)) ty -> GenAttribArg amap g eenv vexpr ty) args mspec.FormalArgTypes - mkILCustomAttribMethRef g.ilg (mspec,ilArgs, props) - + let ilArgs = List.map2 (fun (AttribExpr(_, vexpr)) ty -> GenAttribArg amap g eenv vexpr ty) args mspec.FormalArgTypes + mkILCustomAttribMethRef g.ilg (mspec, ilArgs, props) + and GenAttrs cenv eenv attrs = List.map (GenAttr cenv.amap cenv.g eenv) attrs and GenCompilationArgumentCountsAttr cenv (v:Val) = - [ match v.ValReprInfo with - | Some(tvi) when v.IsMemberOrModuleBinding -> - let arities = if ValSpecIsCompiledAsInstance cenv.g v then List.tail tvi.AritiesOfArgs else tvi.AritiesOfArgs - if arities.Length > 1 then + [ match v.ValReprInfo with + | Some(tvi) when v.IsMemberOrModuleBinding -> + let arities = if ValSpecIsCompiledAsInstance cenv.g v then List.tail tvi.AritiesOfArgs else tvi.AritiesOfArgs + if arities.Length > 1 then yield mkCompilationArgumentCountsAttr cenv.g arities - | _ -> - () ] + | _ -> + () ] -// Create a permission set for a list of security attributes -and CreatePermissionSets cenv eenv (securityAttributes : Attrib list) = - [for ((Attrib(tcref,_,actions,_,_,_,_)) as attr) in securityAttributes do +// Create a permission set for a list of security attributes +and CreatePermissionSets cenv eenv (securityAttributes : Attrib list) = + [for ((Attrib(tcref, _, actions, _, _, _, _)) as attr) in securityAttributes do let action = match actions with | [AttribInt32Arg act] -> act | _ -> failwith "internal error: unrecognized security action" let secaction = (List.assoc action (Lazy.force ILSecurityActionRevMap)) let tref = tcref.CompiledRepresentationForNamedType let ilattr = GenAttr cenv.amap cenv.g eenv attr - let _, ilNamedArgs = + let _, ilNamedArgs = match TryDecodeILAttribute cenv.g tref (mkILCustomAttrs [ilattr]) with - | Some(ae,na) -> ae, na - | _ -> [],[] - let setArgs = ilNamedArgs |> List.map (fun (n,ilt,_,ilae) -> (n,ilt,ilae)) + | Some(ae, na) -> ae, na + | _ -> [], [] + let setArgs = ilNamedArgs |> List.map (fun (n, ilt, _, ilae) -> (n, ilt, ilae)) yield IL.mkPermissionSet cenv.g.ilg (secaction, [(tref, setArgs)])] //-------------------------------------------------------------------------- // Generate the set of modules for an assembly, and the declarations in each module -//-------------------------------------------------------------------------- +//-------------------------------------------------------------------------- /// Generate a static class at the given cloc -and GenTypeDefForCompLoc (cenv, eenv, mgbuf: AssemblyBuilder, cloc, hidden, attribs, initTrigger, eliminateIfEmpty, addAtEnd) = +and GenTypeDefForCompLoc (cenv, eenv, mgbuf: AssemblyBuilder, cloc, hidden, attribs, initTrigger, eliminateIfEmpty, addAtEnd) = let tref = TypeRefForCompLoc cloc - let tdef = + let tdef = mkILSimpleClass cenv.g.ilg - (tref.Name, + (tref.Name, ComputeTypeAccess tref hidden, - emptyILMethods, + emptyILMethods, emptyILFields, emptyILTypeDefs, emptyILProperties, emptyILEvents, - mkILCustomAttrs + mkILCustomAttrs (GenAttrs cenv eenv attribs @ - (if List.contains tref.Name [TypeNameForImplicitMainMethod cloc; TypeNameForInitClass cloc; TypeNameForPrivateImplementationDetails cloc] - then [ ] + (if List.contains tref.Name [TypeNameForImplicitMainMethod cloc; TypeNameForInitClass cloc; TypeNameForPrivateImplementationDetails cloc] + then [ ] else [mkCompilationMappingAttr cenv.g (int SourceConstructFlags.Module)])), initTrigger) let tdef = tdef.WithSealed(true).WithAbstract(true) mgbuf.AddTypeDef(tref, tdef, eliminateIfEmpty, addAtEnd, None) -and GenModuleExpr cenv cgbuf qname lazyInitInfo eenv x = - let (ModuleOrNamespaceExprWithSig(mty, def, _)) = x - // REVIEW: the scopeMarks are used for any shadow locals we create for the module bindings +and GenModuleExpr cenv cgbuf qname lazyInitInfo eenv x = + let (ModuleOrNamespaceExprWithSig(mty, def, _)) = x + // REVIEW: the scopeMarks are used for any shadow locals we create for the module bindings // We use one scope for all the bindings in the module, which makes them all appear with their "default" values - // rather than incrementally as we step through the initializations in the module. This is a little unfortunate + // rather than incrementally as we step through the initializations in the module. This is a little unfortunate // but stems from the way we add module values all at once before we generate the module itself. LocalScope "module" cgbuf (fun scopeMarks -> let sigToImplRemapInfo = ComputeRemappingFromImplementationToSignature cenv.g def mty let eenv = AddSignatureRemapInfo "defs" sigToImplRemapInfo eenv - let eenv = + let eenv = // Allocate all the values, including any shadow locals for static fields let allocVal cloc v = AllocTopValWithinExpr cenv cgbuf cloc scopeMarks v AddBindingsForModuleDef allocVal eenv.cloc eenv def GenModuleDef cenv cgbuf qname lazyInitInfo eenv def) -and GenModuleDefs cenv cgbuf qname lazyInitInfo eenv mdefs = - mdefs |> List.iter (GenModuleDef cenv cgbuf qname lazyInitInfo eenv) - -and GenModuleDef cenv (cgbuf:CodeGenBuffer) qname lazyInitInfo eenv x = - match x with - | TMDefRec(_isRec,tycons,mbinds,m) -> - tycons |> List.iter (fun tc -> - if tc.IsExceptionDecl - then GenExnDef cenv cgbuf.mgbuf eenv m tc +and GenModuleDefs cenv cgbuf qname lazyInitInfo eenv mdefs = + mdefs |> List.iter (GenModuleDef cenv cgbuf qname lazyInitInfo eenv) + +and GenModuleDef cenv (cgbuf:CodeGenBuffer) qname lazyInitInfo eenv x = + match x with + | TMDefRec(_isRec, tycons, mbinds, m) -> + tycons |> List.iter (fun tc -> + if tc.IsExceptionDecl + then GenExnDef cenv cgbuf.mgbuf eenv m tc else GenTypeDef cenv cgbuf.mgbuf lazyInitInfo eenv m tc) - mbinds |> List.iter (GenModuleBinding cenv cgbuf qname lazyInitInfo eenv m) + mbinds |> List.iter (GenModuleBinding cenv cgbuf qname lazyInitInfo eenv m) - | TMDefLet(bind,_) -> + | TMDefLet(bind, _) -> GenBindings cenv cgbuf eenv [bind] - | TMDefDo(e,_) -> + | TMDefDo(e, _) -> GenExpr cenv cgbuf eenv SPAlways e discard - | TMAbstract(mexpr) -> + | TMAbstract(mexpr) -> GenModuleExpr cenv cgbuf qname lazyInitInfo eenv mexpr - | TMDefs(mdefs) -> + | TMDefs(mdefs) -> GenModuleDefs cenv cgbuf qname lazyInitInfo eenv mdefs // Generate a module binding -and GenModuleBinding cenv (cgbuf:CodeGenBuffer) (qname:QualifiedNameOfFile) lazyInitInfo eenv m x = - match x with - | ModuleOrNamespaceBinding.Binding bind -> - GenLetRecBindings cenv cgbuf eenv ([bind],m) +and GenModuleBinding cenv (cgbuf:CodeGenBuffer) (qname:QualifiedNameOfFile) lazyInitInfo eenv m x = + match x with + | ModuleOrNamespaceBinding.Binding bind -> + GenLetRecBindings cenv cgbuf eenv ([bind], m) | ModuleOrNamespaceBinding.Module (mspec, mdef) -> let hidden = IsHiddenTycon eenv.sigToImplRemapInfo mspec - let eenvinner = - if mspec.IsNamespace then eenv else + let eenvinner = + if mspec.IsNamespace then eenv else {eenv with cloc = CompLocForFixedModule cenv.opts.fragName qname.Text mspec } - // Create the class to hold the contents of this module. No class needed if - // we're compiling it as a namespace. + // Create the class to hold the contents of this module. No class needed if + // we're compiling it as a namespace. // - // Most module static fields go into the "InitClass" static class. - // However mutable static fields go into the class for the module itself. - // So this static class ends up with a .cctor if it has mutable fields. + // Most module static fields go into the "InitClass" static class. + // However mutable static fields go into the class for the module itself. + // So this static class ends up with a .cctor if it has mutable fields. // - if not mspec.IsNamespace then - // The use of ILTypeInit.OnAny prevents the execution of the cctor before the + if not mspec.IsNamespace then + // The use of ILTypeInit.OnAny prevents the execution of the cctor before the // "main" method in the case where the "main" method is implicit. let staticClassTrigger = (* if eenv.isFinalFile then *) ILTypeInit.OnAny (* else ILTypeInit.BeforeField *) GenTypeDefForCompLoc (cenv, eenvinner, cgbuf.mgbuf, eenvinner.cloc, hidden, mspec.Attribs, staticClassTrigger, false, (* atEnd= *) true) - // Generate the declarations in the module and its initialization code + // Generate the declarations in the module and its initialization code GenModuleDef cenv cgbuf qname lazyInitInfo eenvinner mdef - - // If the module has a .cctor for some mutable fields, we need to ensure that when - // those fields are "touched" the InitClass .cctor is forced. The InitClass .cctor will + + // If the module has a .cctor for some mutable fields, we need to ensure that when + // those fields are "touched" the InitClass .cctor is forced. The InitClass .cctor will // then fill in the value of the mutable fields. - if not mspec.IsNamespace && (cgbuf.mgbuf.GetCurrentFields(TypeRefForCompLoc eenvinner.cloc) |> Seq.isEmpty |> not) then + if not mspec.IsNamespace && (cgbuf.mgbuf.GetCurrentFields(TypeRefForCompLoc eenvinner.cloc) |> Seq.isEmpty |> not) then GenForceWholeFileInitializationAsPartOfCCtor cenv cgbuf.mgbuf lazyInitInfo (TypeRefForCompLoc eenvinner.cloc) mspec.Range @@ -6191,57 +6359,57 @@ and GenTopImpl cenv (mgbuf: AssemblyBuilder) mainInfoOpt eenv (TImplFile(qname, for anonInfo in anonRecdTypes.Values do mgbuf.GenerateAnonType((fun ilThisTy -> GenToStringMethod cenv eenv ilThisTy m), anonInfo) |> ignore - let eenv = {eenv with cloc = { eenv.cloc with clocTopImplQualifiedName = qname.Text } } + let eenv = {eenv with cloc = { eenv.cloc with TopImplQualifiedName = qname.Text } } cenv.optimizeDuringCodeGen <- optimizeDuringCodeGen - // This is used to point the inner classes back to the startup module for initialization purposes + // This is used to point the inner classes back to the startup module for initialization purposes let isFinalFile = Option.isSome mainInfoOpt - let initClassCompLoc = CompLocForInitClass eenv.cloc - let initClassTy = mkILTyForCompLoc initClassCompLoc + let initClassCompLoc = CompLocForInitClass eenv.cloc + let initClassTy = mkILTyForCompLoc initClassCompLoc let initClassTrigger = (* if isFinalFile then *) ILTypeInit.OnAny (* else ILTypeInit.BeforeField *) - + let eenv = {eenv with cloc = initClassCompLoc isFinalFile = isFinalFile - someTypeInThisAssembly = initClassTy } - - // Create the class to hold the initialization code and static fields for this file. + someTypeInThisAssembly = initClassTy } + + // Create the class to hold the initialization code and static fields for this file. // internal static class $ {} // Put it at the end since that gives an approximation of dependency order (to aid FSI.EXE's code generator - see FSharp 1.0 5548) - GenTypeDefForCompLoc (cenv, eenv, mgbuf, initClassCompLoc, useHiddenInitCode, [], initClassTrigger, false, (*atEnd=*)true) - + GenTypeDefForCompLoc (cenv, eenv, mgbuf, initClassCompLoc, useHiddenInitCode, [], initClassTrigger, false, (*atEnd=*)true) + // lazyInitInfo is an accumulator of functions which add the forced initialization of the storage module to // - mutable fields in public modules - // - static "let" bindings in types + // - static "let" bindings in types // These functions only get executed/committed if we actually end up producing some code for the .cctor for the storage module. - // The existence of .cctors adds costs to execution, so this is a half-sensible attempt to avoid adding them when possible. + // The existence of .cctors adds costs to execution, so this is a half-sensible attempt to avoid adding them when possible. let lazyInitInfo = new ResizeArray ILInstr list -> ILInstr list -> unit>() // codegen .cctor/main for outer module let clocCcu = CompLocForCcu cenv.viewCcu - + // This method name is only used internally in ilxgen.fs to aid debugging - let methodName = - match mainInfoOpt with - // Library file - | None -> ".cctor" - // Final file, explicit entry point + let methodName = + match mainInfoOpt with + // Library file + | None -> ".cctor" + // Final file, explicit entry point | Some _ when hasExplicitEntryPoint -> ".cctor" - // Final file, implicit entry point - | Some _ -> mainMethName - + // Final file, implicit entry point + | Some _ -> mainMethName + // topInstrs is ILInstr[] and contains the abstract IL for this file's top-level actions. topCode is the ILMethodBody for that same code. - let topInstrs,topCode = - CodeGenMethod cenv mgbuf - ([],methodName,eenv,0, - (fun cgbuf eenv -> + let topInstrs, topCode = + CodeGenMethod cenv mgbuf + ([], methodName, eenv, 0, + (fun cgbuf eenv -> GenModuleExpr cenv cgbuf qname lazyInitInfo eenv mexpr - CG.EmitInstr cgbuf (pop 0) Push0 I_ret),m) + CG.EmitInstr cgbuf (pop 0) Push0 I_ret), m) // The code generation for the initialization is now complete and the IL code is in topCode. - // Make a .cctor and/or main method to contain the code. This initializes all modules. + // Make a .cctor and/or main method to contain the code. This initializes all modules. // Library file (mainInfoOpt = None) : optional .cctor if topCode has initialization effect // Final file, explicit entry point (mainInfoOpt = Some _, GetExplicitEntryPointInfo() = Some) : main + optional .cctor if topCode has initialization effect // Final file, implicit entry point (mainInfoOpt = Some _, GetExplicitEntryPointInfo() = None) : main + initialize + optional .cctor calling initialize @@ -6249,212 +6417,212 @@ and GenTopImpl cenv (mgbuf: AssemblyBuilder) mainInfoOpt eenv (TImplFile(qname, // Make a FEEFEE instruction to mark hidden code regions // We expect the first instruction to be a sequence point when generating debug symbols - let feefee, seqpt = - if topInstrs.Length > 1 then - match topInstrs.[0] with + let feefee, seqpt = + if topInstrs.Length > 1 then + match topInstrs.[0] with | I_seqpoint sp as i -> [ FeeFeeInstr cenv sp.Document ], [ i ] - | _ -> [], [] - else + | _ -> [], [] + else [], [] begin - match mainInfoOpt with + match mainInfoOpt with // Final file in .EXE - | Some mainInfo -> + | Some mainInfo -> - // Generate an explicit main method. If necessary, make a class constructor as - // well for the bindings earlier in the file containing the entrypoint. + // Generate an explicit main method. If necessary, make a class constructor as + // well for the bindings earlier in the file containing the entrypoint. match mgbuf.GetExplicitEntryPointInfo() with // Final file, explicit entry point : place the code in a .cctor, and add code to main that forces the .cctor (if topCode has initialization effect). - | Some tref -> + | Some tref -> if doesSomething then - lazyInitInfo.Add (fun fspec feefee seqpt -> + lazyInitInfo.Add (fun fspec feefee seqpt -> // This adds the explicit init of the .cctor to the explicit entrypoint main method mgbuf.AddExplicitInitToSpecificMethodDef((fun md -> md.IsEntryPoint), tref, fspec, GenPossibleILSourceMarker cenv m, feefee, seqpt)) - let cctorMethDef = mkILClassCtor (MethodBody.IL topCode) - mgbuf.AddMethodDef(initClassTy.TypeRef,cctorMethDef) + let cctorMethDef = mkILClassCtor (MethodBody.IL topCode) + mgbuf.AddMethodDef(initClassTy.TypeRef, cctorMethDef) // Final file, implicit entry point. We generate no .cctor. - // void main@() { - // + // void main@() { + // // } | None -> let ilAttrs = mkILCustomAttrs (GenAttrs cenv eenv mainInfo) - if not cenv.opts.isInteractive && not doesSomething then + if not cenv.opts.isInteractive && not doesSomething then let errorM = m.EndRange warning (Error(FSComp.SR.ilMainModuleEmpty(), errorM)) - // generate main@ - let ilMainMethodDef = - let mdef = mkILNonGenericStaticMethod(mainMethName,ILMemberAccess.Public,[],mkILReturn ILType.Void, MethodBody.IL topCode) + // generate main@ + let ilMainMethodDef = + let mdef = mkILNonGenericStaticMethod(mainMethName, ILMemberAccess.Public, [], mkILReturn ILType.Void, MethodBody.IL topCode) mdef.With(isEntryPoint= true, customAttrs = ilAttrs) - mgbuf.AddMethodDef(initClassTy.TypeRef,ilMainMethodDef) + mgbuf.AddMethodDef(initClassTy.TypeRef, ilMainMethodDef) // Library file : generate an optional .cctor if topCode has initialization effect - | None -> - if doesSomething then + | None -> + if doesSomething then + + // Add the cctor + let cctorMethDef = mkILClassCtor (MethodBody.IL topCode) + mgbuf.AddMethodDef(initClassTy.TypeRef, cctorMethDef) - // Add the cctor - let cctorMethDef = mkILClassCtor (MethodBody.IL topCode) - mgbuf.AddMethodDef(initClassTy.TypeRef,cctorMethDef) - end - + // Commit the directed initializations - if doesSomething then - // Create the field to act as the target for the forced initialization. + if doesSomething then + // Create the field to act as the target for the forced initialization. // Why do this for the final file? // There is no need to do this for a final file with an implicit entry point. For an explicit entry point in lazyInitInfo. let initFieldName = CompilerGeneratedName "init" - let ilFieldDef = - mkILStaticField (initFieldName,cenv.g.ilg.typ_Int32, None, None, ComputeMemberAccess true) - |> cenv.g.AddFieldNeverAttrs - |> cenv.g.AddFieldGeneratedAttrs + let ilFieldDef = + mkILStaticField (initFieldName, cenv.g.ilg.typ_Int32, None, None, ComputeMemberAccess true) + |> cenv.g.AddFieldNeverAttrs + |> cenv.g.AddFieldGeneratedAttrs let fspec = mkILFieldSpecInTy (initClassTy, initFieldName, cenv. g.ilg.typ_Int32) CountStaticFieldDef() - mgbuf.AddFieldDef(initClassTy.TypeRef,ilFieldDef) + mgbuf.AddFieldDef(initClassTy.TypeRef, ilFieldDef) - // Run the imperative (yuck!) actions that force the generation - // of references to the cctor for nested modules etc. + // Run the imperative (yuck!) actions that force the generation + // of references to the cctor for nested modules etc. lazyInitInfo |> Seq.iter (fun f -> f fspec feefee seqpt) - if isScript && not(isFinalFile) then - mgbuf.AddScriptInitFieldSpec(fspec,m) + if isScript && not(isFinalFile) then + mgbuf.AddScriptInitFieldSpec(fspec, m) // Compute the ilxgenEnv after the generation of the module, i.e. the residue need to generate anything that // uses the constructs exported from this module. // We add the module type all over again. Note no shadow locals for static fields needed here since they are only relevant to the main/.cctor - let eenvafter = - let allocVal = ComputeAndAddStorageForLocalTopVal (cenv.amap, cenv.g, cenv.intraAssemblyInfo, cenv.opts.isInteractive, NoShadowLocal) + let eenvafter = + let allocVal = ComputeAndAddStorageForLocalTopVal (cenv.amap, cenv.g, cenv.intraAssemblyInfo, cenv.opts.isInteractive, NoShadowLocal) AddBindingsForLocalModuleType allocVal clocCcu eenv mexpr.Type eenvafter and GenForceWholeFileInitializationAsPartOfCCtor cenv (mgbuf:AssemblyBuilder) (lazyInitInfo: ResizeArray<_>) tref m = - // Authoring a .cctor with effects forces the cctor for the 'initialization' module by doing a dummy store & load of a field - // Doing both a store and load keeps FxCop happier because it thinks the field is useful - lazyInitInfo.Add (fun fspec feefee seqpt -> mgbuf.AddExplicitInitToSpecificMethodDef((fun md -> md.Name = ".cctor"), tref, fspec, GenPossibleILSourceMarker cenv m, feefee, seqpt)) + // Authoring a .cctor with effects forces the cctor for the 'initialization' module by doing a dummy store & load of a field + // Doing both a store and load keeps FxCop happier because it thinks the field is useful + lazyInitInfo.Add (fun fspec feefee seqpt -> mgbuf.AddExplicitInitToSpecificMethodDef((fun md -> md.Name = ".cctor"), tref, fspec, GenPossibleILSourceMarker cenv m, feefee, seqpt)) -/// Generate an Equals method. +/// Generate an Equals method. and GenEqualsOverrideCallingIComparable cenv (tcref:TyconRef, ilThisTy, _ilThatTy) = let mspec = mkILNonGenericInstanceMethSpecInTy (cenv.g.iltyp_IComparable, "CompareTo", [cenv.g.ilg.typ_Object], cenv.g.ilg.typ_Int32) - + mkILNonGenericVirtualMethod - ("Equals",ILMemberAccess.Public, - [mkILParamNamed ("obj",cenv.g.ilg.typ_Object)], + ("Equals", ILMemberAccess.Public, + [mkILParamNamed ("obj", cenv.g.ilg.typ_Object)], mkILReturn cenv.g.ilg.typ_Bool, - mkMethodBody(true,[],2, + mkMethodBody(true, [], 2, nonBranchingInstrsToCode [ yield mkLdarg0 - yield mkLdarg 1us - if tcref.IsStructOrEnumTycon then - yield I_callconstraint ( Normalcall, ilThisTy,mspec,None) - else - yield I_callvirt ( Normalcall, mspec,None) + yield mkLdarg 1us + if tcref.IsStructOrEnumTycon then + yield I_callconstraint ( Normalcall, ilThisTy, mspec, None) + else + yield I_callvirt ( Normalcall, mspec, None) yield mkLdcInt32 (0) - yield AI_ceq ], + yield AI_ceq ], None)) |> AddNonUserCompilerGeneratedAttribs cenv.g and GenFieldInit m c = - match c with + match c with | ConstToILFieldInit fieldInit -> fieldInit - | _ -> error(Error(FSComp.SR.ilTypeCannotBeUsedForLiteralField(),m)) + | _ -> error(Error(FSComp.SR.ilTypeCannotBeUsedForLiteralField(), m)) and GenAbstractBinding cenv eenv tref (vref:ValRef) = assert(vref.IsMember) let m = vref.Range let memberInfo = Option.get vref.MemberInfo let attribs = vref.Attribs - let hasPreserveSigImplFlag,hasSynchronizedImplFlag,hasNoInliningFlag,hasAggressiveInliningImplFlag,attribs = ComputeMethodImplAttribs cenv vref.Deref attribs - if memberInfo.MemberFlags.IsDispatchSlot && not memberInfo.IsImplemented then - let ilAttrs = - [ yield! GenAttrs cenv eenv attribs + let hasPreserveSigImplFlag, hasSynchronizedImplFlag, hasNoInliningFlag, hasAggressiveInliningImplFlag, attribs = ComputeMethodImplAttribs cenv vref.Deref attribs + if memberInfo.MemberFlags.IsDispatchSlot && not memberInfo.IsImplemented then + let ilAttrs = + [ yield! GenAttrs cenv eenv attribs yield! GenCompilationArgumentCountsAttr cenv vref.Deref ] - - let mspec,ctps,mtps,argInfos,retInfo,methodArgTys = GetMethodSpecForMemberVal cenv.amap cenv.g memberInfo vref + + let mspec, ctps, mtps, argInfos, retInfo, methodArgTys = GetMethodSpecForMemberVal cenv.amap cenv.g memberInfo vref let eenvForMeth = EnvForTypars (ctps@mtps) eenv let ilMethTypars = GenGenericParams cenv eenvForMeth mtps let ilReturn = GenReturnInfo cenv eenvForMeth mspec.FormalReturnType retInfo let ilParams = GenParams cenv eenvForMeth mspec argInfos methodArgTys None - + let compileAsInstance = ValRefIsCompiledAsInstanceMember cenv.g vref - let mdef = mkILGenericVirtualMethod (vref.CompiledName,ILMemberAccess.Public,ilMethTypars,ilParams,ilReturn,MethodBody.Abstract) + let mdef = mkILGenericVirtualMethod (vref.CompiledName, ILMemberAccess.Public, ilMethTypars, ilParams, ilReturn, MethodBody.Abstract) let mdef = fixupVirtualSlotFlags mdef - let mdef = - if mdef.IsVirtual then - mdef.WithFinal(memberInfo.MemberFlags.IsFinal).WithAbstract(memberInfo.MemberFlags.IsDispatchSlot) + let mdef = + if mdef.IsVirtual then + mdef.WithFinal(memberInfo.MemberFlags.IsFinal).WithAbstract(memberInfo.MemberFlags.IsDispatchSlot) else mdef let mdef = mdef.WithPreserveSig(hasPreserveSigImplFlag).WithSynchronized(hasSynchronizedImplFlag).WithNoInlining(hasNoInliningFlag).WithAggressiveInlining(hasAggressiveInliningImplFlag) - - match memberInfo.MemberFlags.MemberKind with - | MemberKind.ClassConstructor - | MemberKind.Constructor - | MemberKind.Member -> + + match memberInfo.MemberFlags.MemberKind with + | MemberKind.ClassConstructor + | MemberKind.Constructor + | MemberKind.Member -> let mdef = mdef.With(customAttrs= mkILCustomAttrs ilAttrs) [mdef], [], [] - | MemberKind.PropertyGetSet -> error(Error(FSComp.SR.ilUnexpectedGetSetAnnotation(),m)) + | MemberKind.PropertyGetSet -> error(Error(FSComp.SR.ilUnexpectedGetSetAnnotation(), m)) | MemberKind.PropertySet | MemberKind.PropertyGet -> let v = vref.Deref let vtyp = ReturnTypeOfPropertyVal cenv.g v - if CompileAsEvent cenv.g attribs then - - let edef = GenEventForProperty cenv eenvForMeth mspec v ilAttrs m vtyp - [],[],[edef] + if CompileAsEvent cenv.g attribs then + + let edef = GenEventForProperty cenv eenvForMeth mspec v ilAttrs m vtyp + [], [], [edef] else - let ilPropDef = + let ilPropDef = let ilPropTy = GenType cenv.amap m eenvForMeth.tyenv vtyp let ilArgTys = v |> ArgInfosOfPropertyVal cenv.g |> List.map fst |> GenTypes cenv.amap m eenvForMeth.tyenv GenPropertyForMethodDef compileAsInstance tref mdef v memberInfo ilArgTys ilPropTy (mkILCustomAttrs ilAttrs) None let mdef = mdef.WithSpecialName - [mdef], [ilPropDef],[] + [mdef], [ilPropDef], [] - else - [],[],[] + else + [], [], [] /// Generate a ToString method that calls 'sprintf "%A"' -and GenToStringMethod cenv eenv ilThisTy m = - [ match (eenv.valsInScope.TryFind cenv.g.sprintf_vref.Deref, +and GenToStringMethod cenv eenv ilThisTy m = + [ match (eenv.valsInScope.TryFind cenv.g.sprintf_vref.Deref, eenv.valsInScope.TryFind cenv.g.new_format_vref.Deref) with - | Some(Lazy(Method(_,_,sprintfMethSpec,_,_,_,_))), Some(Lazy(Method(_,_,newFormatMethSpec,_,_,_,_))) -> + | Some(Lazy(Method(_, _, sprintfMethSpec, _, _, _, _))), Some(Lazy(Method(_, _, newFormatMethSpec, _, _, _, _))) -> // The type returned by the 'sprintf' call let funcTy = EraseClosures.mkILFuncTy cenv.g.ilxPubCloEnv ilThisTy cenv.g.ilg.typ_String // Give the instantiation of the printf format object, i.e. a Format`5 object compatible with StringFormat - let newFormatMethSpec = mkILMethSpec(newFormatMethSpec.MethodRef,AsObject, + let newFormatMethSpec = mkILMethSpec(newFormatMethSpec.MethodRef, AsObject, [// 'T -> string' - funcTy + funcTy // rest follow from 'StringFormat' - GenUnitTy cenv eenv m - cenv.g.ilg.typ_String - cenv.g.ilg.typ_String - ilThisTy],[]) + GenUnitTy cenv eenv m + cenv.g.ilg.typ_String + cenv.g.ilg.typ_String + ilThisTy], []) // Instantiate with our own type - let sprintfMethSpec = mkILMethSpec(sprintfMethSpec.MethodRef,AsObject,[],[funcTy]) + let sprintfMethSpec = mkILMethSpec(sprintfMethSpec.MethodRef, AsObject, [], [funcTy]) // Here's the body of the method. Call printf, then invoke the function it returns let callInstrs = EraseClosures.mkCallFunc cenv.g.ilxPubCloEnv (fun _ -> 0us) eenv.tyenv.Count Normalcall (Apps_app(ilThisTy, Apps_done cenv.g.ilg.typ_String)) - let mdef = - mkILNonGenericVirtualMethod ("ToString",ILMemberAccess.Public,[], + let mdef = + mkILNonGenericVirtualMethod ("ToString", ILMemberAccess.Public, [], mkILReturn cenv.g.ilg.typ_String, - mkMethodBody (true,[],2,nonBranchingInstrsToCode + mkMethodBody (true, [], 2, nonBranchingInstrsToCode ([ // load the hardwired format string - yield I_ldstr "%+A" + yield I_ldstr "%+A" // make the printf format object yield mkNormalNewobj newFormatMethSpec // call sprintf - yield mkNormalCall sprintfMethSpec + yield mkNormalCall sprintfMethSpec // call the function returned by sprintf - yield mkLdarg0 + yield mkLdarg0 if ilThisTy.Boxity = ILBoxity.AsValue then yield mkNormalLdobj ilThisTy ] @ callInstrs), @@ -6466,57 +6634,57 @@ and GenToStringMethod cenv eenv ilThisTy m = and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = let tcref = mkLocalTyconRef tycon if tycon.IsTypeAbbrev then () else - match tycon.TypeReprInfo with + match tycon.TypeReprInfo with #if !NO_EXTENSIONTYPING | TProvidedNamespaceExtensionPoint _ -> () | TProvidedTypeExtensionPoint _ -> () #endif | TNoRepr -> () - | TAsmRepr _ | TILObjectRepr _ | TMeasureableRepr _ -> () - | TFSharpObjectRepr _ | TRecdRepr _ | TUnionRepr _ -> + | TAsmRepr _ | TILObjectRepr _ | TMeasureableRepr _ -> () + | TFSharpObjectRepr _ | TRecdRepr _ | TUnionRepr _ -> let eenvinner = ReplaceTyenv (TypeReprEnv.ForTycon tycon) eenv let thisTy = generalizedTyconRef tcref let ilThisTy = GenType cenv.amap m eenvinner.tyenv thisTy let tref = ilThisTy.TypeRef let ilGenParams = GenGenericParams cenv eenvinner tycon.TyparsNoRange - let ilIntfTys = tycon.ImmediateInterfaceTypesOfFSharpTycon |> List.map (GenType cenv.amap m eenvinner.tyenv) + let ilIntfTys = tycon.ImmediateInterfaceTypesOfFSharpTycon |> List.map (GenType cenv.amap m eenvinner.tyenv) let ilTypeName = tref.Name let hidden = IsHiddenTycon eenv.sigToImplRemapInfo tycon let hiddenRepr = hidden || IsHiddenTyconRepr eenv.sigToImplRemapInfo tycon let access = ComputeTypeAccess tref hidden - // The implicit augmentation doesn't actually create CompareTo(object) or Object.Equals - // So we do it here. + // The implicit augmentation doesn't actually create CompareTo(object) or Object.Equals + // So we do it here. // - // Note you only have to implement 'System.IComparable' to customize structural comparison AND equality on F# types + // Note you only have to implement 'System.IComparable' to customize structural comparison AND equality on F# types // See also FinalTypeDefinitionChecksAtEndOfInferenceScope in tc.fs - // + // // Generate an Equals method implemented via IComparable if the type EXPLICITLY implements IComparable. - // HOWEVER, if the type doesn't override Object.Equals already. - let augmentOverrideMethodDefs = + // HOWEVER, if the type doesn't override Object.Equals already. + let augmentOverrideMethodDefs = (if Option.isNone tycon.GeneratedCompareToValues && Option.isNone tycon.GeneratedHashAndEqualsValues && - tycon.HasInterface cenv.g cenv.g.mk_IComparable_ty && + tycon.HasInterface cenv.g cenv.g.mk_IComparable_ty && not (tycon.HasOverride cenv.g "Equals" [cenv.g.obj_ty]) && not tycon.IsFSharpInterfaceTycon - then - [ GenEqualsOverrideCallingIComparable cenv (tcref,ilThisTy,ilThisTy) ] + then + [ GenEqualsOverrideCallingIComparable cenv (tcref, ilThisTy, ilThisTy) ] else []) - // Generate the interface slots and abstract slots. - let abstractMethodDefs,abstractPropDefs, abstractEventDefs = - if tycon.IsFSharpDelegateTycon then - [],[],[] + // Generate the interface slots and abstract slots. + let abstractMethodDefs, abstractPropDefs, abstractEventDefs = + if tycon.IsFSharpDelegateTycon then + [], [], [] else // sort by order of declaration // REVIEW: this should be based off tcaug_adhoc_list, which is in declaration order tycon.MembersOfFSharpTyconSorted - |> List.sortWith (fun v1 v2 -> rangeOrder.Compare(v1.DefinitionRange,v2.DefinitionRange)) + |> List.sortWith (fun v1 v2 -> rangeOrder.Compare(v1.DefinitionRange, v2.DefinitionRange)) |> List.map (GenAbstractBinding cenv eenv tref) - |> List.unzip3 + |> List.unzip3 |> mapTriple (List.concat, List.concat, List.concat) @@ -6524,80 +6692,80 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = let isAbstract = isAbstractTycon tycon // Generate all the method impls showing how various abstract slots and interface slots get implemented - // REVIEW: no method impl generated for IStructuralHash or ICompare - let methodImpls = + // REVIEW: no method impl generated for IStructuralHash or ICompare + let methodImpls = [ for vref in tycon.MembersOfFSharpTyconByName |> NameMultiMap.range do assert(vref.IsMember) let memberInfo = vref.MemberInfo.Value - if memberInfo.MemberFlags.IsOverrideOrExplicitImpl && not (CompileAsEvent cenv.g vref.Attribs) then + if memberInfo.MemberFlags.IsOverrideOrExplicitImpl && not (CompileAsEvent cenv.g vref.Attribs) then for slotsig in memberInfo.ImplementedSlotSigs do if isInterfaceTy cenv.g slotsig.ImplementedType then - match vref.ValReprInfo with - | Some _ -> + match vref.ValReprInfo with + | Some _ -> - let memberParentTypars,memberMethodTypars = + let memberParentTypars, memberMethodTypars = match PartitionValRefTypars cenv.g vref with - | Some(_,memberParentTypars,memberMethodTypars,_,_) -> memberParentTypars,memberMethodTypars - | None -> [],[] + | Some(_, memberParentTypars, memberMethodTypars, _, _) -> memberParentTypars, memberMethodTypars + | None -> [], [] let useMethodImpl = true let eenvUnderTypars = EnvForTypars memberParentTypars eenv - let _,methodImplGenerator = GenMethodImpl cenv eenvUnderTypars (useMethodImpl,slotsig) m + let _, methodImplGenerator = GenMethodImpl cenv eenvUnderTypars (useMethodImpl, slotsig) m if useMethodImpl then - yield methodImplGenerator (ilThisTy,memberMethodTypars) + yield methodImplGenerator (ilThisTy, memberMethodTypars) | _ -> () ] - + // Try to add a DefaultMemberAttribute for the 'Item' property - let defaultMemberAttrs = + let defaultMemberAttrs = // REVIEW: this should be based off tcaug_adhoc_list, which is in declaration order tycon.MembersOfFSharpTyconSorted - |> List.tryPick (fun vref -> + |> List.tryPick (fun vref -> let name = vref.DisplayName - match vref.MemberInfo with + match vref.MemberInfo with | None -> None - | Some memberInfo -> - match name, memberInfo.MemberFlags.MemberKind with + | Some memberInfo -> + match name, memberInfo.MemberFlags.MemberKind with | ("Item" | "op_IndexedLookup"), (MemberKind.PropertyGet | MemberKind.PropertySet) when not (isNil (ArgInfosOfPropertyVal cenv.g vref.Deref)) -> - Some( mkILCustomAttribute cenv.g.ilg (cenv.g.FindSysILTypeRef "System.Reflection.DefaultMemberAttribute",[cenv.g.ilg.typ_String],[ILAttribElem.String(Some(name))],[]) ) + Some( mkILCustomAttribute cenv.g.ilg (cenv.g.FindSysILTypeRef "System.Reflection.DefaultMemberAttribute", [cenv.g.ilg.typ_String], [ILAttribElem.String(Some(name))], []) ) | _ -> None) |> Option.toList let tyconRepr = tycon.TypeReprInfo // DebugDisplayAttribute gets copied to the subtypes generated as part of DU compilation - let debugDisplayAttrs,normalAttrs = tycon.Attribs |> List.partition (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_DebuggerDisplayAttribute) - let securityAttrs,normalAttrs = normalAttrs |> List.partition (fun a -> IsSecurityAttribute cenv.g cenv.amap cenv.casApplied a m) + let debugDisplayAttrs, normalAttrs = tycon.Attribs |> List.partition (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_DebuggerDisplayAttribute) + let securityAttrs, normalAttrs = normalAttrs |> List.partition (fun a -> IsSecurityAttribute cenv.g cenv.amap cenv.casApplied a m) let generateDebugDisplayAttribute = not cenv.g.compilingFslib && tycon.IsUnionTycon && isNil debugDisplayAttrs let generateDebugProxies = (not (tyconRefEq cenv.g tcref cenv.g.unit_tcr_canon) && not (HasFSharpAttribute cenv.g cenv.g.attrib_DebuggerTypeProxyAttribute tycon.Attribs)) let permissionSets = CreatePermissionSets cenv eenv securityAttrs let secDecls = if List.isEmpty securityAttrs then emptyILSecurityDecls else mkILSecurityDecls permissionSets - - let ilDebugDisplayAttributes = + + let ilDebugDisplayAttributes = [ yield! GenAttrs cenv eenv debugDisplayAttrs - if generateDebugDisplayAttribute then + if generateDebugDisplayAttribute then yield cenv.g.mkDebuggerDisplayAttribute ("{" + debugDisplayMethodName + "(),nq}") ] - let ilCustomAttrs = - [ yield! defaultMemberAttrs - yield! normalAttrs - |> List.filter (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_StructLayoutAttribute >> not) + let ilCustomAttrs = + [ yield! defaultMemberAttrs + yield! normalAttrs + |> List.filter (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_StructLayoutAttribute >> not) |> GenAttrs cenv eenv yield! ilDebugDisplayAttributes ] let reprAccess = ComputeMemberAccess hiddenRepr - let ilTypeDefKind = - match tyconRepr with - | TFSharpObjectRepr o -> - match o.fsobjmodel_kind with + let ilTypeDefKind = + match tyconRepr with + | TFSharpObjectRepr o -> + match o.fsobjmodel_kind with | TTyconClass -> ILTypeDefKind.Class | TTyconStruct -> ILTypeDefKind.ValueType | TTyconInterface -> ILTypeDefKind.Interface @@ -6606,27 +6774,27 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = | TRecdRepr _ | TUnionRepr _ when tycon.IsStructOrEnumTycon -> ILTypeDefKind.ValueType | _ -> ILTypeDefKind.Class - let requiresExtraField = - let isEmptyStruct = + let requiresExtraField = + let isEmptyStruct = (match ilTypeDefKind with ILTypeDefKind.ValueType -> true | _ -> false) && - // All structs are sequential by default + // All structs are sequential by default // Structs with no instance fields get size 1, pack 0 tycon.AllFieldsArray |> Array.forall (fun f -> f.IsStatic) isEmptyStruct && cenv.opts.workAroundReflectionEmitBugs && not tycon.TyparsNoRange.IsEmpty - - // Compute a bunch of useful things for each field - let isCLIMutable = (TryFindFSharpBoolAttribute cenv.g cenv.g.attrib_CLIMutableAttribute tycon.Attribs = Some true) - let fieldSummaries = + + // Compute a bunch of useful things for each field + let isCLIMutable = (TryFindFSharpBoolAttribute cenv.g cenv.g.attrib_CLIMutableAttribute tycon.Attribs = Some true) + let fieldSummaries = [ for fspec in tycon.AllFieldsArray do let useGenuineField = useGenuineField tycon fspec - // The property (or genuine IL field) is hidden in these circumstances: - // - secret fields apart from "__value" fields for enums - // - the representation of the type is hidden - // - the F# field is hidden by a signature or private declaration + // The property (or genuine IL field) is hidden in these circumstances: + // - secret fields apart from "__value" fields for enums + // - the representation of the type is hidden + // - the F# field is hidden by a signature or private declaration let isPropHidden = // Enums always have public cases irrespective of Enum Visibility if tycon.IsEnumTycon then false @@ -6635,54 +6803,54 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = IsHiddenRecdField eenv.sigToImplRemapInfo (tcref.MakeNestedRecdFieldRef fspec)) let ilType = GenType cenv.amap m eenvinner.tyenv fspec.FormalType let ilFieldName = ComputeFieldName tycon fspec - - yield (useGenuineField, ilFieldName, fspec.IsMutable, fspec.IsStatic, fspec.PropertyAttribs, ilType, isPropHidden, fspec) ] - // Generate the IL fields - let ilFieldDefs = - [ for (useGenuineField,ilFieldName,isFSharpMutable,isStatic,_,ilPropType,isPropHidden,fspec) in fieldSummaries do + yield (useGenuineField, ilFieldName, fspec.IsMutable, fspec.IsStatic, fspec.PropertyAttribs, ilType, isPropHidden, fspec) ] + + // Generate the IL fields + let ilFieldDefs = + [ for (useGenuineField, ilFieldName, isFSharpMutable, isStatic, _, ilPropType, isPropHidden, fspec) in fieldSummaries do - let ilFieldOffset = + let ilFieldOffset = match TryFindFSharpAttribute cenv.g cenv.g.attrib_FieldOffsetAttribute fspec.FieldAttribs with - | Some (Attrib(_,_,[ AttribInt32Arg(fieldOffset) ],_,_,_,_)) -> + | Some (Attrib(_, _, [ AttribInt32Arg(fieldOffset) ], _, _, _, _)) -> Some fieldOffset - | Some (Attrib(_,_,_,_,_,_,m)) -> - errorR(Error(FSComp.SR.ilFieldOffsetAttributeCouldNotBeDecoded(),m)) + | Some (Attrib(_, _, _, _, _, _, m)) -> + errorR(Error(FSComp.SR.ilFieldOffsetAttributeCouldNotBeDecoded(), m)) None - | _ -> + | _ -> None - let attribs = + let attribs = [ // If using a field then all the attributes go on the field // See also FSharp 1.0 Bug 4727: once we start compiling them as real mutable fields, you should not be able to target both "property" for "val mutable" fields in classes - if useGenuineField then yield! fspec.PropertyAttribs + if useGenuineField then yield! fspec.PropertyAttribs yield! fspec.FieldAttribs ] - + let ilNotSerialized = HasFSharpAttributeOpt cenv.g cenv.g.attrib_NonSerializedAttribute attribs - - let fattribs = + + let fattribs = attribs - // Do not generate FieldOffset as a true CLI custom attribute, since it is implied by other corresponding CLI metadata - |> List.filter (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_FieldOffsetAttribute >> not) - // Do not generate NonSerialized as a true CLI custom attribute, since it is implied by other corresponding CLI metadata - |> List.filter (IsMatchingFSharpAttributeOpt cenv.g cenv.g.attrib_NonSerializedAttribute >> not) + // Do not generate FieldOffset as a true CLI custom attribute, since it is implied by other corresponding CLI metadata + |> List.filter (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_FieldOffsetAttribute >> not) + // Do not generate NonSerialized as a true CLI custom attribute, since it is implied by other corresponding CLI metadata + |> List.filter (IsMatchingFSharpAttributeOpt cenv.g cenv.g.attrib_NonSerializedAttribute >> not) let ilFieldMarshal, fattribs = GenMarshal cenv fattribs - // The IL field is hidden if the property/field is hidden OR we're using a property AND the field is not mutable (because we can take the address of a mutable field). - // Otherwise fields are always accessed via their property getters/setters + // The IL field is hidden if the property/field is hidden OR we're using a property AND the field is not mutable (because we can take the address of a mutable field). + // Otherwise fields are always accessed via their property getters/setters let isFieldHidden = isPropHidden || (not useGenuineField && not isFSharpMutable) - - let extraAttribs = - match tyconRepr with + + let extraAttribs = + match tyconRepr with | TRecdRepr _ when not useGenuineField -> [ cenv.g.DebuggerBrowsableNeverAttribute ] // hide fields in records in debug display | _ -> [] // don't hide fields in classes in debug display let access = ComputeMemberAccess isFieldHidden let literalValue = Option.map (GenFieldInit m) fspec.LiteralValue - + let fdef = ILFieldDef(name = ilFieldName, fieldType = ilPropType, @@ -6700,13 +6868,13 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = .WithFieldMarshal(ilFieldMarshal) yield fdef - if requiresExtraField then - yield mkILInstanceField("__dummy",cenv.g.ilg.typ_Int32,None,ILMemberAccess.Assembly) ] - - // Generate property definitions for the fields compiled as properties - let ilPropertyDefsForFields = - [ for (i, (useGenuineField,_,isFSharpMutable,isStatic,propAttribs,ilPropType,_,fspec)) in markup fieldSummaries do - if not useGenuineField then + if requiresExtraField then + yield mkILInstanceField("__dummy", cenv.g.ilg.typ_Int32, None, ILMemberAccess.Assembly) ] + + // Generate property definitions for the fields compiled as properties + let ilPropertyDefsForFields = + [ for (i, (useGenuineField, _, isFSharpMutable, isStatic, propAttribs, ilPropType, _, fspec)) in Seq.indexed fieldSummaries do + if not useGenuineField then let ilCallingConv = if isStatic then ILCallingConv.Static else ILCallingConv.Instance let ilPropName = fspec.Name let ilHasSetter = isCLIMutable || isFSharpMutable @@ -6714,105 +6882,105 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = yield ILPropertyDef(name= ilPropName, attributes= PropertyAttributes.None, - setMethod= (if ilHasSetter then Some(mkILMethRef(tref,ilCallingConv,"set_" + ilPropName,0,[ilPropType],ILType.Void)) else None), - getMethod= Some(mkILMethRef(tref,ilCallingConv,"get_" + ilPropName,0,[],ilPropType)), + setMethod= (if ilHasSetter then Some(mkILMethRef(tref, ilCallingConv, "set_" + ilPropName, 0, [ilPropType], ILType.Void)) else None), + getMethod= Some(mkILMethRef(tref, ilCallingConv, "get_" + ilPropName, 0, [], ilPropType)), callingConv= ilCallingConv.ThisConv, propertyType= ilPropType, init= None, args= [], - customAttrs = mkILCustomAttrs ilFieldAttrs) ] - - let methodDefs = - [ // Generate property getter methods for those fields that have properties - for (useGenuineField,ilFieldName,_,isStatic,_,ilPropType,isPropHidden,fspec) in fieldSummaries do - if not useGenuineField then + customAttrs = mkILCustomAttrs ilFieldAttrs) ] + + let methodDefs = + [ // Generate property getter methods for those fields that have properties + for (useGenuineField, ilFieldName, _, isStatic, _, ilPropType, isPropHidden, fspec) in fieldSummaries do + if not useGenuineField then let ilPropName = fspec.Name let ilMethName = "get_" + ilPropName let access = ComputeMemberAccess isPropHidden - yield mkLdfldMethodDef (ilMethName,access,isStatic,ilThisTy,ilFieldName,ilPropType) + yield mkLdfldMethodDef (ilMethName, access, isStatic, ilThisTy, ilFieldName, ilPropType) - // Generate property setter methods for the mutable fields - for (useGenuineField,ilFieldName,isFSharpMutable,isStatic,_,ilPropType,isPropHidden,fspec) in fieldSummaries do - let ilHasSetter = (isCLIMutable || isFSharpMutable) && not useGenuineField - if ilHasSetter then + // Generate property setter methods for the mutable fields + for (useGenuineField, ilFieldName, isFSharpMutable, isStatic, _, ilPropType, isPropHidden, fspec) in fieldSummaries do + let ilHasSetter = (isCLIMutable || isFSharpMutable) && not useGenuineField + if ilHasSetter then let ilPropName = fspec.Name - let ilFieldSpec = mkILFieldSpecInTy(ilThisTy,ilFieldName,ilPropType) + let ilFieldSpec = mkILFieldSpecInTy(ilThisTy, ilFieldName, ilPropType) let ilMethName = "set_" + ilPropName - let ilParams = [mkILParamNamed("value",ilPropType)] + let ilParams = [mkILParamNamed("value", ilPropType)] let ilReturn = mkILReturn ILType.Void let iLAccess = ComputeMemberAccess isPropHidden - let ilMethodDef = - if isStatic then + let ilMethodDef = + if isStatic then mkILNonGenericStaticMethod - (ilMethName,iLAccess,ilParams,ilReturn, - mkMethodBody(true,[],2,nonBranchingInstrsToCode ([ mkLdarg0;mkNormalStsfld ilFieldSpec]),None)) - else + (ilMethName, iLAccess, ilParams, ilReturn, + mkMethodBody(true, [], 2, nonBranchingInstrsToCode ([ mkLdarg0;mkNormalStsfld ilFieldSpec]), None)) + else mkILNonGenericInstanceMethod - (ilMethName,iLAccess,ilParams,ilReturn, - mkMethodBody(true,[],2,nonBranchingInstrsToCode ([ mkLdarg0;mkLdarg 1us;mkNormalStfld ilFieldSpec]),None)) + (ilMethName, iLAccess, ilParams, ilReturn, + mkMethodBody(true, [], 2, nonBranchingInstrsToCode ([ mkLdarg0;mkLdarg 1us;mkNormalStfld ilFieldSpec]), None)) yield ilMethodDef.WithSpecialName - if generateDebugDisplayAttribute then + if generateDebugDisplayAttribute then let (|Lazy|) (x:Lazy<_>) = x.Force() match (eenv.valsInScope.TryFind cenv.g.sprintf_vref.Deref, eenv.valsInScope.TryFind cenv.g.new_format_vref.Deref) with - | Some(Lazy(Method(_,_,sprintfMethSpec,_,_,_,_))), Some(Lazy(Method(_,_,newFormatMethSpec,_,_,_,_))) -> + | Some(Lazy(Method(_, _, sprintfMethSpec, _, _, _, _))), Some(Lazy(Method(_, _, newFormatMethSpec, _, _, _, _))) -> // The type returned by the 'sprintf' call let funcTy = EraseClosures.mkILFuncTy cenv.g.ilxPubCloEnv ilThisTy cenv.g.ilg.typ_String // Give the instantiation of the printf format object, i.e. a Format`5 object compatible with StringFormat - let newFormatMethSpec = mkILMethSpec(newFormatMethSpec.MethodRef,AsObject, + let newFormatMethSpec = mkILMethSpec(newFormatMethSpec.MethodRef, AsObject, [// 'T -> string' - funcTy + funcTy // rest follow from 'StringFormat' - GenUnitTy cenv eenv m - cenv.g.ilg.typ_String - cenv.g.ilg.typ_String - cenv.g.ilg.typ_String],[]) + GenUnitTy cenv eenv m + cenv.g.ilg.typ_String + cenv.g.ilg.typ_String + cenv.g.ilg.typ_String], []) // Instantiate with our own type - let sprintfMethSpec = mkILMethSpec(sprintfMethSpec.MethodRef,AsObject,[],[funcTy]) + let sprintfMethSpec = mkILMethSpec(sprintfMethSpec.MethodRef, AsObject, [], [funcTy]) // Here's the body of the method. Call printf, then invoke the function it returns let callInstrs = EraseClosures.mkCallFunc cenv.g.ilxPubCloEnv (fun _ -> 0us) eenv.tyenv.Count Normalcall (Apps_app(ilThisTy, Apps_done cenv.g.ilg.typ_String)) - let ilMethodDef = mkILNonGenericInstanceMethod (debugDisplayMethodName,ILMemberAccess.Assembly,[], + let ilMethodDef = mkILNonGenericInstanceMethod (debugDisplayMethodName, ILMemberAccess.Assembly, [], mkILReturn cenv.g.ilg.typ_Object, - mkMethodBody - (true,[],2, - nonBranchingInstrsToCode + mkMethodBody + (true, [], 2, + nonBranchingInstrsToCode ([ // load the hardwired format string - yield I_ldstr "%+0.8A" + yield I_ldstr "%+0.8A" // make the printf format object yield mkNormalNewobj newFormatMethSpec // call sprintf - yield mkNormalCall sprintfMethSpec + yield mkNormalCall sprintfMethSpec // call the function returned by sprintf - yield mkLdarg0 + yield mkLdarg0 if ilThisTy.Boxity = ILBoxity.AsValue then yield mkNormalLdobj ilThisTy ] @ callInstrs), None)) yield ilMethodDef.WithSpecialName |> AddNonUserCompilerGeneratedAttribs cenv.g - | None,_ -> + | None, _ -> //printfn "sprintf not found" () - | _,None -> + | _, None -> //printfn "new formatnot found" () | _ -> //printfn "neither found, or non-method" () - // Build record constructors and the funky methods that go with records and delegate types. - // Constructors and delegate methods have the same access as the representation - match tyconRepr with + // Build record constructors and the funky methods that go with records and delegate types. + // Constructors and delegate methods have the same access as the representation + match tyconRepr with | TRecdRepr _ when not (tycon.IsEnumTycon) -> - // No constructor for enum types - // Otherwise find all the non-static, non zero-init fields and build a constructor - let relevantFields = - fieldSummaries - |> List.filter (fun (_,_,_,isStatic,_,_,_,fspec) -> not isStatic && not fspec.IsZeroInit) + // No constructor for enum types + // Otherwise find all the non-static, non zero-init fields and build a constructor + let relevantFields = + fieldSummaries + |> List.filter (fun (_, _, _, isStatic, _, _, _, fspec) -> not isStatic && not fspec.IsZeroInit) - let fieldNamesAndTypes = + let fieldNamesAndTypes = relevantFields - |> List.map (fun (_,ilFieldName,_,_,_,ilPropType,_,fspec) -> (fspec.Name,ilFieldName,ilPropType)) + |> List.map (fun (_, ilFieldName, _, _, _, ilPropType, _, fspec) -> (fspec.Name, ilFieldName, ilPropType)) let isStructRecord = tycon.IsStructRecordOrUnionTycon @@ -6820,45 +6988,45 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = let spec = if isStructRecord then None else Some(cenv.g.ilg.typ_Object.TypeSpec) let ilMethodDef = mkILSimpleStorageCtorWithParamNames(None, spec, ilThisTy, [], ChooseParamNames fieldNamesAndTypes, reprAccess) - yield ilMethodDef + yield ilMethodDef // FSharp 1.0 bug 1988: Explicitly setting the ComVisible(true) attribute on an F# type causes an F# record to be emitted in a way that enables mutation for COM interop scenarios // FSharp 3.0 feature: adding CLIMutable to a record type causes emit of default constructor, and all fields get property setters // Records that are value types do not create a default constructor with CLIMutable or ComVisible if not isStructRecord && (isCLIMutable || (TryFindFSharpBoolAttribute cenv.g cenv.g.attrib_ComVisibleAttribute tycon.Attribs = Some true)) then - yield mkILSimpleStorageCtor(None, Some cenv.g.ilg.typ_Object.TypeSpec, ilThisTy, [], [], reprAccess) - + yield mkILSimpleStorageCtor(None, Some cenv.g.ilg.typ_Object.TypeSpec, ilThisTy, [], [], reprAccess) + if not (tycon.HasMember cenv.g "ToString" []) then yield! GenToStringMethod cenv eenv ilThisTy m | TFSharpObjectRepr r when tycon.IsFSharpDelegateTycon -> - // Build all the methods that go with a delegate type - match r.fsobjmodel_kind with + // Build all the methods that go with a delegate type + match r.fsobjmodel_kind with | TTyconDelegate ss -> - let p,r = + let p, r = // When "type delegateTy = delegate of unit -> returnTy", - // suppress the unit arg from delegate .Invoke vslot. - let (TSlotSig(nm,ty,ctps,mtps,paraml,returnTy)) = ss - let paraml = + // suppress the unit arg from delegate .Invoke vslot. + let (TSlotSig(nm, ty, ctps, mtps, paraml, returnTy)) = ss + let paraml = match paraml with | [[tsp]] when isUnitTy cenv.g tsp.Type -> [] (* suppress unit arg *) | paraml -> paraml - GenActualSlotsig m cenv eenvinner (TSlotSig(nm,ty,ctps,mtps,paraml,returnTy)) [] [] - yield! mkILDelegateMethods reprAccess cenv.g.ilg (cenv.g.iltyp_AsyncCallback, cenv.g.iltyp_IAsyncResult) (p,r) - | _ -> + GenActualSlotsig m cenv eenvinner (TSlotSig(nm, ty, ctps, mtps, paraml, returnTy)) [] [] + yield! mkILDelegateMethods reprAccess cenv.g.ilg (cenv.g.iltyp_AsyncCallback, cenv.g.iltyp_IAsyncResult) (p, r) + | _ -> () - | TUnionRepr _ when not (tycon.HasMember cenv.g "ToString" []) -> + | TUnionRepr _ when not (tycon.HasMember cenv.g "ToString" []) -> yield! GenToStringMethod cenv eenv ilThisTy m | _ -> () ] - + let ilMethods = methodDefs @ augmentOverrideMethodDefs @ abstractMethodDefs let ilProperties = mkILProperties (ilPropertyDefsForFields @ abstractPropDefs) let ilEvents = mkILEvents abstractEventDefs let ilFields = mkILFields ilFieldDefs - - let tdef, tdefDiscards = + + let tdef, tdefDiscards = let isSerializable = (TryFindFSharpBoolAttribute cenv.g cenv.g.attrib_AutoSerializableAttribute tycon.Attribs <> Some(false)) - match tycon.TypeReprInfo with + match tycon.TypeReprInfo with | TILObjectRepr _ -> let tdef = tycon.ILTyconRawMetadata.WithAccess(access) let tdef = tdef.With(customAttrs = mkILCustomAttrs ilCustomAttrs, genericParams = ilGenParams) @@ -6867,111 +7035,111 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = | TRecdRepr _ | TFSharpObjectRepr _ as tyconRepr -> let super = superOfTycon cenv.g tycon let ilBaseTy = GenType cenv.amap m eenvinner.tyenv super - - // Build a basic type definition + + // Build a basic type definition let isObjectType = (match tyconRepr with TFSharpObjectRepr _ -> true | _ -> false) - let ilAttrs = - ilCustomAttrs @ + let ilAttrs = + ilCustomAttrs @ [mkCompilationMappingAttr cenv.g (int (if isObjectType then SourceConstructFlags.ObjectType elif hiddenRepr then SourceConstructFlags.RecordType ||| SourceConstructFlags.NonPublicRepresentation else SourceConstructFlags.RecordType)) ] - - // For now, generic types always use ILTypeInit.BeforeField. This is because - // there appear to be some cases where ILTypeInit.OnAny causes problems for + + // For now, generic types always use ILTypeInit.BeforeField. This is because + // there appear to be some cases where ILTypeInit.OnAny causes problems for // the .NET CLR when used in conjunction with generic classes in cross-DLL - // and NGEN scenarios. + // and NGEN scenarios. // // We don't apply this rule to the final file. This is because ALL classes with .cctors in - // the final file (which may in turn trigger the .cctor for the .EXE itself, which - // in turn calls the main() method) must have deterministic initialization + // the final file (which may in turn trigger the .cctor for the .EXE itself, which + // in turn calls the main() method) must have deterministic initialization // that is not triggered prior to execution of the main() method. - // If this property doesn't hold then the .cctor can end up running + // If this property doesn't hold then the .cctor can end up running // before the main method even starts. - let typeDefTrigger = - if eenv.isFinalFile || tycon.TyparsNoRange.IsEmpty then + let typeDefTrigger = + if eenv.isFinalFile || tycon.TyparsNoRange.IsEmpty then ILTypeInit.OnAny - else + else ILTypeInit.BeforeField - let tdef = mkILGenericClass (ilTypeName, access, ilGenParams, ilBaseTy, ilIntfTys, - mkILMethods ilMethods, ilFields, emptyILTypeDefs, ilProperties, ilEvents, mkILCustomAttrs ilAttrs, + let tdef = mkILGenericClass (ilTypeName, access, ilGenParams, ilBaseTy, ilIntfTys, + mkILMethods ilMethods, ilFields, emptyILTypeDefs, ilProperties, ilEvents, mkILCustomAttrs ilAttrs, typeDefTrigger) - // Set some the extra entries in the definition + // Set some the extra entries in the definition let isTheSealedAttribute = tyconRefEq cenv.g tcref cenv.g.attrib_SealedAttribute.TyconRef let tdef = tdef.WithSealed(isSealedTy cenv.g thisTy || isTheSealedAttribute).WithSerializable(isSerializable).WithAbstract(isAbstract).WithImport(isComInteropTy cenv.g thisTy) let tdef = tdef.With(methodImpls=mkILMethodImpls methodImpls) - let tdLayout,tdEncoding = + let tdLayout, tdEncoding = match TryFindFSharpAttribute cenv.g cenv.g.attrib_StructLayoutAttribute tycon.Attribs with - | Some (Attrib(_,_,[ AttribInt32Arg(layoutKind) ],namedArgs,_,_,_)) -> + | Some (Attrib(_, _, [ AttribInt32Arg(layoutKind) ], namedArgs, _, _, _)) -> let decoder = AttributeDecoder namedArgs let ilPack = decoder.FindInt32 "Pack" 0x0 let ilSize = decoder.FindInt32 "Size" 0x0 - let tdEncoding = + let tdEncoding = match (decoder.FindInt32 "CharSet" 0x0) with (* enumeration values for System.Runtime.InteropServices.CharSet taken from mscorlib.il *) | 0x03 -> ILDefaultPInvokeEncoding.Unicode | 0x04 -> ILDefaultPInvokeEncoding.Auto | _ -> ILDefaultPInvokeEncoding.Ansi - let layoutInfo = - if ilPack = 0x0 && ilSize = 0x0 - then { Size=None; Pack=None } + let layoutInfo = + if ilPack = 0x0 && ilSize = 0x0 + then { Size=None; Pack=None } else { Size = Some ilSize; Pack = Some (uint16 ilPack) } - let tdLayout = + let tdLayout = match layoutKind with (* enumeration values for System.Runtime.InteropServices.LayoutKind taken from mscorlib.il *) | 0x0 -> ILTypeDefLayout.Sequential layoutInfo | 0x2 -> ILTypeDefLayout.Explicit layoutInfo | _ -> ILTypeDefLayout.Auto - tdLayout,tdEncoding - | Some (Attrib(_,_,_,_,_,_,m)) -> - errorR(Error(FSComp.SR.ilStructLayoutAttributeCouldNotBeDecoded(),m)) + tdLayout, tdEncoding + | Some (Attrib(_, _, _, _, _, _, m)) -> + errorR(Error(FSComp.SR.ilStructLayoutAttributeCouldNotBeDecoded(), m)) ILTypeDefLayout.Auto, ILDefaultPInvokeEncoding.Ansi | _ when (match ilTypeDefKind with ILTypeDefKind.ValueType -> true | _ -> false) -> - - // All structs are sequential by default + + // All structs are sequential by default // Structs with no instance fields get size 1, pack 0 if tycon.AllFieldsArray |> Array.exists (fun f -> not f.IsStatic) || // Reflection emit doesn't let us emit 'pack' and 'size' for generic structs. // In that case we generate a dummy field instead - (cenv.opts.workAroundReflectionEmitBugs && not tycon.TyparsNoRange.IsEmpty) - then + (cenv.opts.workAroundReflectionEmitBugs && not tycon.TyparsNoRange.IsEmpty) + then ILTypeDefLayout.Sequential { Size=None; Pack=None }, ILDefaultPInvokeEncoding.Ansi else ILTypeDefLayout.Sequential { Size=Some 1; Pack=Some 0us }, ILDefaultPInvokeEncoding.Ansi - - | _ -> + + | _ -> ILTypeDefLayout.Auto, ILDefaultPInvokeEncoding.Ansi - + // if the type's layout is Explicit, ensure that each field has a valid offset let validateExplicit (fdef: ILFieldDef) = match fdef.Offset with // Remove field suffix "@" for pretty printing - | None -> errorR(Error(FSComp.SR.ilFieldDoesNotHaveValidOffsetForStructureLayout(tdef.Name, fdef.Name.Replace("@","")), (trimRangeToLine m))) + | None -> errorR(Error(FSComp.SR.ilFieldDoesNotHaveValidOffsetForStructureLayout(tdef.Name, fdef.Name.Replace("@", "")), (trimRangeToLine m))) | _ -> () - + // if the type's layout is Sequential, no offsets should be applied let validateSequential (fdef: ILFieldDef) = match fdef.Offset with | Some _ -> errorR(Error(FSComp.SR.ilFieldHasOffsetForSequentialLayout(), (trimRangeToLine m))) | _ -> () - + match tdLayout with | ILTypeDefLayout.Explicit(_) -> List.iter validateExplicit ilFieldDefs | ILTypeDefLayout.Sequential(_) -> List.iter validateSequential ilFieldDefs | _ -> () - + let tdef = tdef.WithKind(ilTypeDefKind).WithLayout(tdLayout).WithEncoding(tdEncoding) tdef, None - | TUnionRepr _ -> - let alternatives = - tycon.UnionCasesArray |> Array.mapi (fun i ucspec -> + | TUnionRepr _ -> + let alternatives = + tycon.UnionCasesArray |> Array.mapi (fun i ucspec -> { altName=ucspec.CompiledName altFields=GenUnionCaseRef cenv.amap m eenvinner.tyenv i ucspec.RecdFieldsArray altCustomAttrs= mkILCustomAttrs (GenAttrs cenv eenv ucspec.Attribs @ [mkCompilationMappingAttrWithSeqNum cenv.g (int SourceConstructFlags.UnionCase) i]) }) @@ -6985,23 +7153,23 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = cudAlternatives= alternatives cudWhere = None} - let layout = - if isStructTy cenv.g thisTy then + let layout = + if isStructTy cenv.g thisTy then if (match ilTypeDefKind with ILTypeDefKind.ValueType -> true | _ -> false) then // Structs with no instance fields get size 1, pack 0 ILTypeDefLayout.Sequential { Size=Some 1; Pack=Some 0us } else ILTypeDefLayout.Sequential { Size=None; Pack=None } - else + else ILTypeDefLayout.Auto - let cattrs = - mkILCustomAttrs (ilCustomAttrs @ + let cattrs = + mkILCustomAttrs (ilCustomAttrs @ [mkCompilationMappingAttr cenv.g (int (if hiddenRepr - then SourceConstructFlags.SumType ||| SourceConstructFlags.NonPublicRepresentation + then SourceConstructFlags.SumType ||| SourceConstructFlags.NonPublicRepresentation else SourceConstructFlags.SumType)) ]) - let tdef = + let tdef = ILTypeDef(name = ilTypeName, layout = layout, attributes = enum 0, @@ -7024,17 +7192,17 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = .WithInitSemantics(ILTypeInit.BeforeField) let tdef2 = cenv.g.eraseClassUnionDef tref tdef cuinfo - - // Discard the user-supplied (i.e. prim-type.fs) implementations of the get_Empty, get_IsEmpty, get_Value and get_None and Some methods. - // This is because we will replace their implementations by ones that load the unique + + // Discard the user-supplied (i.e. prim-type.fs) implementations of the get_Empty, get_IsEmpty, get_Value and get_None and Some methods. + // This is because we will replace their implementations by ones that load the unique // private static field for lists etc. - // + // // Also discard the F#-compiler supplied implementation of the Empty, IsEmpty, Value and None properties. - let tdefDiscards = + let tdefDiscards = Some ((fun (md: ILMethodDef) -> (cuinfo.cudHasHelpers = SpecialFSharpListHelpers && (md.Name = "get_Empty" || md.Name = "Cons" || md.Name = "get_IsEmpty")) || (cuinfo.cudHasHelpers = SpecialFSharpOptionHelpers && (md.Name = "get_Value" || md.Name = "get_None" || md.Name = "Some"))), - + (fun (pd: ILPropertyDef) -> (cuinfo.cudHasHelpers = SpecialFSharpListHelpers && (pd.Name = "Empty" || pd.Name = "IsEmpty" )) || (cuinfo.cudHasHelpers = SpecialFSharpOptionHelpers && (pd.Name = "Value" || pd.Name = "None")))) @@ -7049,7 +7217,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = // If a non-generic type is written with "static let" and "static do" (i.e. it has a ".cctor") // then the code for the .cctor is placed into .cctor for the backing static class for the file. - // It is not placed in its own .cctor as there is no feasible way for this to be given a coherent + // It is not placed in its own .cctor as there is no feasible way for this to be given a coherent // order in the sequential initialization of the file. // // In this case, the .cctor for this type must force the .cctor of the backing static class for the file. @@ -7057,11 +7225,11 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = GenForceWholeFileInitializationAsPartOfCCtor cenv mgbuf lazyInitInfo tref m - -/// Generate the type for an F# exception declaration. + +/// Generate the type for an F# exception declaration. and GenExnDef cenv mgbuf eenv m (exnc:Tycon) = let exncref = mkLocalEntityRef exnc - match exnc.ExceptionInfo with + match exnc.ExceptionInfo with | TExnAbbrevRepr _ | TExnAsmRepr _ | TExnNone -> () | TExnFresh _ -> let ilThisTy = GenExnType cenv.amap m eenv.tyenv exncref @@ -7069,98 +7237,98 @@ and GenExnDef cenv mgbuf eenv m (exnc:Tycon) = let isHidden = IsHiddenTycon eenv.sigToImplRemapInfo exnc let access = ComputeTypeAccess tref isHidden let reprAccess = ComputeMemberAccess isHidden - let fspecs = exnc.TrueInstanceFieldsAsList + let fspecs = exnc.TrueInstanceFieldsAsList - let ilMethodDefsForProperties,ilFieldDefs,ilPropertyDefs,fieldNamesAndTypes = - [ for i,fld in markup fspecs do + let ilMethodDefsForProperties, ilFieldDefs, ilPropertyDefs, fieldNamesAndTypes = + [ for i, fld in Seq.indexed fspecs do let ilPropName = fld.Name let ilPropType = GenType cenv.amap m eenv.tyenv fld.FormalType let ilMethName = "get_" + fld.Name - let ilFieldName = ComputeFieldName exnc fld - let ilMethodDef = mkLdfldMethodDef (ilMethName,reprAccess,false,ilThisTy,ilFieldName,ilPropType) - let ilFieldDef = IL.mkILInstanceField(ilFieldName,ilPropType, None, ILMemberAccess.Assembly) - let ilPropDef = + let ilFieldName = ComputeFieldName exnc fld + let ilMethodDef = mkLdfldMethodDef (ilMethName, reprAccess, false, ilThisTy, ilFieldName, ilPropType) + let ilFieldDef = IL.mkILInstanceField(ilFieldName, ilPropType, None, ILMemberAccess.Assembly) + let ilPropDef = ILPropertyDef(name = ilPropName, attributes = PropertyAttributes.None, setMethod = None, - getMethod = Some(mkILMethRef(tref,ILCallingConv.Instance,ilMethName,0,[],ilPropType)), + getMethod = Some(mkILMethRef(tref, ILCallingConv.Instance, ilMethName, 0, [], ilPropType)), callingConv = ILThisConvention.Instance, propertyType = ilPropType, init = None, args = [], customAttrs=mkILCustomAttrs (GenAttrs cenv eenv fld.PropertyAttribs @ [mkCompilationMappingAttrWithSeqNum cenv.g (int SourceConstructFlags.Field) i])) - yield (ilMethodDef,ilFieldDef,ilPropDef,(ilPropName,ilFieldName,ilPropType)) ] + yield (ilMethodDef, ilFieldDef, ilPropDef, (ilPropName, ilFieldName, ilPropType)) ] |> List.unzip4 - let ilCtorDef = - mkILSimpleStorageCtorWithParamNames(None, Some cenv.g.iltyp_Exception.TypeSpec, ilThisTy, [], ChooseParamNames fieldNamesAndTypes, reprAccess) + let ilCtorDef = + mkILSimpleStorageCtorWithParamNames(None, Some cenv.g.iltyp_Exception.TypeSpec, ilThisTy, [], ChooseParamNames fieldNamesAndTypes, reprAccess) // In compiled code, all exception types get a parameterless constructor for use with XML serialization // This does default-initialization of all fields - let ilCtorDefNoArgs = - if not (isNil fieldNamesAndTypes) then + let ilCtorDefNoArgs = + if not (isNil fieldNamesAndTypes) then [ mkILSimpleStorageCtor(None, Some cenv.g.iltyp_Exception.TypeSpec, ilThisTy, [], [], reprAccess) ] else [] let serializationRelatedMembers = // do not emit serialization related members if target framework lacks SerializationInfo or StreamingContext - match cenv.g.iltyp_SerializationInfo, cenv.g.iltyp_StreamingContext with - | Some serializationInfoType, Some streamingContextType -> - let ilCtorDefForSerialziation = + match cenv.g.iltyp_SerializationInfo, cenv.g.iltyp_StreamingContext with + | Some serializationInfoType, Some streamingContextType -> + let ilCtorDefForSerialziation = mkILCtor(ILMemberAccess.Family, - [mkILParamNamed("info", serializationInfoType);mkILParamNamed("context",streamingContextType)], + [mkILParamNamed("info", serializationInfoType);mkILParamNamed("context", streamingContextType)], mkMethodBody - (false,[],8, + (false, [], 8, nonBranchingInstrsToCode - [ mkLdarg0 + [ mkLdarg0 mkLdarg 1us mkLdarg 2us - mkNormalCall (mkILCtorMethSpecForTy (cenv.g.iltyp_Exception,[serializationInfoType; streamingContextType])) ] - ,None)) - + mkNormalCall (mkILCtorMethSpecForTy (cenv.g.iltyp_Exception, [serializationInfoType; streamingContextType])) ] + , None)) + //#if BE_SECURITY_TRANSPARENT [ilCtorDefForSerialziation] //#else (* - let getObjectDataMethodForSerialization = - - let ilMethodDef = + let getObjectDataMethodForSerialization = + + let ilMethodDef = mkILNonGenericVirtualMethod - ("GetObjectData",ILMemberAccess.Public, - [mkILParamNamed ("info", serializationInfoType);mkILParamNamed("context",cenv.g.iltyp_StreamingContext)], + ("GetObjectData", ILMemberAccess.Public, + [mkILParamNamed ("info", serializationInfoType);mkILParamNamed("context", cenv.g.iltyp_StreamingContext)], mkILReturn ILType.Void, - (let code = + (let code = nonBranchingInstrsToCode - [ mkLdarg0 + [ mkLdarg0 mkLdarg 1us mkLdarg 2us mkNormalCall (mkILNonGenericInstanceMethSpecInTy (cenv.g.iltyp_Exception, "GetObjectData", [serializationInfoType; cenv.g.iltyp_StreamingContext], ILType.Void)) ] - mkMethodBody(true,[],8,code,None))) + mkMethodBody(true, [], 8, code, None))) // Here we must encode: [SecurityPermission(SecurityAction.Demand, SerializationFormatter = true)] // In ILDASM this is: .permissionset demand = {[mscorlib]System.Security.Permissions.SecurityPermissionAttribute = {property bool 'SerializationFormatter' = bool(true)}} match cenv.g.tref_SecurityPermissionAttribute with | None -> ilMethodDef | Some securityPermissionAttributeType -> - { ilMethodDef with - SecurityDecls=mkILSecurityDecls [ IL.mkPermissionSet cenv.g.ilg (ILSecurityAction.Demand,[(securityPermissionAttributeType, [("SerializationFormatter",cenv.g.ilg.typ_Bool, ILAttribElem.Bool(true))])])] + { ilMethodDef with + SecurityDecls=mkILSecurityDecls [ IL.mkPermissionSet cenv.g.ilg (ILSecurityAction.Demand, [(securityPermissionAttributeType, [("SerializationFormatter", cenv.g.ilg.typ_Bool, ILAttribElem.Bool(true))])])] HasSecurity=true } [ilCtorDefForSerialziation; getObjectDataMethodForSerialization] *) -//#endif +//#endif | _ -> [] let ilTypeName = tref.Name - - let interfaces = exnc.ImmediateInterfaceTypesOfFSharpTycon |> List.map (GenType cenv.amap m eenv.tyenv) - let tdef = + + let interfaces = exnc.ImmediateInterfaceTypesOfFSharpTycon |> List.map (GenType cenv.amap m eenv.tyenv) + let tdef = mkILGenericClass - (ilTypeName,access,[],cenv.g.iltyp_Exception, - interfaces, + (ilTypeName, access, [], cenv.g.iltyp_Exception, + interfaces, mkILMethods ([ilCtorDef] @ ilCtorDefNoArgs @ serializationRelatedMembers @ ilMethodDefsForProperties), mkILFields ilFieldDefs, - emptyILTypeDefs, + emptyILTypeDefs, mkILProperties ilPropertyDefs, emptyILEvents, mkILCustomAttrs [mkCompilationMappingAttr cenv.g (int SourceConstructFlags.Exception)], @@ -7169,26 +7337,26 @@ and GenExnDef cenv mgbuf eenv m (exnc:Tycon) = mgbuf.AddTypeDef(tref, tdef, false, false, None) -let CodegenAssembly cenv eenv mgbuf fileImpls = - if not (isNil fileImpls) then - let a,b = List.frontAndBack fileImpls +let CodegenAssembly cenv eenv mgbuf fileImpls = + if not (isNil fileImpls) then + let a, b = List.frontAndBack fileImpls let eenv = List.fold (GenTopImpl cenv mgbuf None) eenv a let eenv = GenTopImpl cenv mgbuf cenv.opts.mainMethodInfo eenv b // Some constructs generate residue types and bindings. Generate these now. They don't result in any // top-level initialization code. - begin + begin let extraBindings = mgbuf.GrabExtraBindingsToGenerate() //printfn "#extraBindings = %d" extraBindings.Length - if extraBindings.Length > 0 then - let mexpr = TMDefs [ for b in extraBindings -> TMDefLet(b,range0) ] - let _emptyTopInstrs,_emptyTopCode = - CodeGenMethod cenv mgbuf ([],"unused",eenv,0, (fun cgbuf eenv -> + if extraBindings.Length > 0 then + let mexpr = TMDefs [ for b in extraBindings -> TMDefLet(b, range0) ] + let _emptyTopInstrs, _emptyTopCode = + CodeGenMethod cenv mgbuf ([], "unused", eenv, 0, (fun cgbuf eenv -> let lazyInitInfo = ResizeArray() let qname = QualifiedNameOfFile(mkSynId range0 "unused") LocalScope "module" cgbuf (fun scopeMarks -> let eenv = AddBindingsForModuleDef (fun cloc v -> AllocTopValWithinExpr cenv cgbuf cloc scopeMarks v) eenv.cloc eenv mexpr - GenModuleDef cenv cgbuf qname lazyInitInfo eenv mexpr)),range0) + GenModuleDef cenv cgbuf qname lazyInitInfo eenv mexpr)), range0) //printfn "#_emptyTopInstrs = %d" _emptyTopInstrs.Length () end @@ -7196,15 +7364,15 @@ let CodegenAssembly cenv eenv mgbuf fileImpls = mgbuf.AddInitializeScriptsInOrderToEntryPoint() //------------------------------------------------------------------------- -// When generating a module we just write into mutable -// structures representing the contents of the module. -//------------------------------------------------------------------------- +// When generating a module we just write into mutable +// structures representing the contents of the module. +//------------------------------------------------------------------------- -let GetEmptyIlxGenEnv (ilg : ILGlobals) ccu = +let GetEmptyIlxGenEnv (ilg : ILGlobals) ccu = let thisCompLoc = CompLocForCcu ccu { tyenv=TypeReprEnv.Empty cloc = thisCompLoc - valsInScope=ValMap<_>.Empty + valsInScope=ValMap<_>.Empty someTypeInThisAssembly=ilg.typ_Object (* dummy value *) isFinalFile = false letBoundVars=[] @@ -7213,7 +7381,7 @@ let GetEmptyIlxGenEnv (ilg : ILGlobals) ccu = sigToImplRemapInfo = [] (* "module remap info" *) withinSEH = false } -type IlxGenResults = +type IlxGenResults = { ilTypeDefs: ILTypeDef list ilAssemAttrs : ILAttribute list ilNetModuleAttrs: ILAttribute list @@ -7226,10 +7394,10 @@ let GenerateCode (cenv, anonTypeTable, eenv, TypedAssemblyAfterOptimization file use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.IlxGen - // Generate the implementations into the mgbuf + // Generate the implementations into the mgbuf let mgbuf = new AssemblyBuilder(cenv, anonTypeTable) let eenv = { eenv with cloc = CompLocForFragment cenv.opts.fragName cenv.viewCcu } - + // Generate the PrivateImplementationDetails type GenTypeDefForCompLoc (cenv, eenv, mgbuf, CompLocForPrivateImplementationDetails eenv.cloc, useHiddenInitCode, [], ILTypeInit.BeforeField, true, (* atEnd= *) true) @@ -7237,39 +7405,39 @@ let GenerateCode (cenv, anonTypeTable, eenv, TypedAssemblyAfterOptimization file CodegenAssembly cenv eenv mgbuf fileImpls let ilAssemAttrs = GenAttrs cenv eenv assemAttribs - - let tdefs,reflectedDefinitions = mgbuf.Close() + + let tdefs, reflectedDefinitions = mgbuf.Close() // Generate the quotations - let quotationResourceInfo = - match reflectedDefinitions with + let quotationResourceInfo = + match reflectedDefinitions with | [] -> [] - | _ -> + | _ -> let qscope = QuotationTranslator.QuotationGenerationScope.Create (cenv.g, cenv.amap, cenv.viewCcu, QuotationTranslator.IsReflectedDefinition.Yes) - let defns = - reflectedDefinitions |> List.choose (fun ((methName, v),e) -> - try + let defns = + reflectedDefinitions |> List.choose (fun ((methName, v), e) -> + try let ety = tyOfExpr cenv.g e - let tps,taue,_ = - match e with - | Expr.TyLambda (_,tps,b,_,_) -> tps,b,applyForallTy cenv.g ety (List.map mkTyparTy tps) - | _ -> [],e,ety + let tps, taue, _ = + match e with + | Expr.TyLambda (_, tps, b, _, _) -> tps, b, applyForallTy cenv.g ety (List.map mkTyparTy tps) + | _ -> [], e, ety let env = QuotationTranslator.QuotationTranslationEnv.Empty.BindTypars tps let astExpr = QuotationTranslator.ConvExprPublic qscope env taue let mbaseR = QuotationTranslator.ConvMethodBase qscope env (methName, v) - - Some(mbaseR,astExpr) - with + + Some(mbaseR, astExpr) + with | QuotationTranslator.InvalidQuotedTerm e -> warning(e); None) let referencedTypeDefs, freeTypes, spliceArgExprs = qscope.Close() - for (_freeType, m) in freeTypes do - error(InternalError("A free type variable was detected in a reflected definition",m)) + for (_freeType, m) in freeTypes do + error(InternalError("A free type variable was detected in a reflected definition", m)) - for (_spliceArgExpr, m) in spliceArgExprs do - error(Error(FSComp.SR.ilReflectedDefinitionsCannotUseSliceOperator(),m)) + for (_spliceArgExpr, m) in spliceArgExprs do + error(Error(FSComp.SR.ilReflectedDefinitionsCannotUseSliceOperator(), m)) let defnsResourceBytes = defns |> QuotationPickler.PickleDefns @@ -7288,13 +7456,13 @@ let GenerateCode (cenv, anonTypeTable, eenv, TypedAssemblyAfterOptimization file topAssemblyAttrs = topAssemblyAttrs permissionSets = permissionSets quotationResourceInfo = quotationResourceInfo } - + //------------------------------------------------------------------------- // For printing values in fsi we want to lookup the value of given vrefs. // The storage in the eenv says if the vref is stored in a static field. // If we know how/where the field was generated, then we can lookup via reflection. -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- open System open System.Reflection @@ -7304,18 +7472,18 @@ type ExecutionContext = { LookupFieldRef : (ILFieldRef -> FieldInfo) LookupMethodRef : (ILMethodRef -> MethodInfo) LookupTypeRef : (ILTypeRef -> Type) - LookupType : (ILType -> Type) } + LookupType : (ILType -> Type) } // A helper to generate a default value for any System.Type. I couldn't find a System.Reflection // method to do this. -let defaultOf = - let gminfo = - lazy - (match <@@ Unchecked.defaultof @@> with - | Quotations.Patterns.Call(_,minfo,_) -> minfo.GetGenericMethodDefinition() +let defaultOf = + let gminfo = + lazy + (match <@@ Unchecked.defaultof @@> with + | Quotations.Patterns.Call(_, minfo, _) -> minfo.GetGenericMethodDefinition() | _ -> failwith "unexpected failure decoding quotation at ilxgen startup") - fun ty -> gminfo.Value.MakeGenericMethod([| ty |]).Invoke(null,[| |]) - + fun ty -> gminfo.Value.MakeGenericMethod([| ty |]).Invoke(null, [| |]) + /// Top-level val bindings are stored (for example) in static fields. /// In the FSI case, these fields are be created and initialised, so we can recover the object. /// IlxGen knows how v was stored, and then ilreflect knows how this storage was generated. @@ -7341,8 +7509,8 @@ let LookupGeneratedValue (amap:ImportMap) (ctxt: ExecutionContext) eenv (v:Val) // because it is the MethodBuilder and that does not support Invoke. // Rather, we look for the getter MethodInfo from the built type and .Invoke on that. let methInfo = staticTy.GetMethod(ilGetterMethRef.Name, BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic) - methInfo.Invoke((null:obj),(null:obj[])) - Some (obj,objTyp()) + methInfo.Invoke((null:obj), (null:obj[])) + Some (obj, objTyp()) | StaticProperty (ilGetterMethSpec, _) -> let obj = @@ -7351,28 +7519,28 @@ let LookupGeneratedValue (amap:ImportMap) (ctxt: ExecutionContext) eenv (v:Val) // because it is the MethodBuilder and that does not support Invoke. // Rather, we look for the getter MethodInfo from the built type and .Invoke on that. let methInfo = staticTy.GetMethod(ilGetterMethSpec.Name, BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic) - methInfo.Invoke((null:obj),(null:obj[])) - Some (obj,objTyp()) + methInfo.Invoke((null:obj), (null:obj[])) + Some (obj, objTyp()) | Null -> - Some (null,objTyp()) - | Local _ -> None + Some (null, objTyp()) + | Local _ -> None | Method _ -> None | Arg _ -> None | Env _ -> None with e -> -#if DEBUG +#if DEBUG printf "ilxGen.LookupGeneratedValue for v=%s caught exception:\n%A\n\n" v.LogicalName e -#endif +#endif None - + // Invoke the set_Foo method for a declaration with a default/null value. Used to release storage in fsi.exe let ClearGeneratedValue (ctxt: ExecutionContext) (_g:TcGlobals) eenv (v:Val) = try match StorageForVal v.Range v eenv with | StaticField (fspec, _, hasLiteralAttr, _, _, _, _ilGetterMethRef, ilSetterMethRef, _) -> - if not hasLiteralAttr && v.IsMutable then + if not hasLiteralAttr && v.IsMutable then let staticTy = ctxt.LookupTypeRef ilSetterMethRef.DeclaringTypeRef let ty = ctxt.LookupType fspec.ActualType @@ -7381,33 +7549,33 @@ let ClearGeneratedValue (ctxt: ExecutionContext) (_g:TcGlobals) eenv (v:Val) = | _ -> () with e -> -#if DEBUG +#if DEBUG printf "ilxGen.ClearGeneratedValue for v=%s caught exception:\n%A\n\n" v.LogicalName e -#endif +#endif () /// The published API from the ILX code generator -type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal : ConstraintSolver.TcValF, ccu: Tast.CcuThunk) = - +type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal : ConstraintSolver.TcValF, ccu: Tast.CcuThunk) = + // The incremental state held by the ILX code generator let mutable ilxGenEnv = GetEmptyIlxGenEnv tcGlobals.ilg ccu let anonTypeTable = AnonTypeGenerationTable() - let intraAssemblyInfo = { StaticFieldInfo = new Dictionary<_,_>(HashIdentity.Structural) } - let casApplied = new Dictionary() + let intraAssemblyInfo = { StaticFieldInfo = new Dictionary<_, _>(HashIdentity.Structural) } + let casApplied = new Dictionary() /// Register a set of referenced assemblies with the ILX code generator - member __.AddExternalCcus ccus = + member __.AddExternalCcus ccus = ilxGenEnv <- AddExternalCcusToIlxGenEnv amap tcGlobals ilxGenEnv ccus /// Register a fragment of the current assembly with the ILX code generator. If 'isIncrementalFragment' is true then the input /// is assumed to be a fragment 'typed' into FSI.EXE, otherwise the input is assumed to be the result of a '#load' - member __.AddIncrementalLocalAssemblyFragment (isIncrementalFragment, fragName, typedImplFiles) = + member __.AddIncrementalLocalAssemblyFragment (isIncrementalFragment, fragName, typedImplFiles) = ilxGenEnv <- AddIncrementalLocalAssemblyFragmentToIlxGenEnv (amap, isIncrementalFragment, tcGlobals, ccu, fragName, intraAssemblyInfo, ilxGenEnv, typedImplFiles) /// Generate ILX code for an assembly fragment - member __.GenerateCode (codeGenOpts, typedAssembly, assemAttribs, moduleAttribs) = - let cenv : cenv = + member __.GenerateCode (codeGenOpts, typedAssembly, assemAttribs, moduleAttribs) = + let cenv : cenv = { g=tcGlobals TcVal = tcVal viewCcu = ccu @@ -7415,7 +7583,7 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal : Constra amap = amap casApplied = casApplied intraAssemblyInfo = intraAssemblyInfo - opts = codeGenOpts + opts = codeGenOpts optimizeDuringCodeGen = (fun x -> x) } GenerateCode (cenv, anonTypeTable, ilxGenEnv, typedAssembly, assemAttribs, moduleAttribs) diff --git a/src/fsharp/IlxGen.fsi b/src/fsharp/IlxGen.fsi index 5e2823f8e3853ca4a41e9edd97c16f8a0c9bf4e2..c93d95fdfe1180f1de4e19ccabf90611b803968e 100644 --- a/src/fsharp/IlxGen.fsi +++ b/src/fsharp/IlxGen.fsi @@ -100,4 +100,6 @@ type public IlxAssemblyGenerator = val ReportStatistics : TextWriter -> unit -val IsValCompiledAsMethod : TcGlobals -> Val -> bool + +/// Determine if an F#-declared value, method or function is compiled as a method. +val IsFSharpValCompiledAsMethod : TcGlobals -> Val -> bool diff --git a/src/fsharp/InfoReader.fs b/src/fsharp/InfoReader.fs index 23544c61209d2d291e038bee5184144bea1f5a16..baa7419119ca0be3627ad52c31f9434709b3f4bc 100644 --- a/src/fsharp/InfoReader.fs +++ b/src/fsharp/InfoReader.fs @@ -8,7 +8,6 @@ open System.Collections.Generic open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Internal.Library - open FSharp.Compiler open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.Ast @@ -44,11 +43,11 @@ let private checkFilter optFilter (nm:string) = match optFilter with None -> tru /// Try to select an F# value when querying members, and if so return a MethInfo that wraps the F# value. let TrySelectMemberVal g optFilter ty pri _membInfo (vref:ValRef) = if checkFilter optFilter vref.LogicalName then - Some(FSMeth(g,ty,vref,pri)) + Some(FSMeth(g, ty, vref, pri)) else None -let rec GetImmediateIntrinsicMethInfosOfTypeAux (optFilter,ad) g amap m origTy metadataTy = +let rec GetImmediateIntrinsicMethInfosOfTypeAux (optFilter, ad) g amap m origTy metadataTy = let minfos = match metadataOfTy g metadataTy with @@ -72,12 +71,12 @@ let rec GetImmediateIntrinsicMethInfosOfTypeAux (optFilter,ad) g amap m origTy m // In this case convert to the .NET Tuple type that carries metadata and try again if isAnyTupleTy g metadataTy then let betterMetadataTy = convertToTypeWithMetadataIfPossible g metadataTy - GetImmediateIntrinsicMethInfosOfTypeAux (optFilter,ad) g amap m origTy betterMetadataTy - // Function types support methods FSharpFunc<_,_>.FromConverter and friends from .NET metadata, + GetImmediateIntrinsicMethInfosOfTypeAux (optFilter, ad) g amap m origTy betterMetadataTy + // Function types support methods FSharpFunc<_, _>.FromConverter and friends from .NET metadata, // but not instance methods (you can't write "f.Invoke(x)", you have to write "f x") elif isFunTy g metadataTy then let betterMetadataTy = convertToTypeWithMetadataIfPossible g metadataTy - GetImmediateIntrinsicMethInfosOfTypeAux (optFilter,ad) g amap m origTy betterMetadataTy + GetImmediateIntrinsicMethInfosOfTypeAux (optFilter, ad) g amap m origTy betterMetadataTy |> List.filter (fun minfo -> not minfo.IsInstance) else match tryDestAppTy g metadataTy with @@ -89,8 +88,8 @@ let rec GetImmediateIntrinsicMethInfosOfTypeAux (optFilter,ad) g amap m origTy m /// Query the immediate methods of an F# type, not taking into account inherited methods. The optFilter /// parameter is an optional name to restrict the set of properties returned. -let GetImmediateIntrinsicMethInfosOfType (optFilter,ad) g amap m ty = - GetImmediateIntrinsicMethInfosOfTypeAux (optFilter,ad) g amap m ty ty +let GetImmediateIntrinsicMethInfosOfType (optFilter, ad) g amap m ty = + GetImmediateIntrinsicMethInfosOfTypeAux (optFilter, ad) g amap m ty ty /// A helper type to help collect properties. /// @@ -105,13 +104,13 @@ type PropertyCollector(g, amap, m, ty, optFilter, ad) = PropInfosEquivByNameAndPartialSig EraseNone g amap m pinfo1 pinfo2 && pinfo1.IsDefiniteFSharpOverride = pinfo2.IsDefiniteFSharpOverride ) - let props = new Dictionary(hashIdentity) + let props = new Dictionary(hashIdentity) let add pinfo = match props.TryGetValue(pinfo), pinfo with - | (true, FSProp (_, ty, Some vref1 ,_)), FSProp (_, _, _, Some vref2) + | (true, FSProp (_, ty, Some vref1 , _)), FSProp (_, _, _, Some vref2) | (true, FSProp (_, ty, _, Some vref2)), FSProp (_, _, Some vref1, _) -> - let pinfo = FSProp (g,ty,Some vref1,Some vref2) + let pinfo = FSProp (g, ty, Some vref1, Some vref2) props.[pinfo] <- pinfo | (true, _), _ -> // This assert fires while editing bad code. We will give a warning later in check.fs @@ -120,22 +119,22 @@ type PropertyCollector(g, amap, m, ty, optFilter, ad) = | _ -> props.[pinfo] <- pinfo - member x.Collect(membInfo:ValMemberInfo,vref:ValRef) = + member x.Collect(membInfo:ValMemberInfo, vref:ValRef) = match membInfo.MemberFlags.MemberKind with | MemberKind.PropertyGet -> - let pinfo = FSProp(g,ty,Some vref,None) + let pinfo = FSProp(g, ty, Some vref, None) if checkFilter optFilter vref.PropertyName && IsPropInfoAccessible g amap m ad pinfo then add pinfo | MemberKind.PropertySet -> - let pinfo = FSProp(g,ty,None,Some vref) + let pinfo = FSProp(g, ty, None, Some vref) if checkFilter optFilter vref.PropertyName && IsPropInfoAccessible g amap m ad pinfo then add pinfo | _ -> () - member x.Close() = [ for KeyValue(_,pinfo) in props -> pinfo ] + member x.Close() = [ for KeyValue(_, pinfo) in props -> pinfo ] -let rec GetImmediateIntrinsicPropInfosOfTypeAux (optFilter,ad) g amap m origTy metadataTy = +let rec GetImmediateIntrinsicPropInfosOfTypeAux (optFilter, ad) g amap m origTy metadataTy = let pinfos = match metadataOfTy g metadataTy with @@ -166,7 +165,7 @@ let rec GetImmediateIntrinsicPropInfosOfTypeAux (optFilter,ad) g amap m origTy m // In this case convert to the .NET Tuple type that carries metadata and try again if isAnyTupleTy g metadataTy || isFunTy g metadataTy then let betterMetadataTy = convertToTypeWithMetadataIfPossible g metadataTy - GetImmediateIntrinsicPropInfosOfTypeAux (optFilter,ad) g amap m origTy betterMetadataTy + GetImmediateIntrinsicPropInfosOfTypeAux (optFilter, ad) g amap m origTy betterMetadataTy else match tryDestAppTy g metadataTy with | ValueNone -> [] @@ -180,8 +179,8 @@ let rec GetImmediateIntrinsicPropInfosOfTypeAux (optFilter,ad) g amap m origTy m /// Query the immediate properties of an F# type, not taking into account inherited properties. The optFilter /// parameter is an optional name to restrict the set of properties returned. -let rec GetImmediateIntrinsicPropInfosOfType (optFilter,ad) g amap m ty = - GetImmediateIntrinsicPropInfosOfTypeAux (optFilter,ad) g amap m ty ty +let rec GetImmediateIntrinsicPropInfosOfType (optFilter, ad) g amap m ty = + GetImmediateIntrinsicPropInfosOfTypeAux (optFilter, ad) g amap m ty ty // Checks whether the given type has an indexer property. let IsIndexerType g amap ty = @@ -218,17 +217,17 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) = let st = info.ProvidedType match optFilter with | None -> - [ for fi in st.PApplyArray((fun st -> st.GetFields()), "GetFields" , m) -> ProvidedField(amap,fi,m) ] + [ for fi in st.PApplyArray((fun st -> st.GetFields()), "GetFields" , m) -> ProvidedField(amap, fi, m) ] | Some name -> match st.PApply ((fun st -> st.GetField name), m) with | Tainted.Null -> [] - | fi -> [ ProvidedField(amap,fi,m) ] + | fi -> [ ProvidedField(amap, fi, m) ] #endif | ILTypeMetadata _ -> let tinfo = ILTypeInfo.FromType g ty let fdefs = tinfo.RawMetadata.Fields let fdefs = match optFilter with None -> fdefs.AsList | Some nm -> fdefs.LookupByName nm - fdefs |> List.map (fun pd -> ILFieldInfo(tinfo,pd)) + fdefs |> List.map (fun pd -> ILFieldInfo(tinfo, pd)) | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> [] let infos = infos |> List.filter (IsILFieldInfoAccessible g amap m ad) @@ -243,18 +242,18 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) = let st = info.ProvidedType match optFilter with | None -> - [ for ei in st.PApplyArray((fun st -> st.GetEvents()), "GetEvents" , m) -> ProvidedEvent(amap,ei,m) ] + [ for ei in st.PApplyArray((fun st -> st.GetEvents()), "GetEvents" , m) -> ProvidedEvent(amap, ei, m) ] | Some name -> match st.PApply ((fun st -> st.GetEvent name), m) with | Tainted.Null -> [] - | ei -> [ ProvidedEvent(amap,ei,m) ] + | ei -> [ ProvidedEvent(amap, ei, m) ] #endif | ILTypeMetadata _ -> let tinfo = ILTypeInfo.FromType g ty let edefs = tinfo.RawMetadata.Events let edefs = match optFilter with None -> edefs.AsList | Some nm -> edefs.LookupByName nm [ for edef in edefs do - let ileinfo = ILEventInfo(tinfo,edef) + let ileinfo = ILEventInfo(tinfo, edef) if IsILEventInfoAccessible g amap m ad ileinfo then yield ILEvent ileinfo ] | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> @@ -263,7 +262,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) = /// Make a reference to a record or class field let MakeRecdFieldInfo g ty (tcref:TyconRef) fspec = - RecdFieldInfo(argsOfAppTy g ty,tcref.MakeNestedRecdFieldRef fspec) + RecdFieldInfo(argsOfAppTy g ty, tcref.MakeNestedRecdFieldRef fspec) /// Get the F#-declared record fields or class 'val' fields of a type let GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter, _ad) _m ty = @@ -284,38 +283,38 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) = /// The primitive reader for the method info sets up a hierarchy - let GetIntrinsicMethodSetsUncached ((optFilter,ad,allowMultiIntfInst),m,ty) = - FoldPrimaryHierarchyOfType (fun ty acc -> GetImmediateIntrinsicMethInfosOfType (optFilter,ad) g amap m ty :: acc) g amap m allowMultiIntfInst ty [] + let GetIntrinsicMethodSetsUncached ((optFilter, ad, allowMultiIntfInst), m, ty) = + FoldPrimaryHierarchyOfType (fun ty acc -> GetImmediateIntrinsicMethInfosOfType (optFilter, ad) g amap m ty :: acc) g amap m allowMultiIntfInst ty [] /// The primitive reader for the property info sets up a hierarchy - let GetIntrinsicPropertySetsUncached ((optFilter,ad,allowMultiIntfInst),m,ty) = - FoldPrimaryHierarchyOfType (fun ty acc -> GetImmediateIntrinsicPropInfosOfType (optFilter,ad) g amap m ty :: acc) g amap m allowMultiIntfInst ty [] + let GetIntrinsicPropertySetsUncached ((optFilter, ad, allowMultiIntfInst), m, ty) = + FoldPrimaryHierarchyOfType (fun ty acc -> GetImmediateIntrinsicPropInfosOfType (optFilter, ad) g amap m ty :: acc) g amap m allowMultiIntfInst ty [] - let GetIntrinsicILFieldInfosUncached ((optFilter,ad),m,ty) = - FoldPrimaryHierarchyOfType (fun ty acc -> GetImmediateIntrinsicILFieldsOfType (optFilter,ad) m ty @ acc) g amap m AllowMultiIntfInstantiations.Yes ty [] + let GetIntrinsicILFieldInfosUncached ((optFilter, ad), m, ty) = + FoldPrimaryHierarchyOfType (fun ty acc -> GetImmediateIntrinsicILFieldsOfType (optFilter, ad) m ty @ acc) g amap m AllowMultiIntfInstantiations.Yes ty [] - let GetIntrinsicEventInfosUncached ((optFilter,ad),m,ty) = - FoldPrimaryHierarchyOfType (fun ty acc -> ComputeImmediateIntrinsicEventsOfType (optFilter,ad) m ty @ acc) g amap m AllowMultiIntfInstantiations.Yes ty [] + let GetIntrinsicEventInfosUncached ((optFilter, ad), m, ty) = + FoldPrimaryHierarchyOfType (fun ty acc -> ComputeImmediateIntrinsicEventsOfType (optFilter, ad) m ty @ acc) g amap m AllowMultiIntfInstantiations.Yes ty [] - let GetIntrinsicRecdOrClassFieldInfosUncached ((optFilter,ad),m,ty) = - FoldPrimaryHierarchyOfType (fun ty acc -> GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter,ad) m ty @ acc) g amap m AllowMultiIntfInstantiations.Yes ty [] + let GetIntrinsicRecdOrClassFieldInfosUncached ((optFilter, ad), m, ty) = + FoldPrimaryHierarchyOfType (fun ty acc -> GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter, ad) m ty @ acc) g amap m AllowMultiIntfInstantiations.Yes ty [] - let GetEntireTypeHierachyUncached (allowMultiIntfInst,m,ty) = + let GetEntireTypeHierachyUncached (allowMultiIntfInst, m, ty) = FoldEntireHierarchyOfType (fun ty acc -> ty :: acc) g amap m allowMultiIntfInst ty [] - let GetPrimaryTypeHierachyUncached (allowMultiIntfInst,m,ty) = + let GetPrimaryTypeHierachyUncached (allowMultiIntfInst, m, ty) = FoldPrimaryHierarchyOfType (fun ty acc -> ty :: acc) g amap m allowMultiIntfInst ty [] /// The primitive reader for the named items up a hierarchy - let GetIntrinsicNamedItemsUncached ((nm,ad),m,ty) = + let GetIntrinsicNamedItemsUncached ((nm, ad), m, ty) = if nm = ".ctor" then None else // '.ctor' lookups only ever happen via constructor syntax let optFilter = Some nm FoldPrimaryHierarchyOfType (fun ty acc -> - let minfos = GetImmediateIntrinsicMethInfosOfType (optFilter,ad) g amap m ty - let pinfos = GetImmediateIntrinsicPropInfosOfType (optFilter,ad) g amap m ty - let finfos = GetImmediateIntrinsicILFieldsOfType (optFilter,ad) m ty - let einfos = ComputeImmediateIntrinsicEventsOfType (optFilter,ad) m ty - let rfinfos = GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter,ad) m ty + let minfos = GetImmediateIntrinsicMethInfosOfType (optFilter, ad) g amap m ty + let pinfos = GetImmediateIntrinsicPropInfosOfType (optFilter, ad) g amap m ty + let finfos = GetImmediateIntrinsicILFieldsOfType (optFilter, ad) m ty + let einfos = ComputeImmediateIntrinsicEventsOfType (optFilter, ad) m ty + let rfinfos = GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter, ad) m ty match acc with | Some(MethodItem(inheritedMethSets)) when not (isNil minfos) -> Some(MethodItem (minfos::inheritedMethSets)) | _ when not (isNil minfos) -> Some(MethodItem ([minfos])) @@ -337,47 +336,47 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) = /// caches computations for monomorphic types. let MakeInfoCache f (flagsEq : System.Collections.Generic.IEqualityComparer<_>) = - new MemoizationTable<_,_> + new MemoizationTable<_, _> (compute=f, // Only cache closed, monomorphic types (closed = all members for the type // have been processed). Generic type instantiations could be processed if we had // a decent hash function for these. - canMemoize=(fun (_flags,(_:range),ty) -> + canMemoize=(fun (_flags, (_:range), ty) -> match stripTyEqns g ty with - | TType_app(tcref,[]) -> tcref.TypeContents.tcaug_closed + | TType_app(tcref, []) -> tcref.TypeContents.tcaug_closed | _ -> false), keyComparer= { new System.Collections.Generic.IEqualityComparer<_> with - member x.Equals((flags1,_,typ1),(flags2,_,typ2)) = + member x.Equals((flags1, _, typ1), (flags2, _, typ2)) = // Ignoring the ranges - that's OK. - flagsEq.Equals(flags1,flags2) && + flagsEq.Equals(flags1, flags2) && match stripTyEqns g typ1, stripTyEqns g typ2 with - | TType_app(tcref1,[]),TType_app(tcref2,[]) -> tyconRefEq g tcref1 tcref2 + | TType_app(tcref1, []), TType_app(tcref2, []) -> tyconRefEq g tcref1 tcref2 | _ -> false - member x.GetHashCode((flags,_,ty)) = + member x.GetHashCode((flags, _, ty)) = // Ignoring the ranges - that's OK. flagsEq.GetHashCode flags + (match stripTyEqns g ty with - | TType_app(tcref,[]) -> hash tcref.LogicalName + | TType_app(tcref, []) -> hash tcref.LogicalName | _ -> 0) }) let hashFlags0 = { new System.Collections.Generic.IEqualityComparer<_> with member x.GetHashCode((filter: string option, ad: AccessorDomain, _allowMultiIntfInst1)) = hash filter + AccessorDomain.CustomGetHashCode ad - member x.Equals((filter1, ad1, allowMultiIntfInst1), (filter2,ad2, allowMultiIntfInst2)) = - (filter1 = filter2) && AccessorDomain.CustomEquals(g,ad1,ad2) && allowMultiIntfInst1 = allowMultiIntfInst2 } + member x.Equals((filter1, ad1, allowMultiIntfInst1), (filter2, ad2, allowMultiIntfInst2)) = + (filter1 = filter2) && AccessorDomain.CustomEquals(g, ad1, ad2) && allowMultiIntfInst1 = allowMultiIntfInst2 } let hashFlags1 = { new System.Collections.Generic.IEqualityComparer<_> with - member x.GetHashCode((filter: string option,ad: AccessorDomain)) = hash filter + AccessorDomain.CustomGetHashCode ad - member x.Equals((filter1,ad1), (filter2,ad2)) = (filter1 = filter2) && AccessorDomain.CustomEquals(g,ad1,ad2) } + member x.GetHashCode((filter: string option, ad: AccessorDomain)) = hash filter + AccessorDomain.CustomGetHashCode ad + member x.Equals((filter1, ad1), (filter2, ad2)) = (filter1 = filter2) && AccessorDomain.CustomEquals(g, ad1, ad2) } let hashFlags2 = { new System.Collections.Generic.IEqualityComparer<_> with - member x.GetHashCode((nm: string,ad: AccessorDomain)) = hash nm + AccessorDomain.CustomGetHashCode ad - member x.Equals((nm1,ad1), (nm2,ad2)) = (nm1 = nm2) && AccessorDomain.CustomEquals(g,ad1,ad2) } + member x.GetHashCode((nm: string, ad: AccessorDomain)) = hash nm + AccessorDomain.CustomGetHashCode ad + member x.Equals((nm1, ad1), (nm2, ad2)) = (nm1 = nm2) && AccessorDomain.CustomEquals(g, ad1, ad2) } let methodInfoCache = MakeInfoCache GetIntrinsicMethodSetsUncached hashFlags0 let propertyInfoCache = MakeInfoCache GetIntrinsicPropertySetsUncached hashFlags0 @@ -393,30 +392,30 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) = member x.amap = amap /// Read the raw method sets of a type, including inherited ones. Cache the result for monomorphic types - member x.GetRawIntrinsicMethodSetsOfType (optFilter,ad,allowMultiIntfInst,m,ty) = - methodInfoCache.Apply(((optFilter,ad,allowMultiIntfInst),m,ty)) + member x.GetRawIntrinsicMethodSetsOfType (optFilter, ad, allowMultiIntfInst, m, ty) = + methodInfoCache.Apply(((optFilter, ad, allowMultiIntfInst), m, ty)) /// Read the raw property sets of a type, including inherited ones. Cache the result for monomorphic types - member x.GetRawIntrinsicPropertySetsOfType (optFilter,ad,allowMultiIntfInst,m,ty) = - propertyInfoCache.Apply(((optFilter,ad,allowMultiIntfInst),m,ty)) + member x.GetRawIntrinsicPropertySetsOfType (optFilter, ad, allowMultiIntfInst, m, ty) = + propertyInfoCache.Apply(((optFilter, ad, allowMultiIntfInst), m, ty)) /// Read the record or class fields of a type, including inherited ones. Cache the result for monomorphic types. - member x.GetRecordOrClassFieldsOfType (optFilter,ad,m,ty) = - recdOrClassFieldInfoCache.Apply(((optFilter,ad),m,ty)) + member x.GetRecordOrClassFieldsOfType (optFilter, ad, m, ty) = + recdOrClassFieldInfoCache.Apply(((optFilter, ad), m, ty)) /// Read the IL fields of a type, including inherited ones. Cache the result for monomorphic types. - member x.GetILFieldInfosOfType (optFilter,ad,m,ty) = - ilFieldInfoCache.Apply(((optFilter,ad),m,ty)) + member x.GetILFieldInfosOfType (optFilter, ad, m, ty) = + ilFieldInfoCache.Apply(((optFilter, ad), m, ty)) - member x.GetImmediateIntrinsicEventsOfType (optFilter,ad,m,ty) = ComputeImmediateIntrinsicEventsOfType (optFilter,ad) m ty + member x.GetImmediateIntrinsicEventsOfType (optFilter, ad, m, ty) = ComputeImmediateIntrinsicEventsOfType (optFilter, ad) m ty /// Read the events of a type, including inherited ones. Cache the result for monomorphic types. - member x.GetEventInfosOfType (optFilter,ad,m,ty) = - eventInfoCache.Apply(((optFilter,ad),m,ty)) + member x.GetEventInfosOfType (optFilter, ad, m, ty) = + eventInfoCache.Apply(((optFilter, ad), m, ty)) /// Try and find a record or class field for a type. - member x.TryFindRecdOrClassFieldInfoOfType (nm,m,ty) = - match recdOrClassFieldInfoCache.Apply((Some nm,AccessibleFromSomewhere),m,ty) with + member x.TryFindRecdOrClassFieldInfoOfType (nm, m, ty) = + match recdOrClassFieldInfoCache.Apply((Some nm, AccessibleFromSomewhere), m, ty) with | [] -> ValueNone | [single] -> ValueSome single | flds -> @@ -431,16 +430,16 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) = | _ -> failwith "unexpected multiple fields with same name" // Because it should have been already reported as duplicate fields /// Try and find an item with the given name in a type. - member x.TryFindNamedItemOfType (nm,ad,m,ty) = - namedItemsCache.Apply(((nm,ad),m,ty)) + member x.TryFindNamedItemOfType (nm, ad, m, ty) = + namedItemsCache.Apply(((nm, ad), m, ty)) /// Get the super-types of a type, including interface types. - member x.GetEntireTypeHierachy (allowMultiIntfInst,m,ty) = - entireTypeHierarchyCache.Apply((allowMultiIntfInst,m,ty)) + member x.GetEntireTypeHierachy (allowMultiIntfInst, m, ty) = + entireTypeHierarchyCache.Apply((allowMultiIntfInst, m, ty)) /// Get the super-types of a type, excluding interface types. - member x.GetPrimaryTypeHierachy (allowMultiIntfInst,m,ty) = - primaryTypeHierarchyCache.Apply((allowMultiIntfInst,m,ty)) + member x.GetPrimaryTypeHierachy (allowMultiIntfInst, m, ty) = + primaryTypeHierarchyCache.Apply((allowMultiIntfInst, m, ty)) /// Get the declared constructors of any F# type @@ -453,7 +452,7 @@ let rec GetIntrinsicConstructorInfosOfTypeAux (infoReader:InfoReader) m origTy m | ProvidedTypeMetadata info -> let st = info.ProvidedType [ for ci in st.PApplyArray((fun st -> st.GetConstructors()), "GetConstructors", m) do - yield ProvidedMeth(amap,ci.Coerce(m),None,m) ] + yield ProvidedMeth(amap, ci.Coerce(m), None, m) ] #endif | ILTypeMetadata _ -> let tinfo = ILTypeInfo.FromType g origTy @@ -510,10 +509,10 @@ type private IndexedList<'T>(itemLists: 'T list list, itemsByName: NameMultiMap< member x.ItemsWithName(nm) = NameMultiMap.find nm itemsByName /// Add new items, extracting the names using the given function. - member x.AddItems(items,nmf) = IndexedList<'T>(items::itemLists,List.foldBack (fun x acc -> NameMultiMap.add (nmf x) x acc) items itemsByName ) + member x.AddItems(items, nmf) = IndexedList<'T>(items::itemLists, List.foldBack (fun x acc -> NameMultiMap.add (nmf x) x acc) items itemsByName ) /// Get an empty set of items - static member Empty = IndexedList<'T>([],NameMultiMap.empty) + static member Empty = IndexedList<'T>([], NameMultiMap.empty) /// Filter a set of new items to add according to the content of the list. Only keep an item /// if it passes 'keepTest' for all matching items already in the list. @@ -541,7 +540,7 @@ let private FilterItemsInSubTypesBasedOnItemsInSuperTypes nmf keepTest itemLists | items :: itemsInSuperTypes -> let ilist = loop itemsInSuperTypes let itemsToAdd = ilist.FilterNewItems keepTest nmf items - ilist.AddItems(itemsToAdd,nmf) + ilist.AddItems(itemsToAdd, nmf) (loop itemLists).Items /// Add all the items to the IndexedList, preferring the ones in the sub-types. @@ -551,7 +550,7 @@ let private FilterItemsInSuperTypesBasedOnItemsInSubTypes nmf keepTest itemLists | [] -> List.rev indexedItemsInSubTypes.Items | items :: itemsInSuperTypes -> let itemsToAdd = items |> List.filter (fun item -> keepTest item (indexedItemsInSubTypes.ItemsWithName(nmf item))) - let ilist = indexedItemsInSubTypes.AddItems(itemsToAdd,nmf) + let ilist = indexedItemsInSubTypes.AddItems(itemsToAdd, nmf) loop itemsInSuperTypes ilist loop itemLists IndexedList.Empty @@ -560,7 +559,7 @@ let private ExcludeItemsInSuperTypesBasedOnEquivTestWithItemsInSubTypes nmf equi FilterItemsInSuperTypesBasedOnItemsInSubTypes nmf (fun item1 items -> not (items |> List.exists (fun item2 -> equivTest item1 item2))) itemLists /// Filter the overrides of methods or properties, either keeping the overrides or keeping the dispatch slots. -let private FilterOverrides findFlag (isVirt:'a->bool,isNewSlot,isDefiniteOverride,isFinal,equivSigs,nmf:'a->string) items = +let private FilterOverrides findFlag (isVirt:'a->bool, isNewSlot, isDefiniteOverride, isFinal, equivSigs, nmf:'a->string) items = let equivVirts x y = isVirt x && isVirt y && equivSigs x y match findFlag with @@ -641,7 +640,7 @@ let private FilterOverridesOfPropInfos findFlag g amap m props = (fun pinfo -> pinfo.IsNewSlot), (fun pinfo -> pinfo.IsDefiniteFSharpOverride), (fun _ -> false), - PropInfosEquivByNameAndSig EraseNone g amap m, + PropInfosEquivByNameAndSig EraseNone g amap m, (fun pinfo -> pinfo.PropertyName)) /// Exclude methods from super types which have the same signature as a method in a more specific type. @@ -663,25 +662,25 @@ let ExcludeHiddenOfPropInfos g amap m pinfos = |> List.concat /// Get the sets of intrinsic methods in the hierarchy (not including extension methods) -let GetIntrinsicMethInfoSetsOfType (infoReader:InfoReader) (optFilter,ad,allowMultiIntfInst) findFlag m ty = - infoReader.GetRawIntrinsicMethodSetsOfType(optFilter,ad,allowMultiIntfInst,m,ty) +let GetIntrinsicMethInfoSetsOfType (infoReader:InfoReader) (optFilter, ad, allowMultiIntfInst) findFlag m ty = + infoReader.GetRawIntrinsicMethodSetsOfType(optFilter, ad, allowMultiIntfInst, m, ty) |> FilterOverridesOfMethInfos findFlag infoReader.g infoReader.amap m /// Get the sets intrinsic properties in the hierarchy (not including extension properties) -let GetIntrinsicPropInfoSetsOfType (infoReader:InfoReader) (optFilter,ad,allowMultiIntfInst) findFlag m ty = - infoReader.GetRawIntrinsicPropertySetsOfType(optFilter,ad,allowMultiIntfInst,m,ty) +let GetIntrinsicPropInfoSetsOfType (infoReader:InfoReader) (optFilter, ad, allowMultiIntfInst) findFlag m ty = + infoReader.GetRawIntrinsicPropertySetsOfType(optFilter, ad, allowMultiIntfInst, m, ty) |> FilterOverridesOfPropInfos findFlag infoReader.g infoReader.amap m /// Get the flattened list of intrinsic methods in the hierarchy -let GetIntrinsicMethInfosOfType infoReader (optFilter,ad,allowMultiIntfInst) findFlag m ty = - GetIntrinsicMethInfoSetsOfType infoReader (optFilter,ad,allowMultiIntfInst) findFlag m ty |> List.concat +let GetIntrinsicMethInfosOfType infoReader (optFilter, ad, allowMultiIntfInst) findFlag m ty = + GetIntrinsicMethInfoSetsOfType infoReader (optFilter, ad, allowMultiIntfInst) findFlag m ty |> List.concat /// Get the flattened list of intrinsic properties in the hierarchy -let GetIntrinsicPropInfosOfType infoReader (optFilter,ad,allowMultiIntfInst) findFlag m ty = - GetIntrinsicPropInfoSetsOfType infoReader (optFilter,ad,allowMultiIntfInst) findFlag m ty |> List.concat +let GetIntrinsicPropInfosOfType infoReader (optFilter, ad, allowMultiIntfInst) findFlag m ty = + GetIntrinsicPropInfoSetsOfType infoReader (optFilter, ad, allowMultiIntfInst) findFlag m ty |> List.concat /// Perform type-directed name resolution of a particular named member in an F# type -let TryFindIntrinsicNamedItemOfType (infoReader:InfoReader) (nm,ad) findFlag m ty = +let TryFindIntrinsicNamedItemOfType (infoReader:InfoReader) (nm, ad) findFlag m ty = match infoReader.TryFindNamedItemOfType(nm, ad, m, ty) with | Some item -> match item with @@ -696,12 +695,12 @@ let TryFindIntrinsicNamedItemOfType (infoReader:InfoReader) (nm,ad) findFlag m t /// -- getting the Dispose method when resolving the 'use' construct /// -- getting the various methods used to desugar the computation expression syntax let TryFindIntrinsicMethInfo infoReader m ad nm ty = - GetIntrinsicMethInfosOfType infoReader (Some nm,ad,AllowMultiIntfInstantiations.Yes) IgnoreOverrides m ty + GetIntrinsicMethInfosOfType infoReader (Some nm, ad, AllowMultiIntfInstantiations.Yes) IgnoreOverrides m ty /// Try to find a particular named property on a type. Only used to ensure that local 'let' definitions and property names /// are distinct, a somewhat adhoc check in tc.fs. let TryFindPropInfo infoReader m ad nm ty = - GetIntrinsicPropInfosOfType infoReader (Some nm,ad,AllowMultiIntfInstantiations.Yes) IgnoreOverrides m ty + GetIntrinsicPropInfosOfType infoReader (Some nm, ad, AllowMultiIntfInstantiations.Yes) IgnoreOverrides m ty //------------------------------------------------------------------------- // Helpers related to delegates and events - these use method searching hence are in this file @@ -718,16 +717,16 @@ let GetSigOfFunctionForDelegate (infoReader:InfoReader) delty m ad = let g = infoReader.g let amap = infoReader.amap let invokeMethInfo = - match GetIntrinsicMethInfosOfType infoReader (Some "Invoke",ad,AllowMultiIntfInstantiations.Yes) IgnoreOverrides m delty with + match GetIntrinsicMethInfosOfType infoReader (Some "Invoke", ad, AllowMultiIntfInstantiations.Yes) IgnoreOverrides m delty with | [h] -> h - | [] -> error(Error(FSComp.SR.noInvokeMethodsFound (),m)) - | h :: _ -> warning(InternalError(FSComp.SR.moreThanOneInvokeMethodFound (),m)); h + | [] -> error(Error(FSComp.SR.noInvokeMethodsFound (), m)) + | h :: _ -> warning(InternalError(FSComp.SR.moreThanOneInvokeMethodFound (), m)); h let minst = [] // a delegate's Invoke method is never generic let compiledViewOfDelArgTys = match invokeMethInfo.GetParamTypes(amap, m, minst) with | [args] -> args - | _ -> error(Error(FSComp.SR.delegatesNotAllowedToHaveCurriedSignatures (),m)) + | _ -> error(Error(FSComp.SR.delegatesNotAllowedToHaveCurriedSignatures (), m)) let fsharpViewOfDelArgTys = match compiledViewOfDelArgTys with | [] -> [g.unit_ty] @@ -735,14 +734,14 @@ let GetSigOfFunctionForDelegate (infoReader:InfoReader) delty m ad = let delRetTy = invokeMethInfo.GetFSharpReturnTy(amap, m, minst) CheckMethInfoAttributes g m None invokeMethInfo |> CommitOperationResult let fty = mkIteratedFunTy fsharpViewOfDelArgTys delRetTy - SigOfFunctionForDelegate(invokeMethInfo,compiledViewOfDelArgTys,delRetTy,fty) + SigOfFunctionForDelegate(invokeMethInfo, compiledViewOfDelArgTys, delRetTy, fty) /// Try and interpret a delegate type as a "standard" .NET delegate type associated with an event, with a "sender" parameter. let TryDestStandardDelegateType (infoReader:InfoReader) m ad delTy = let g = infoReader.g - let (SigOfFunctionForDelegate(_,compiledViewOfDelArgTys,delRetTy,_)) = GetSigOfFunctionForDelegate infoReader delTy m ad + let (SigOfFunctionForDelegate(_, compiledViewOfDelArgTys, delRetTy, _)) = GetSigOfFunctionForDelegate infoReader delTy m ad match compiledViewOfDelArgTys with - | senderTy :: argTys when (isObjTy g senderTy) && not (List.exists (isByrefTy g) argTys) -> Some(mkRefTupledTy g argTys,delRetTy) + | senderTy :: argTys when (isObjTy g senderTy) && not (List.exists (isByrefTy g) argTys) -> Some(mkRefTupledTy g argTys, delRetTy) | _ -> None @@ -762,7 +761,7 @@ let TryDestStandardDelegateType (infoReader:InfoReader) m ad delTy = /// already defined an appropriate delegate type: EventHandler. /// (from http://msdn.microsoft.com/library/default.asp?url=/library/en-us/csref/html/vcwlkEventsTutorial.asp) let IsStandardEventInfo (infoReader:InfoReader) m ad (einfo:EventInfo) = - let dty = einfo.GetDelegateType(infoReader.amap,m) + let dty = einfo.GetDelegateType(infoReader.amap, m) match TryDestStandardDelegateType infoReader m ad dty with | Some _ -> true | None -> false @@ -770,9 +769,9 @@ let IsStandardEventInfo (infoReader:InfoReader) m ad (einfo:EventInfo) = /// Get the (perhaps tupled) argument type accepted by an event let ArgsTypOfEventInfo (infoReader:InfoReader) m ad (einfo:EventInfo) = let amap = infoReader.amap - let dty = einfo.GetDelegateType(amap,m) + let dty = einfo.GetDelegateType(amap, m) match TryDestStandardDelegateType infoReader m ad dty with - | Some(argtys,_) -> argtys + | Some(argtys, _) -> argtys | None -> error(nonStandardEventError einfo.EventName m) /// Get the type of the event when looked at as if it is a property @@ -780,7 +779,7 @@ let ArgsTypOfEventInfo (infoReader:InfoReader) m ad (einfo:EventInfo) = let PropTypOfEventInfo (infoReader:InfoReader) m ad (einfo:EventInfo) = let g = infoReader.g let amap = infoReader.amap - let delTy = einfo.GetDelegateType(amap,m) + let delTy = einfo.GetDelegateType(amap, m) let argsTy = ArgsTypOfEventInfo infoReader m ad einfo mkIEventType g delTy argsTy diff --git a/src/fsharp/InnerLambdasToTopLevelFuncs.fs b/src/fsharp/InnerLambdasToTopLevelFuncs.fs index c03ac2ace3c8f3b3f570056d349249a4256ea679..e25d1b4d11be6121fd30caf744313533fdad88e5 100644 --- a/src/fsharp/InnerLambdasToTopLevelFuncs.fs +++ b/src/fsharp/InnerLambdasToTopLevelFuncs.fs @@ -1,10 +1,10 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.InnerLambdasToTopLevelFuncs +module internal FSharp.Compiler.InnerLambdasToTopLevelFuncs -open FSharp.Compiler -open FSharp.Compiler.AbstractIL.Internal -open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler +open FSharp.Compiler.AbstractIL.Internal +open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.Ast open FSharp.Compiler.ErrorLogger @@ -22,13 +22,13 @@ let verboseTLR = false // library helpers //------------------------------------------------------------------------- -let internalError str = dprintf "Error: %s\n" str;raise (Failure str) +let internalError str = dprintf "Error: %s\n" str;raise (Failure str) -module Zmap = - let force k mp (str,soK) = - try Zmap.find k mp - with e -> - dprintf "Zmap.force: %s %s\n" str (soK k); +module Zmap = + let force k mp (str, soK) = + try Zmap.find k mp + with e -> + dprintf "Zmap.force: %s %s\n" str (soK k) PreserveStackTrace(e) raise e @@ -36,7 +36,7 @@ module Zmap = // misc //------------------------------------------------------------------------- -/// tree, used to store dec sequence +/// tree, used to store dec sequence type Tree<'T> = | TreeNode of Tree<'T> list | LeafNode of 'T @@ -46,7 +46,7 @@ let fringeTR tr = match tr with | TreeNode subts -> List.foldBack collect subts acc | LeafNode x -> x::acc - + collect tr [] let emptyTR = TreeNode[] @@ -56,32 +56,32 @@ let emptyTR = TreeNode[] // misc //------------------------------------------------------------------------- -/// Collapse reclinks on app and combine apps if possible -/// recursive ids are inside reclinks and maybe be type instanced with a Expr.App +/// Collapse reclinks on app and combine apps if possible +/// recursive ids are inside reclinks and maybe be type instanced with a Expr.App -// CLEANUP NOTE: mkApps ensures applications are kept in a collapsed -// and combined form, so this function should not be needed -let destApp (f,fty,tys,args,m) = +// CLEANUP NOTE: mkApps ensures applications are kept in a collapsed +// and combined form, so this function should not be needed +let destApp (f, fty, tys, args, m) = match stripExpr f with - | Expr.App (f2,fty2,tys2,[] ,_) -> (f2,fty2,tys2 @ tys,args,m) - | Expr.App _ -> (f,fty,tys,args,m) (* has args, so not combine ty args *) - | f -> (f,fty,tys,args,m) + | Expr.App (f2, fty2, tys2, [] , _) -> (f2, fty2, tys2 @ tys, args, m) + | Expr.App _ -> (f, fty, tys, args, m) (* has args, so not combine ty args *) + | f -> (f, fty, tys, args, m) #if DEBUG -let showTyparSet tps = showL (commaListL (List.map typarL (Zset.elements tps))) +let showTyparSet tps = showL (commaListL (List.map typarL (Zset.elements tps))) #endif -// CLEANUP NOTE: don't like the look of this function - this distinction -// should never be needed -let isDelayedRepr (f:Val) e = - let _tps,vss,_b,_rty = stripTopLambda (e,f.Type) +// CLEANUP NOTE: don't like the look of this function - this distinction +// should never be needed +let isDelayedRepr (f:Val) e = + let _tps, vss, _b, _rty = stripTopLambda (e, f.Type) List.length vss>0 -// REVIEW: these should just be replaced by direct calls to mkLocal, mkCompGenLocal etc. -// REVIEW: However these set an arity whereas the others don't +// REVIEW: these should just be replaced by direct calls to mkLocal, mkCompGenLocal etc. +// REVIEW: However these set an arity whereas the others don't let mkLocalNameTypeArity compgen m name ty topValInfo = - NewVal(name,m,None,ty,Immutable,compgen,topValInfo,taccessPublic,ValNotInRecScope,None,NormalVal,[],ValInline.Optional,XmlDoc.Empty,false,false,false,false,false,false,None,ParentNone) + NewVal(name, m, None, ty, Immutable, compgen, topValInfo, taccessPublic, ValNotInRecScope, None, NormalVal, [], ValInline.Optional, XmlDoc.Empty, false, false, false, false, false, false, None, ParentNone) //------------------------------------------------------------------------- // definitions: TLR, arity, arity-met, arity-short @@ -143,20 +143,20 @@ let GetValsBoundUnderMustInline xinfo = //------------------------------------------------------------------------- // pass1: IsRefusedTLR //------------------------------------------------------------------------- - -let IsRefusedTLR g (f:Val) = + +let IsRefusedTLR g (f:Val) = let mutableVal = f.IsMutable - // things marked ValInline.Never are special + // things marked ValInline.Never are special let dllImportStubOrOtherNeverInline = (f.InlineInfo = ValInline.Never) - // Cannot have static fields of byref type + // Cannot have static fields of byref type let byrefVal = isByrefLikeTy g f.Range f.Type - // Special values are instance methods etc. on .NET types. For now leave these alone + // Special values are instance methods etc. on .NET types. For now leave these alone let specialVal = f.MemberInfo.IsSome let alreadyChosen = f.ValReprInfo.IsSome let refuseTest = alreadyChosen || mutableVal || byrefVal || specialVal || dllImportStubOrOtherNeverInline refuseTest -let IsMandatoryTopLevel (f:Val) = +let IsMandatoryTopLevel (f:Val) = let specialVal = f.MemberInfo.IsSome let isModulBinding = f.IsMemberOrModuleBinding specialVal || isModulBinding @@ -169,34 +169,34 @@ let IsMandatoryNonTopLevel g (f:Val) = // pass1: decide which f are to be TLR? and if so, arity(f) //------------------------------------------------------------------------- -module Pass1_DetermineTLRAndArities = +module Pass1_DetermineTLRAndArities = let GetMaxNumArgsAtUses xinfo f = match Zmap.tryFind f xinfo.Uses with | None -> 0 (* no call sites *) - | Some sites -> - sites |> List.map (fun (_accessors,_tinst,args) -> List.length args) |> List.max + | Some sites -> + sites |> List.map (fun (_accessors, _tinst, args) -> List.length args) |> List.max let SelectTLRVals g xinfo f e = - if IsRefusedTLR g f then None + if IsRefusedTLR g f then None // Exclude values bound in a decision tree else if Zset.contains f xinfo.DecisionTreeBindings then None else - // Could the binding be TLR? with what arity? + // Could the binding be TLR? with what arity? let atTopLevel = Zset.contains f xinfo.TopLevelBindings - let tps,vss,_b,_rty = stripTopLambda (e,f.Type) + let tps, vss, _b, _rty = stripTopLambda (e, f.Type) let nFormals = vss.Length - let nMaxApplied = GetMaxNumArgsAtUses xinfo f + let nMaxApplied = GetMaxNumArgsAtUses xinfo f let arity = Operators.min nFormals nMaxApplied - if atTopLevel || arity<>0 || not (isNil tps) then Some (f,arity) + if atTopLevel || arity<>0 || not (isNil tps) then Some (f, arity) else None /// Check if f involves any value recursion (so can skip those). /// ValRec considered: recursive && some f in mutual binding is not bound to a lambda let IsValueRecursionFree xinfo f = - let hasDelayedRepr f = isDelayedRepr f (Zmap.force f xinfo.Defns ("IsValueRecursionFree - hasDelayedRepr",nameOfVal)) - let isRecursive,mudefs = Zmap.force f xinfo.RecursiveBindings ("IsValueRecursionFree",nameOfVal) + let hasDelayedRepr f = isDelayedRepr f (Zmap.force f xinfo.Defns ("IsValueRecursionFree - hasDelayedRepr", nameOfVal)) + let isRecursive, mudefs = Zmap.force f xinfo.RecursiveBindings ("IsValueRecursionFree", nameOfVal) not isRecursive || List.forall hasDelayedRepr mudefs let DumpArity arityM = @@ -207,28 +207,28 @@ module Pass1_DetermineTLRAndArities = let xinfo = GetUsageInfoOfImplFile g expr let fArities = Zmap.chooseL (SelectTLRVals g xinfo) xinfo.Defns let fArities = List.filter (fst >> IsValueRecursionFree xinfo) fArities - // Do not TLR v if it is bound under a mustinline defn - // There is simply no point - the original value will be duplicated and TLR'd anyway + // Do not TLR v if it is bound under a mustinline defn + // There is simply no point - the original value will be duplicated and TLR'd anyway let rejectS = GetValsBoundUnderMustInline xinfo - let fArities = List.filter (fun (v,_) -> not (Zset.contains v rejectS)) fArities + let fArities = List.filter (fun (v, _) -> not (Zset.contains v rejectS)) fArities (*-*) let tlrS = Zset.ofList valOrder (List.map fst fArities) let topValS = xinfo.TopLevelBindings (* genuinely top level *) let topValS = Zset.filter (IsMandatoryNonTopLevel g >> not) topValS (* restrict *) (* REPORT MISSED CASES *) #if DEBUG - if verboseTLR then + if verboseTLR then let missed = Zset.diff xinfo.TopLevelBindings tlrS - missed |> Zset.iter (fun v -> dprintf "TopLevel but not TLR = %s\n" v.LogicalName) + missed |> Zset.iter (fun v -> dprintf "TopLevel but not TLR = %s\n" v.LogicalName) #endif - (* REPORT OVER *) + (* REPORT OVER *) let arityM = Zmap.ofList valOrder fArities #if DEBUG if verboseTLR then DumpArity arityM #endif - tlrS,topValS, arityM + tlrS, topValS, arityM + - (* NOTES: For constants, @@ -244,28 +244,28 @@ module Pass1_DetermineTLRAndArities = // pass2: determine reqdTypars(f) and envreq(f) - notes //------------------------------------------------------------------------- -/// What are the closing types/values for {f1,f2...} mutually defined? +/// What are the closing types/values for {f1, f2...} mutually defined? /// // Note: arity-met g-applications (g TLR) will translated as: // [[g @ tps ` args]] -> gHAT @ reqdTypars(g) tps ` env(g) args // so they require availability of closing types/values for g. // -// If g is free wrt f1,f2... then g's closure must be included. +// If g is free wrt f1, f2... then g's closure must be included. // // Note: mutual definitions have a common closure. // -// For f1,f2,... = fBody1,fbody2... mutual bindings: +// For f1, f2, ... = fBody1, fbody2... mutual bindings: +// +// DEFN: The reqdVals0 are the free-values of fBody1, fBody2... // -// DEFN: The reqdVals0 are the free-values of fBody1,fBody2... -// // What are the closure equations? // -// reqdTypars(f1,f2..) includes free-tps(f) -// reqdTypars(f1,f2..) includes reqdTypars(g) if fBody has arity-met g-occurrence (g TLR). +// reqdTypars(f1, f2..) includes free-tps(f) +// reqdTypars(f1, f2..) includes reqdTypars(g) if fBody has arity-met g-occurrence (g TLR). // -// reqdItems(f1,f2...) includes ReqdSubEnv(g) if fBody has arity-met g-occurrence (g TLR) -// reqdItems(f1,f2...) includes ReqdVal(g) if fBody has arity-short g-occurrence (g TLR) -// reqdItems(f1,f2...) includes ReqdVal(g) if fBody has g-occurrence (g not TLR) +// reqdItems(f1, f2...) includes ReqdSubEnv(g) if fBody has arity-met g-occurrence (g TLR) +// reqdItems(f1, f2...) includes ReqdVal(g) if fBody has arity-short g-occurrence (g TLR) +// reqdItems(f1, f2...) includes ReqdVal(g) if fBody has g-occurrence (g not TLR) // // and only collect requirements if g is a generator (see next notes). // @@ -273,7 +273,7 @@ module Pass1_DetermineTLRAndArities = // In the translated code, env(h) will be defined at the h definition point. // So, where-ever h could be called (recursive or not), // the env(h) will be available (in scope). -// +// // Note (subtle): "sub-env-requirement-only-for-reqdVals0" // If have an arity-met call to h inside fBody, but h is not a freevar for f, // then h does not contribute env(h) to env(f), the closure for f. @@ -299,7 +299,7 @@ type BindingGroupSharingSameReqdItems(bindings: Bindings) = member fclass.IsEmpty = isNil vals - member fclass.Pairs = vals |> List.map (fun f -> (f,fclass)) + member fclass.Pairs = vals |> List.map (fun f -> (f, fclass)) override fclass.ToString() = "+" + String.concat "+" (List.map nameOfVal vals) @@ -312,18 +312,18 @@ let fclassOrder = Order.orderOn (fun (b: BindingGroupSharingSameReqdItems) -> b. type ReqdItem = | ReqdSubEnv of Val | ReqdVal of Val - override i.ToString() = - match i with + override i.ToString() = + match i with | ReqdSubEnv f -> "&" + f.LogicalName | ReqdVal f -> f.LogicalName let reqdItemOrder = let rep = function - | ReqdSubEnv v -> true ,v - | ReqdVal v -> false,v - - Order.orderOn rep (Pair.order (Bool.order,valOrder)) + | ReqdSubEnv v -> true , v + | ReqdVal v -> false, v + + Order.orderOn rep (Pair.order (Bool.order, valOrder)) /// An env says what is needed to close the corresponding defn(s). /// The reqdTypars are the free reqdTypars of the defns, and those required by any direct TLR arity-met calls. @@ -335,19 +335,19 @@ type ReqdItemsForDefn = member env.ReqdSubEnvs = [ for x in env.reqdItems do match x with | ReqdSubEnv f -> yield f | ReqdVal _ -> () ] member env.ReqdVals = [ for x in env.reqdItems do match x with | ReqdSubEnv _ -> () | ReqdVal v -> yield v ] - member env.Extend (typars,items) = + member env.Extend (typars, items) = {env with reqdTypars = Zset.addList typars env.reqdTypars reqdItems = Zset.addList items env.reqdItems} - static member Initial typars m = + static member Initial typars m = {reqdTypars = Zset.addList typars (Zset.empty typarOrder) reqdItems = Zset.empty reqdItemOrder m = m } - override env.ToString() = + override env.ToString() = (showL (commaListL (List.map typarL (Zset.elements env.reqdTypars)))) + "--" + - (String.concat "," (List.map string (Zset.elements env.reqdItems))) + (String.concat ", " (List.map string (Zset.elements env.reqdItems))) (*--debug-stuff--*) @@ -358,12 +358,12 @@ type ReqdItemsForDefn = type Generators = Zset -/// check a named function value applied to sufficient arguments -let IsArityMet (vref:ValRef) wf (tys: TypeInst) args = - (tys.Length = vref.Typars.Length) && (wf <= List.length args) +/// check a named function value applied to sufficient arguments +let IsArityMet (vref:ValRef) wf (tys: TypeInst) args = + (tys.Length = vref.Typars.Length) && (wf <= List.length args) -module Pass2_DetermineReqdItems = +module Pass2_DetermineReqdItems = // IMPLEMENTATION PLAN: @@ -371,19 +371,19 @@ module Pass2_DetermineReqdItems = // fold over expr. // // - at an instance g, - // - (a) g arity-met, LogRequiredFrom g - ReqdSubEnv(g) -- direct call will require env(g) and reqdTypars(g) + // - (a) g arity-met, LogRequiredFrom g - ReqdSubEnv(g) -- direct call will require env(g) and reqdTypars(g) // - (b) g arity-short, LogRequiredFrom g - ReqdVal(g) -- remains g call - // - (c) g non-TLR, LogRequiredFrom g - ReqdVal(g) -- remains g + // - (c) g non-TLR, LogRequiredFrom g - ReqdVal(g) -- remains g // where - // LogRequiredFrom g ... = logs info into (reqdVals0,env) if g in reqdVals0. + // LogRequiredFrom g ... = logs info into (reqdVals0, env) if g in reqdVals0. + // + // - at some mu-bindings, f1, f2... = fBody1, fBody2, ... + // "note reqdVals0, push (reqdVals0, env), fold-over bodies, pop, fold rest" // - // - at some mu-bindings, f1,f2... = fBody1,fBody2,... - // "note reqdVals0, push (reqdVals0,env), fold-over bodies, pop, fold rest" - // - // - let fclass = ff1,... be the fi which are being made TLR. + // - let fclass = ff1, ... be the fi which are being made TLR. // - required to find an env for these. // - start a new envCollector: - // freetps = freetypars of (fBody1,fBody2,...) + // freetps = freetypars of (fBody1, fBody2, ...) // freevs = freevars of .. // initialise: // reqdTypars = freetps @@ -409,14 +409,14 @@ module Pass2_DetermineReqdItems = /// recShortCallS - the f which are "recursively-called" in arity short instance. /// /// When walking expr, at each mutual binding site, - /// push a (generator,env) collector frame on stack. + /// push a (generator, env) collector frame on stack. /// If occurrences in body are relevant (for a generator) then it's contribution is logged. /// /// recShortCalls to f will require a binding for f in terms of fHat within the fHatBody. type state = { stack : (BindingGroupSharingSameReqdItems * Generators * ReqdItemsForDefn) list - reqdItemsMap : Zmap - fclassM : Zmap + reqdItemsMap : Zmap + fclassM : Zmap revDeclist : BindingGroupSharingSameReqdItems list recShortCallS : Zset } @@ -428,45 +428,45 @@ module Pass2_DetermineReqdItems = revDeclist = [] recShortCallS = Zset.empty valOrder } - /// PUSH = start collecting for fclass - let PushFrame (fclass: BindingGroupSharingSameReqdItems) (reqdTypars0,reqdVals0,m) state = - if fclass.IsEmpty then - state + /// PUSH = start collecting for fclass + let PushFrame (fclass: BindingGroupSharingSameReqdItems) (reqdTypars0, reqdVals0, m) state = + if fclass.IsEmpty then + state else {state with revDeclist = fclass :: state.revDeclist - stack = (let env = ReqdItemsForDefn.Initial reqdTypars0 m in (fclass,reqdVals0,env)::state.stack) } + stack = (let env = ReqdItemsForDefn.Initial reqdTypars0 m in (fclass, reqdVals0, env)::state.stack) } - /// POP & SAVE = end collecting for fclass and store - let SaveFrame (fclass: BindingGroupSharingSameReqdItems) state = + /// POP & SAVE = end collecting for fclass and store + let SaveFrame (fclass: BindingGroupSharingSameReqdItems) state = if verboseTLR then dprintf "SaveFrame: %A\n" fclass - if fclass.IsEmpty then - state + if fclass.IsEmpty then + state else match state.stack with | [] -> internalError "trl: popFrame has empty stack" - | (fclass,_reqdVals0,env)::stack -> (* ASSERT: same fclass *) + | (fclass, _reqdVals0, env)::stack -> (* ASSERT: same fclass *) {state with stack = stack reqdItemsMap = Zmap.add fclass env state.reqdItemsMap - fclassM = List.fold (fun mp (k,v) -> Zmap.add k v mp) state.fclassM fclass.Pairs } + fclassM = List.fold (fun mp (k, v) -> Zmap.add k v mp) state.fclassM fclass.Pairs } - /// Log requirements for gv in the relevant stack frames + /// Log requirements for gv in the relevant stack frames let LogRequiredFrom gv items state = let logIntoFrame (fclass, reqdVals0:Zset, env: ReqdItemsForDefn) = - let env = + let env = if reqdVals0.Contains gv then - env.Extend ([],items) + env.Extend ([], items) else env - - fclass,reqdVals0,env - + + fclass, reqdVals0, env + {state with stack = List.map logIntoFrame state.stack} let LogShortCall gv state = - if state.stack |> List.exists (fun (fclass,_reqdVals0,_env) -> fclass.Contains gv) then + if state.stack |> List.exists (fun (fclass, _reqdVals0, _env) -> fclass.Contains gv) then if verboseTLR then dprintf "shortCall: rec: %s\n" gv.LogicalName - // Have short call to gv within it's (mutual) definition(s) + // Have short call to gv within it's (mutual) definition(s) {state with recShortCallS = Zset.add gv state.recShortCallS} else @@ -476,80 +476,84 @@ module Pass2_DetermineReqdItems = let FreeInBindings bs = List.fold (foldOn (freeInBindingRhs CollectTyparsAndLocals) unionFreeVars) emptyFreeVars bs /// Intercepts selected exprs. - /// "letrec f1,f2,... = fBody1,fBody2,... in rest" - + /// "letrec f1, f2, ... = fBody1, fBody2, ... in rest" - /// "val v" - free occurrence - /// "app (f,tps,args)" - occurrence + /// "app (f, tps, args)" - occurrence /// - /// On intercepted nodes, must exprF fold to collect from subexpressions. - let ExprEnvIntercept (tlrS,arityM) exprF z expr = - let accInstance z (fvref:ValRef,tps,args) (* f known local *) = + /// On intercepted nodes, must recurseF fold to collect from subexpressions. + let ExprEnvIntercept (tlrS, arityM) recurseF noInterceptF z expr = + + let accInstance z (fvref:ValRef, tps, args) = let f = fvref.Deref match Zmap.tryFind f arityM with - - | Some wf -> - // f is TLR with arity wf + + | Some wf -> + // f is TLR with arity wf if IsArityMet fvref wf tps args then - // arity-met call to a TLR g - LogRequiredFrom f [ReqdSubEnv f] z + // arity-met call to a TLR g + LogRequiredFrom f [ReqdSubEnv f] z else - // arity-short instance - let z = LogRequiredFrom f [ReqdVal f] z - // LogShortCall - logs recursive short calls - let z = LogShortCall f z + // arity-short instance + let z = LogRequiredFrom f [ReqdVal f] z + // LogShortCall - logs recursive short calls + let z = LogShortCall f z z - - | None -> - // f is non-TLR - LogRequiredFrom f [ReqdVal f] z - + + | None -> + // f is non-TLR + LogRequiredFrom f [ReqdVal f] z + let accBinds m z (binds: Bindings) = - let tlrBs,nonTlrBs = binds |> List.partition (fun b -> Zset.contains b.Var tlrS) - // For bindings marked TLR, collect implied env + let tlrBs, nonTlrBs = binds |> List.partition (fun b -> Zset.contains b.Var tlrS) + // For bindings marked TLR, collect implied env let fclass = BindingGroupSharingSameReqdItems tlrBs - // what determines env? - let frees = FreeInBindings tlrBs - let reqdTypars0 = frees.FreeTyvars.FreeTypars |> Zset.elements (* put in env *) + // what determines env? + let frees = FreeInBindings tlrBs + // put in env + let reqdTypars0 = frees.FreeTyvars.FreeTypars |> Zset.elements // occurrences contribute to env let reqdVals0 = frees.FreeLocals |> Zset.elements // tlrBs are not reqdVals0 for themselves let reqdVals0 = reqdVals0 |> List.filter (fun gv -> not (fclass.Contains gv)) let reqdVals0 = reqdVals0 |> Zset.ofList valOrder // collect into env over bodies - let z = PushFrame fclass (reqdTypars0,reqdVals0,m) z - let z = (z,tlrBs) ||> List.fold (foldOn (fun b -> b.Expr) exprF) - let z = SaveFrame fclass z - (* for bindings not marked TRL, collect *) - let z = (z,nonTlrBs) ||> List.fold (foldOn (fun b -> b.Expr) exprF) + let z = PushFrame fclass (reqdTypars0, reqdVals0,m) z + let z = (z, tlrBs) ||> List.fold (foldOn (fun b -> b.Expr) recurseF) + let z = SaveFrame fclass z + // for bindings not marked TRL, collect + let z = (z, nonTlrBs) ||> List.fold (foldOn (fun b -> b.Expr) recurseF) z - + match expr with - | Expr.Val (v,_,_) -> - let z = accInstance z (v,[],[]) - Some z - | Expr.Op (TOp.LValueOp (_,v),_tys,args,_) -> - let z = accInstance z (v,[],[]) - let z = List.fold exprF z args - Some z - | Expr.App (f,fty,tys,args,m) -> - let f,_fty,tys,args,_m = destApp (f,fty,tys,args,m) + | Expr.Val (v, _, _) -> + accInstance z (v, [], []) + + | Expr.Op (TOp.LValueOp (_, v), _tys, args, _) -> + let z = accInstance z (v, [], []) + List.fold recurseF z args + + | Expr.App (f, fty, tys, args, m) -> + let f, _fty, tys, args, _m = destApp (f, fty, tys, args, m) match f with - | Expr.Val (f,_,_) -> - // // YES: APP vspec tps args - log - let z = accInstance z (f,tys,args) - let z = List.fold exprF z args - Some z + | Expr.Val (f, _, _) -> + // YES: APP vspec tps args - log + let z = accInstance z (f, tys, args) + List.fold recurseF z args | _ -> - (* NO: app, but function is not val - no log *) - None - | Expr.LetRec (binds,body,m,_) -> + // NO: app, but function is not val - no log + noInterceptF z expr + + | Expr.LetRec (binds, body, m, _) -> let z = accBinds m z binds - let z = exprF z body - Some z - | Expr.Let (bind,body,m,_) -> + recurseF z body + + | Expr.Let (bind,body,m,_) -> let z = accBinds m z [bind] - let z = exprF z body - Some z - | _ -> None (* NO: no intercept *) + // tailcall for linear sequences + recurseF z body + + | _ -> + noInterceptF z expr /// Initially, reqdTypars(fclass) = freetps(bodies). @@ -557,12 +561,12 @@ module Pass2_DetermineReqdItems = /// Required to include the reqdTypars(gv) in reqdTypars(fclass). let CloseReqdTypars fclassM reqdItemsMap = if verboseTLR then dprintf "CloseReqdTypars------\n" - + let closeStep reqdItemsMap changed fc (env: ReqdItemsForDefn) = let directCallReqdEnvs = env.ReqdSubEnvs - let directCallReqdTypars = directCallReqdEnvs |> List.map (fun f -> - let fc = Zmap.force f fclassM ("reqdTyparsFor",nameOfVal) - let env = Zmap.force fc reqdItemsMap ("reqdTyparsFor",string) + let directCallReqdTypars = directCallReqdEnvs |> List.map (fun f -> + let fc = Zmap.force f fclassM ("reqdTyparsFor", nameOfVal) + let env = Zmap.force fc reqdItemsMap ("reqdTyparsFor", string) env.reqdTypars) let reqdTypars0 = env.reqdTypars @@ -570,35 +574,35 @@ module Pass2_DetermineReqdItems = let changed = changed || (not (Zset.equal reqdTypars0 reqdTypars)) let env = {env with reqdTypars = reqdTypars} #if DEBUG - if verboseTLR then + if verboseTLR then dprintf "closeStep: fc=%30A nSubs=%d reqdTypars0=%s reqdTypars=%s\n" fc directCallReqdEnvs.Length (showTyparSet reqdTypars0) (showTyparSet reqdTypars) - directCallReqdEnvs |> List.iter (fun f -> dprintf "closeStep: dcall f=%s\n" f.LogicalName) + directCallReqdEnvs |> List.iter (fun f -> dprintf "closeStep: dcall f=%s\n" f.LogicalName) directCallReqdEnvs |> List.iter (fun f -> dprintf "closeStep: dcall fc=%A\n" (Zmap.find f fclassM)) - directCallReqdTypars |> List.iter (fun _reqdTypars -> dprintf "closeStep: dcall reqdTypars=%s\n" (showTyparSet reqdTypars0)) + directCallReqdTypars |> List.iter (fun _reqdTypars -> dprintf "closeStep: dcall reqdTypars=%s\n" (showTyparSet reqdTypars0)) #else ignore fc #endif - changed,env - + changed, env + let rec fixpoint reqdItemsMap = let changed = false - let changed,reqdItemsMap = Zmap.foldMap (closeStep reqdItemsMap) changed reqdItemsMap + let changed, reqdItemsMap = Zmap.foldMap (closeStep reqdItemsMap) changed reqdItemsMap if changed then fixpoint reqdItemsMap else reqdItemsMap - + fixpoint reqdItemsMap #if DEBUG let DumpReqdValMap reqdItemsMap = - for KeyValue(fc,env) in reqdItemsMap do + for KeyValue(fc, env) in reqdItemsMap do dprintf "CLASS=%A\n env=%A\n" fc env #endif - let DetermineReqdItems (tlrS,arityM) expr = + let DetermineReqdItems (tlrS, arityM) expr = if verboseTLR then dprintf "DetermineReqdItems------\n" - let folder = {ExprFolder0 with exprIntercept = ExprEnvIntercept (tlrS,arityM)} + let folder = {ExprFolder0 with exprIntercept = ExprEnvIntercept (tlrS, arityM)} let z = state0 // Walk the entire assembly let z = FoldImplFile folder z expr @@ -607,25 +611,25 @@ module Pass2_DetermineReqdItems = let fclassM = z.fclassM let declist = List.rev z.revDeclist let recShortCallS = z.recShortCallS - // diagnostic dump + // diagnostic dump #if DEBUG if verboseTLR then DumpReqdValMap reqdItemsMap #endif - // close the reqdTypars under the subEnv reln + // close the reqdTypars under the subEnv reln let reqdItemsMap = CloseReqdTypars fclassM reqdItemsMap - // filter out trivial fclass - with no TLR defns + // filter out trivial fclass - with no TLR defns let reqdItemsMap = Zmap.remove (BindingGroupSharingSameReqdItems List.empty) reqdItemsMap - // restrict declist to those with reqdItemsMap bindings (the non-trivial ones) + // restrict declist to those with reqdItemsMap bindings (the non-trivial ones) let declist = List.filter (Zmap.memberOf reqdItemsMap) declist #if DEBUG - // diagnostic dump + // diagnostic dump if verboseTLR then DumpReqdValMap reqdItemsMap - declist |> List.iter (fun fc -> dprintf "Declist: %A\n" fc) - recShortCallS |> Zset.iter (fun f -> dprintf "RecShortCall: %s\n" f.LogicalName) + declist |> List.iter (fun fc -> dprintf "Declist: %A\n" fc) + recShortCallS |> Zset.iter (fun f -> dprintf "RecShortCall: %s\n" f.LogicalName) #endif - reqdItemsMap,fclassM,declist,recShortCallS + reqdItemsMap, fclassM, declist, recShortCallS //------------------------------------------------------------------------- // step3: PackedReqdItems @@ -645,14 +649,14 @@ module Pass2_DetermineReqdItems = /// provided it is fixed up via a copyExpr call on the final expr. type PackedReqdItems = - { /// The actual typars - ep_etps : Typars - /// The actual env carrier values - ep_aenvs : Val list - /// Sequentially define the aenvs in terms of the fvs - ep_pack : Bindings - /// Sequentially define the fvs in terms of the aenvs - ep_unpack : Bindings + { /// The actual typars + ep_etps : Typars + /// The actual env carrier values + ep_aenvs : Val list + /// Sequentially define the aenvs in terms of the fvs + ep_pack : Bindings + /// Sequentially define the fvs in terms of the aenvs + ep_unpack : Bindings } @@ -667,98 +671,98 @@ exception AbortTLR of Range.range /// Note, tupling would cause an allocation, /// so, unless arg lists get very long, this flat packing will be preferable. -/// Given (fclass,env). -/// Have env = ReqdVal vj, ReqdSubEnv subEnvk -- ranging over j,k +/// Given (fclass, env). +/// Have env = ReqdVal vj, ReqdSubEnv subEnvk -- ranging over j, k /// Define vals(env) = {vj}|j union vals(subEnvk)|k -- trans closure of vals of env. -/// Define for each vi in vals(env). +/// Define for each vi in vals(env). /// This is the cmap for the env. /// reqdTypars = env.reqdTypars /// carriers = aenvi|i -/// pack = TBIND(aenvi = vi) for each (aenvi,vi) in cmap +/// pack = TBIND(aenvi = vi) for each (aenvi, vi) in cmap /// unpack = TBIND(vj = aenvFor(vj)) for each vj in reqvals(env). -/// and TBIND(asubEnvi = aenvFor(v)) for each (asubEnvi,v) in cmap(subEnvk) ranging over required subEnvk. +/// and TBIND(asubEnvi = aenvFor(v)) for each (asubEnvi, v) in cmap(subEnvk) ranging over required subEnvk. /// where -/// aenvFor(v) = aenvi where (v,aenvi) in cmap. -let FlatEnvPacks g fclassM topValS declist (reqdItemsMap: Zmap) = - let fclassOf f = Zmap.force f fclassM ("fclassM",nameOfVal) +/// aenvFor(v) = aenvi where (v, aenvi) in cmap. +let FlatEnvPacks g fclassM topValS declist (reqdItemsMap: Zmap) = + let fclassOf f = Zmap.force f fclassM ("fclassM", nameOfVal) let packEnv carrierMaps (fc:BindingGroupSharingSameReqdItems) = if verboseTLR then dprintf "\ntlr: packEnv fc=%A\n" fc - let env = Zmap.force fc reqdItemsMap ("packEnv",string) + let env = Zmap.force fc reqdItemsMap ("packEnv", string) - // carrierMaps = (fclass,(v,aenv)map)map - let carrierMapFor f = Zmap.force (fclassOf f) carrierMaps ("carrierMapFor",string) + // carrierMaps = (fclass, (v, aenv)map)map + let carrierMapFor f = Zmap.force (fclassOf f) carrierMaps ("carrierMapFor", string) let valsSubEnvFor f = Zmap.keys (carrierMapFor f) - // determine vals(env) - transclosure - let vals = env.ReqdVals @ List.collect valsSubEnvFor env.ReqdSubEnvs // list, with repeats + // determine vals(env) - transclosure + let vals = env.ReqdVals @ List.collect valsSubEnvFor env.ReqdSubEnvs // list, with repeats let vals = List.noRepeats valOrder vals // noRepeats // Remove genuinely toplevel, no need to close over these - let vals = vals |> List.filter (IsMandatoryTopLevel >> not) + let vals = vals |> List.filter (IsMandatoryTopLevel >> not) // Remove byrefs, no need to close over these, and would be invalid to do so since their values can change. // // Note that it is normally not OK to skip closing over values, since values given (method) TLR must have implementations // which are truly closed. However, byref values never escape into any lambdas, so are never used in anything - // for which we will choose a method TLR. - // + // for which we will choose a method TLR. + // // For example, consider this (FSharp 1.0 bug 5578): // - // let mutable a = 1 + // let mutable a = 1 // - // let resutl1 = + // let resutl1 = // let x = &a // This is NOT given TLR, because it is byref - // x <- 111 - // let temp = x // This is given a static field TLR, not a method TLR + // x <- 111 + // let temp = x // This is given a static field TLR, not a method TLR // // let f () = x // This is not allowed, can't capture x - // x <- 999 + // x <- 999 // temp - // + // // Compare with this: - // let mutable a = 1 + // let mutable a = 1 // - // let result2 = + // let result2 = // let x = a // this is given static field TLR - // a <- 111 + // a <- 111 // let temp = a // let f () = x // This is not allowed, and is given a method TLR - // a <- 999 + // a <- 999 // temp let vals = vals |> List.filter (fun v -> not (isByrefLikeTy g v.Range v.Type)) // Remove values which have been labelled TLR, no need to close over these - let vals = vals |> List.filter (Zset.memberOf topValS >> not) - - // Carrier sets cannot include constrained polymorphic values. We can't just take such a value out, so for the moment - // we'll just abandon TLR altogether and give a warning about this condition. - match vals |> List.tryFind (IsGenericValWithGenericContraints g) with - | None -> () + let vals = vals |> List.filter (Zset.memberOf topValS >> not) + + // Carrier sets cannot include constrained polymorphic values. We can't just take such a value out, so for the moment + // we'll just abandon TLR altogether and give a warning about this condition. + match vals |> List.tryFind (IsGenericValWithGenericContraints g) with + | None -> () | Some v -> raise (AbortTLR v.Range) - // build cmap for env - let cmapPairs = vals |> List.map (fun v -> (v,(mkCompGenLocal env.m v.LogicalName v.Type |> fst))) + // build cmap for env + let cmapPairs = vals |> List.map (fun v -> (v, (mkCompGenLocal env.m v.LogicalName v.Type |> fst))) let cmap = Zmap.ofList valOrder cmapPairs - let aenvFor v = Zmap.force v cmap ("aenvFor",nameOfVal) + let aenvFor v = Zmap.force v cmap ("aenvFor", nameOfVal) let aenvExprFor v = exprForVal env.m (aenvFor v) - // build PackedReqdItems + // build PackedReqdItems let reqdTypars = env.reqdTypars let aenvs = Zmap.values cmap - let pack = cmapPairs |> List.map (fun (v,aenv) -> mkInvisibleBind aenv (exprForVal env.m v)) - let unpack = - let unpackCarrier (v,aenv) = mkInvisibleBind (setValHasNoArity v) (exprForVal env.m aenv) - let unpackSubenv f = - let subCMap = carrierMapFor f + let pack = cmapPairs |> List.map (fun (v, aenv) -> mkInvisibleBind aenv (exprForVal env.m v)) + let unpack = + let unpackCarrier (v, aenv) = mkInvisibleBind (setValHasNoArity v) (exprForVal env.m aenv) + let unpackSubenv f = + let subCMap = carrierMapFor f let vaenvs = Zmap.toList subCMap - vaenvs |> List.map (fun (subv,subaenv) -> mkBind NoSequencePointAtInvisibleBinding subaenv (aenvExprFor subv)) + vaenvs |> List.map (fun (subv, subaenv) -> mkBind NoSequencePointAtInvisibleBinding subaenv (aenvExprFor subv)) List.map unpackCarrier (Zmap.toList cmap) @ List.collect unpackSubenv env.ReqdSubEnvs - - // extend carrierMaps + + // extend carrierMaps let carrierMaps = Zmap.add fc cmap carrierMaps - // dump + // dump if verboseTLR then dprintf "tlr: packEnv envVals =%s\n" (showL (listL valL env.ReqdVals)) dprintf "tlr: packEnv envSubs =%s\n" (showL (listL valL env.ReqdSubEnvs)) @@ -767,14 +771,14 @@ let FlatEnvPacks g fclassM topValS declist (reqdItemsMap: Zmap showL (valL v))) - let fc = Zmap.force f fclassM ("createFHat - fc",nameOfVal) - let envp = Zmap.force fc envPackM ("CreateNewValuesForTLR - envp",string) + let wf = Zmap.force f arityM ("createFHat - wf", (fun v -> showL (valL v))) + let fc = Zmap.force f fclassM ("createFHat - fc", nameOfVal) + let envp = Zmap.force fc envPackM ("CreateNewValuesForTLR - envp", string) let name = f.LogicalName (* + "_TLR_" + string wf *) let m = f.Range - let tps,tau = f.TypeScheme - let argtys,res = stripFunTy g tau + let tps, tau = f.TypeScheme + let argtys, res = stripFunTy g tau let newTps = envp.ep_etps @ tps - let fHatTy = + let fHatTy = let newArgtys = List.map typeOfVal envp.ep_aenvs @ argtys mkLambdaTy newTps newArgtys res let fHatArity = MakeSimpleArityInfo newTps (envp.ep_aenvs.Length + wf) - let fHatName = globalNng.FreshCompilerGeneratedName(name,m) + let fHatName = globalNng.FreshCompilerGeneratedName(name, m) let fHat = mkLocalNameTypeArity f.IsCompilerGenerated m fHatName fHatTy (Some fHatArity) fHat - + let fs = Zset.elements tlrS - let ffHats = List.map (fun f -> f,createFHat f) fs + let ffHats = List.map (fun f -> f, createFHat f) fs let fHatM = Zmap.ofList valOrder ffHats fHatM @@ -854,14 +858,14 @@ module Pass4_RewriteAssembly = type RewriteContext = { ccu : CcuThunk g : TcGlobals - tlrS : Zset - topValS : Zset - arityM : Zmap - fclassM : Zmap - recShortCallS : Zset - envPackM : Zmap + tlrS : Zset + topValS : Zset + arityM : Zmap + fclassM : Zmap + recShortCallS : Zset + envPackM : Zmap /// The mapping from 'f' values to 'fHat' values - fHatM : Zmap + fHatM : Zmap } @@ -870,7 +874,7 @@ module Pass4_RewriteAssembly = //------------------------------------------------------------------------- type IsRecursive = IsRec | NotRec - type LiftedDeclaration = IsRecursive * Bindings (* where bool=true if letrec *) + type LiftedDeclaration = IsRecursive * Bindings (* where bool=true if letrec *) /// This state is related to lifting to top-level (which is actually disabled right now) /// This is to ensure the TLR constants get initialised once. @@ -885,70 +889,70 @@ module Pass4_RewriteAssembly = /// giving pre-declarations to insert before the outermost lambda expr. type RewriteState = { rws_mustinline: bool - /// counts level of enclosing "lambdas" - rws_innerLevel : int - /// collected preDecs (fringe is in-order) - rws_preDecs : Tree + /// counts level of enclosing "lambdas" + rws_innerLevel : int + /// collected preDecs (fringe is in-order) + rws_preDecs : Tree } let rewriteState0 = {rws_mustinline=false;rws_innerLevel=0;rws_preDecs=emptyTR} - // move in/out of lambdas (or lambda containing construct) + // move in/out of lambdas (or lambda containing construct) let EnterInner z = {z with rws_innerLevel = z.rws_innerLevel + 1} let ExitInner z = {z with rws_innerLevel = z.rws_innerLevel - 1} - let EnterMustInline b z f = + let EnterMustInline b z f = let orig = z.rws_mustinline - let x,z' = f (if b then {z with rws_mustinline = true } else z) - {z' with rws_mustinline = orig },x + let x, z' = f (if b then {z with rws_mustinline = true } else z) + {z' with rws_mustinline = orig }, x - /// extract PreDecs (iff at top-level) + /// extract PreDecs (iff at top-level) let ExtractPreDecs z = // If level=0, so at top-level, then pop decs, // else keep until get back to a top-level point. if z.rws_innerLevel=0 then - // at top-level, extract preDecs + // at top-level, extract preDecs let preDecs = fringeTR z.rws_preDecs - preDecs,{z with rws_preDecs=emptyTR} - else - // not yet top-level, keep decs - [],z + preDecs, {z with rws_preDecs=emptyTR} + else + // not yet top-level, keep decs + [], z - /// pop and set preDecs as "LiftedDeclaration tree" - let PopPreDecs z = {z with rws_preDecs=emptyTR},z.rws_preDecs + /// pop and set preDecs as "LiftedDeclaration tree" + let PopPreDecs z = {z with rws_preDecs=emptyTR}, z.rws_preDecs let SetPreDecs z pdt = {z with rws_preDecs=pdt} - /// collect Top* repr bindings - if needed... + /// collect Top* repr bindings - if needed... let LiftTopBinds _isRec _penv z binds = - z,binds - - /// Wrap preDecs (in order) over an expr - use letrec/let as approp - let MakePreDec m (isRec,binds: Bindings) expr = - if isRec=IsRec then + z, binds + + /// Wrap preDecs (in order) over an expr - use letrec/let as approp + let MakePreDec m (isRec, binds: Bindings) expr = + if isRec=IsRec then // By definition top level bindings don't refer to non-top level bindings, so we can build them in two parts - let topLevelBinds, nonTopLevelBinds = binds |> List.partition (fun bind -> bind.Var.IsCompiledAsTopLevel) + let topLevelBinds, nonTopLevelBinds = binds |> List.partition (fun bind -> bind.Var.IsCompiledAsTopLevel) mkLetRecBinds m topLevelBinds (mkLetRecBinds m nonTopLevelBinds expr) - else + else mkLetsFromBindings m binds expr /// Must MakePreDecs around every construct that could do EnterInner (which filters TLR decs). - /// i.e. let,letrec (bind may...), ilobj, lambda, tlambda. + /// i.e. let, letrec (bind may...), ilobj, lambda, tlambda. let MakePreDecs m preDecs expr = List.foldBack (MakePreDec m) preDecs expr let RecursivePreDecs pdsA pdsB = let pds = fringeTR (TreeNode[pdsA;pdsB]) let decs = pds |> List.collect snd - LeafNode (IsRec,decs) + LeafNode (IsRec, decs) //------------------------------------------------------------------------- // pass4: lowertop - convert_vterm_bind on TopLevel binds //------------------------------------------------------------------------- - let ConvertBind g (TBind(v,repr,_) as bind) = - match v.ValReprInfo with + let ConvertBind g (TBind(v, repr, _) as bind) = + match v.ValReprInfo with | None -> v.SetValReprInfo (Some (InferArityOfExprBinding g AllowTypeDirectedDetupling.Yes v repr )) | Some _ -> () - + bind //------------------------------------------------------------------------- @@ -956,82 +960,82 @@ module Pass4_RewriteAssembly = //------------------------------------------------------------------------- // Transform - // let f vss = f_body[,f_freeVars] + // let f vss = f_body[, f_freeVars] // To // let f vss = fHat f_freeVars vss - // let fHat f_freeVars vss = f_body[,f_freeVars] - let TransTLRBindings penv (binds:Bindings) = - if isNil binds then List.empty,List.empty else + // let fHat f_freeVars vss = f_body[, f_freeVars] + let TransTLRBindings penv (binds:Bindings) = + if isNil binds then List.empty, List.empty else let fc = BindingGroupSharingSameReqdItems binds - let envp = Zmap.force fc penv.envPackM ("TransTLRBindings",string) - - let fRebinding (TBind(fOrig,b,letSeqPtOpt)) = + let envp = Zmap.force fc penv.envPackM ("TransTLRBindings", string) + + let fRebinding (TBind(fOrig, b, letSeqPtOpt)) = let m = fOrig.Range - let tps,vss,_b,rty = stripTopLambda (b,fOrig.Type) - let aenvExprs = envp.ep_aenvs |> List.map (exprForVal m) - let vsExprs = vss |> List.map (mkRefTupledVars penv.g m) - let fHat = Zmap.force fOrig penv.fHatM ("fRebinding",nameOfVal) + let tps, vss, _b, rty = stripTopLambda (b, fOrig.Type) + let aenvExprs = envp.ep_aenvs |> List.map (exprForVal m) + let vsExprs = vss |> List.map (mkRefTupledVars penv.g m) + let fHat = Zmap.force fOrig penv.fHatM ("fRebinding", nameOfVal) (* REVIEW: is this mutation really, really necessary? *) (* Why are we applying TLR if the thing already has an arity? *) let fOrig = setValHasNoArity fOrig - let fBind = - mkMultiLambdaBind fOrig letSeqPtOpt m tps vss - (mkApps penv.g + let fBind = + mkMultiLambdaBind fOrig letSeqPtOpt m tps vss + (mkApps penv.g ((exprForVal m fHat, fHat.Type), [List.map mkTyparTy (envp.ep_etps @ tps)], - aenvExprs @ vsExprs,m),rty) - fBind + aenvExprs @ vsExprs, m), rty) + fBind - let fHatNewBinding (shortRecBinds:Bindings) (TBind(f,b,letSeqPtOpt)) = - let wf = Zmap.force f penv.arityM ("fHatNewBinding - arityM",nameOfVal) - let fHat = Zmap.force f penv.fHatM ("fHatNewBinding - fHatM",nameOfVal) + let fHatNewBinding (shortRecBinds:Bindings) (TBind(f, b, letSeqPtOpt)) = + let wf = Zmap.force f penv.arityM ("fHatNewBinding - arityM", nameOfVal) + let fHat = Zmap.force f penv.fHatM ("fHatNewBinding - fHatM", nameOfVal) // Take off the variables - let tps,vss,b,rty = stripTopLambda (b,f.Type) + let tps, vss, b, rty = stripTopLambda (b, f.Type) // Don't take all the variables - only up to length wf - let vssTake,vssDrop = List.splitAt wf vss + let vssTake, vssDrop = List.splitAt wf vss // put the variables back on - let b,rty = mkMultiLambdasCore b.Range vssDrop (b,rty) - // fHat, args + let b, rty = mkMultiLambdasCore b.Range vssDrop (b, rty) + // fHat, args let m = fHat.Range // Add the type variables to the front let fHat_tps = envp.ep_etps @ tps // Add the 'aenv' and original taken variables to the front let fHat_args = List.map List.singleton envp.ep_aenvs @ vssTake - let fHat_body = mkLetsFromBindings m envp.ep_unpack b - let fHat_body = mkLetsFromBindings m shortRecBinds fHat_body // bind "f" if have short recursive calls (somewhere) - // fHat binding, f rebinding - let fHatBind = mkMultiLambdaBind fHat letSeqPtOpt m fHat_tps fHat_args (fHat_body,rty) + let fHat_body = mkLetsFromBindings m envp.ep_unpack b + let fHat_body = mkLetsFromBindings m shortRecBinds fHat_body // bind "f" if have short recursive calls (somewhere) + // fHat binding, f rebinding + let fHatBind = mkMultiLambdaBind fHat letSeqPtOpt m fHat_tps fHat_args (fHat_body, rty) fHatBind - let rebinds = binds |> List.map fRebinding - let shortRecBinds = rebinds |> List.filter (fun b -> penv.recShortCallS.Contains(b.Var)) - let newBinds = binds |> List.map (fHatNewBinding shortRecBinds) - newBinds,rebinds + let rebinds = binds |> List.map fRebinding + let shortRecBinds = rebinds |> List.filter (fun b -> penv.recShortCallS.Contains(b.Var)) + let newBinds = binds |> List.map (fHatNewBinding shortRecBinds) + newBinds, rebinds let GetAEnvBindings penv fc = match Zmap.tryFind fc penv.envPackM with - | None -> List.empty // no env for this mutual binding - | Some envp -> envp.ep_pack // environment pack bindings + | None -> List.empty // no env for this mutual binding + | Some envp -> envp.ep_pack // environment pack bindings let TransBindings xisRec penv (binds:Bindings) = - let tlrBs,nonTlrBs = binds |> List.partition (fun b -> Zset.contains b.Var penv.tlrS) + let tlrBs, nonTlrBs = binds |> List.partition (fun b -> Zset.contains b.Var penv.tlrS) let fclass = BindingGroupSharingSameReqdItems tlrBs - // Trans each TLR f binding into fHat and f rebind - let newTlrBinds,tlrRebinds = TransTLRBindings penv tlrBs + // Trans each TLR f binding into fHat and f rebind + let newTlrBinds, tlrRebinds = TransTLRBindings penv tlrBs let aenvBinds = GetAEnvBindings penv fclass - // lower nonTlrBs if they are GTL - // QUERY: we repeat this logic in LowerCallsAndSeqs. Do we really need to do this here? - // QUERY: yes and no - if we don't, we have an unrealizable term, and many decisions must - // QUERY: correlate with LowerCallsAndSeqs. - let forceTopBindToHaveArity (bind:Binding) = - if penv.topValS.Contains(bind.Var) then ConvertBind penv.g bind + // lower nonTlrBs if they are GTL + // QUERY: we repeat this logic in LowerCallsAndSeqs. Do we really need to do this here? + // QUERY: yes and no - if we don't, we have an unrealizable term, and many decisions must + // QUERY: correlate with LowerCallsAndSeqs. + let forceTopBindToHaveArity (bind:Binding) = + if penv.topValS.Contains(bind.Var) then ConvertBind penv.g bind else bind - let nonTlrBs = nonTlrBs |> List.map forceTopBindToHaveArity - let tlrRebinds = tlrRebinds |> List.map forceTopBindToHaveArity - // assemble into replacement bindings - let bindAs,rebinds = + let nonTlrBs = nonTlrBs |> List.map forceTopBindToHaveArity + let tlrRebinds = tlrRebinds |> List.map forceTopBindToHaveArity + // assemble into replacement bindings + let bindAs, rebinds = match xisRec with - | IsRec -> newTlrBinds @ tlrRebinds @ nonTlrBs @ aenvBinds,[] (* note: aenv last, order matters in letrec! *) + | IsRec -> newTlrBinds @ tlrRebinds @ nonTlrBs @ aenvBinds, [] (* note: aenv last, order matters in letrec! *) | NotRec -> aenvBinds @ newTlrBinds, tlrRebinds @ nonTlrBs (* note: aenv go first, they may be used *) bindAs, rebinds @@ -1040,28 +1044,28 @@ module Pass4_RewriteAssembly = // pass4: TransApp (translate) //------------------------------------------------------------------------- - let TransApp penv (fx,fty,tys,args,m) = - // Is it a val app, where the val f is TLR with arity wf? - // CLEANUP NOTE: should be using a mkApps to make all applications + let TransApp penv (fx, fty, tys, args, m) = + // Is it a val app, where the val f is TLR with arity wf? + // CLEANUP NOTE: should be using a mkApps to make all applications match fx with - | Expr.Val (fvref:ValRef,_,m) when + | Expr.Val (fvref:ValRef, _, m) when (Zset.contains fvref.Deref penv.tlrS) && - (let wf = Zmap.force fvref.Deref penv.arityM ("TransApp - wf",nameOfVal) + (let wf = Zmap.force fvref.Deref penv.arityM ("TransApp - wf", nameOfVal) IsArityMet fvref wf tys args) -> let f = fvref.Deref (* replace by direct call to corresponding fHat (and additional closure args) *) - let fc = Zmap.force f penv.fclassM ("TransApp - fc",nameOfVal) - let envp = Zmap.force fc penv.envPackM ("TransApp - envp",string) - let fHat = Zmap.force f penv.fHatM ("TransApp - fHat",nameOfVal) + let fc = Zmap.force f penv.fclassM ("TransApp - fc", nameOfVal) + let envp = Zmap.force fc penv.envPackM ("TransApp - envp", string) + let fHat = Zmap.force f penv.fHatM ("TransApp - fHat", nameOfVal) let tys = (List.map mkTyparTy envp.ep_etps) @ tys let aenvExprs = List.map (exprForVal m) envp.ep_aenvs let args = aenvExprs @ args - mkApps penv.g ((exprForVal m fHat, fHat.Type),[tys],args,m) (* change, direct fHat call with closure (reqdTypars,aenvs) *) - | _ -> - if isNil tys && isNil args then - fx - else Expr.App (fx,fty,tys,args,m) + mkApps penv.g ((exprForVal m fHat, fHat.Type), [tys], args, m) (* change, direct fHat call with closure (reqdTypars, aenvs) *) + | _ -> + if isNil tys && isNil args then + fx + else Expr.App (fx, fty, tys, args, m) (* no change, f is expr *) //------------------------------------------------------------------------- @@ -1070,225 +1074,243 @@ module Pass4_RewriteAssembly = /// At bindings, fixup any TLR bindings. /// At applications, fixup calls if they are arity-met instances of TLR. - /// At free vals, fixup 0-call if it is an arity-met constant. + /// At free vals, fixup 0-call if it is an arity-met constant. /// Other cases rewrite structurally. let rec TransExpr (penv: RewriteContext) (z:RewriteState) expr : Expr * RewriteState = + match expr with - // Use TransLinearExpr with a rebuild-continuation for some forms to avoid stack overflows on large terms *) - | Expr.LetRec _ | Expr.Let _ | Expr.Sequential _ -> + // Use TransLinearExpr with a rebuild-continuation for some forms to avoid stack overflows on large terms + | LinearOpExpr _ + | LinearMatchExpr _ + | Expr.LetRec _ // note, Expr.LetRec not normally considered linear, but keeping it here as it's always been here + | Expr.Let _ + | Expr.Sequential _ -> TransLinearExpr penv z expr (fun res -> res) // app - call sites may require z. // - match the app (collapsing reclinks and type instances). // - patch it. - | Expr.App (f,fty,tys,args,m) -> - // pass over f,args subexprs - let f,z = TransExpr penv z f - let args,z = List.mapFold (TransExpr penv) z args - // match app, and fixup if needed - let f,fty,tys,args,m = destApp (f,fty,tys,args,m) - let expr = TransApp penv (f,fty,tys,args,m) - expr,z - - | Expr.Val (v,_,m) -> - // consider this a trivial app - let fx,fty = expr,v.Type - let expr = TransApp penv (fx,fty,[],[],m) - expr,z - - // reclink - suppress + | Expr.App (f, fty, tys, args, m) -> + // pass over f, args subexprs + let f, z = TransExpr penv z f + let args, z = List.mapFold (TransExpr penv) z args + // match app, and fixup if needed + let f, fty, tys, args, m = destApp (f, fty, tys, args, m) + let expr = TransApp penv (f, fty, tys, args, m) + expr, z + + | Expr.Val (v, _, m) -> + // consider this a trivial app + let fx, fty = expr, v.Type + let expr = TransApp penv (fx, fty, [], [], m) + expr, z + + // reclink - suppress | Expr.Link r -> TransExpr penv z (!r) - // ilobj - has implicit lambda exprs and recursive/base references - | Expr.Obj (_,ty,basev,basecall,overrides,iimpls,m) -> - let basecall,z = TransExpr penv z basecall - let overrides,z = List.mapFold (TransMethod penv) z overrides - let (iimpls:(TType*ObjExprMethod list)list),(z:RewriteState) = - List.mapFold (fun z (tType,objExprs) -> - let objExprs',z' = List.mapFold (TransMethod penv) z objExprs - (tType,objExprs'),z') z iimpls - let expr = Expr.Obj(newUnique(),ty,basev,basecall,overrides,iimpls,m) - let pds,z = ExtractPreDecs z - MakePreDecs m pds expr,z (* if TopLevel, lift preDecs over the ilobj expr *) - - // lambda, tlambda - explicit lambda terms - | Expr.Lambda(_,ctorThisValOpt,baseValOpt,argvs,body,m,rty) -> + // ilobj - has implicit lambda exprs and recursive/base references + | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, m) -> + let basecall, z = TransExpr penv z basecall + let overrides, z = List.mapFold (TransMethod penv) z overrides + let (iimpls:(TType*ObjExprMethod list)list), (z:RewriteState) = + List.mapFold (fun z (tType, objExprs) -> + let objExprs', z' = List.mapFold (TransMethod penv) z objExprs + (tType, objExprs'), z') z iimpls + let expr = Expr.Obj(newUnique(), ty, basev, basecall, overrides, iimpls, m) + let pds, z = ExtractPreDecs z + MakePreDecs m pds expr, z (* if TopLevel, lift preDecs over the ilobj expr *) + + // lambda, tlambda - explicit lambda terms + | Expr.Lambda(_, ctorThisValOpt, baseValOpt, argvs, body, m, rty) -> let z = EnterInner z - let body,z = TransExpr penv z body + let body, z = TransExpr penv z body let z = ExitInner z - let pds,z = ExtractPreDecs z - MakePreDecs m pds (rebuildLambda m ctorThisValOpt baseValOpt argvs (body,rty)),z + let pds, z = ExtractPreDecs z + MakePreDecs m pds (rebuildLambda m ctorThisValOpt baseValOpt argvs (body, rty)), z - | Expr.TyLambda(_,argtyvs,body,m,rty) -> + | Expr.TyLambda(_, argtyvs, body, m, rty) -> let z = EnterInner z - let body,z = TransExpr penv z body + let body, z = TransExpr penv z body let z = ExitInner z - let pds,z = ExtractPreDecs z - MakePreDecs m pds (mkTypeLambda m argtyvs (body,rty)),z + let pds, z = ExtractPreDecs z + MakePreDecs m pds (mkTypeLambda m argtyvs (body, rty)), z /// Lifting TLR out over constructs (disabled) /// Lift minimally to ensure the defn is not lifted up and over defns on which it depends (disabled) - | Expr.Match(spBind,exprm,dtree,targets,m,ty) -> + | Expr.Match(spBind, exprm, dtree, targets, m, ty) -> let targets = Array.toList targets - let dtree,z = TransDecisionTree penv z dtree - let targets,z = List.mapFold (TransDecisionTreeTarget penv) z targets + let dtree, z = TransDecisionTree penv z dtree + let targets, z = List.mapFold (TransDecisionTreeTarget penv) z targets // TransDecisionTreeTarget wraps EnterInner/exitInnter, so need to collect any top decs let pds,z = ExtractPreDecs z - MakePreDecs m pds (mkAndSimplifyMatch spBind exprm m ty dtree targets),z + MakePreDecs m pds (mkAndSimplifyMatch spBind exprm m ty dtree targets), z // all others - below - rewrite structurally - so boiler plate code after this point... - | Expr.Const _ -> expr,z (* constant wrt Val *) + | Expr.Const _ -> + expr,z + | Expr.Quote (a,{contents=Some(typeDefs,argTypes,argExprs,data)},isFromQueryExpression,m,ty) -> let argExprs,z = List.mapFold (TransExpr penv) z argExprs Expr.Quote(a,{contents=Some(typeDefs,argTypes,argExprs,data)},isFromQueryExpression,m,ty),z + | Expr.Quote (a,{contents=None},isFromQueryExpression,m,ty) -> Expr.Quote(a,{contents=None},isFromQueryExpression,m,ty),z + | Expr.Op (c,tyargs,args,m) -> let args,z = List.mapFold (TransExpr penv) z args Expr.Op(c,tyargs,args,m),z + | Expr.StaticOptimization (constraints,e2,e3,m) -> let e2,z = TransExpr penv z e2 let e3,z = TransExpr penv z e3 Expr.StaticOptimization(constraints,e2,e3,m),z + | Expr.TyChoose (_,_,m) -> error(Error(FSComp.SR.tlrUnexpectedTExpr(),m)) /// Walk over linear structured terms in tail-recursive loop, using a continuation /// to represent the rebuild-the-term stack and TransLinearExpr penv z expr (contf: Expr * RewriteState -> Expr * RewriteState) = - match expr with - | Expr.Sequential (e1,e2,dir,spSeq,m) -> - let e1,z = TransExpr penv z e1 - TransLinearExpr penv z e2 (contf << (fun (e2,z) -> - Expr.Sequential(e1,e2,dir,spSeq,m),z)) - - // letrec - pass_recbinds does the work - | Expr.LetRec (binds,e,m,_) -> + match expr with + | Expr.Sequential (e1, e2, dir, spSeq, m) -> + let e1, z = TransExpr penv z e1 + TransLinearExpr penv z e2 (contf << (fun (e2, z) -> + Expr.Sequential(e1, e2, dir, spSeq, m), z)) + + // letrec - pass_recbinds does the work + | Expr.LetRec (binds, e, m, _) -> let z = EnterInner z - // For letrec, preDecs from RHS must mutually recurse with those from the bindings - let z,pdsPrior = PopPreDecs z - let binds,z = List.mapFold (TransBindingRhs penv) z binds - let z,pdsRhs = PopPreDecs z - let binds,rebinds = TransBindings IsRec penv binds - let z,binds = LiftTopBinds IsRec penv z binds (* factor Top* repr binds *) - let z,rebinds = LiftTopBinds IsRec penv z rebinds - let z,pdsBind = PopPreDecs z + // For letrec, preDecs from RHS must mutually recurse with those from the bindings + let z, pdsPrior = PopPreDecs z + let binds, z = List.mapFold (TransBindingRhs penv) z binds + let z, pdsRhs = PopPreDecs z + let binds, rebinds = TransBindings IsRec penv binds + let z, binds = LiftTopBinds IsRec penv z binds (* factor Top* repr binds *) + let z, rebinds = LiftTopBinds IsRec penv z rebinds + let z, pdsBind = PopPreDecs z let z = SetPreDecs z (TreeNode [pdsPrior;RecursivePreDecs pdsBind pdsRhs]) let z = ExitInner z - let pds,z = ExtractPreDecs z + let pds, z = ExtractPreDecs z // tailcall - TransLinearExpr penv z e (contf << (fun (e,z) -> + TransLinearExpr penv z e (contf << (fun (e, z) -> let e = mkLetsFromBindings m rebinds e - MakePreDecs m pds (Expr.LetRec (binds,e,m,NewFreeVarsCache())),z)) - - // let - can consider the mu-let bindings as mu-letrec bindings - so like as above - | Expr.Let (bind,e,m,_) -> - - // For let, preDecs from RHS go before those of bindings, which is collection order - let bind,z = TransBindingRhs penv z bind - let binds,rebinds = TransBindings NotRec penv [bind] - // factor Top* repr binds - let z,binds = LiftTopBinds NotRec penv z binds - let z,rebinds = LiftTopBinds NotRec penv z rebinds - // any lifted PreDecs from binding, if so wrap them... - let pds,z = ExtractPreDecs z + MakePreDecs m pds (Expr.LetRec (binds, e, m, NewFreeVarsCache())), z)) + + // let - can consider the mu-let bindings as mu-letrec bindings - so like as above + | Expr.Let (bind, e, m, _) -> + + // For let, preDecs from RHS go before those of bindings, which is collection order + let bind, z = TransBindingRhs penv z bind + let binds, rebinds = TransBindings NotRec penv [bind] + // factor Top* repr binds + let z, binds = LiftTopBinds NotRec penv z binds + let z, rebinds = LiftTopBinds NotRec penv z rebinds + // any lifted PreDecs from binding, if so wrap them... + let pds, z = ExtractPreDecs z // tailcall - TransLinearExpr penv z e (contf << (fun (e,z) -> + TransLinearExpr penv z e (contf << (fun (e, z) -> let e = mkLetsFromBindings m rebinds e - MakePreDecs m pds (mkLetsFromBindings m binds e),z)) + MakePreDecs m pds (mkLetsFromBindings m binds e), z)) + + | LinearMatchExpr (spBind, exprm, dtree, tg1, e2, sp2, m2, ty) -> + let dtree, z = TransDecisionTree penv z dtree + let tg1, z = TransDecisionTreeTarget penv z tg1 + // tailcall + TransLinearExpr penv z e2 (contf << (fun (e2, z) -> + rebuildLinearMatchExpr (spBind, exprm, dtree, tg1, e2, sp2, m2, ty), z)) - | LinearMatchExpr (spBind,exprm,dtree,tg1,e2,sp2,m2,ty) -> - let dtree,z = TransDecisionTree penv z dtree - let tg1,z = TransDecisionTreeTarget penv z tg1 + | LinearOpExpr (op, tyargs, argsHead, argLast, m) -> + let argsHead,z = List.mapFold (TransExpr penv) z argsHead // tailcall - TransLinearExpr penv z e2 (contf << (fun (e2,z) -> - rebuildLinearMatchExpr (spBind,exprm,dtree,tg1,e2,sp2,m2,ty),z)) + TransLinearExpr penv z argLast (contf << (fun (argLast, z) -> + rebuildLinearOpExpr (op, tyargs, argsHead, argLast, m), z)) | _ -> + // not a linear expression contf (TransExpr penv z expr) - - and TransMethod penv (z:RewriteState) (TObjExprMethod(slotsig,attribs,tps,vs,e,m)) = - let z = EnterInner z - let e,z = TransExpr penv z e - let z = ExitInner z - TObjExprMethod(slotsig,attribs,tps,vs,e,m),z - - and TransBindingRhs penv z (TBind(v,e,letSeqPtOpt)) : Binding * RewriteState = + + and TransMethod penv (z:RewriteState) (TObjExprMethod(slotsig, attribs, tps, vs, e, m)) = + let z = EnterInner z + let e, z = TransExpr penv z e + let z = ExitInner z + TObjExprMethod(slotsig, attribs, tps, vs, e, m), z + + and TransBindingRhs penv z (TBind(v, e, letSeqPtOpt)) : Binding * RewriteState = let mustInline = v.MustInline - let z,e = EnterMustInline mustInline z (fun z -> TransExpr penv z e) - TBind (v,e,letSeqPtOpt),z + let z, e = EnterMustInline mustInline z (fun z -> TransExpr penv z e) + TBind (v, e, letSeqPtOpt), z and TransDecisionTree penv z x : DecisionTree * RewriteState = - match x with - | TDSuccess (es,n) -> - let es,z = List.mapFold (TransExpr penv) z es - TDSuccess(es,n),z - | TDBind (bind,rest) -> - let bind,z = TransBindingRhs penv z bind - let rest,z = TransDecisionTree penv z rest - TDBind(bind,rest),z - | TDSwitch (e,cases,dflt,m) -> - let e,z = TransExpr penv z e - let TransDecisionTreeCase penv z (TCase (discrim,dtree)) = - let dtree,z = TransDecisionTree penv z dtree - TCase(discrim,dtree),z - - let cases,z = List.mapFold (TransDecisionTreeCase penv) z cases - let dflt,z = Option.mapFold (TransDecisionTree penv) z dflt - TDSwitch (e,cases,dflt,m),z - - and TransDecisionTreeTarget penv z (TTarget(vs,e,spTarget)) = - let z = EnterInner z - let e,z = TransExpr penv z e + match x with + | TDSuccess (es, n) -> + let es, z = List.mapFold (TransExpr penv) z es + TDSuccess(es, n), z + | TDBind (bind, rest) -> + let bind, z = TransBindingRhs penv z bind + let rest, z = TransDecisionTree penv z rest + TDBind(bind, rest), z + | TDSwitch (e, cases, dflt, m) -> + let e, z = TransExpr penv z e + let TransDecisionTreeCase penv z (TCase (discrim, dtree)) = + let dtree, z = TransDecisionTree penv z dtree + TCase(discrim, dtree), z + + let cases, z = List.mapFold (TransDecisionTreeCase penv) z cases + let dflt, z = Option.mapFold (TransDecisionTree penv) z dflt + TDSwitch (e, cases, dflt, m), z + + and TransDecisionTreeTarget penv z (TTarget(vs, e, spTarget)) = + let z = EnterInner z + let e, z = TransExpr penv z e let z = ExitInner z - TTarget(vs,e,spTarget),z + TTarget(vs, e, spTarget), z - and TransValBinding penv z bind = TransBindingRhs penv z bind + and TransValBinding penv z bind = TransBindingRhs penv z bind and TransValBindings penv z binds = List.mapFold (TransValBinding penv) z binds - and TransModuleExpr penv z x = - match x with - | ModuleOrNamespaceExprWithSig(mty, def, m) -> - let def,z = TransModuleDef penv z def - ModuleOrNamespaceExprWithSig(mty, def, m),z - + and TransModuleExpr penv z x = + match x with + | ModuleOrNamespaceExprWithSig(mty, def, m) -> + let def, z = TransModuleDef penv z def + ModuleOrNamespaceExprWithSig(mty, def, m), z + and TransModuleDefs penv z x = List.mapFold (TransModuleDef penv) z x - and TransModuleDef penv (z: RewriteState) x : ModuleOrNamespaceExpr * RewriteState = - match x with - | TMDefRec(isRec,tycons,mbinds,m) -> - let mbinds,z = TransModuleBindings penv z mbinds - TMDefRec(isRec,tycons,mbinds,m),z - | TMDefLet(bind,m) -> - let bind,z = TransValBinding penv z bind - TMDefLet(bind,m),z - | TMDefDo(e,m) -> - let _bind,z = TransExpr penv z e - TMDefDo(e,m),z - | TMDefs(defs) -> - let defs,z = TransModuleDefs penv z defs - TMDefs(defs),z - | TMAbstract(mexpr) -> - let mexpr,z = TransModuleExpr penv z mexpr - TMAbstract(mexpr),z + and TransModuleDef penv (z: RewriteState) x : ModuleOrNamespaceExpr * RewriteState = + match x with + | TMDefRec(isRec, tycons, mbinds, m) -> + let mbinds, z = TransModuleBindings penv z mbinds + TMDefRec(isRec, tycons, mbinds, m), z + | TMDefLet(bind, m) -> + let bind, z = TransValBinding penv z bind + TMDefLet(bind, m), z + | TMDefDo(e, m) -> + let _bind, z = TransExpr penv z e + TMDefDo(e, m), z + | TMDefs(defs) -> + let defs, z = TransModuleDefs penv z defs + TMDefs(defs), z + | TMAbstract(mexpr) -> + let mexpr, z = TransModuleExpr penv z mexpr + TMAbstract(mexpr), z and TransModuleBindings penv z binds = List.mapFold (TransModuleBinding penv) z binds - and TransModuleBinding penv z x = - match x with - | ModuleOrNamespaceBinding.Binding bind -> - let bind,z = TransValBinding penv z bind - ModuleOrNamespaceBinding.Binding bind,z - | ModuleOrNamespaceBinding.Module(nm, rhs) -> - let rhs,z = TransModuleDef penv z rhs - ModuleOrNamespaceBinding.Module(nm,rhs),z - - let TransImplFile penv z (TImplFile(fragName,pragmas,moduleExpr,hasExplicitEntryPoint,isScript,anonRecdTypes)) = - let moduleExpr,z = TransModuleExpr penv z moduleExpr - (TImplFile(fragName,pragmas,moduleExpr,hasExplicitEntryPoint,isScript,anonRecdTypes)),z + and TransModuleBinding penv z x = + match x with + | ModuleOrNamespaceBinding.Binding bind -> + let bind, z = TransValBinding penv z bind + ModuleOrNamespaceBinding.Binding bind, z + | ModuleOrNamespaceBinding.Module(nm, rhs) -> + let rhs, z = TransModuleDef penv z rhs + ModuleOrNamespaceBinding.Module(nm, rhs), z + + let TransImplFile penv z (TImplFile(fragName, pragmas, moduleExpr, hasExplicitEntryPoint, isScript, anonRecdTypes)) = + let moduleExpr, z = TransModuleExpr penv z moduleExpr + (TImplFile(fragName, pragmas, moduleExpr, hasExplicitEntryPoint, isScript, anonRecdTypes)), z //------------------------------------------------------------------------- // pass5: copyExpr //------------------------------------------------------------------------- -let RecreateUniqueBounds g expr = +let RecreateUniqueBounds g expr = copyImplFile g OnlyCloneExprVals expr //------------------------------------------------------------------------- @@ -1297,28 +1319,28 @@ let RecreateUniqueBounds g expr = let MakeTLRDecisions ccu g expr = try - // pass1: choose the f to be TLR with arity(f) - let tlrS,topValS, arityM = Pass1_DetermineTLRAndArities.DetermineTLRAndArities g expr + // pass1: choose the f to be TLR with arity(f) + let tlrS, topValS, arityM = Pass1_DetermineTLRAndArities.DetermineTLRAndArities g expr - // pass2: determine the typar/freevar closures, f->fclass and fclass declist - let reqdItemsMap,fclassM,declist,recShortCallS = Pass2_DetermineReqdItems.DetermineReqdItems (tlrS,arityM) expr + // pass2: determine the typar/freevar closures, f->fclass and fclass declist + let reqdItemsMap, fclassM, declist, recShortCallS = Pass2_DetermineReqdItems.DetermineReqdItems (tlrS, arityM) expr // pass3 let envPackM = ChooseReqdItemPackings g fclassM topValS declist reqdItemsMap let fHatM = CreateNewValuesForTLR g tlrS arityM fclassM envPackM - // pass4: rewrite + // pass4: rewrite if verboseTLR then dprintf "TransExpr(rw)------\n" - let expr,_ = - let penv : Pass4_RewriteAssembly.RewriteContext = + let expr, _ = + let penv : Pass4_RewriteAssembly.RewriteContext = {ccu=ccu; g=g; tlrS=tlrS; topValS=topValS; arityM=arityM; fclassM=fclassM; recShortCallS=recShortCallS; envPackM=envPackM; fHatM=fHatM} let z = Pass4_RewriteAssembly.rewriteState0 Pass4_RewriteAssembly.TransImplFile penv z expr - // pass5: copyExpr to restore "each bound is unique" property - // aka, copyExpr + // pass5: copyExpr to restore "each bound is unique" property + // aka, copyExpr if verboseTLR then dprintf "copyExpr------\n" - let expr = RecreateUniqueBounds g expr + let expr = RecreateUniqueBounds g expr if verboseTLR then dprintf "TLR-done------\n" // Summary: @@ -1329,9 +1351,9 @@ let MakeTLRDecisions ccu g expr = // (lengthS (Zset.diff tlrS topValS)) // (lengthS (Zset.inter topValS tlrS)) // (lengthS (Zset.diff topValS tlrS)) - - // DONE + + // DONE expr - with AbortTLR m -> - warning(Error(FSComp.SR.tlrLambdaLiftingOptimizationsNotApplied(),m)) + with AbortTLR m -> + warning(Error(FSComp.SR.tlrLambdaLiftingOptimizationsNotApplied(), m)) expr diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs index 5ae8ebc328962d6cb3bffe555b9fed303208dc78..0c78c7c0e1ce668405eb9756c9834ec7e5d2b064 100755 --- a/src/fsharp/LexFilter.fs +++ b/src/fsharp/LexFilter.fs @@ -15,7 +15,6 @@ open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Parser open FSharp.Compiler.Lexhelp - let debug = false let stringOfPos (p:Position) = sprintf "(%d:%d)" p.OriginalLine p.Column @@ -66,12 +65,12 @@ type Context = member c.StartPos = match c with - | CtxtNamespaceHead (p,_) | CtxtModuleHead (p,_) | CtxtException p | CtxtModuleBody (p,_) | CtxtNamespaceBody p - | CtxtLetDecl (_,p) | CtxtDo p | CtxtInterfaceHead p | CtxtTypeDefns p | CtxtParen (_,p) | CtxtMemberHead p | CtxtMemberBody p + | CtxtNamespaceHead (p, _) | CtxtModuleHead (p, _) | CtxtException p | CtxtModuleBody (p, _) | CtxtNamespaceBody p + | CtxtLetDecl (_, p) | CtxtDo p | CtxtInterfaceHead p | CtxtTypeDefns p | CtxtParen (_, p) | CtxtMemberHead p | CtxtMemberBody p | CtxtWithAsLet p | CtxtWithAsAugment p - | CtxtMatchClauses (_,p) | CtxtIf p | CtxtMatch p | CtxtFor p | CtxtWhile p | CtxtWhen p | CtxtFunction p | CtxtFun p | CtxtTry p | CtxtThen p | CtxtElse p | CtxtVanilla (p,_) - | CtxtSeqBlock (_,p,_) -> p + | CtxtMatchClauses (_, p) | CtxtIf p | CtxtMatch p | CtxtFor p | CtxtWhile p | CtxtWhen p | CtxtFunction p | CtxtFun p | CtxtTry p | CtxtThen p | CtxtElse p | CtxtVanilla (p, _) + | CtxtSeqBlock (_, p, _) -> p member c.StartCol = c.StartPos.Column @@ -82,7 +81,7 @@ type Context = | CtxtException _ -> "exception" | CtxtModuleBody _ -> "modbody" | CtxtNamespaceBody _ -> "nsbody" - | CtxtLetDecl(b,p) -> sprintf "let(%b,%s)" b (stringOfPos p) + | CtxtLetDecl(b, p) -> sprintf "let(%b, %s)" b (stringOfPos p) | CtxtWithAsLet p -> sprintf "withlet(%s)" (stringOfPos p) | CtxtWithAsAugment _ -> "withaug" | CtxtDo _ -> "do" @@ -91,7 +90,7 @@ type Context = | CtxtParen _ -> "paren" | CtxtMemberHead _ -> "member-head" | CtxtMemberBody _ -> "body" - | CtxtSeqBlock (b,p,_addBlockEnd) -> sprintf "seqblock(%s,%s)" (match b with FirstInSeqBlock -> "first" | NotFirstInSeqBlock -> "subsequent") (stringOfPos p) + | CtxtSeqBlock (b, p, _addBlockEnd) -> sprintf "seqblock(%s, %s)" (match b with FirstInSeqBlock -> "first" | NotFirstInSeqBlock -> "subsequent") (stringOfPos p) | CtxtMatchClauses _ -> "matching" | CtxtIf _ -> "if" @@ -105,7 +104,7 @@ type Context = | CtxtThen _ -> "then" | CtxtElse p -> sprintf "else(%s)" (stringOfPos p) - | CtxtVanilla (p,_) -> sprintf "vanilla(%s)" (stringOfPos p) + | CtxtVanilla (p, _) -> sprintf "vanilla(%s)" (stringOfPos p) and AddBlockEnd = AddBlockEnd | NoAddBlockEnd | AddOneSidedBlockEnd and FirstInSequence = FirstInSeqBlock | NotFirstInSeqBlock @@ -263,7 +262,7 @@ let rec isTypeContinuator token = // and Y = c <--- 'and' HERE // // type X = { - // x: int; + // x: int // y: int // } <--- '}' HERE // and Y = c @@ -337,10 +336,10 @@ let rec isSeqBlockElementContinuator token = match token with // The following tokens may align with the first column of a sequence block without closing a sequence element and starting a new one *) // e.g. - // new MenuItem("&Open...", + // new MenuItem("&Open...", // new EventHandler(fun _ _ -> // ... - // ), <------- NOTE RPAREN HERE + // ), <------- NOTE RPAREN HERE // Shortcut.CtrlO) | END | AND | WITH | THEN | RPAREN | RBRACE | BAR_RBRACE | RBRACK | BAR_RBRACK | RQUOTE _ -> true @@ -378,25 +377,25 @@ let isAtomicExprEndToken token = // give a 'begin' token, does an 'end' token match? //-------------------------------------------------------------------------- let parenTokensBalance t1 t2 = - match t1,t2 with - | (LPAREN,RPAREN) - | (LBRACE,RBRACE) - | (LBRACE_BAR,BAR_RBRACE) - | (LBRACK,RBRACK) - | (INTERFACE,END) - | (CLASS,END) - | (SIG,END) - | (STRUCT,END) - | (LBRACK_BAR,BAR_RBRACK) - | (LESS true,GREATER true) - | (BEGIN,END) -> true - | (LQUOTE q1,RQUOTE q2) when q1 = q2 -> true + match t1, t2 with + | (LPAREN, RPAREN) + | (LBRACE, RBRACE) + | (LBRACE_BAR, BAR_RBRACE) + | (LBRACK, RBRACK) + | (INTERFACE, END) + | (CLASS, END) + | (SIG, END) + | (STRUCT, END) + | (LBRACK_BAR, BAR_RBRACK) + | (LESS true, GREATER true) + | (BEGIN, END) -> true + | (LQUOTE q1, RQUOTE q2) when q1 = q2 -> true | _ -> false /// Used to save some aspects of the lexbuffer state [] -type LexbufState(startPos: Position, - endPos : Position, +type LexbufState(startPos: Position, + endPos : Position, pastEOF : bool) = member x.StartPos = startPos member x.EndPos = endPos @@ -414,7 +413,7 @@ type TokenTup = val Token : token val LexbufState : LexbufState val LastTokenPos: PositionTuple - new (token,state,lastTokenPos) = { Token=token; LexbufState=state;LastTokenPos=lastTokenPos } + new (token, state, lastTokenPos) = { Token=token; LexbufState=state;LastTokenPos=lastTokenPos } /// Returns starting position of the token member x.StartPos = x.LexbufState.StartPos @@ -424,15 +423,15 @@ type TokenTup = /// Returns a token 'tok' with the same position as this token member x.UseLocation(tok) = let tokState = x.LexbufState - TokenTup(tok,LexbufState(tokState.StartPos, tokState.EndPos,false),x.LastTokenPos) + TokenTup(tok, LexbufState(tokState.StartPos, tokState.EndPos, false), x.LastTokenPos) /// Returns a token 'tok' with the same position as this token, except that /// it is shifted by specified number of characters from the left and from the right /// Note: positive value means shift to the right in both cases member x.UseShiftedLocation(tok, shiftLeft, shiftRight) = let tokState = x.LexbufState - TokenTup(tok,LexbufState(tokState.StartPos.ShiftColumnBy(shiftLeft), - tokState.EndPos.ShiftColumnBy(shiftRight),false),x.LastTokenPos) + TokenTup(tok, LexbufState(tokState.StartPos.ShiftColumnBy(shiftLeft), + tokState.EndPos.ShiftColumnBy(shiftRight), false), x.LastTokenPos) @@ -488,7 +487,7 @@ let (|TyparsCloseOp|_|) (txt:string) = | ('/' :: _) | ('%' :: _) -> Some (INFIX_STAR_DIV_MOD_OP(s)) | _ -> None - Some([| for _c in angles do yield GREATER |],afterOp) + Some([| for _c in angles do yield GREATER |], afterOp) [] type PositionWithColumn = @@ -526,8 +525,8 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // Make sure we don't report 'eof' when inserting a token, and set the positions to the // last reported token position - let lexbufStateForInsertedDummyTokens (lastTokenStartPos,lastTokenEndPos) = - new LexbufState(lastTokenStartPos,lastTokenEndPos,false) + let lexbufStateForInsertedDummyTokens (lastTokenStartPos, lastTokenEndPos) = + new LexbufState(lastTokenStartPos, lastTokenEndPos, false) let getLexbufState() = new LexbufState(lexbuf.StartPos, lexbuf.EndPos, lexbuf.IsPastEndOfStream) @@ -563,7 +562,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, let tokenLexbufState = getLexbufState() savedLexbufState <- tokenLexbufState haveLexbufState <- true - TokenTup(token,tokenLexbufState,PositionTuple(lastTokenStart,lastTokenEnd)) + TokenTup(token, tokenLexbufState, PositionTuple(lastTokenStart, lastTokenEnd)) //---------------------------------------------------------------------------- // Fetch a raw token, either from the old lexer or from our delayedStack @@ -602,11 +601,11 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, delayToken initialLookaheadTokenTup initialized <- true - offsideStack <- (CtxtSeqBlock(FirstInSeqBlock,startPosOfTokenTup initialLookaheadTokenTup,NoAddBlockEnd)) :: offsideStack + offsideStack <- (CtxtSeqBlock(FirstInSeqBlock, startPosOfTokenTup initialLookaheadTokenTup, NoAddBlockEnd)) :: offsideStack initialLookaheadTokenTup let warn (s:TokenTup) msg = - warning(Lexhelp.IndentationProblem(msg,mkSynRange (startPosOfTokenTup s) s.LexbufState.EndPos)) + warning(Lexhelp.IndentationProblem(msg, mkSynRange (startPosOfTokenTup s) s.LexbufState.EndPos)) // 'query { join x in ys ... }' // 'query { ... @@ -616,7 +615,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, let detectJoinInCtxt stack = let rec check s = match s with - | CtxtParen(LBRACE,_) :: _ -> true + | CtxtParen(LBRACE, _) :: _ -> true | (CtxtSeqBlock _ | CtxtDo _ | CtxtFor _) :: rest -> check rest | _ -> false match stack with @@ -632,7 +631,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, let pushCtxt tokenTup (newCtxt:Context) = let rec unindentationLimit strict stack = - match newCtxt,stack with + match newCtxt, stack with | _, [] -> PositionWithColumn(newCtxt.StartPos, -1) // ignore Vanilla because a SeqBlock is always coming @@ -643,10 +642,10 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // 'begin match' limited by minimum of two // '(match' limited by minimum of two - | _,(((CtxtMatch _) as ctxt1) :: CtxtSeqBlock _ :: (CtxtParen ((BEGIN | LPAREN),_) as ctxt2) :: _rest) + | _, (((CtxtMatch _) as ctxt1) :: CtxtSeqBlock _ :: (CtxtParen ((BEGIN | LPAREN), _) as ctxt2) :: _rest) -> if ctxt1.StartCol <= ctxt2.StartCol - then PositionWithColumn(ctxt1.StartPos,ctxt1.StartCol) - else PositionWithColumn(ctxt2.StartPos,ctxt2.StartCol) + then PositionWithColumn(ctxt1.StartPos, ctxt1.StartCol) + else PositionWithColumn(ctxt2.StartPos, ctxt2.StartCol) // 'let ... = function' limited by 'let', precisely // This covers the common form @@ -655,26 +654,26 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // | Case1 -> ... // | Case2 -> ... | (CtxtMatchClauses _), (CtxtFunction _ :: CtxtSeqBlock _ :: (CtxtLetDecl _ as limitCtxt) :: _rest) - -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol) + -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol) // Otherwise 'function ...' places no limit until we hit a CtxtLetDecl etc... (Recursive) | (CtxtMatchClauses _), (CtxtFunction _ :: rest) -> unindentationLimit false rest // 'try ... with' limited by 'try' - | _,(CtxtMatchClauses _ :: (CtxtTry _ as limitCtxt) :: _rest) - -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol) + | _, (CtxtMatchClauses _ :: (CtxtTry _ as limitCtxt) :: _rest) + -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol) // 'fun ->' places no limit until we hit a CtxtLetDecl etc... (Recursive) - | _,(CtxtFun _ :: rest) + | _, (CtxtFun _ :: rest) -> unindentationLimit false rest // 'f ...{' places no limit until we hit a CtxtLetDecl etc... // 'f ...[' places no limit until we hit a CtxtLetDecl etc... // 'f ...[|' places no limit until we hit a CtxtLetDecl etc... - | _,(CtxtParen ((LBRACE | LBRACK | LBRACK_BAR),_) :: CtxtSeqBlock _ :: rest) - | _,(CtxtParen ((LBRACE | LBRACK | LBRACK_BAR),_) :: CtxtVanilla _ :: CtxtSeqBlock _ :: rest) - | _,(CtxtSeqBlock _ :: CtxtParen((LBRACE | LBRACK | LBRACK_BAR),_) :: CtxtVanilla _ :: CtxtSeqBlock _ :: rest) + | _, (CtxtParen ((LBRACE | LBRACK | LBRACK_BAR), _) :: CtxtSeqBlock _ :: rest) + | _, (CtxtParen ((LBRACE | LBRACK | LBRACK_BAR), _) :: CtxtVanilla _ :: CtxtSeqBlock _ :: rest) + | _, (CtxtSeqBlock _ :: CtxtParen((LBRACE | LBRACK | LBRACK_BAR), _) :: CtxtVanilla _ :: CtxtSeqBlock _ :: rest) -> unindentationLimit false rest // MAJOR PERMITTED UNDENTATION This is allowing: @@ -684,7 +683,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // This is a serious thing to allow, but is required since there is no "return" in this language. // Without it there is no way of escaping special cases in large bits of code without indenting the main case. | CtxtSeqBlock _, (CtxtElse _ :: (CtxtIf _ as limitCtxt) :: _rest) - -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol) + -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol) // Permitted inner-construct precise block alignment: // interface ... @@ -694,19 +693,19 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // type ... // with ... // end - | CtxtWithAsAugment _,((CtxtInterfaceHead _ | CtxtMemberHead _ | CtxtException _ | CtxtTypeDefns _) as limitCtxt :: _rest) - -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol) + | CtxtWithAsAugment _, ((CtxtInterfaceHead _ | CtxtMemberHead _ | CtxtException _ | CtxtTypeDefns _) as limitCtxt :: _rest) + -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol) // Permit unindentation via parentheses (or begin/end) following a 'then', 'else' or 'do': // if nr > 0 then ( - // nr <- nr - 1; - // acc <- d; + // nr <- nr - 1 + // acc <- d // i <- i - 1 // ) else ( // i <- -1 - // ); + // ) - // PERMITTED UNDENTATION: Inner construct (then,with,else,do) that dangle, places no limit until we hit the corresponding leading construct CtxtIf, CtxtFor, CtxtWhile, CtxtVanilla etc... *) + // PERMITTED UNDENTATION: Inner construct (then, with, else, do) that dangle, places no limit until we hit the corresponding leading construct CtxtIf, CtxtFor, CtxtWhile, CtxtVanilla etc... *) // e.g. if ... then ... // expr // else @@ -719,7 +718,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // ... <-- this is before the "with" // end - | _,((CtxtWithAsAugment _ | CtxtThen _ | CtxtElse _ | CtxtDo _ ) :: rest) + | _, ((CtxtWithAsAugment _ | CtxtThen _ | CtxtElse _ | CtxtDo _ ) :: rest) -> unindentationLimit false rest @@ -737,7 +736,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // let fffffff() = function 1 -> // 0 // | 2 -> ... <---- not allowed - | _,(CtxtFunction _ :: rest) + | _, (CtxtFunction _ :: rest) -> unindentationLimit false rest // 'module ... : sig' limited by 'module' @@ -751,27 +750,27 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // 'if ... else {' limited by 'if' // 'if ... else [' limited by 'if' // 'if ... else [|' limited by 'if' - | _,(CtxtParen ((SIG | STRUCT | BEGIN),_) :: CtxtSeqBlock _ :: (CtxtModuleBody (_,false) as limitCtxt) :: _) - | _,(CtxtParen ((BEGIN | LPAREN | LBRACK | LBRACE | LBRACE_BAR | LBRACK_BAR) ,_) :: CtxtSeqBlock _ :: CtxtThen _ :: (CtxtIf _ as limitCtxt) :: _) - | _,(CtxtParen ((BEGIN | LPAREN | LBRACK | LBRACE | LBRACE_BAR | LBRACK_BAR | LBRACK_LESS) ,_) :: CtxtSeqBlock _ :: CtxtElse _ :: (CtxtIf _ as limitCtxt) :: _) + | _, (CtxtParen ((SIG | STRUCT | BEGIN), _) :: CtxtSeqBlock _ :: (CtxtModuleBody (_, false) as limitCtxt) :: _) + | _, (CtxtParen ((BEGIN | LPAREN | LBRACK | LBRACE | LBRACE_BAR | LBRACK_BAR) , _) :: CtxtSeqBlock _ :: CtxtThen _ :: (CtxtIf _ as limitCtxt) :: _) + | _, (CtxtParen ((BEGIN | LPAREN | LBRACK | LBRACE | LBRACE_BAR | LBRACK_BAR | LBRACK_LESS) , _) :: CtxtSeqBlock _ :: CtxtElse _ :: (CtxtIf _ as limitCtxt) :: _) // 'f ... (' in seqblock limited by 'f' // 'f ... {' in seqblock limited by 'f' NOTE: this is covered by the more generous case above // 'f ... [' in seqblock limited by 'f' // 'f ... [|' in seqblock limited by 'f' // 'f ... Foo<' in seqblock limited by 'f' - | _,(CtxtParen ((BEGIN | LPAREN | LESS true | LBRACK | LBRACK_BAR) ,_) :: CtxtVanilla _ :: (CtxtSeqBlock _ as limitCtxt) :: _) + | _, (CtxtParen ((BEGIN | LPAREN | LESS true | LBRACK | LBRACK_BAR) , _) :: CtxtVanilla _ :: (CtxtSeqBlock _ as limitCtxt) :: _) // 'type C = class ... ' limited by 'type' // 'type C = interface ... ' limited by 'type' // 'type C = struct ... ' limited by 'type' - | _,(CtxtParen ((CLASS | STRUCT | INTERFACE),_) :: CtxtSeqBlock _ :: (CtxtTypeDefns _ as limitCtxt) :: _) - -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol + 1) + | _, (CtxtParen ((CLASS | STRUCT | INTERFACE), _) :: CtxtSeqBlock _ :: (CtxtTypeDefns _ as limitCtxt) :: _) + -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol + 1) // REVIEW: document these - | _,(CtxtSeqBlock _ :: CtxtParen((BEGIN | LPAREN | LBRACK | LBRACK_BAR),_) :: CtxtVanilla _ :: (CtxtSeqBlock _ as limitCtxt) :: _) - | (CtxtSeqBlock _),(CtxtParen ((BEGIN | LPAREN | LBRACE | LBRACE_BAR | LBRACK | LBRACK_BAR) ,_) :: CtxtSeqBlock _ :: ((CtxtTypeDefns _ | CtxtLetDecl _ | CtxtMemberBody _ | CtxtWithAsLet _) as limitCtxt) :: _) - -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol + 1) + | _, (CtxtSeqBlock _ :: CtxtParen((BEGIN | LPAREN | LBRACK | LBRACK_BAR), _) :: CtxtVanilla _ :: (CtxtSeqBlock _ as limitCtxt) :: _) + | (CtxtSeqBlock _), (CtxtParen ((BEGIN | LPAREN | LBRACE | LBRACE_BAR | LBRACK | LBRACK_BAR) , _) :: CtxtSeqBlock _ :: ((CtxtTypeDefns _ | CtxtLetDecl _ | CtxtMemberBody _ | CtxtWithAsLet _) as limitCtxt) :: _) + -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol + 1) // Permitted inner-construct (e.g. "then" block and "else" block in overall // "if-then-else" block ) block alignment: @@ -780,22 +779,22 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // elif expr // else expr | (CtxtIf _ | CtxtElse _ | CtxtThen _), (CtxtIf _ as limitCtxt) :: _rest - -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol) + -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol) // Permitted inner-construct precise block alignment: // while ... // do expr // done | (CtxtDo _), ((CtxtFor _ | CtxtWhile _) as limitCtxt) :: _rest - -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol) + -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol) // These contexts all require indentation by at least one space - | _,((CtxtInterfaceHead _ | CtxtNamespaceHead _ | CtxtModuleHead _ | CtxtException _ | CtxtModuleBody (_,false) | CtxtIf _ | CtxtWithAsLet _ | CtxtLetDecl _ | CtxtMemberHead _ | CtxtMemberBody _) as limitCtxt :: _) - -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol + 1) + | _, ((CtxtInterfaceHead _ | CtxtNamespaceHead _ | CtxtModuleHead _ | CtxtException _ | CtxtModuleBody (_, false) | CtxtIf _ | CtxtWithAsLet _ | CtxtLetDecl _ | CtxtMemberHead _ | CtxtMemberBody _) as limitCtxt :: _) + -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol + 1) // These contexts can have their contents exactly aligning - | _,((CtxtParen _ | CtxtFor _ | CtxtWhen _ | CtxtWhile _ | CtxtTypeDefns _ | CtxtMatch _ | CtxtModuleBody (_,true) | CtxtNamespaceBody _ | CtxtTry _ | CtxtMatchClauses _ | CtxtSeqBlock _) as limitCtxt :: _) - -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol) + | _, ((CtxtParen _ | CtxtFor _ | CtxtWhen _ | CtxtWhile _ | CtxtTypeDefns _ | CtxtMatch _ | CtxtModuleBody (_, true) | CtxtNamespaceBody _ | CtxtTry _ | CtxtMatchClauses _ | CtxtSeqBlock _) as limitCtxt :: _) + -> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol) match newCtxt with // Don't bother to check pushes of Vanilla blocks since we've @@ -867,7 +866,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, let rec scanAhead nParen = let lookaheadTokenTup = popNextTokenTup() let lookaheadToken = lookaheadTokenTup.Token - stack := (lookaheadTokenTup,true) :: !stack + stack := (lookaheadTokenTup, true) :: !stack let lookaheadTokenStartPos = startPosOfTokenTup lookaheadTokenTup match lookaheadToken with | Parser.EOF _ | SEMICOLON_SEMICOLON -> false @@ -883,7 +882,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, let hasAfterOp = (match lookaheadToken with GREATER _ -> false | _ -> true) if nParen > 0 then // Don't smash the token if there is an after op and we're in a nested paren - stack := (lookaheadTokenTup,not hasAfterOp) :: (!stack).Tail + stack := (lookaheadTokenTup, not hasAfterOp) :: (!stack).Tail scanAhead nParen else // On successful parse of a set of type parameters, look for an adjacent (, e.g. @@ -891,13 +890,13 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // and insert a HIGH_PRECEDENCE_PAREN_APP if not hasAfterOp && (match nextTokenIsAdjacentLParenOrLBrack lookaheadTokenTup with Some(LPAREN) -> true | _ -> false) then let dotTokenTup = peekNextTokenTup() - stack := (dotTokenTup.UseLocation(HIGH_PRECEDENCE_PAREN_APP),false) :: !stack + stack := (dotTokenTup.UseLocation(HIGH_PRECEDENCE_PAREN_APP), false) :: !stack true - | INFIX_COMPARE_OP (TyparsCloseOp(greaters,afterOp)) -> + | INFIX_COMPARE_OP (TyparsCloseOp(greaters, afterOp)) -> let nParen = nParen - greaters.Length if nParen > 0 then // Don't smash the token if there is an after op and we're in a nested paren - stack := (lookaheadTokenTup,not afterOp.IsSome) :: (!stack).Tail + stack := (lookaheadTokenTup, not afterOp.IsSome) :: (!stack).Tail scanAhead nParen else // On successful parse of a set of type parameters, look for an adjacent (, e.g. @@ -905,7 +904,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // and insert a HIGH_PRECEDENCE_PAREN_APP if afterOp.IsNone && (match nextTokenIsAdjacentLParenOrLBrack lookaheadTokenTup with Some LPAREN -> true | _ -> false) then let dotTokenTup = peekNextTokenTup() - stack := (dotTokenTup.UseLocation(HIGH_PRECEDENCE_PAREN_APP),false) :: !stack + stack := (dotTokenTup.UseLocation(HIGH_PRECEDENCE_PAREN_APP), false) :: !stack true | (LPAREN | LESS _ | LBRACK | LBRACK_LESS | INFIX_COMPARE_OP " scanAhead (nParen+1) @@ -956,7 +955,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, let res = scanAhead 0 // Put the tokens back on and smash them up if needed - !stack |> List.iter (fun (tokenTup,smash) -> + !stack |> List.iter (fun (tokenTup, smash) -> if smash then match tokenTup.Token with | INFIX_COMPARE_OP " @@ -970,7 +969,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, delayToken (tokenTup.UseShiftedLocation(GREATER res, 0, -1)) | GREATER _ -> delayToken (tokenTup.UseLocation(GREATER res)) - | (INFIX_COMPARE_OP (TyparsCloseOp(greaters,afterOp) as opstr)) -> + | (INFIX_COMPARE_OP (TyparsCloseOp(greaters, afterOp) as opstr)) -> match afterOp with | None -> () | Some tok -> delayToken (tokenTup.UseShiftedLocation(tok, greaters.Length, 0)) @@ -996,14 +995,14 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, let rec suffixExists p l = match l with [] -> false | _::t -> p t || suffixExists p t let tokenBalancesHeadContext token stack = - match token,stack with + match token, stack with | END, (CtxtWithAsAugment(_) :: _) | (ELSE | ELIF), (CtxtIf _ :: _) | DONE , (CtxtDo _ :: _) // WITH balances except in the following contexts.... Phew - an overused keyword! | WITH , ( ((CtxtMatch _ | CtxtException _ | CtxtMemberHead _ | CtxtInterfaceHead _ | CtxtTry _ | CtxtTypeDefns _ | CtxtMemberBody _) :: _) // This is the nasty record/object-expression case - | (CtxtSeqBlock _ :: CtxtParen((LBRACE | LBRACE_BAR),_) :: _) ) + | (CtxtSeqBlock _ :: CtxtParen((LBRACE | LBRACE_BAR), _) :: _) ) | FINALLY , (CtxtTry _ :: _) -> true @@ -1023,10 +1022,10 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, | SEMICOLON_SEMICOLON, (CtxtSeqBlock _ :: CtxtNamespaceBody _ :: _) -> true - | SEMICOLON_SEMICOLON, (CtxtSeqBlock _ :: CtxtModuleBody (_,true) :: _) -> + | SEMICOLON_SEMICOLON, (CtxtSeqBlock _ :: CtxtModuleBody (_, true) :: _) -> true - | t2 , (CtxtParen(t1,_) :: _) -> + | t2 , (CtxtParen(t1, _) :: _) -> parenTokensBalance t1 t2 | _ -> @@ -1127,9 +1126,9 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, false // no member currently on the stack, nothing to pop else // there is a member context - if List.exists (function CtxtParen(LBRACE,_) -> true | _ -> false) ctxtStack then + if List.exists (function CtxtParen(LBRACE, _) -> true | _ -> false) ctxtStack then false // an LBRACE could mean an object expression, and object expressions can have 'member' tokens in them, so do not pop, to be safe - elif List.count (function CtxtParen(LPAREN,_) -> true | _ -> false) ctxtStack >= 2 then + elif List.count (function CtxtParen(LPAREN, _) -> true | _ -> false) ctxtStack >= 2 then false // static member constraints always are embedded in at least two LPARENS, so do not pop, to be safe else true @@ -1145,13 +1144,13 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, Some ODECLEND | CtxtDo _ - | CtxtLetDecl (true,_) -> + | CtxtLetDecl (true, _) -> Some ODECLEND - | CtxtSeqBlock(_,_,AddBlockEnd) -> + | CtxtSeqBlock(_, _, AddBlockEnd) -> Some OBLOCKEND - | CtxtSeqBlock(_,_,AddOneSidedBlockEnd) -> + | CtxtSeqBlock(_, _, AddOneSidedBlockEnd) -> Some ORIGHT_BLOCK_END | _ -> @@ -1203,9 +1202,9 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, match offsideStack with // next outermost is namespace or module | _ :: (CtxtNamespaceBody _ | CtxtModuleBody _) :: _ -> true - // The context pair below is created a namespace/module scope when user explicitly uses 'begin'...'end', + // The context pair below is created a namespace/module scope when user explicitly uses 'begin'...'end', // and these can legally contain type definitions, so ignore this combo as uninteresting and recurse deeper - | _ :: CtxtParen((BEGIN|STRUCT),_) :: CtxtSeqBlock(_,_,_) :: _ -> nextOuterMostInterestingContextIsNamespaceOrModule(offsideStack.Tail.Tail) + | _ :: CtxtParen((BEGIN|STRUCT), _) :: CtxtSeqBlock(_, _, _) :: _ -> nextOuterMostInterestingContextIsNamespaceOrModule(offsideStack.Tail.Tail) // at the top of the stack there is an implicit module | _ :: [] -> true // anything else is a non-namespace/module @@ -1213,7 +1212,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, while not offsideStack.IsEmpty && (not(nextOuterMostInterestingContextIsNamespaceOrModule(offsideStack))) && (match offsideStack.Head with // open-parens of sorts - | CtxtParen((LPAREN|LBRACK|LBRACE|LBRACE_BAR|LBRACK_BAR),_) -> true + | CtxtParen((LPAREN|LBRACK|LBRACE|LBRACE_BAR|LBRACK_BAR), _) -> true // seq blocks | CtxtSeqBlock _ -> true // vanillas @@ -1224,15 +1223,15 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, | CtxtParen _ -> if debug then dprintf "%s at %a terminates CtxtParen()\n" keywordName outputPos tokenStartPos popCtxt() - | CtxtSeqBlock(_,_,AddBlockEnd) -> + | CtxtSeqBlock(_, _, AddBlockEnd) -> popCtxt() effectsToDo <- (fun() -> if debug then dprintf "--> because %s is coming, inserting OBLOCKEND\n" keywordName delayTokenNoProcessing (tokenTup.UseLocation(OBLOCKEND))) :: effectsToDo - | CtxtSeqBlock(_,_,NoAddBlockEnd) -> + | CtxtSeqBlock(_, _, NoAddBlockEnd) -> if debug then dprintf "--> because %s is coming, popping CtxtSeqBlock\n" keywordName popCtxt() - | CtxtSeqBlock(_,_,AddOneSidedBlockEnd) -> + | CtxtSeqBlock(_, _, AddOneSidedBlockEnd) -> popCtxt() effectsToDo <- (fun() -> if debug then dprintf "--> because %s is coming, inserting ORIGHT_BLOCK_END\n" keywordName @@ -1241,7 +1240,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, if debug then dprintf "--> because %s is coming, popping CtxtVanilla\n" keywordName popCtxt() | _ -> failwith "impossible, the while loop guard just above prevents this" - // See bugs 91609/92107/245850; we turn ...TYPE... into ...TYPE_COMING_SOON(x6),TYPE_IS_HERE... to help the parser recover when it sees "type" in a parenthesized expression. + // See bugs 91609/92107/245850; we turn ...TYPE... into ...TYPE_COMING_SOON(x6), TYPE_IS_HERE... to help the parser recover when it sees "type" in a parenthesized expression. // And we do the same thing for MODULE. // Why _six_ TYPE_COMING_SOON? It's rather arbitrary, this means we can recover from up to six unmatched parens before failing. The unit tests (with 91609 in the name) demonstrate this. // Don't "delayToken tokenTup", we are replacing it, so consume it. @@ -1252,7 +1251,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, for e in List.rev effectsToDo do e() // push any END tokens after pushing the TYPE_IS_HERE and TYPE_COMING_SOON stuff, so that they come before those in the token stream - match token,offsideStack with + match token, offsideStack with // inserted faux tokens need no other processing | _ when tokensThatNeedNoProcessingCount > 0 -> tokensThatNeedNoProcessingCount <- tokensThatNeedNoProcessingCount - 1 @@ -1288,7 +1287,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // Balancing rule. Encountering an 'in' balances with a 'let'. i.e. even a non-offside 'in' closes a 'let' // The 'IN' token is thrown away and becomes an ODECLEND - | IN, (CtxtLetDecl (blockLet,offsidePos) :: _) -> + | IN, (CtxtLetDecl (blockLet, offsidePos) :: _) -> if debug then dprintf "IN at %a (becomes %s)\n" outputPos tokenStartPos (if blockLet then "ODECLEND" else "IN") if tokenStartCol < offsidePos.Column then warn tokenTup (FSComp.SR.lexfltIncorrentIndentationOfIn()) popCtxt() @@ -1306,7 +1305,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, hwTokenFetch(useBlockRule) // Balancing rule. Encountering a ')' or '}' balances with a '(' or '{', even if not offside - | ((END | RPAREN | RBRACE | BAR_RBRACE | RBRACK | BAR_RBRACK | RQUOTE _ | GREATER true) as t2), (CtxtParen (t1,_) :: _) + | ((END | RPAREN | RBRACE | BAR_RBRACE | RBRACK | BAR_RBRACK | RQUOTE _ | GREATER true) as t2), (CtxtParen (t1, _) :: _) when parenTokensBalance t1 t2 -> if debug then dprintf "RPAREN/RBRACE/BAR_RBRACE/RBRACK/BAR_RBRACK/RQUOTE/END at %a terminates CtxtParen()\n" outputPos tokenStartPos popCtxt() @@ -1348,7 +1347,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // Transition rule. CtxtModuleHead ~~~> push CtxtModuleBody; push CtxtSeqBlock // Applied when a ':' or '=' token is seen // Otherwise it's a 'head' module declaration, so ignore it - | _, (CtxtModuleHead (moduleTokenPos,prevToken) :: _) -> + | _, (CtxtModuleHead (moduleTokenPos, prevToken) :: _) -> match prevToken, token with | MODULE, GLOBAL when moduleTokenPos.Column < tokenStartPos.Column -> replaceCtxt tokenTup (CtxtModuleHead (moduleTokenPos, token)) @@ -1364,8 +1363,8 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, | _, (EQUALS | COLON) -> if debug then dprintf "CtxtModuleHead: COLON/EQUALS, pushing CtxtModuleBody and CtxtSeqBlock\n" popCtxt() - pushCtxt tokenTup (CtxtModuleBody (moduleTokenPos,false)) - pushCtxtSeqBlock(true,AddBlockEnd) + pushCtxt tokenTup (CtxtModuleBody (moduleTokenPos, false)) + pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState token | _ -> if debug then dprintf "CtxtModuleHead: start of file, CtxtSeqBlock\n" @@ -1376,7 +1375,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, returnToken tokenLexbufState token | _ -> delayToken tokenTup - pushCtxt tokenTup (CtxtModuleBody (moduleTokenPos,true)) + pushCtxt tokenTup (CtxtModuleBody (moduleTokenPos, true)) pushCtxtSeqBlockAt (tokenTup, true, AddBlockEnd) hwTokenFetch(false) @@ -1384,10 +1383,10 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // f x // g x // ... - | _, (CtxtSeqBlock(_,offsidePos,addBlockEnd) :: rest) when + | _, (CtxtSeqBlock(_, offsidePos, addBlockEnd) :: rest) when // NOTE: ;; does not terminate a 'namespace' body. - ((isSemiSemi && not (match rest with (CtxtNamespaceBody _ | CtxtModuleBody (_,true)) :: _ -> true | _ -> false)) || + ((isSemiSemi && not (match rest with (CtxtNamespaceBody _ | CtxtModuleBody (_, true)) :: _ -> true | _ -> false)) || let grace = match token, rest with // When in a type context allow a grace of 2 column positions for '|' tokens, permits @@ -1433,7 +1432,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // i.e. // // let x = - // stmt; + // stmt // -expr (if isInfix token then infixTokenLength token + 1 else 0) (tokenStartCol + grace < offsidePos.Column)) -> @@ -1449,7 +1448,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // fff // eeeee // - | _, (CtxtVanilla(offsidePos,_) :: _) when isSemiSemi || tokenStartCol <= offsidePos.Column -> + | _, (CtxtVanilla(offsidePos, _) :: _) when isSemiSemi || tokenStartCol <= offsidePos.Column -> if debug then dprintf "offside token at column %d indicates end of CtxtVanilla started at %a!\n" tokenStartCol outputPos offsidePos popCtxt() reprocess() @@ -1458,21 +1457,21 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // [< ... >] // decl - | _, (CtxtSeqBlock(NotFirstInSeqBlock,offsidePos,addBlockEnd) :: _) + | _, (CtxtSeqBlock(NotFirstInSeqBlock, offsidePos, addBlockEnd) :: _) when (match token with GREATER_RBRACK -> true | _ -> false) -> // Attribute-end tokens mean CtxtSeqBlock rule is NOT applied to the next token - replaceCtxt tokenTup (CtxtSeqBlock (FirstInSeqBlock,offsidePos,addBlockEnd)) + replaceCtxt tokenTup (CtxtSeqBlock (FirstInSeqBlock, offsidePos, addBlockEnd)) reprocessWithoutBlockRule() // Offside rule for SeqBlock - avoiding inserting OBLOCKSEP on first item in block - | _, (CtxtSeqBlock (FirstInSeqBlock,offsidePos,addBlockEnd) :: _) when useBlockRule -> + | _, (CtxtSeqBlock (FirstInSeqBlock, offsidePos, addBlockEnd) :: _) when useBlockRule -> // This is the first token in a block, or a token immediately // following an infix operator (see above). // Return the token, but only after processing any additional rules // applicable for this token. Don't apply the CtxtSeqBlock rule for // this token, but do apply it on subsequent tokens. if debug then dprintf "repull for CtxtSeqBlockStart\n" - replaceCtxt tokenTup (CtxtSeqBlock (NotFirstInSeqBlock,offsidePos,addBlockEnd)) + replaceCtxt tokenTup (CtxtSeqBlock (NotFirstInSeqBlock, offsidePos, addBlockEnd)) reprocessWithoutBlockRule() // Offside rule for SeqBlock - inserting OBLOCKSEP on subsequent items in a block when they are precisely aligned @@ -1493,7 +1492,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // let x3 = expr // ... // ~~> insert OBLOCKSEP - | _, (CtxtSeqBlock (NotFirstInSeqBlock,offsidePos,addBlockEnd) :: rest) + | _, (CtxtSeqBlock (NotFirstInSeqBlock, offsidePos, addBlockEnd) :: rest) when useBlockRule && not (let isTypeCtxt = (match rest with | (CtxtTypeDefns _ :: _) -> true | _ -> false) // Don't insert 'OBLOCKSEP' between namespace declarations @@ -1504,7 +1503,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, && (tokenStartCol = offsidePos.Column) && (tokenStartPos.OriginalLine <> offsidePos.OriginalLine) -> if debug then dprintf "offside at column %d matches start of block(%a)! delaying token, returning OBLOCKSEP\n" tokenStartCol outputPos offsidePos - replaceCtxt tokenTup (CtxtSeqBlock (FirstInSeqBlock,offsidePos,addBlockEnd)) + replaceCtxt tokenTup (CtxtSeqBlock (FirstInSeqBlock, offsidePos, addBlockEnd)) // No change to offside stack: another statement block starts... insertTokenFromPrevPosToCurrentPos OBLOCKSEP @@ -1520,7 +1519,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // let .... = // ... // <*> - | _, (CtxtLetDecl (true,offsidePos) :: _) when + | _, (CtxtLetDecl (true, offsidePos) :: _) when isSemiSemi || (if isLetContinuator token then tokenStartCol + 1 else tokenStartCol) <= offsidePos.Column -> if debug then dprintf "token at column %d is offside from LET(offsidePos=%a)! delaying token, returning ODECLEND\n" tokenStartCol outputPos offsidePos popCtxt() @@ -1556,7 +1555,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // module M = ... // ... // NOTE: ;; does not terminate a whole file module body. - | _, ((CtxtModuleBody (offsidePos,wholeFile)) :: _) when (isSemiSemi && not wholeFile) || tokenStartCol <= offsidePos.Column -> + | _, ((CtxtModuleBody (offsidePos, wholeFile)) :: _) when (isSemiSemi && not wholeFile) || tokenStartCol <= offsidePos.Column -> if debug then dprintf "token at column %d is offside from MODULE with offsidePos %a! delaying token\n" tokenStartCol outputPos offsidePos popCtxt() reprocess() @@ -1663,7 +1662,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, reprocess() // leadingBar=false permits match patterns without an initial '|' - | _, (CtxtMatchClauses (leadingBar,offsidePos) :: _) + | _, (CtxtMatchClauses (leadingBar, offsidePos) :: _) when (isSemiSemi || (match token with // BAR occurs in pattern matching 'with' blocks @@ -1671,7 +1670,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, let cond1 = tokenStartCol + (if leadingBar then 0 else 2) < offsidePos.Column let cond2 = tokenStartCol + (if leadingBar then 1 else 2) < offsidePos.Column if (cond1 <> cond2) then - errorR(Lexhelp.IndentationProblem(FSComp.SR.lexfltSeparatorTokensOfPatternMatchMisaligned(),mkSynRange (startPosOfTokenTup tokenTup) tokenTup.LexbufState.EndPos)) + errorR(Lexhelp.IndentationProblem(FSComp.SR.lexfltSeparatorTokensOfPatternMatchMisaligned(), mkSynRange (startPosOfTokenTup tokenTup) tokenTup.LexbufState.EndPos)) cond1 | END -> tokenStartCol + (if leadingBar then -1 else 1) < offsidePos.Column | _ -> tokenStartCol + (if leadingBar then -1 else 1) < offsidePos.Column)) -> @@ -1681,20 +1680,20 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // namespace ... ~~~> CtxtNamespaceHead - | NAMESPACE,(_ :: _) -> + | NAMESPACE, (_ :: _) -> if debug then dprintf "NAMESPACE: entering CtxtNamespaceHead, awaiting end of long identifier to push CtxtSeqBlock\n" pushCtxt tokenTup (CtxtNamespaceHead (tokenStartPos, token)) returnToken tokenLexbufState token // module ... ~~~> CtxtModuleHead - | MODULE,(_ :: _) -> + | MODULE, (_ :: _) -> insertComingSoonTokens("MODULE", MODULE_COMING_SOON, MODULE_IS_HERE) if debug then dprintf "MODULE: entering CtxtModuleHead, awaiting EQUALS to go to CtxtSeqBlock (%a)\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtModuleHead (tokenStartPos, token)) hwTokenFetch(useBlockRule) // exception ... ~~~> CtxtException - | EXCEPTION,(_ :: _) -> + | EXCEPTION, (_ :: _) -> if debug then dprintf "EXCEPTION: entering CtxtException(%a)\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtException tokenStartPos) returnToken tokenLexbufState token @@ -1706,7 +1705,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, if debug then dprintf "LET: entering CtxtLetDecl(), awaiting EQUALS to go to CtxtSeqBlock (%a)\n" outputPos tokenStartPos let startPos = match ctxt with CtxtMemberHead startPos -> startPos | _ -> tokenStartPos popCtxt() // get rid of the CtxtMemberHead - pushCtxt tokenTup (CtxtLetDecl(true,startPos)) + pushCtxt tokenTup (CtxtLetDecl(true, startPos)) returnToken tokenLexbufState (OLET(isUse)) // let ... ~~~> CtxtLetDecl @@ -1718,14 +1717,14 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, | CtxtMatchClauses _ -> true | _ -> false if debug then dprintf "LET: entering CtxtLetDecl(blockLet=%b), awaiting EQUALS to go to CtxtSeqBlock (%a)\n" blockLet outputPos tokenStartPos - pushCtxt tokenTup (CtxtLetDecl(blockLet,tokenStartPos)) + pushCtxt tokenTup (CtxtLetDecl(blockLet, tokenStartPos)) returnToken tokenLexbufState (if blockLet then OLET(isUse) else token) // let! ... ~~~> CtxtLetDecl | BINDER b, (ctxt :: _) -> let blockLet = match ctxt with CtxtSeqBlock _ -> true | _ -> false if debug then dprintf "LET: entering CtxtLetDecl(blockLet=%b), awaiting EQUALS to go to CtxtSeqBlock (%a)\n" blockLet outputPos tokenStartPos - pushCtxt tokenTup (CtxtLetDecl(blockLet,tokenStartPos)) + pushCtxt tokenTup (CtxtLetDecl(blockLet, tokenStartPos)) returnToken tokenLexbufState (if blockLet then OBINDER b else token) | (VAL | STATIC | ABSTRACT | MEMBER | OVERRIDE | DEFAULT), ctxtStack when thereIsACtxtMemberBodyOnTheStackAndWeShouldPopStackForUpcomingMember ctxtStack -> @@ -1752,13 +1751,13 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // override ... ~~~> CtxtMemberHead // default ... ~~~> CtxtMemberHead // val ... ~~~> CtxtMemberHead - | (VAL | STATIC | ABSTRACT | MEMBER | OVERRIDE | DEFAULT),(ctxt :: _) when (match ctxt with CtxtMemberHead _ -> false | _ -> true) -> + | (VAL | STATIC | ABSTRACT | MEMBER | OVERRIDE | DEFAULT), (ctxt :: _) when (match ctxt with CtxtMemberHead _ -> false | _ -> true) -> if debug then dprintf "STATIC/MEMBER/OVERRIDE/DEFAULT: entering CtxtMemberHead, awaiting EQUALS to go to CtxtSeqBlock (%a)\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtMemberHead(tokenStartPos)) returnToken tokenLexbufState token // public new... ~~~> CtxtMemberHead - | (PUBLIC | PRIVATE | INTERNAL),(_ctxt :: _) when (match peekNextToken() with NEW -> true | _ -> false) -> + | (PUBLIC | PRIVATE | INTERNAL), (_ctxt :: _) when (match peekNextToken() with NEW -> true | _ -> false) -> if debug then dprintf "PUBLIC/PRIVATE/INTERNAL NEW: entering CtxtMemberHead, awaiting EQUALS to go to CtxtSeqBlock (%a)\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtMemberHead(tokenStartPos)) returnToken tokenLexbufState token @@ -1772,18 +1771,18 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // 'let ... = ' ~~~> CtxtSeqBlock | EQUALS, (CtxtLetDecl _ :: _) -> if debug then dprintf "CtxtLetDecl: EQUALS, pushing CtxtSeqBlock\n" - pushCtxtSeqBlock(true,AddBlockEnd) + pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState token | EQUALS, (CtxtTypeDefns _ :: _) -> if debug then dprintf "CtxType: EQUALS, pushing CtxtSeqBlock\n" - pushCtxtSeqBlock(true,AddBlockEnd) + pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState token | (LAZY | ASSERT), _ -> if isControlFlowOrNotSameLine() then if debug then dprintf "LAZY/ASSERT, pushing CtxtSeqBlock\n" - pushCtxtSeqBlock(true,AddBlockEnd) + pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState (match token with LAZY -> OLAZY | _ -> OASSERT) else returnToken tokenLexbufState token @@ -1801,16 +1800,16 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // '{ id1 = 1 // M.id2 = ... ' ~~~> CtxtSeqBlock | EQUALS, ((CtxtWithAsLet _) :: _) // This detects 'with = '. - | EQUALS, ((CtxtVanilla (_,true)) :: (CtxtSeqBlock _) :: (CtxtWithAsLet _ | CtxtParen((LBRACE | LBRACE_BAR),_)) :: _) -> + | EQUALS, ((CtxtVanilla (_, true)) :: (CtxtSeqBlock _) :: (CtxtWithAsLet _ | CtxtParen((LBRACE | LBRACE_BAR), _)) :: _) -> if debug then dprintf "CtxtLetDecl/CtxtWithAsLet: EQUALS, pushing CtxtSeqBlock\n" // We don't insert begin/end block tokens for single-line bindings since we can't properly distinguish single-line *) // record update expressions such as "{ t with gbuckets=Array.copy t.gbuckets; gcount=t.gcount }" *) // These have a syntactically odd status because of the use of ";" to terminate expressions, so each *) // "=" binding is not properly balanced by "in" or "and" tokens in the single line syntax (unlike other bindings) *) if isControlFlowOrNotSameLine() then - pushCtxtSeqBlock(true,AddBlockEnd) + pushCtxtSeqBlock(true, AddBlockEnd) else - pushCtxtSeqBlock(false,NoAddBlockEnd) + pushCtxtSeqBlock(false, NoAddBlockEnd) returnToken tokenLexbufState token // 'new(... =' ~~~> CtxtMemberBody, CtxtSeqBlock @@ -1821,14 +1820,14 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, | EQUALS, ((CtxtMemberHead(offsidePos)) :: _) -> if debug then dprintf "CtxtMemberHead: EQUALS, pushing CtxtSeqBlock\n" replaceCtxt tokenTup (CtxtMemberBody (offsidePos)) - pushCtxtSeqBlock(true,AddBlockEnd) + pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState token // '(' tokens are balanced with ')' tokens and also introduce a CtxtSeqBlock | (BEGIN | LPAREN | SIG | LBRACE | LBRACE_BAR | LBRACK | LBRACK_BAR | LQUOTE _ | LESS true), _ -> if debug then dprintf "LPAREN etc., pushes CtxtParen, pushing CtxtSeqBlock, tokenStartPos = %a\n" outputPos tokenStartPos - pushCtxt tokenTup (CtxtParen (token,tokenStartPos)) - pushCtxtSeqBlock(false,NoAddBlockEnd) + pushCtxt tokenTup (CtxtParen (token, tokenStartPos)) + pushCtxtSeqBlock(false, NoAddBlockEnd) returnToken tokenLexbufState token // '(' tokens are balanced with ')' tokens and also introduce a CtxtSeqBlock @@ -1841,8 +1840,8 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, | _ -> false) (* type X<'a when 'a : struct> *) -> if debug then dprintf "LPAREN etc., pushes CtxtParen, pushing CtxtSeqBlock, tokenStartPos = %a\n" outputPos tokenStartPos - pushCtxt tokenTup (CtxtParen (token,tokenStartPos)) - pushCtxtSeqBlock(false,NoAddBlockEnd) + pushCtxt tokenTup (CtxtParen (token, tokenStartPos)) + pushCtxtSeqBlock(false, NoAddBlockEnd) returnToken tokenLexbufState token | RARROW, ctxts @@ -1856,19 +1855,19 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, | (CtxtSeqBlock _ :: (CtxtDo _ | CtxtWhile _ | CtxtFor _ | CtxtWhen _ | CtxtMatchClauses _ | CtxtTry _ | CtxtThen _ | CtxtElse _) :: _) -> true | _ -> false) -> if debug then dprintf "RARROW, pushing CtxtSeqBlock, tokenStartPos = %a\n" outputPos tokenStartPos - pushCtxtSeqBlock(false,AddOneSidedBlockEnd) + pushCtxtSeqBlock(false, AddOneSidedBlockEnd) returnToken tokenLexbufState token | LARROW, _ when isControlFlowOrNotSameLine() -> if debug then dprintf "LARROW, pushing CtxtSeqBlock, tokenStartPos = %a\n" outputPos tokenStartPos - pushCtxtSeqBlock(true,AddBlockEnd) + pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState token // do ~~> CtxtDo;CtxtSeqBlock (unconditionally) | (DO | DO_BANG), _ -> if debug then dprintf "DO: pushing CtxtSeqBlock, tokenStartPos = %a\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtDo (tokenStartPos)) - pushCtxtSeqBlock(true,AddBlockEnd) + pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState (match token with DO -> ODO | DO_BANG -> ODO_BANG | _ -> failwith "unreachable") // The r.h.s. of an infix token begins a new block. @@ -1885,7 +1884,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, (match ctxts with CtxtMatchClauses _ :: _ -> false | _ -> true)) -> if debug then dprintf "(Infix etc.), pushing CtxtSeqBlock, tokenStartPos = %a\n" outputPos tokenStartPos - pushCtxtSeqBlock(false,NoAddBlockEnd) + pushCtxtSeqBlock(false, NoAddBlockEnd) returnToken tokenLexbufState token | WITH, ((CtxtTry _ | CtxtMatch _) :: _) -> @@ -1893,16 +1892,16 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, let lookaheadTokenStartPos = startPosOfTokenTup lookaheadTokenTup let leadingBar = match (peekNextToken()) with BAR -> true | _ -> false if debug then dprintf "WITH, pushing CtxtMatchClauses, lookaheadTokenStartPos = %a, tokenStartPos = %a\n" outputPos lookaheadTokenStartPos outputPos tokenStartPos - pushCtxt lookaheadTokenTup (CtxtMatchClauses(leadingBar,lookaheadTokenStartPos)) + pushCtxt lookaheadTokenTup (CtxtMatchClauses(leadingBar, lookaheadTokenStartPos)) returnToken tokenLexbufState OWITH | FINALLY, (CtxtTry _ :: _) -> if debug then dprintf "FINALLY, pushing pushCtxtSeqBlock, tokenStartPos = %a\n" outputPos tokenStartPos - pushCtxtSeqBlock(true,AddBlockEnd) + pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState token | WITH, (((CtxtException _ | CtxtTypeDefns _ | CtxtMemberHead _ | CtxtInterfaceHead _ | CtxtMemberBody _) as limCtxt) :: _) - | WITH, ((CtxtSeqBlock _) as limCtxt :: CtxtParen((LBRACE | LBRACE_BAR),_) :: _) -> + | WITH, ((CtxtSeqBlock _) as limCtxt :: CtxtParen((LBRACE | LBRACE_BAR), _) :: _) -> let lookaheadTokenTup = peekNextTokenTup() let lookaheadTokenStartPos = startPosOfTokenTup lookaheadTokenTup match lookaheadTokenTup.Token with @@ -1930,14 +1929,14 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // (HOWEVER: note the above language construct is now deprecated/removed) // // It also happens to detect - // { foo with m = 1; + // { foo with m = 1 // n = 2 } // So we're careful to set the offside column to be the minimum required *) tokenStartPos else // This detects: // { foo with - // m = 1; + // m = 1 // n = 2 } // So we're careful to set the offside column to be the minimum required *) limCtxt.StartPos @@ -1960,7 +1959,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, res if isFollowedByLongIdentEquals then - pushCtxtSeqBlock(false,NoAddBlockEnd) + pushCtxtSeqBlock(false, NoAddBlockEnd) returnToken tokenLexbufState OWITH | _ -> @@ -1993,14 +1992,14 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, let offsidePos = limCtxt.StartPos pushCtxt tokenTup (CtxtWithAsAugment(offsidePos)) - pushCtxtSeqBlock(true,AddBlockEnd) + pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState token | WITH, stack -> if debug then dprintf "WITH\n" if debug then dprintf "WITH --> NO MATCH, pushing CtxtWithAsAugment (type augmentation), stack = %A" stack pushCtxt tokenTup (CtxtWithAsAugment(tokenStartPos)) - pushCtxtSeqBlock(true,AddBlockEnd) + pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState token | FUNCTION, _ -> @@ -2008,13 +2007,13 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, let lookaheadTokenStartPos = startPosOfTokenTup lookaheadTokenTup let leadingBar = match (peekNextToken()) with BAR -> true | _ -> false pushCtxt tokenTup (CtxtFunction(tokenStartPos)) - pushCtxt lookaheadTokenTup (CtxtMatchClauses(leadingBar,lookaheadTokenStartPos)) + pushCtxt lookaheadTokenTup (CtxtMatchClauses(leadingBar, lookaheadTokenStartPos)) returnToken tokenLexbufState OFUNCTION - | THEN,_ -> + | THEN, _ -> if debug then dprintf "THEN, replacing THEN with OTHEN, pushing CtxtSeqBlock;CtxtThen(%a)\n" outputPos tokenStartPos pushCtxt tokenTup (CtxtThen(tokenStartPos)) - pushCtxtSeqBlock(true,AddBlockEnd) + pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState OTHEN | ELSE, _ -> @@ -2022,7 +2021,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, let lookaheadTokenStartPos = startPosOfTokenTup lookaheadTokenTup match peekNextToken() with | IF when isSameLine() -> - // We convert ELSE IF to ELIF since it then opens the block at the right point, + // We convert ELSE IF to ELIF since it then opens the block at the right point, // In particular the case // if e1 then e2 // else if e3 then e4 @@ -2035,7 +2034,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, | _ -> if debug then dprintf "ELSE: replacing ELSE with OELSE, pushing CtxtSeqBlock, CtxtElse(%a)\n" outputPos lookaheadTokenStartPos pushCtxt tokenTup (CtxtElse(tokenStartPos)) - pushCtxtSeqBlock(true,AddBlockEnd) + pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState OELSE | (ELIF | IF), _ -> @@ -2075,8 +2074,8 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // type I = interface .... end | DEFAULT | OVERRIDE | INTERFACE | NEW | TYPE | STATIC | END | MEMBER | ABSTRACT | INHERIT | LBRACK_LESS -> if debug then dprintf "INTERFACE, pushing CtxtParen, tokenStartPos = %a, lookaheadTokenStartPos = %a\n" outputPos tokenStartPos outputPos lookaheadTokenStartPos - pushCtxt tokenTup (CtxtParen (token,tokenStartPos)) - pushCtxtSeqBlock(true,AddBlockEnd) + pushCtxt tokenTup (CtxtParen (token, tokenStartPos)) + pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState token // type C with interface .... with // type C = interface .... with @@ -2087,8 +2086,8 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, | CLASS, _ -> if debug then dprintf "CLASS, pushing CtxtParen(%a)\n" outputPos tokenStartPos - pushCtxt tokenTup (CtxtParen (token,tokenStartPos)) - pushCtxtSeqBlock(true,AddBlockEnd) + pushCtxt tokenTup (CtxtParen (token, tokenStartPos)) + pushCtxtSeqBlock(true, AddBlockEnd) returnToken tokenLexbufState token | TYPE, _ -> @@ -2105,18 +2104,18 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, // WITH is used in the grammar (see what happens when we hit a WITH below. // This hits in the single line case: "try make ef1 t with _ -> make ef2 t". - pushCtxtSeqBlock(false,AddOneSidedBlockEnd) + pushCtxtSeqBlock(false, AddOneSidedBlockEnd) returnToken tokenLexbufState token - | OBLOCKBEGIN,_ -> + | OBLOCKBEGIN, _ -> returnToken tokenLexbufState token - | ODUMMY(_),_ -> + | ODUMMY(_), _ -> if debug then dprintf "skipping dummy token as no offside rules apply\n" hwTokenFetch (useBlockRule) // Ordinary tokens start a vanilla block - | _,CtxtSeqBlock _ :: _ -> + | _, CtxtSeqBlock _ :: _ -> pushCtxt tokenTup (CtxtVanilla(tokenStartPos, isLongIdentEquals token)) if debug then dprintf "pushing CtxtVanilla at tokenStartPos = %a\n" outputPos tokenStartPos returnToken tokenLexbufState token @@ -2151,16 +2150,16 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, true // Split this token to allow "1..2" for range specification - | INT32_DOT_DOT (i,v) -> + | INT32_DOT_DOT (i, v) -> let dotdotPos = new LexbufState(tokenTup.EndPos.ShiftColumnBy(-2), tokenTup.EndPos, false) delayToken(new TokenTup(DOT_DOT, dotdotPos, tokenTup.LastTokenPos)) - delayToken(tokenTup.UseShiftedLocation(INT32(i,v), 0, -2)) + delayToken(tokenTup.UseShiftedLocation(INT32(i, v), 0, -2)) true // Split @>. and @@>. into two - | RQUOTE_DOT (s,raw) -> + | RQUOTE_DOT (s, raw) -> let dotPos = new LexbufState(tokenTup.EndPos.ShiftColumnBy(-1), tokenTup.EndPos, false) delayToken(new TokenTup(DOT, dotPos, tokenTup.LastTokenPos)) - delayToken(tokenTup.UseShiftedLocation(RQUOTE(s,raw), 0, -1)) + delayToken(tokenTup.UseShiftedLocation(RQUOTE(s, raw), 0, -1)) true | MINUS | PLUS_MINUS_OP _ | PERCENT_OP _ | AMP | AMP_AMP @@ -2182,7 +2181,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, | _ -> false let nextTokenTup = popNextTokenTup() /// Merge the location of the prefix token and the literal - let delayMergedToken tok = delayToken(new TokenTup(tok,new LexbufState(tokenTup.LexbufState.StartPos,nextTokenTup.LexbufState.EndPos,nextTokenTup.LexbufState.PastEOF),tokenTup.LastTokenPos)) + let delayMergedToken tok = delayToken(new TokenTup(tok, new LexbufState(tokenTup.LexbufState.StartPos, nextTokenTup.LexbufState.EndPos, nextTokenTup.LexbufState.PastEOF), tokenTup.LastTokenPos)) let noMerge() = let tokenName = match tokenTup.Token with @@ -2198,16 +2197,16 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, if plusOrMinus then match nextTokenTup.Token with - | INT8(v,bad) -> delayMergedToken(INT8((if plus then v else -v),(plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not - | INT16(v,bad) -> delayMergedToken(INT16((if plus then v else -v),(plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not - | INT32(v,bad) -> delayMergedToken(INT32((if plus then v else -v),(plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not - | INT32_DOT_DOT(v,bad) -> delayMergedToken(INT32_DOT_DOT((if plus then v else -v),(plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not - | INT64(v,bad) -> delayMergedToken(INT64((if plus then v else -v),(plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not + | INT8(v, bad) -> delayMergedToken(INT8((if plus then v else -v), (plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not + | INT16(v, bad) -> delayMergedToken(INT16((if plus then v else -v), (plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not + | INT32(v, bad) -> delayMergedToken(INT32((if plus then v else -v), (plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not + | INT32_DOT_DOT(v, bad) -> delayMergedToken(INT32_DOT_DOT((if plus then v else -v), (plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not + | INT64(v, bad) -> delayMergedToken(INT64((if plus then v else -v), (plus && bad))) // note: '-' makes a 'bad' max int 'good'. '+' does not | NATIVEINT(v) -> delayMergedToken(NATIVEINT(if plus then v else -v)) | IEEE32(v) -> delayMergedToken(IEEE32(if plus then v else -v)) | IEEE64(v) -> delayMergedToken(IEEE64(if plus then v else -v)) | DECIMAL(v) -> delayMergedToken(DECIMAL(if plus then v else System.Decimal.op_UnaryNegation v)) - | BIGNUM(v,s) -> delayMergedToken(BIGNUM((if plus then v else "-" + v),s)) + | BIGNUM(v, s) -> delayMergedToken(BIGNUM((if plus then v else "-" + v), s)) | _ -> noMerge() else noMerge() @@ -2216,12 +2215,12 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, | _ -> false - and pushCtxtSeqBlock(addBlockBegin,addBlockEnd) = pushCtxtSeqBlockAt (peekNextTokenTup(),addBlockBegin,addBlockEnd) - and pushCtxtSeqBlockAt(p:TokenTup,addBlockBegin,addBlockEnd) = + and pushCtxtSeqBlock(addBlockBegin, addBlockEnd) = pushCtxtSeqBlockAt (peekNextTokenTup(), addBlockBegin, addBlockEnd) + and pushCtxtSeqBlockAt(p:TokenTup, addBlockBegin, addBlockEnd) = if addBlockBegin then if debug then dprintf "--> insert OBLOCKBEGIN \n" delayToken(p.UseLocation(OBLOCKBEGIN)) - pushCtxt p (CtxtSeqBlock(FirstInSeqBlock, startPosOfTokenTup p,addBlockEnd)) + pushCtxt p (CtxtSeqBlock(FirstInSeqBlock, startPosOfTokenTup p, addBlockEnd)) let rec swTokenFetch() = let tokenTup = popNextTokenTup() diff --git a/src/fsharp/LowerCallsAndSeqs.fs b/src/fsharp/LowerCallsAndSeqs.fs index bec0d2afe8695af8b79819d658719f45eba10f0f..087d49f39b3da84890e2343c371a9d3efb98aadd 100644 --- a/src/fsharp/LowerCallsAndSeqs.fs +++ b/src/fsharp/LowerCallsAndSeqs.fs @@ -1,13 +1,13 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.LowerCallsAndSeqs +module internal FSharp.Compiler.LowerCallsAndSeqs open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler.AbstractIL.Internal.Library -open FSharp.Compiler.AccessibilityLogic +open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.Ast open FSharp.Compiler.Infos open FSharp.Compiler.ErrorLogger @@ -24,35 +24,35 @@ open FSharp.Compiler.MethodCalls let InterceptExpr g cont expr = match expr with - | Expr.Val(vref,flags,m) -> - match vref.ValReprInfo with + | Expr.Val(vref, flags, m) -> + match vref.ValReprInfo with | Some arity -> Some (fst (AdjustValForExpectedArity g m vref flags arity)) | None -> None - - // App (Val v,tys,args) - | Expr.App((Expr.Val (vref,flags,_) as f0),f0ty,tyargsl,argsl,m) -> - // Only transform if necessary, i.e. there are not enough arguments + + // App (Val v, tys, args) + | Expr.App((Expr.Val (vref, flags, _) as f0), f0ty, tyargsl, argsl, m) -> + // Only transform if necessary, i.e. there are not enough arguments match vref.ValReprInfo with | Some(topValInfo) -> - let argsl = List.map cont argsl - let f0 = + let argsl = List.map cont argsl + let f0 = if topValInfo.AritiesOfArgs.Length > argsl.Length - then fst(AdjustValForExpectedArity g m vref flags topValInfo) - else f0 + then fst(AdjustValForExpectedArity g m vref flags topValInfo) + else f0 - Some (MakeApplicationAndBetaReduce g (f0,f0ty,[tyargsl],argsl,m)) + Some (MakeApplicationAndBetaReduce g (f0, f0ty, [tyargsl], argsl, m)) | None -> None - | Expr.App(f0,f0ty,tyargsl,argsl,m) -> - Some (MakeApplicationAndBetaReduce g (f0,f0ty, [tyargsl],argsl,m) ) + | Expr.App(f0, f0ty, tyargsl, argsl, m) -> + Some (MakeApplicationAndBetaReduce g (f0, f0ty, [tyargsl], argsl, m) ) | _ -> None -/// An "expr -> expr" pass that eta-expands under-applied values of -/// known arity to lambda expressions and beta-var-reduces to bind -/// any known arguments. The results are later optimized by the peephole +/// An "expr -> expr" pass that eta-expands under-applied values of +/// known arity to lambda expressions and beta-var-reduces to bind +/// any known arguments. The results are later optimized by the peephole /// optimizer in opt.fs -let LowerImplFile g assembly = +let LowerImplFile g assembly = RewriteImplFile { PreIntercept = Some(InterceptExpr g) PreInterceptBinding=None PostTransform= (fun _ -> None) @@ -62,45 +62,45 @@ let LowerImplFile g assembly = //---------------------------------------------------------------------------- // State machine compilation for sequence expressions -let mkLambdaNoType g m uv e = - mkLambda m uv (e,tyOfExpr g e) +let mkLambdaNoType g m uv e = + mkLambda m uv (e, tyOfExpr g e) let mkUnitDelayLambda (g: TcGlobals) m e = - let uv,_ue = mkCompGenLocal m "unitVar" g.unit_ty - mkLambdaNoType g m uv e + let uv, _ue = mkCompGenLocal m "unitVar" g.unit_ty + mkLambdaNoType g m uv e let callNonOverloadedMethod g amap m methName ty args = - match TryFindIntrinsicMethInfo (InfoReader(g,amap)) m AccessibleFromSomeFSharpCode methName ty with - | [] -> error(InternalError("No method called '"+methName+"' was found",m)) - | ILMeth(g,ilMethInfo,_) :: _ -> + match TryFindIntrinsicMethInfo (InfoReader(g, amap)) m AccessibleFromSomeFSharpCode methName ty with + | [] -> error(InternalError("No method called '"+methName+"' was found", m)) + | ILMeth(g, ilMethInfo, _) :: _ -> // REVIEW: consider if this should ever be a constrained call. At the moment typecheck limitations in the F# typechecker // ensure the enumerator type used within computation expressions is not a struct type BuildILMethInfoCall g amap m false ilMethInfo NormalValUse [] false args |> fst - | _ -> - error(InternalError("The method called '"+methName+"' resolved to a non-IL type",m)) - + | _ -> + error(InternalError("The method called '"+methName+"' resolved to a non-IL type", m)) -type LoweredSeqFirstPhaseResult = + +type LoweredSeqFirstPhaseResult = { /// The code to run in the second phase, to rebuild the expressions, once all code labels and their mapping to program counters have been determined /// 'nextVar' is the argument variable for the GenerateNext method that represents the byref argument that holds the "goto" destination for a tailcalling sequence expression - phase2 : ((* pc: *) ValRef * (* current: *) ValRef * (* nextVar: *) ValRef * Map -> Expr * Expr * Expr) + phase2 : ((* pc: *) ValRef * (* current: *) ValRef * (* nextVar: *) ValRef * Map -> Expr * Expr * Expr) /// The labels allocated for one portion of the sequence expression - labels : int list + labels : int list /// any actual work done in Close significantClose : bool - + /// The state variables allocated for one portion of the sequence expression (i.e. the local let-bound variables which become state variables) - stateVars: ValRef list - + stateVars: ValRef list + /// The vars captured by the non-synchronous path capturedVars: FreeVars } let isVarFreeInExpr v e = Zset.contains v (freeInExpr CollectTyparsAndLocals e).FreeLocals /// Analyze a TAST expression to detect the elaborated form of a sequence expression. -/// Then compile it to a state machine represented as a TAST containing goto, return and label nodes. +/// Then compile it to a state machine represented as a TAST containing goto, return and label nodes. /// The returned state machine will also contain references to state variables (from internal 'let' bindings), /// a program counter (pc) that records the current state, and a current generated value (current). /// All these variables are then represented as fields in a hosting closure object along with any additional @@ -109,327 +109,327 @@ let isVarFreeInExpr v e = Zset.contains v (freeInExpr CollectTyparsAndLocals e). /// The analysis is done in two phases. The first phase determines the state variables and state labels (as Abstract IL code labels). /// We then allocate an integer pc for each state label and proceed with the second phase, which builds two related state machine /// expressions: one for 'MoveNext' and one for 'Dispose'. -let LowerSeqExpr g amap overallExpr = +let LowerSeqExpr g amap overallExpr = /// Detect a 'yield x' within a 'seq { ... }' - let (|SeqYield|_|) expr = + let (|SeqYield|_|) expr = match expr with - | Expr.App(Expr.Val (vref,_,_),_f0ty,_tyargsl,[arg],m) when valRefEq g vref g.seq_singleton_vref -> - Some (arg,m) - | _ -> + | Expr.App(Expr.Val (vref, _, _), _f0ty, _tyargsl, [arg], m) when valRefEq g vref g.seq_singleton_vref -> + Some (arg, m) + | _ -> None - + /// Detect a 'expr; expr' within a 'seq { ... }' - let (|SeqAppend|_|) expr = + let (|SeqAppend|_|) expr = match expr with - | Expr.App(Expr.Val (vref,_,_),_f0ty,_tyargsl,[arg1;arg2],m) when valRefEq g vref g.seq_append_vref -> - Some (arg1,arg2,m) - | _ -> + | Expr.App(Expr.Val (vref, _, _), _f0ty, _tyargsl, [arg1;arg2], m) when valRefEq g vref g.seq_append_vref -> + Some (arg1, arg2, m) + | _ -> None - + /// Detect a 'while gd do expr' within a 'seq { ... }' - let (|SeqWhile|_|) expr = + let (|SeqWhile|_|) expr = match expr with - | Expr.App(Expr.Val (vref,_,_),_f0ty,_tyargsl,[Expr.Lambda(_,_,_,[dummyv],gd,_,_);arg2],m) - when valRefEq g vref g.seq_generated_vref && - not (isVarFreeInExpr dummyv gd) -> - Some (gd,arg2,m) - | _ -> + | Expr.App(Expr.Val (vref, _, _), _f0ty, _tyargsl, [Expr.Lambda(_, _, _, [dummyv], gd, _, _);arg2], m) + when valRefEq g vref g.seq_generated_vref && + not (isVarFreeInExpr dummyv gd) -> + Some (gd, arg2, m) + | _ -> None - - let (|SeqTryFinally|_|) expr = + + let (|SeqTryFinally|_|) expr = match expr with - | Expr.App(Expr.Val (vref,_,_),_f0ty,_tyargsl,[arg1;Expr.Lambda(_,_,_,[dummyv],compensation,_,_)],m) - when valRefEq g vref g.seq_finally_vref && - not (isVarFreeInExpr dummyv compensation) -> - Some (arg1,compensation,m) - | _ -> + | Expr.App(Expr.Val (vref, _, _), _f0ty, _tyargsl, [arg1;Expr.Lambda(_, _, _, [dummyv], compensation, _, _)], m) + when valRefEq g vref g.seq_finally_vref && + not (isVarFreeInExpr dummyv compensation) -> + Some (arg1, compensation, m) + | _ -> None - - let (|SeqUsing|_|) expr = + + let (|SeqUsing|_|) expr = match expr with - | Expr.App(Expr.Val (vref,_,_),_f0ty,[_;_;elemTy],[resource;Expr.Lambda(_,_,_,[v],body,_,_)],m) - when valRefEq g vref g.seq_using_vref -> - Some (resource,v,body,elemTy,m) - | _ -> + | Expr.App(Expr.Val (vref, _, _), _f0ty, [_;_;elemTy], [resource;Expr.Lambda(_, _, _, [v], body, _, _)], m) + when valRefEq g vref g.seq_using_vref -> + Some (resource, v, body, elemTy, m) + | _ -> None - - let (|SeqFor|_|) expr = + + let (|SeqFor|_|) expr = match expr with // Nested for loops are represented by calls to Seq.collect - | Expr.App(Expr.Val (vref,_,_),_f0ty,[_inpElemTy;_enumty2;genElemTy],[Expr.Lambda(_,_,_,[v],body,_,_); inp],m) when valRefEq g vref g.seq_collect_vref -> - Some (inp,v,body,genElemTy,m) + | Expr.App(Expr.Val (vref, _, _), _f0ty, [_inpElemTy;_enumty2;genElemTy], [Expr.Lambda(_, _, _, [v], body, _, _); inp], m) when valRefEq g vref g.seq_collect_vref -> + Some (inp, v, body, genElemTy, m) // "for x in e -> e2" is converted to a call to Seq.map by the F# type checker. This could be removed, except it is also visible in F# quotations. - | Expr.App(Expr.Val (vref,_,_),_f0ty,[_inpElemTy;genElemTy],[Expr.Lambda(_,_,_,[v],body,_,_); inp],m) when valRefEq g vref g.seq_map_vref -> - Some (inp,v,mkCallSeqSingleton g body.Range genElemTy body,genElemTy,m) + | Expr.App(Expr.Val (vref, _, _), _f0ty, [_inpElemTy;genElemTy], [Expr.Lambda(_, _, _, [v], body, _, _); inp], m) when valRefEq g vref g.seq_map_vref -> + Some (inp, v, mkCallSeqSingleton g body.Range genElemTy body, genElemTy, m) | _ -> None - - let (|SeqDelay|_|) expr = + + let (|SeqDelay|_|) expr = match expr with - | Expr.App(Expr.Val (vref,_,_),_f0ty,[elemTy],[Expr.Lambda(_,_,_,[v],e,_,_)],_m) when valRefEq g vref g.seq_delay_vref && not (isVarFreeInExpr v e) -> Some (e,elemTy) + | Expr.App(Expr.Val (vref, _, _), _f0ty, [elemTy], [Expr.Lambda(_, _, _, [v], e, _, _)], _m) when valRefEq g vref g.seq_delay_vref && not (isVarFreeInExpr v e) -> Some (e, elemTy) | _ -> None - - let (|SeqEmpty|_|) expr = + + let (|SeqEmpty|_|) expr = match expr with - | Expr.App(Expr.Val (vref,_,_),_f0ty,_tyargsl,[],m) when valRefEq g vref g.seq_empty_vref -> Some (m) + | Expr.App(Expr.Val (vref, _, _), _f0ty, _tyargsl, [], m) when valRefEq g vref g.seq_empty_vref -> Some (m) | _ -> None - - let (|Seq|_|) expr = + + let (|Seq|_|) expr = match expr with // use 'seq { ... }' as an indicator - | Expr.App(Expr.Val (vref,_,_),_f0ty,[elemTy],[e],_m) when valRefEq g vref g.seq_vref -> Some (e,elemTy) + | Expr.App(Expr.Val (vref, _, _), _f0ty, [elemTy], [e], _m) when valRefEq g vref g.seq_vref -> Some (e, elemTy) | _ -> None - let RepresentBindingAsLocal (bind: Binding) res2 m = + let RepresentBindingAsLocal (bind: Binding) res2 m = // printfn "found letrec state variable %s" bind.Var.DisplayName { res2 with - phase2 = (fun ctxt -> - let generate2,dispose2,checkDispose2 = res2.phase2 ctxt + phase2 = (fun ctxt -> + let generate2, dispose2, checkDispose2 = res2.phase2 ctxt let generate = mkLetBind m bind generate2 let dispose = dispose2 let checkDispose = checkDispose2 - generate,dispose,checkDispose) + generate, dispose, checkDispose) stateVars = res2.stateVars } - let RepresentBindingAsStateMachineLocal (bind: Binding) res2 m = + let RepresentBindingAsStateMachineLocal (bind: Binding) res2 m = // printfn "found letrec state variable %s" bind.Var.DisplayName - let (TBind(v,e,sp)) = bind - let sp,spm = - match sp with - | SequencePointAtBinding m -> SequencePointsAtSeq,m - | _ -> SuppressSequencePointOnExprOfSequential,e.Range + let (TBind(v, e, sp)) = bind + let sp, spm = + match sp with + | SequencePointAtBinding m -> SequencePointsAtSeq, m + | _ -> SuppressSequencePointOnExprOfSequential, e.Range let vref = mkLocalValRef v { res2 with - phase2 = (fun ctxt -> - let generate2,dispose2,checkDispose2 = res2.phase2 ctxt - let generate = - mkCompGenSequential m - (mkSequential sp m - (mkValSet spm vref e) - generate2) + phase2 = (fun ctxt -> + let generate2, dispose2, checkDispose2 = res2.phase2 ctxt + let generate = + mkCompGenSequential m + (mkSequential sp m + (mkValSet spm vref e) + generate2) // zero out the current value to free up its memory - (mkValSet m vref (mkDefault (m,vref.Type))) + (mkValSet m vref (mkDefault (m, vref.Type))) let dispose = dispose2 let checkDispose = checkDispose2 - generate,dispose,checkDispose) + generate, dispose, checkDispose) stateVars = vref::res2.stateVars } - let RepresentBindingsAsLifted mkBinds res2 = + let RepresentBindingsAsLifted mkBinds res2 = // printfn "found top level let " { res2 with - phase2 = (fun ctxt -> - let generate2,dispose2,checkDispose2 = res2.phase2 ctxt + phase2 = (fun ctxt -> + let generate2, dispose2, checkDispose2 = res2.phase2 ctxt let generate = mkBinds generate2 let dispose = dispose2 let checkDispose = checkDispose2 - generate,dispose, checkDispose) } + generate, dispose, checkDispose) } - let rec Lower - isWholeExpr + let rec Lower + isWholeExpr isTailCall // is this sequence in tailcall position? noDisposeContinuationLabel // represents the label for the code where there is effectively nothing to do to dispose the iterator for the current state currentDisposeContinuationLabel // represents the label for the code we have to run to dispose the iterator given the current state - expr = + expr = - match expr with - | SeqYield(e,m) -> + match expr with + | SeqYield(e, m) -> // printfn "found Seq.singleton" - //this.pc <- NEXT - //curr <- e - //return true + //this.pc <- NEXT + //curr <- e + //return true //NEXT: let label = IL.generateCodeLabel() - Some { phase2 = (fun (pcv,currv,_nextv,pcMap) -> - let generate = - mkCompGenSequential m + Some { phase2 = (fun (pcv, currv, _nextv, pcMap) -> + let generate = + mkCompGenSequential m (mkValSet m pcv (mkInt32 g m pcMap.[label])) - (mkSequential SequencePointsAtSeq m + (mkSequential SequencePointsAtSeq m (mkValSet m currv e) - (mkCompGenSequential m - (Expr.Op(TOp.Return,[],[mkOne g m],m)) - (Expr.Op(TOp.Label label,[],[],m)))) - let dispose = - mkCompGenSequential m - (Expr.Op(TOp.Label label,[],[],m)) - (Expr.Op(TOp.Goto currentDisposeContinuationLabel,[],[],m)) - let checkDispose = - mkCompGenSequential m - (Expr.Op(TOp.Label label,[],[],m)) - (Expr.Op(TOp.Return,[],[mkBool g m (not (noDisposeContinuationLabel = currentDisposeContinuationLabel))],m)) - generate,dispose,checkDispose) + (mkCompGenSequential m + (Expr.Op(TOp.Return, [], [mkOne g m], m)) + (Expr.Op(TOp.Label label, [], [], m)))) + let dispose = + mkCompGenSequential m + (Expr.Op(TOp.Label label, [], [], m)) + (Expr.Op(TOp.Goto currentDisposeContinuationLabel, [], [], m)) + let checkDispose = + mkCompGenSequential m + (Expr.Op(TOp.Label label, [], [], m)) + (Expr.Op(TOp.Return, [], [mkBool g m (not (noDisposeContinuationLabel = currentDisposeContinuationLabel))], m)) + generate, dispose, checkDispose) labels=[label] stateVars=[] significantClose = false capturedVars = emptyFreeVars } - | SeqDelay(delayedExpr,_elemTy) -> + | SeqDelay(delayedExpr, _elemTy) -> // printfn "found Seq.delay" // note, using 'isWholeExpr' here prevents 'seq { yield! e }' and 'seq { 0 .. 1000 }' from being compiled - Lower isWholeExpr isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel delayedExpr + Lower isWholeExpr isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel delayedExpr - | SeqAppend(e1,e2,m) -> + | SeqAppend(e1, e2, m) -> // printfn "found Seq.append" let res1 = Lower false false noDisposeContinuationLabel currentDisposeContinuationLabel e1 let res2 = Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel e2 - match res1, res2 with - | Some res1, Some res2 -> + match res1, res2 with + | Some res1, Some res2 -> - let capturedVars = - if res1.labels.IsEmpty then - res2.capturedVars - else + let capturedVars = + if res1.labels.IsEmpty then + res2.capturedVars + else // All of 'e2' is needed after resuming at any of the labels unionFreeVars res1.capturedVars (freeInExpr CollectLocals e2) - Some { phase2 = (fun ctxt -> - let generate1,dispose1,checkDispose1 = res1.phase2 ctxt - let generate2,dispose2,checkDispose2 = res2.phase2 ctxt + Some { phase2 = (fun ctxt -> + let generate1, dispose1, checkDispose1 = res1.phase2 ctxt + let generate2, dispose2, checkDispose2 = res2.phase2 ctxt let generate = mkCompGenSequential m generate1 generate2 // Order shouldn't matter here, since disposals actions are linked together by goto's (each ends in a goto). // However leaving as is for now. - let dispose = mkCompGenSequential m dispose2 dispose1 + let dispose = mkCompGenSequential m dispose2 dispose1 let checkDispose = mkCompGenSequential m checkDispose2 checkDispose1 - generate,dispose,checkDispose) + generate, dispose, checkDispose) labels= res1.labels @ res2.labels - stateVars = res1.stateVars @ res2.stateVars + stateVars = res1.stateVars @ res2.stateVars significantClose = res1.significantClose || res2.significantClose capturedVars = capturedVars } - | _ -> + | _ -> None - | SeqWhile(guardExpr,bodyExpr,m) -> + | SeqWhile(guardExpr, bodyExpr, m) -> // printfn "found Seq.while" let resBody = Lower false false noDisposeContinuationLabel currentDisposeContinuationLabel bodyExpr - match resBody with - | Some res2 -> - let capturedVars = - if res2.labels.IsEmpty then + match resBody with + | Some res2 -> + let capturedVars = + if res2.labels.IsEmpty then res2.capturedVars // the whole loopis synchronous, no labels - else + else freeInExpr CollectLocals expr // everything is needed on subsequent iterations - - Some { phase2 = (fun ctxt -> - let generate2,dispose2,checkDispose2 = res2.phase2 ctxt - let generate = mkWhile g (SequencePointAtWhileLoop guardExpr.Range,NoSpecialWhileLoopMarker,guardExpr,generate2,m) + + Some { phase2 = (fun ctxt -> + let generate2, dispose2, checkDispose2 = res2.phase2 ctxt + let generate = mkWhile g (SequencePointAtWhileLoop guardExpr.Range, NoSpecialWhileLoopMarker, guardExpr, generate2, m) let dispose = dispose2 let checkDispose = checkDispose2 - generate,dispose,checkDispose) + generate, dispose, checkDispose) labels = res2.labels - stateVars = res2.stateVars + stateVars = res2.stateVars significantClose = res2.significantClose capturedVars = capturedVars } - | _ -> + | _ -> None - | SeqUsing(resource,v,body,elemTy,m) -> + | SeqUsing(resource, v, body, elemTy, m) -> // printfn "found Seq.using" - let reduction = - mkLet (SequencePointAtBinding body.Range) m v resource - (mkCallSeqFinally g m elemTy body - (mkUnitDelayLambda g m + let reduction = + mkLet (SequencePointAtBinding body.Range) m v resource + (mkCallSeqFinally g m elemTy body + (mkUnitDelayLambda g m (mkCallDispose g m v.Type (exprForVal m v)))) Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel reduction - | SeqFor(inp,v,body,genElemTy,m) -> + | SeqFor(inp, v, body, genElemTy, m) -> // printfn "found Seq.for" let inpElemTy = v.Type let inpEnumTy = mkIEnumeratorTy g inpElemTy let enumv, enume = mkCompGenLocal m "enum" inpEnumTy // [[ use enum = inp.GetEnumerator() // while enum.MoveNext() do - // let v = enum.Current - // body ]] - let reduction = - mkCallSeqUsing g m inpEnumTy genElemTy (callNonOverloadedMethod g amap m "GetEnumerator" (mkSeqTy g inpElemTy) [inp]) - (mkLambdaNoType g m enumv + // let v = enum.Current + // body ]] + let reduction = + mkCallSeqUsing g m inpEnumTy genElemTy (callNonOverloadedMethod g amap m "GetEnumerator" (mkSeqTy g inpElemTy) [inp]) + (mkLambdaNoType g m enumv (mkCallSeqGenerated g m genElemTy (mkUnitDelayLambda g m (callNonOverloadedMethod g amap m "MoveNext" inpEnumTy [enume])) (mkInvisibleLet m v (callNonOverloadedMethod g amap m "get_Current" inpEnumTy [enume]) (mkCoerceIfNeeded g (mkSeqTy g genElemTy) (tyOfExpr g body) body)))) Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel reduction - | SeqTryFinally(e1,compensation,m) -> + | SeqTryFinally(e1, compensation, m) -> // printfn "found Seq.try/finally" let innerDisposeContinuationLabel = IL.generateCodeLabel() let resBody = Lower false false noDisposeContinuationLabel innerDisposeContinuationLabel e1 - match resBody with - | Some res1 -> - let capturedVars = unionFreeVars res1.capturedVars (freeInExpr CollectLocals compensation) - Some { phase2 = (fun ((pcv,_currv,_,pcMap) as ctxt) -> - let generate1,dispose1,checkDispose1 = res1.phase2 ctxt - let generate = + match resBody with + | Some res1 -> + let capturedVars = unionFreeVars res1.capturedVars (freeInExpr CollectLocals compensation) + Some { phase2 = (fun ((pcv, _currv, _, pcMap) as ctxt) -> + let generate1, dispose1, checkDispose1 = res1.phase2 ctxt + let generate = // copy the compensation expression - one copy for the success continuation and one for the exception let compensation = copyExpr g CloneAllAndMarkExprValsAsCompilerGenerated compensation - mkCompGenSequential m - // set the PC to the inner finally, so that if an exception happens we run the right finally - (mkCompGenSequential m + mkCompGenSequential m + // set the PC to the inner finally, so that if an exception happens we run the right finally + (mkCompGenSequential m (mkValSet m pcv (mkInt32 g m pcMap.[innerDisposeContinuationLabel])) generate1 ) // set the PC past the try/finally before trying to run it, to make sure we only run it once - (mkCompGenSequential m - (Expr.Op(TOp.Label innerDisposeContinuationLabel,[],[],m)) - (mkCompGenSequential m + (mkCompGenSequential m + (Expr.Op(TOp.Label innerDisposeContinuationLabel, [], [], m)) + (mkCompGenSequential m (mkValSet m pcv (mkInt32 g m pcMap.[currentDisposeContinuationLabel])) compensation)) - let dispose = + let dispose = // generate inner try/finallys, then outer try/finallys - mkCompGenSequential m - dispose1 + mkCompGenSequential m + dispose1 // set the PC past the try/finally before trying to run it, to make sure we only run it once - (mkCompGenSequential m - (Expr.Op(TOp.Label innerDisposeContinuationLabel,[],[],m)) - (mkCompGenSequential m + (mkCompGenSequential m + (Expr.Op(TOp.Label innerDisposeContinuationLabel, [], [], m)) + (mkCompGenSequential m (mkValSet m pcv (mkInt32 g m pcMap.[currentDisposeContinuationLabel])) - (mkCompGenSequential m + (mkCompGenSequential m compensation - (Expr.Op(TOp.Goto currentDisposeContinuationLabel,[],[],m))))) - let checkDispose = - mkCompGenSequential m - checkDispose1 - (mkCompGenSequential m - (Expr.Op(TOp.Label innerDisposeContinuationLabel,[],[],m)) - (Expr.Op(TOp.Return,[],[mkTrue g m (* yes, we must dispose!!! *) ],m))) - - generate,dispose,checkDispose) + (Expr.Op(TOp.Goto currentDisposeContinuationLabel, [], [], m))))) + let checkDispose = + mkCompGenSequential m + checkDispose1 + (mkCompGenSequential m + (Expr.Op(TOp.Label innerDisposeContinuationLabel, [], [], m)) + (Expr.Op(TOp.Return, [], [mkTrue g m (* yes, we must dispose!!! *) ], m))) + + generate, dispose, checkDispose) labels = innerDisposeContinuationLabel :: res1.labels - stateVars = res1.stateVars - significantClose = true + stateVars = res1.stateVars + significantClose = true capturedVars = capturedVars } - | _ -> + | _ -> None - | SeqEmpty m -> + | SeqEmpty m -> // printfn "found Seq.empty" - Some { phase2 = (fun _ -> + Some { phase2 = (fun _ -> let generate = mkUnit g m - let dispose = Expr.Op(TOp.Goto currentDisposeContinuationLabel,[],[],m) - let checkDispose = Expr.Op(TOp.Goto currentDisposeContinuationLabel,[],[],m) - generate,dispose,checkDispose) + let dispose = Expr.Op(TOp.Goto currentDisposeContinuationLabel, [], [], m) + let checkDispose = Expr.Op(TOp.Goto currentDisposeContinuationLabel, [], [], m) + generate, dispose, checkDispose) labels = [] - stateVars = [] + stateVars = [] significantClose = false capturedVars = emptyFreeVars } - | Expr.Sequential(x1,x2,NormalSeq,ty,m) -> - match Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel x2 with - | Some res2-> + | Expr.Sequential(x1, x2, NormalSeq, ty, m) -> + match Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel x2 with + | Some res2-> // printfn "found sequential execution" Some { res2 with - phase2 = (fun ctxt -> - let generate2,dispose2,checkDispose2 = res2.phase2 ctxt - let generate = Expr.Sequential(x1,generate2,NormalSeq,ty,m) + phase2 = (fun ctxt -> + let generate2, dispose2, checkDispose2 = res2.phase2 ctxt + let generate = Expr.Sequential(x1, generate2, NormalSeq, ty, m) let dispose = dispose2 let checkDispose = checkDispose2 - generate,dispose,checkDispose) } + generate, dispose, checkDispose) } | None -> None - | Expr.Let(bind,bodyExpr,m,_) + | Expr.Let(bind, bodyExpr, m, _) // Restriction: compilation of sequence expressions containing non-toplevel constrained generic functions is not supported - when bind.Var.IsCompiledAsTopLevel || not (IsGenericValWithGenericContraints g bind.Var) -> + when bind.Var.IsCompiledAsTopLevel || not (IsGenericValWithGenericContraints g bind.Var) -> let resBody = Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel bodyExpr - match resBody with + match resBody with | Some res2 -> - if bind.Var.IsCompiledAsTopLevel then + if bind.Var.IsCompiledAsTopLevel then Some (RepresentBindingsAsLifted (mkLetBind m bind) res2) elif not (res2.capturedVars.FreeLocals.Contains(bind.Var)) then // printfn "found state variable %s" bind.Var.DisplayName @@ -437,69 +437,69 @@ let LowerSeqExpr g amap overallExpr = else // printfn "found state variable %s" bind.Var.DisplayName Some (RepresentBindingAsStateMachineLocal bind res2 m) - | None -> + | None -> None (* - | Expr.LetRec(binds,e2,m,_) + | Expr.LetRec(binds, e2, m, _) when // Restriction: only limited forms of "let rec" in sequence expressions can be handled by assignment to state local values - (let recvars = valsOfBinds binds |> List.map (fun v -> (v,0)) |> ValMap.OfList - binds |> List.forall (fun bind -> + (let recvars = valsOfBinds binds |> List.map (fun v -> (v, 0)) |> ValMap.OfList + binds |> List.forall (fun bind -> // Rule 1 - IsCompiledAsTopLevel require no state local value - bind.Var.IsCompiledAsTopLevel || + bind.Var.IsCompiledAsTopLevel || // Rule 2 - funky constrained local funcs not allowed not (IsGenericValWithGenericContraints g bind.Var)) && - binds |> List.count (fun bind -> + binds |> List.count (fun bind -> // Rule 3 - Recursive non-lambda and repack values are allowed - match stripExpr bind.Expr with - | Expr.Lambda _ + match stripExpr bind.Expr with + | Expr.Lambda _ | Expr.TyLambda _ -> false // "let v = otherv" bindings get produced for environment packing by InnerLambdasToTopLevelFuncs.fs, we can accept and compiler these ok - | Expr.Val(v,_,_) when not (recvars.ContainsVal v.Deref) -> false - | _ -> true) <= 1) -> + | Expr.Val(v, _, _) when not (recvars.ContainsVal v.Deref) -> false + | _ -> true) <= 1) -> - match Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel e2 with + match Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel e2 with | Some res2 -> - let topLevelBinds, nonTopLevelBinds = binds |> List.partition (fun bind -> bind.Var.IsCompiledAsTopLevel) + let topLevelBinds, nonTopLevelBinds = binds |> List.partition (fun bind -> bind.Var.IsCompiledAsTopLevel) // Represent the closure-capturing values as state machine locals. They may still be recursively-referential - let res3 = (res2,nonTopLevelBinds) ||> List.fold (fun acc bind -> RepresentBindingAsStateMachineLocal bind acc m) + let res3 = (res2, nonTopLevelBinds) ||> List.fold (fun acc bind -> RepresentBindingAsStateMachineLocal bind acc m) // Represent the non-closure-capturing values as ordinary bindings on the expression. let res4 = if topLevelBinds.IsEmpty then res3 else RepresentBindingsAsLifted (mkLetRecBinds m topLevelBinds) res3 Some res4 - | None -> + | None -> None *) - | Expr.Match (spBind,exprm,pt,targets,m,ty) when targets |> Array.forall (fun (TTarget(vs,_e,_spTarget)) -> isNil vs) -> + | Expr.Match (spBind, exprm, pt, targets, m, ty) when targets |> Array.forall (fun (TTarget(vs, _e, _spTarget)) -> isNil vs) -> // lower all the targets. abandon if any fail to lower - let tglArray = targets |> Array.map (fun (TTarget(_vs,targetExpr,_spTarget)) -> Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel targetExpr) - // LIMITATION: non-trivial pattern matches involving or-patterns or active patterns where bindings can't be - // transferred to the r.h.s. are not yet compiled. - if tglArray |> Array.forall Option.isSome then + let tglArray = targets |> Array.map (fun (TTarget(_vs, targetExpr, _spTarget)) -> Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel targetExpr) + // LIMITATION: non-trivial pattern matches involving or-patterns or active patterns where bindings can't be + // transferred to the r.h.s. are not yet compiled. + if tglArray |> Array.forall Option.isSome then let tglArray = Array.map Option.get tglArray let tgl = Array.toList tglArray let labs = tgl |> List.collect (fun res -> res.labels) - let (capturedVars, _) = - ((emptyFreeVars, false), Array.zip targets tglArray) - ||> Array.fold (fun (fvs, seenLabel) ((TTarget(_vs,e,_spTarget)), res) -> - if seenLabel then unionFreeVars fvs (freeInExpr CollectLocals e), true + let (capturedVars, _) = + ((emptyFreeVars, false), Array.zip targets tglArray) + ||> Array.fold (fun (fvs, seenLabel) ((TTarget(_vs, e, _spTarget)), res) -> + if seenLabel then unionFreeVars fvs (freeInExpr CollectLocals e), true else res.capturedVars, not res.labels.IsEmpty) let stateVars = tgl |> List.collect (fun res -> res.stateVars) let significantClose = tgl |> List.exists (fun res -> res.significantClose) - Some { phase2 = (fun ctxt -> - let gtgs,disposals,checkDisposes = - (Array.toList targets,tgl) - ||> List.map2 (fun (TTarget(vs,_,spTarget)) res -> - let generate,dispose,checkDispose = res.phase2 ctxt - let gtg = TTarget(vs,generate,spTarget) - gtg,dispose,checkDispose) - |> List.unzip3 - let generate = primMkMatch (spBind,exprm,pt,Array.ofList gtgs,m,ty) + Some { phase2 = (fun ctxt -> + let gtgs, disposals, checkDisposes = + (Array.toList targets, tgl) + ||> List.map2 (fun (TTarget(vs, _, spTarget)) res -> + let generate, dispose, checkDispose = res.phase2 ctxt + let gtg = TTarget(vs, generate, spTarget) + gtg, dispose, checkDispose) + |> List.unzip3 + let generate = primMkMatch (spBind, exprm, pt, Array.ofList gtgs, m, ty) let dispose = if isNil disposals then mkUnit g m else List.reduce (mkCompGenSequential m) disposals let checkDispose = if isNil checkDisposes then mkFalse g m else List.reduce (mkCompGenSequential m) checkDisposes - generate,dispose,checkDispose) + generate, dispose, checkDispose) labels=labs - stateVars = stateVars + stateVars = stateVars significantClose = significantClose capturedVars = capturedVars } else @@ -507,126 +507,126 @@ let LowerSeqExpr g amap overallExpr = // yield! e ---> (for x in e -> x) // - // Design choice: we compile 'yield! e' as 'for x in e do yield x'. + // Design choice: we compile 'yield! e' as 'for x in e do yield x'. // - // Note, however, this leads to a loss of tailcalls: the case not + // Note, however, this leads to a loss of tailcalls: the case not // handled correctly yet is sequence expressions that use yield! in the last position - // This can give rise to infinite iterator chains when implemented by the naive expansion to + // This can give rise to infinite iterator chains when implemented by the naive expansion to // �for x in e yield e�. For example consider this: // - // let rec rwalk x = { yield x + // let rec rwalk x = { yield x // yield! rwalk (x + rand()) } // - // This is the moral equivalent of a tailcall optimization. These also don�t compile well + // This is the moral equivalent of a tailcall optimization. These also don�t compile well // in the C# compilation model - | arbitrarySeqExpr -> + | arbitrarySeqExpr -> let m = arbitrarySeqExpr.Range - if isWholeExpr then + if isWholeExpr then // printfn "FAILED - not worth compiling an unrecognized immediate yield! %s " (stringOfRange m) None else let tyConfirmsToSeq g ty = isAppTy g ty && tyconRefEq g (tcrefOfAppTy g ty) g.tcref_System_Collections_Generic_IEnumerable match SearchEntireHierarchyOfType (tyConfirmsToSeq g) g amap m (tyOfExpr g arbitrarySeqExpr) with - | None -> + | None -> // printfn "FAILED - yield! did not yield a sequence! %s" (stringOfRange m) None - | Some ty -> + | Some ty -> // printfn "found yield!" let inpElemTy = List.head (argsOfAppTy g ty) - if isTailCall then - //this.pc <- NEXT - //nextEnumerator <- e - //return 2 + if isTailCall then + //this.pc <- NEXT + //nextEnumerator <- e + //return 2 //NEXT: let label = IL.generateCodeLabel() - Some { phase2 = (fun (pcv,_currv,nextv,pcMap) -> - let generate = - mkCompGenSequential m + Some { phase2 = (fun (pcv, _currv, nextv, pcMap) -> + let generate = + mkCompGenSequential m (mkValSet m pcv (mkInt32 g m pcMap.[label])) - (mkSequential SequencePointsAtSeq m + (mkSequential SequencePointsAtSeq m (mkAddrSet m nextv arbitrarySeqExpr) - (mkCompGenSequential m - (Expr.Op(TOp.Return,[],[mkTwo g m],m)) - (Expr.Op(TOp.Label label,[],[],m)))) - let dispose = - mkCompGenSequential m - (Expr.Op(TOp.Label label,[],[],m)) - (Expr.Op(TOp.Goto currentDisposeContinuationLabel,[],[],m)) - let checkDispose = - mkCompGenSequential m - (Expr.Op(TOp.Label label,[],[],m)) - (Expr.Op(TOp.Return,[],[mkFalse g m],m)) - generate,dispose,checkDispose) + (mkCompGenSequential m + (Expr.Op(TOp.Return, [], [mkTwo g m], m)) + (Expr.Op(TOp.Label label, [], [], m)))) + let dispose = + mkCompGenSequential m + (Expr.Op(TOp.Label label, [], [], m)) + (Expr.Op(TOp.Goto currentDisposeContinuationLabel, [], [], m)) + let checkDispose = + mkCompGenSequential m + (Expr.Op(TOp.Label label, [], [], m)) + (Expr.Op(TOp.Return, [], [mkFalse g m], m)) + generate, dispose, checkDispose) labels=[label] - stateVars=[] - significantClose = false + stateVars=[] + significantClose = false capturedVars = emptyFreeVars } else - let v,ve = mkCompGenLocal m "v" inpElemTy + let v, ve = mkCompGenLocal m "v" inpElemTy Lower false isTailCall noDisposeContinuationLabel currentDisposeContinuationLabel (mkCallSeqCollect g m inpElemTy inpElemTy (mkLambdaNoType g m v (mkCallSeqSingleton g m inpElemTy ve)) arbitrarySeqExpr) - - match overallExpr with - | Seq(e,ty) -> + + match overallExpr with + | Seq(e, ty) -> // printfn "found seq { ... } or Seq.delay (fun () -> ...) in FSharp.Core.dll" let m = e.Range let initLabel = IL.generateCodeLabel() let noDisposeContinuationLabel = IL.generateCodeLabel() - match Lower true true noDisposeContinuationLabel noDisposeContinuationLabel e with + match Lower true true noDisposeContinuationLabel noDisposeContinuationLabel e with | Some res -> let labs = res.labels - let stateVars = res.stateVars + let stateVars = res.stateVars // printfn "successfully lowered, found %d state variables and %d labels!" stateVars.Length labs.Length - let pcv,pce = mkMutableCompGenLocal m "pc" g.int32_ty - let currv,_curre = mkMutableCompGenLocal m "current" ty - let nextv,_nexte = mkMutableCompGenLocal m "next" (mkByrefTy g (mkSeqTy g ty)) + let pcv, pce = mkMutableCompGenLocal m "pc" g.int32_ty + let currv, _curre = mkMutableCompGenLocal m "current" ty + let nextv, _nexte = mkMutableCompGenLocal m "next" (mkByrefTy g (mkSeqTy g ty)) let nextvref = mkLocalValRef nextv let pcvref = mkLocalValRef pcv let currvref = mkLocalValRef currv let pcs = labs |> List.mapi (fun i _ -> i + 1) let pcDone = labs.Length + 1 let pcInit = 0 - let pc2lab = Map.ofList ((pcInit,initLabel) :: (pcDone,noDisposeContinuationLabel) :: List.zip pcs labs) - let lab2pc = Map.ofList ((initLabel,pcInit) :: (noDisposeContinuationLabel,pcDone) :: List.zip labs pcs) - let stateMachineExpr,disposalExpr, checkDisposeExpr = res.phase2 (pcvref,currvref,nextvref,lab2pc) + let pc2lab = Map.ofList ((pcInit, initLabel) :: (pcDone, noDisposeContinuationLabel) :: List.zip pcs labs) + let lab2pc = Map.ofList ((initLabel, pcInit) :: (noDisposeContinuationLabel, pcDone) :: List.zip labs pcs) + let stateMachineExpr, disposalExpr, checkDisposeExpr = res.phase2 (pcvref, currvref, nextvref, lab2pc) // Add on the final 'return false' to indicate the iteration is complete - let stateMachineExpr = - mkCompGenSequential m - stateMachineExpr - (mkCompGenSequential m + let stateMachineExpr = + mkCompGenSequential m + stateMachineExpr + (mkCompGenSequential m // set the pc to "finished" (mkValSet m pcvref (mkInt32 g m pcDone)) - (mkCompGenSequential m - (Expr.Op(TOp.Label noDisposeContinuationLabel,[],[],m)) - (mkCompGenSequential m + (mkCompGenSequential m + (Expr.Op(TOp.Label noDisposeContinuationLabel, [], [], m)) + (mkCompGenSequential m // zero out the current value to free up its memory - (mkValSet m currvref (mkDefault (m,currvref.Type))) - (Expr.Op(TOp.Return,[],[mkZero g m],m))))) - let checkDisposeExpr = - mkCompGenSequential m - checkDisposeExpr - (mkCompGenSequential m - (Expr.Op(TOp.Label noDisposeContinuationLabel,[],[],m)) - (Expr.Op(TOp.Return,[],[mkFalse g m],m))) - - let addJumpTable isDisposal expr = - let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) - let mkGotoLabelTarget lab = mbuilder.AddResultTarget(Expr.Op(TOp.Goto lab,[],[],m),SuppressSequencePointAtTarget) - let dtree = + (mkValSet m currvref (mkDefault (m, currvref.Type))) + (Expr.Op(TOp.Return, [], [mkZero g m], m))))) + let checkDisposeExpr = + mkCompGenSequential m + checkDisposeExpr + (mkCompGenSequential m + (Expr.Op(TOp.Label noDisposeContinuationLabel, [], [], m)) + (Expr.Op(TOp.Return, [], [mkFalse g m], m))) + + let addJumpTable isDisposal expr = + let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding, m ) + let mkGotoLabelTarget lab = mbuilder.AddResultTarget(Expr.Op(TOp.Goto lab, [], [], m), SuppressSequencePointAtTarget) + let dtree = TDSwitch(pce, - [ + [ // no disposal action for the initial state (pc = 0) - if isDisposal then - yield mkCase(DecisionTreeTest.Const(Const.Int32 pcInit),mkGotoLabelTarget noDisposeContinuationLabel) - for pc in pcs do - yield mkCase(DecisionTreeTest.Const(Const.Int32 pc),mkGotoLabelTarget pc2lab.[pc]) - yield mkCase(DecisionTreeTest.Const(Const.Int32 pcDone),mkGotoLabelTarget noDisposeContinuationLabel) ], + if isDisposal then + yield mkCase(DecisionTreeTest.Const(Const.Int32 pcInit), mkGotoLabelTarget noDisposeContinuationLabel) + for pc in pcs do + yield mkCase(DecisionTreeTest.Const(Const.Int32 pc), mkGotoLabelTarget pc2lab.[pc]) + yield mkCase(DecisionTreeTest.Const(Const.Int32 pcDone), mkGotoLabelTarget noDisposeContinuationLabel) ], Some(mkGotoLabelTarget pc2lab.[pcInit]), m) - - let table = mbuilder.Close(dtree,m,g.int_ty) - mkCompGenSequential m table (mkCompGenSequential m (Expr.Op(TOp.Label initLabel,[],[],m)) expr) + + let table = mbuilder.Close(dtree, m, g.int_ty) + mkCompGenSequential m table (mkCompGenSequential m (Expr.Op(TOp.Label initLabel, [], [], m)) expr) let handleExeceptionsInDispose disposalExpr = // let mutable exn : exn = null @@ -635,79 +635,79 @@ let LowerSeqExpr g amap overallExpr = // ``disposalExpr'' // with e -> exn <- e // if exn <> null then raise exn - let exnV,exnE = mkMutableCompGenLocal m "exn" g.exn_ty + let exnV, exnE = mkMutableCompGenLocal m "exn" g.exn_ty let exnVref = mkLocalValRef exnV let startLabel = IL.generateCodeLabel() let doneLabel = IL.generateCodeLabel () // try ``disposalExpr'' with e -> exn <- e - let eV,eE = mkLocal m "e" g.exn_ty - let efV,_ = mkLocal m "ef" g.exn_ty - let assignToExn = Expr.Op(TOp.LValueOp(LValueOperation.LSet,exnVref),[],[eE],m) + let eV, eE = mkLocal m "e" g.exn_ty + let efV, _ = mkLocal m "ef" g.exn_ty + let assignToExn = Expr.Op(TOp.LValueOp(LValueOperation.LSet, exnVref), [], [eE], m) let exceptionCatcher = mkTryWith g - (disposalExpr, - efV, Expr.Const((Const.Bool true), m, g.bool_ty), - eV, assignToExn, + (disposalExpr, + efV, Expr.Const((Const.Bool true), m, g.bool_ty), + eV, assignToExn, m, g.unit_ty, NoSequencePointAtTry, NoSequencePointAtWith) - + // while(this.pc != END_STATE) let whileLoop = - let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m) + let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding, m) let addResultTarget e = mbuilder.AddResultTarget(e, SuppressSequencePointAtTarget) let dtree = TDSwitch(pce, [ mkCase((DecisionTreeTest.Const(Const.Int32 pcDone)), addResultTarget (Expr.Op(TOp.Goto doneLabel, [], [], m)) ) ], Some (addResultTarget (mkUnit g m)), m) - let pcIsEndStateComparison = mbuilder.Close(dtree,m,g.unit_ty) + let pcIsEndStateComparison = mbuilder.Close(dtree, m, g.unit_ty) mkCompGenSequential m - (Expr.Op((TOp.Label startLabel),[],[],m)) + (Expr.Op((TOp.Label startLabel), [], [], m)) (mkCompGenSequential m pcIsEndStateComparison (mkCompGenSequential m exceptionCatcher (mkCompGenSequential m - (Expr.Op((TOp.Goto startLabel),[],[],m)) - (Expr.Op((TOp.Label doneLabel),[],[],m)) + (Expr.Op((TOp.Goto startLabel), [], [], m)) + (Expr.Op((TOp.Label doneLabel), [], [], m)) ) ) - ) + ) // if exn != null then raise exn let doRaise = mkNonNullCond g m g.unit_ty exnE (mkThrow m g.unit_ty exnE) (Expr.Const(Const.Unit, m, g.unit_ty)) - - mkLet - NoSequencePointAtLetBinding m exnV (Expr.Const(Const.Zero, m,g.exn_ty)) - (mkCompGenSequential m whileLoop doRaise) + + mkLet + NoSequencePointAtLetBinding m exnV (Expr.Const(Const.Zero, m, g.exn_ty)) + (mkCompGenSequential m whileLoop doRaise) let stateMachineExprWithJumpTable = addJumpTable false stateMachineExpr let disposalExpr = if res.significantClose then - let disposalExpr = - mkCompGenSequential m - disposalExpr - (mkCompGenSequential m - (Expr.Op(TOp.Label noDisposeContinuationLabel,[],[],m)) - (mkCompGenSequential m + let disposalExpr = + mkCompGenSequential m + disposalExpr + (mkCompGenSequential m + (Expr.Op(TOp.Label noDisposeContinuationLabel, [], [], m)) + (mkCompGenSequential m // set the pc to "finished" (mkValSet m pcvref (mkInt32 g m pcDone)) // zero out the current value to free up its memory - (mkValSet m currvref (mkDefault (m,currvref.Type))))) + (mkValSet m currvref (mkDefault (m, currvref.Type))))) disposalExpr - |> addJumpTable true + |> addJumpTable true |> handleExeceptionsInDispose else (mkValSet m pcvref (mkInt32 g m pcDone)) - - let checkDisposeExprWithJumpTable = addJumpTable true checkDisposeExpr + + let checkDisposeExprWithJumpTable = addJumpTable true checkDisposeExpr // all done, no return the results - Some (nextvref, pcvref,currvref,stateVars,stateMachineExprWithJumpTable,disposalExpr,checkDisposeExprWithJumpTable,ty,m) + Some (nextvref, pcvref, currvref, stateVars, stateMachineExprWithJumpTable, disposalExpr, checkDisposeExprWithJumpTable, ty, m) - | None -> + | None -> // printfn "FAILED: no compilation found! %s" (stringOfRange m) None | _ -> None - - + + diff --git a/src/fsharp/MSBuildReferenceResolver.fs b/src/fsharp/MSBuildReferenceResolver.fs index 2e25ebf95a1021dffa5aaabeba0b3860c5ba1d7a..1a49c6a0fca9a6a30b8cb9b6f740e3975ca4f162 100644 --- a/src/fsharp/MSBuildReferenceResolver.fs +++ b/src/fsharp/MSBuildReferenceResolver.fs @@ -6,9 +6,6 @@ module internal FSharp.Compiler.MSBuildReferenceResolver open System.IO open System.Reflection -#if FX_RESHAPED_REFLECTION - open Microsoft.FSharp.Core.ReflectionAdapters -#endif #if FX_RESHAPED_MSBUILD open FSharp.Compiler.MsBuildAdapters open FSharp.Compiler.ToolLocationHelper @@ -20,6 +17,11 @@ module internal FSharp.Compiler.MSBuildReferenceResolver open Microsoft.Build.Utilities open Microsoft.Build.Framework + // Reflection wrapper for properties + type System.Object with + member this.GetPropertyValue(propName) = + this.GetType().GetProperty(propName, BindingFlags.Public).GetValue(this, null) + /// Get the Reference Assemblies directory for the .NET Framework on Window. let DotNetFrameworkReferenceAssembliesRootDirectory = // ProgramFilesX86 is correct for both x86 and x64 architectures @@ -97,7 +99,7 @@ module internal FSharp.Compiler.MSBuildReferenceResolver | _ -> [] let GetPathToDotNetFrameworkReferenceAssemblies(version) = -#if NETSTANDARD1_6 || NETSTANDARD2_0 +#if NETSTANDARD ignore version let r : string list = [] r @@ -129,7 +131,7 @@ module internal FSharp.Compiler.MSBuildReferenceResolver else Net45 // version is 4.5 assumed since this code is running. with _ -> Net45 -#if !FX_RESHAPED_REFLECTION +#if !FX_RESHAPED_MSBUILD // 1. First look to see if we can find the highest installed set of dotnet reference assemblies, if yes then select that framework // 2. Otherwise ask msbuild for the highestinstalled framework let checkFrameworkForReferenceAssemblies (dotNetVersion:string) = @@ -336,9 +338,6 @@ module internal FSharp.Compiler.MSBuildReferenceResolver FindSerializationAssemblies=false, Assemblies=assemblies, SearchPaths=searchPaths, AllowedAssemblyExtensions= [| ".dll" ; ".exe" |]) -#if FX_RESHAPED_REFLECTION - ignore targetProcessorArchitecture // Not implemented in reshapedmsbuild.fs -#else rar.TargetProcessorArchitecture <- targetProcessorArchitecture let targetedRuntimeVersionValue = typeof.Assembly.ImageRuntimeVersion #if ENABLE_MONO_SUPPORT @@ -351,7 +350,6 @@ module internal FSharp.Compiler.MSBuildReferenceResolver rar.TargetedRuntimeVersion <- targetedRuntimeVersionValue rar.CopyLocalDependenciesWhenParentReferenceInGac <- true #endif -#endif let succeeded = rar.Execute() diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index e7737b3f25975d21ea08bc2e04ecc0d034943637..e754ce22d093c7204cad8171c81db6802e766942 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -659,12 +659,14 @@ let BuildFSharpMethodApp g m (vref: ValRef) vexp vexprty (args: Exprs) = match arity, args with | (0|1), [] when typeEquiv g (domainOfFunTy g fty) g.unit_ty -> mkUnit g m, (args, rangeOfFunTy g fty) | 0, (arg::argst) -> - warning(InternalError(sprintf "Unexpected zero arity, args = %s" (Layout.showL (Layout.sepListL (Layout.rightL (Layout.TaggedTextOps.tagText ";")) (List.map exprL args))), m)); + let msg = Layout.showL (Layout.sepListL (Layout.rightL (Layout.TaggedTextOps.tagText ";")) (List.map exprL args)) + warning(InternalError(sprintf "Unexpected zero arity, args = %s" msg, m)) arg, (argst, rangeOfFunTy g fty) | 1, (arg :: argst) -> arg, (argst, rangeOfFunTy g fty) | 1, [] -> error(InternalError("expected additional arguments here", m)) | _ -> - if args.Length < arity then error(InternalError("internal error in getting arguments, n = "+string arity+", #args = "+string args.Length, m)); + if args.Length < arity then + error(InternalError("internal error in getting arguments, n = "+string arity+", #args = "+string args.Length, m)) let tupargs, argst = List.splitAt arity args let tuptys = tupargs |> List.map (tyOfExpr g) (mkRefTupled g m tupargs tuptys), diff --git a/src/fsharp/MethodOverrides.fs b/src/fsharp/MethodOverrides.fs index 686691028609cb4ac1745847273814555a49971e..a58ecf2ce64fbb941b2d96231308ce970ae47ed3 100644 --- a/src/fsharp/MethodOverrides.fs +++ b/src/fsharp/MethodOverrides.fs @@ -31,14 +31,14 @@ type OverrideCanImplement = /// The overall information about a method implementation in a class or object expression type OverrideInfo = | Override of OverrideCanImplement * TyconRef * Ident * (Typars * TyparInst) * TType list list * TType option * bool * bool - member x.CanImplement = let (Override(a,_,_,_,_,_,_,_)) = x in a - member x.BoundingTyconRef = let (Override(_,ty,_,_,_,_,_,_)) = x in ty - member x.LogicalName = let (Override(_,_,id,_,_,_,_,_)) = x in id.idText - member x.Range = let (Override(_,_,id,_,_,_,_,_)) = x in id.idRange - member x.IsFakeEventProperty = let (Override(_,_,_,_,_,_,b,_)) = x in b - member x.ArgTypes = let (Override(_,_,_,_,b,_,_,_)) = x in b - member x.ReturnType = let (Override(_,_,_,_,_,b,_,_)) = x in b - member x.IsCompilerGenerated = let (Override(_,_,_,_,_,_,_,b)) = x in b + member x.CanImplement = let (Override(a, _, _, _, _, _, _, _)) = x in a + member x.BoundingTyconRef = let (Override(_, ty, _, _, _, _, _, _)) = x in ty + member x.LogicalName = let (Override(_, _, id, _, _, _, _, _)) = x in id.idText + member x.Range = let (Override(_, _, id, _, _, _, _, _)) = x in id.idRange + member x.IsFakeEventProperty = let (Override(_, _, _, _, _, _, b, _)) = x in b + member x.ArgTypes = let (Override(_, _, _, _, b, _, _, _)) = x in b + member x.ReturnType = let (Override(_, _, _, _, _, b, _, _)) = x in b + member x.IsCompilerGenerated = let (Override(_, _, _, _, _, _, _, b)) = x in b // If the bool is true then the slot is optional, i.e. is an interface slot // which does not _have_ to be implemented, because an inherited implementation @@ -53,23 +53,23 @@ exception OverrideDoesntOverride of DisplayEnv * OverrideInfo * MethInfo option module DispatchSlotChecking = /// Print the signature of an override to a buffer as part of an error message - let PrintOverrideToBuffer denv os (Override(_,_,id,(mtps,memberToParentInst),argTys,retTy,_,_)) = + let PrintOverrideToBuffer denv os (Override(_, _, id, (mtps, memberToParentInst), argTys, retTy, _, _)) = let denv = { denv with showTyparBinding = true } let retTy = (retTy |> GetFSharpViewOfReturnType denv.g) let argInfos = match argTys with - | [] -> [[(denv.g.unit_ty,ValReprInfo.unnamedTopArg1)]] + | [] -> [[(denv.g.unit_ty, ValReprInfo.unnamedTopArg1)]] | _ -> argTys |> List.mapSquared (fun ty -> (ty, ValReprInfo.unnamedTopArg1)) - Layout.bufferL os (NicePrint.prettyLayoutOfMemberSig denv (memberToParentInst,id.idText,mtps, argInfos, retTy)) + Layout.bufferL os (NicePrint.prettyLayoutOfMemberSig denv (memberToParentInst, id.idText, mtps, argInfos, retTy)) /// Print the signature of a MethInfo to a buffer as part of an error message let PrintMethInfoSigToBuffer g amap m denv os minfo = let denv = { denv with showTyparBinding = true } - let (CompiledSig(argTys,retTy,fmtps,ttpinst)) = CompiledSigOfMeth g amap m minfo + let (CompiledSig(argTys, retTy, fmtps, ttpinst)) = CompiledSigOfMeth g amap m minfo let retTy = (retTy |> GetFSharpViewOfReturnType g) let argInfos = argTys |> List.mapSquared (fun ty -> (ty, ValReprInfo.unnamedTopArg1)) let nm = minfo.LogicalName - Layout.bufferL os (NicePrint.prettyLayoutOfMemberSig denv (ttpinst,nm,fmtps, argInfos, retTy)) + Layout.bufferL os (NicePrint.prettyLayoutOfMemberSig denv (ttpinst, nm, fmtps, argInfos, retTy)) /// Format the signature of an override as a string as part of an error message let FormatOverride denv d = bufs (fun buf -> PrintOverrideToBuffer denv buf d) @@ -80,26 +80,26 @@ module DispatchSlotChecking = /// Get the override info for an existing (inherited) method being used to implement a dispatch slot. let GetInheritedMemberOverrideInfo g amap m parentType (minfo:MethInfo) = let nm = minfo.LogicalName - let (CompiledSig (argTys,retTy,fmtps,ttpinst)) = CompiledSigOfMeth g amap m minfo + let (CompiledSig (argTys, retTy, fmtps, ttpinst)) = CompiledSigOfMeth g amap m minfo let isFakeEventProperty = minfo.IsFSharpEventPropertyMethod - Override(parentType, minfo.ApparentEnclosingTyconRef, mkSynId m nm, (fmtps,ttpinst),argTys,retTy,isFakeEventProperty,false) + Override(parentType, minfo.ApparentEnclosingTyconRef, mkSynId m nm, (fmtps, ttpinst), argTys, retTy, isFakeEventProperty, false) /// Get the override info for a value being used to implement a dispatch slot. let GetTypeMemberOverrideInfo g reqdTy (overrideBy:ValRef) = - let _,argInfos,retTy,_ = GetTypeOfMemberInMemberForm g overrideBy + let _, argInfos, retTy, _ = GetTypeOfMemberInMemberForm g overrideBy let nm = overrideBy.LogicalName let argTys = argInfos |> List.mapSquared fst - let memberMethodTypars,memberToParentInst,argTys,retTy = + let memberMethodTypars, memberToParentInst, argTys, retTy = match PartitionValRefTypars g overrideBy with - | Some(_,_,memberMethodTypars,memberToParentInst,_tinst) -> + | Some(_, _, memberMethodTypars, memberToParentInst, _tinst) -> let argTys = argTys |> List.mapSquared (instType memberToParentInst) let retTy = retTy |> Option.map (instType memberToParentInst) - memberMethodTypars, memberToParentInst,argTys, retTy + memberMethodTypars, memberToParentInst, argTys, retTy | None -> - error(Error(FSComp.SR.typrelMethodIsOverconstrained(),overrideBy.Range)) + error(Error(FSComp.SR.typrelMethodIsOverconstrained(), overrideBy.Range)) let implKind = if ValRefIsExplicitImpl g overrideBy then @@ -121,7 +121,7 @@ module DispatchSlotChecking = //CanImplementAnySlot <<----- Change to this to enable implicit interface implementation let isFakeEventProperty = overrideBy.IsFSharpEventProperty(g) - Override(implKind,overrideBy.MemberApparentEntity, mkSynId overrideBy.Range nm, (memberMethodTypars,memberToParentInst),argTys,retTy,isFakeEventProperty, overrideBy.IsCompilerGenerated) + Override(implKind, overrideBy.MemberApparentEntity, mkSynId overrideBy.Range nm, (memberMethodTypars, memberToParentInst), argTys, retTy, isFakeEventProperty, overrideBy.IsCompilerGenerated) /// Get the override information for an object expression method being used to implement dispatch slots let GetObjectExprOverrideInfo g amap (implty, id:Ident, memberFlags, ty, arityInfo, bindingAttribs, rhsExpr) = @@ -129,7 +129,7 @@ module DispatchSlotChecking = let tps, argInfos, retTy, _ = GetMemberTypeInMemberForm g memberFlags arityInfo ty id.idRange let argTys = argInfos |> List.mapSquared fst // Dissect the implementation - let _, ctorThisValOpt, baseValOpt, vsl, rhsExpr,_ = destTopLambda g amap arityInfo (rhsExpr,ty) + let _, ctorThisValOpt, baseValOpt, vsl, rhsExpr, _ = destTopLambda g amap arityInfo (rhsExpr, ty) assert ctorThisValOpt.IsNone // Drop 'this' @@ -144,10 +144,10 @@ module DispatchSlotChecking = CanImplementAnyClassHierarchySlot //CanImplementAnySlot <<----- Change to this to enable implicit interface implementation let isFakeEventProperty = CompileAsEvent g bindingAttribs - let overrideByInfo = Override(implKind, tcrefOfAppTy g implty, id, (tps,[]), argTys, retTy, isFakeEventProperty, false) + let overrideByInfo = Override(implKind, tcrefOfAppTy g implty, id, (tps, []), argTys, retTy, isFakeEventProperty, false) overrideByInfo, (baseValOpt, thisv, vs, bindingAttribs, rhsExpr) | _ -> - error(InternalError("Unexpected shape for object expression override",id.idRange)) + error(InternalError("Unexpected shape for object expression override", id.idRange)) /// Check if an override matches a dispatch slot by name let IsNameMatch (dispatchSlot:MethInfo) (overrideBy: OverrideInfo) = @@ -164,13 +164,13 @@ module DispatchSlotChecking = | CanImplementAnyInterfaceSlot -> isInterfaceTy g dispatchSlot.ApparentEnclosingType /// Check if the kinds of type parameters match between a dispatch slot and an override. - let IsTyparKindMatch (CompiledSig(_,_,fvmtps,_)) (Override(_,_,_,(mtps,_),_,_,_,_)) = + let IsTyparKindMatch (CompiledSig(_, _, fvmtps, _)) (Override(_, _, _, (mtps, _), _, _, _, _)) = List.lengthsEqAndForall2 (fun (tp1:Typar) (tp2:Typar) -> tp1.Kind = tp2.Kind) mtps fvmtps /// Check if an override is a partial match for the requirements for a dispatch slot - let IsPartialMatch g (dispatchSlot:MethInfo) compiledSig (Override(_,_,_,(mtps,_),argTys,_retTy,_,_) as overrideBy) = + let IsPartialMatch g (dispatchSlot:MethInfo) compiledSig (Override(_, _, _, (mtps, _), argTys, _retTy, _, _) as overrideBy) = IsNameMatch dispatchSlot overrideBy && - let (CompiledSig (vargtys,_,fvmtps,_)) = compiledSig + let (CompiledSig (vargtys, _, fvmtps, _)) = compiledSig mtps.Length = fvmtps.Length && IsTyparKindMatch compiledSig overrideBy && argTys.Length = vargtys.Length && @@ -178,17 +178,17 @@ module DispatchSlotChecking = /// Compute the reverse of a type parameter renaming. let ReverseTyparRenaming g tinst = - tinst |> List.map (fun (tp,ty) -> (destTyparTy g ty, mkTyparTy tp)) + tinst |> List.map (fun (tp, ty) -> (destTyparTy g ty, mkTyparTy tp)) /// Compose two instantiations of type parameters. let ComposeTyparInsts inst1 inst2 = inst1 |> List.map (map2Of2 (instType inst2)) /// Check if an override exactly matches the requirements for a dispatch slot - let IsExactMatch g amap m dispatchSlot (Override(_,_,_,(mtps,mtpinst),argTys,retTy,_,_) as overrideBy) = + let IsExactMatch g amap m dispatchSlot (Override(_, _, _, (mtps, mtpinst), argTys, retTy, _, _) as overrideBy) = let compiledSig = CompiledSigOfMeth g amap m dispatchSlot IsPartialMatch g dispatchSlot compiledSig overrideBy && - let (CompiledSig (vargtys,vrty,fvmtps,ttpinst)) = compiledSig + let (CompiledSig (vargtys, vrty, fvmtps, ttpinst)) = compiledSig // Compare the types. CompiledSigOfMeth, GetObjectExprOverrideInfo and GetTypeMemberOverrideInfo have already // applied all relevant substitutions except the renamings from fvtmps <-> mtps @@ -245,8 +245,8 @@ module DispatchSlotChecking = /// Check all dispatch slots are implemented by some override. - let CheckDispatchSlotsAreImplemented (denv,g,amap,m, - nenv,sink:TcResultsSink, + let CheckDispatchSlotsAreImplemented (denv, g, amap, m, + nenv, sink:TcResultsSink, isOverallTyAbstract, reqdTy, dispatchSlots:RequiredSlot list, @@ -262,14 +262,14 @@ module DispatchSlotChecking = let availPriorOverridesKeyed = availPriorOverrides |> NameMultiMap.initBy (fun ov -> ov.LogicalName) let overridesKeyed = overrides |> NameMultiMap.initBy (fun ov -> ov.LogicalName) - dispatchSlots |> List.iter (fun (RequiredSlot(dispatchSlot,isOptional)) -> + dispatchSlots |> List.iter (fun (RequiredSlot(dispatchSlot, isOptional)) -> match NameMultiMap.find dispatchSlot.LogicalName overridesKeyed |> List.filter (OverrideImplementsDispatchSlot g amap m dispatchSlot) with | [ovd] -> if not ovd.IsCompilerGenerated then - let item = Item.MethodGroup(ovd.LogicalName,[dispatchSlot],None) - CallNameResolutionSink sink (ovd.Range,nenv,item,item,dispatchSlot.FormalMethodTyparInst,ItemOccurence.Implemented,denv,AccessorDomain.AccessibleFromSomewhere) + let item = Item.MethodGroup(ovd.LogicalName, [dispatchSlot], None) + CallNameResolutionSink sink (ovd.Range, nenv, item, item, dispatchSlot.FormalMethodTyparInst, ItemOccurence.Implemented, denv, AccessorDomain.AccessibleFromSomewhere) sink |> ignore () | [] -> @@ -295,14 +295,14 @@ module DispatchSlotChecking = match possibleOverrides with | [] -> noimpl() - | [ Override(_,_,_,(mtps,_),argTys,_,_,_) as overrideBy ] -> + | [ Override(_, _, _, (mtps, _), argTys, _, _, _) as overrideBy ] -> let moreThanOnePossibleDispatchSlot = dispatchSlots - |> List.filter (fun (RequiredSlot(dispatchSlot,_)) -> IsNameMatch dispatchSlot overrideBy && IsImplMatch g dispatchSlot overrideBy) + |> List.filter (fun (RequiredSlot(dispatchSlot, _)) -> IsNameMatch dispatchSlot overrideBy && IsImplMatch g dispatchSlot overrideBy) |> isNilOrSingleton |> not - let (CompiledSig (vargtys,_,fvmtps,_)) = compiledSig + let (CompiledSig (vargtys, _, fvmtps, _)) = compiledSig if moreThanOnePossibleDispatchSlot then noimpl() @@ -316,18 +316,18 @@ module DispatchSlotChecking = else fail(Error(FSComp.SR.typrelMemberCannotImplement(FormatOverride denv overrideBy, NicePrint.stringOfMethInfo amap m denv dispatchSlot, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range)) | overrideBy :: _ -> - errorR(Error(FSComp.SR.typrelOverloadNotFound(FormatMethInfoSig g amap m denv dispatchSlot, FormatMethInfoSig g amap m denv dispatchSlot),overrideBy.Range)) + errorR(Error(FSComp.SR.typrelOverloadNotFound(FormatMethInfoSig g amap m denv dispatchSlot, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range)) | [ overrideBy ] -> - if dispatchSlots |> List.exists (fun (RequiredSlot(dispatchSlot,_)) -> OverrideImplementsDispatchSlot g amap m dispatchSlot overrideBy) then + if dispatchSlots |> List.exists (fun (RequiredSlot(dispatchSlot, _)) -> OverrideImplementsDispatchSlot g amap m dispatchSlot overrideBy) then noimpl() else // Error will be reported below in CheckOverridesAreAllUsedOnce () | _ -> - fail(Error(FSComp.SR.typrelOverrideWasAmbiguous(FormatMethInfoSig g amap m denv dispatchSlot),m)) - | _ -> fail(Error(FSComp.SR.typrelMoreThenOneOverride(FormatMethInfoSig g amap m denv dispatchSlot),m))) + fail(Error(FSComp.SR.typrelOverrideWasAmbiguous(FormatMethInfoSig g amap m denv dispatchSlot), m)) + | _ -> fail(Error(FSComp.SR.typrelMoreThenOneOverride(FormatMethInfoSig g amap m denv dispatchSlot), m))) !res /// Check all implementations implement some dispatch slot. @@ -340,17 +340,17 @@ module DispatchSlotChecking = if not overrideBy.IsFakeEventProperty then let m = overrideBy.Range let relevantVirts = NameMultiMap.find overrideBy.LogicalName dispatchSlotsKeyed - let relevantVirts = relevantVirts |> List.map (fun (RequiredSlot(dispatchSlot,_)) -> dispatchSlot) + let relevantVirts = relevantVirts |> List.map (fun (RequiredSlot(dispatchSlot, _)) -> dispatchSlot) match relevantVirts |> List.filter (fun dispatchSlot -> OverrideImplementsDispatchSlot g amap m dispatchSlot overrideBy) with | [] -> // This is all error reporting match relevantVirts |> List.filter (fun dispatchSlot -> IsPartialMatch g dispatchSlot (CompiledSigOfMeth g amap m dispatchSlot) overrideBy) with | [dispatchSlot] -> - errorR(OverrideDoesntOverride(denv,overrideBy,Some dispatchSlot,g,amap,m)) + errorR(OverrideDoesntOverride(denv, overrideBy, Some dispatchSlot, g, amap, m)) | _ -> match relevantVirts |> List.filter (fun dispatchSlot -> IsNameMatch dispatchSlot overrideBy) with - | [] -> errorR(OverrideDoesntOverride(denv,overrideBy,None,g,amap,m)) + | [] -> errorR(OverrideDoesntOverride(denv, overrideBy, None, g, amap, m)) | [dispatchSlot] -> errorR(OverrideDoesntOverride(denv, overrideBy, Some dispatchSlot, g, amap, m)) | possibleDispatchSlots -> @@ -365,13 +365,13 @@ module DispatchSlotChecking = | [dispatchSlot] -> if dispatchSlot.IsFinal && (isObjExpr || not (typeEquiv g reqdTy dispatchSlot.ApparentEnclosingType)) then - errorR(Error(FSComp.SR.typrelMethodIsSealed(NicePrint.stringOfMethInfo amap m denv dispatchSlot),m)) + errorR(Error(FSComp.SR.typrelMethodIsSealed(NicePrint.stringOfMethInfo amap m denv dispatchSlot), m)) | dispatchSlots -> match dispatchSlots |> List.filter (fun dispatchSlot -> isInterfaceTy g dispatchSlot.ApparentEnclosingType || not (DispatchSlotIsAlreadyImplemented g amap m availPriorOverridesKeyed dispatchSlot)) with | h1 :: h2 :: _ -> - errorR(Error(FSComp.SR.typrelOverrideImplementsMoreThenOneSlot((FormatOverride denv overrideBy), (NicePrint.stringOfMethInfo amap m denv h1), (NicePrint.stringOfMethInfo amap m denv h2)),m)) + errorR(Error(FSComp.SR.typrelOverrideImplementsMoreThenOneSlot((FormatOverride denv overrideBy), (NicePrint.stringOfMethInfo amap m denv h1), (NicePrint.stringOfMethInfo amap m denv h2)), m)) | _ -> // dispatch slots are ordered from the derived classes to base // so we can check the topmost dispatch slot if it is final @@ -394,7 +394,7 @@ module DispatchSlotChecking = let amap = infoReader.amap let availImpliedInterfaces : TType list = - [ for (reqdTy,m) in allReqdTys do + [ for (reqdTy, m) in allReqdTys do if not (isInterfaceTy g reqdTy) then let baseTyOpt = if isObjExpr then Some reqdTy else GetSuperTypeOfType g amap m reqdTy match baseTyOpt with @@ -405,19 +405,19 @@ module DispatchSlotChecking = // interface types implied by the type. This includes the implemented type itself if the implemented type // is an interface type. let intfSets = - allReqdTys |> List.mapi (fun i (reqdTy,m) -> + allReqdTys |> List.mapi (fun i (reqdTy, m) -> let interfaces = AllInterfacesOfType g amap m AllowMultiIntfInstantiations.Yes reqdTy let impliedTys = (if isInterfaceTy g reqdTy then interfaces else reqdTy :: interfaces) - (i, reqdTy, impliedTys,m)) + (i, reqdTy, impliedTys, m)) // For each implemented type, reduce its list of implied interfaces by subtracting out those implied // by another implemented interface type. // // REVIEW: Note complexity O(ity*jty) let reqdTyInfos = - intfSets |> List.map (fun (i,reqdTy,impliedTys,m) -> + intfSets |> List.map (fun (i, reqdTy, impliedTys, m) -> let reduced = - (impliedTys,intfSets) ||> List.fold (fun acc (j,jty,impliedTys2,m) -> + (impliedTys, intfSets) ||> List.fold (fun acc (j, jty, impliedTys2, m) -> if i <> j && TypeFeasiblySubsumesType 0 g amap m jty CanCoerce reqdTy then ListSet.subtract (TypesFeasiblyEquiv 0 g amap m) acc impliedTys2 else acc ) @@ -427,22 +427,22 @@ module DispatchSlotChecking = // duplicates. for (_i, reqdTy, m, impliedTys) in reqdTyInfos do if isInterfaceTy g reqdTy && isNil impliedTys then - errorR(Error(FSComp.SR.typrelDuplicateInterface(),m)) + errorR(Error(FSComp.SR.typrelDuplicateInterface(), m)) // Check that no interface type is implied twice // // Note complexity O(reqdTy*reqdTy) for (i, _reqdTy, reqdTyRange, impliedTys) in reqdTyInfos do - for (j,_,_,impliedTys2) in reqdTyInfos do + for (j, _, _, impliedTys2) in reqdTyInfos do if i > j then let overlap = ListSet.intersect (TypesFeasiblyEquiv 0 g amap reqdTyRange) impliedTys impliedTys2 overlap |> List.iter (fun overlappingTy -> - if not (isNil (GetImmediateIntrinsicMethInfosOfType (None,AccessibleFromSomewhere) g amap reqdTyRange overlappingTy |> List.filter (fun minfo -> minfo.IsVirtual))) then - errorR(Error(FSComp.SR.typrelNeedExplicitImplementation(NicePrint.minimalStringOfType denv (List.head overlap)),reqdTyRange))) + if not (isNil (GetImmediateIntrinsicMethInfosOfType (None, AccessibleFromSomewhere) g amap reqdTyRange overlappingTy |> List.filter (fun minfo -> minfo.IsVirtual))) then + errorR(Error(FSComp.SR.typrelNeedExplicitImplementation(NicePrint.minimalStringOfType denv (List.head overlap)), reqdTyRange))) // Get the SlotImplSet for each implemented type // This contains the list of required members and the list of available members - [ for (_,reqdTy,reqdTyRange,impliedTys) in reqdTyInfos do + [ for (_, reqdTy, reqdTyRange, impliedTys) in reqdTyInfos do // Build a set of the implied interface types, for quicker lookup, by nominal type let isImpliedInterfaceTable = @@ -469,15 +469,15 @@ module DispatchSlotChecking = // specific method is "optionally" implemented. let isOptional = ListSet.contains (typeEquiv g) impliedTy availImpliedInterfaces - for reqdSlot in GetImmediateIntrinsicMethInfosOfType (None,AccessibleFromSomewhere) g amap reqdTyRange impliedTy do + for reqdSlot in GetImmediateIntrinsicMethInfosOfType (None, AccessibleFromSomewhere) g amap reqdTyRange impliedTy do yield RequiredSlot(reqdSlot, isOptional) else // In the normal case, the requirements for a class are precisely all the abstract slots up the whole hierarchy. // So here we get and yield all of those. - for minfo in reqdTy |> GetIntrinsicMethInfosOfType infoReader (None,AccessibleFromSomewhere,AllowMultiIntfInstantiations.Yes) IgnoreOverrides reqdTyRange do + for minfo in reqdTy |> GetIntrinsicMethInfosOfType infoReader (None, AccessibleFromSomewhere, AllowMultiIntfInstantiations.Yes) IgnoreOverrides reqdTyRange do if minfo.IsDispatchSlot then - yield RequiredSlot(minfo,(*isOptional=*) not minfo.IsAbstract) ] + yield RequiredSlot(minfo, (*isOptional=*) not minfo.IsAbstract) ] // Compute the methods that are available to implement abstract slots from the base class @@ -496,10 +496,10 @@ module DispatchSlotChecking = [ // Get any class hierarchy methods on this type // // NOTE: What we have below is an over-approximation that will get too many methods - // and not always correctly relate them to the slots they implement. For example, + // and not always correctly relate them to the slots they implement. For example, // we may get an override from a base class and believe it implements a fresh, new abstract // slot in a subclass. - for minfos in infoReader.GetRawIntrinsicMethodSetsOfType(None,AccessibleFromSomewhere,AllowMultiIntfInstantiations.Yes,reqdTyRange,reqdTy) do + for minfos in infoReader.GetRawIntrinsicMethodSetsOfType(None, AccessibleFromSomewhere, AllowMultiIntfInstantiations.Yes, reqdTyRange, reqdTy) do for minfo in minfos do if not minfo.IsAbstract then yield GetInheritedMemberOverrideInfo g amap reqdTyRange CanImplementAnyClassHierarchySlot minfo ] @@ -510,26 +510,26 @@ module DispatchSlotChecking = isImpliedInterfaceType x.ApparentEnclosingType let reqdProperties = - GetIntrinsicPropInfosOfType infoReader (None,AccessibleFromSomewhere,AllowMultiIntfInstantiations.Yes) IgnoreOverrides reqdTyRange reqdTy + GetIntrinsicPropInfosOfType infoReader (None, AccessibleFromSomewhere, AllowMultiIntfInstantiations.Yes) IgnoreOverrides reqdTyRange reqdTy |> List.filter isRelevantRequiredProperty - let dispatchSlotsKeyed = dispatchSlots |> NameMultiMap.initBy (fun (RequiredSlot(v,_)) -> v.LogicalName) + let dispatchSlotsKeyed = dispatchSlots |> NameMultiMap.initBy (fun (RequiredSlot(v, _)) -> v.LogicalName) yield SlotImplSet(dispatchSlots, dispatchSlotsKeyed, availPriorOverrides, reqdProperties) ] /// Check that a type definition implements all its required interfaces after processing all declarations /// within a file. - let CheckImplementationRelationAtEndOfInferenceScope (infoReader :InfoReader,denv,nenv,sink,tycon:Tycon,isImplementation) = + let CheckImplementationRelationAtEndOfInferenceScope (infoReader :InfoReader, denv, nenv, sink, tycon:Tycon, isImplementation) = let g = infoReader.g let amap = infoReader.amap let tcaug = tycon.TypeContents - let interfaces = tycon.ImmediateInterfacesOfFSharpTycon |> List.map (fun (ity,_compgen,m) -> (ity,m)) + let interfaces = tycon.ImmediateInterfacesOfFSharpTycon |> List.map (fun (ity, _compgen, m) -> (ity, m)) let overallTy = generalizedTyconRef (mkLocalTyconRef tycon) - let allReqdTys = (overallTy,tycon.Range) :: interfaces + let allReqdTys = (overallTy, tycon.Range) :: interfaces // Get all the members that are immediately part of this type // Include the auto-generated members @@ -567,21 +567,21 @@ module DispatchSlotChecking = // We check all the abstracts related to the class hierarchy and then check each interface implementation - for ((reqdTy,m),slotImplSet) in allImpls do - let (SlotImplSet(dispatchSlots, dispatchSlotsKeyed, availPriorOverrides,_)) = slotImplSet + for ((reqdTy, m), slotImplSet) in allImpls do + let (SlotImplSet(dispatchSlots, dispatchSlotsKeyed, availPriorOverrides, _)) = slotImplSet try // Now extract the information about each overriding method relevant to this SlotImplSet let allImmediateMembersThatMightImplementDispatchSlots = allImmediateMembersThatMightImplementDispatchSlots - |> List.map (fun overrideBy -> overrideBy,GetTypeMemberOverrideInfo g reqdTy overrideBy) + |> List.map (fun overrideBy -> overrideBy, GetTypeMemberOverrideInfo g reqdTy overrideBy) // Now check the implementation // We don't give missing method errors for abstract classes if isImplementation && not (isInterfaceTy g overallTy) then let overrides = allImmediateMembersThatMightImplementDispatchSlots |> List.map snd - let allCorrect = CheckDispatchSlotsAreImplemented (denv,g,amap,m,nenv,sink,tcaug.tcaug_abstract,reqdTy,dispatchSlots,availPriorOverrides,overrides) + let allCorrect = CheckDispatchSlotsAreImplemented (denv, g, amap, m, nenv, sink, tcaug.tcaug_abstract, reqdTy, dispatchSlots, availPriorOverrides, overrides) // Tell the user to mark the thing abstract if it was missing implementations if not allCorrect && not tcaug.tcaug_abstract && not (isInterfaceTy g reqdTy) then @@ -606,15 +606,15 @@ module DispatchSlotChecking = let slotsigs = overrideBy.MemberInfo.Value.ImplementedSlotSigs slotsigs |> List.map (ReparentSlotSigToUseMethodTypars g overrideBy.Range overrideBy) else - [ for ((reqdTy,m),(SlotImplSet(_dispatchSlots,dispatchSlotsKeyed,_,_))) in allImpls do + [ for ((reqdTy, m), (SlotImplSet(_dispatchSlots, dispatchSlotsKeyed, _, _))) in allImpls do let overrideByInfo = GetTypeMemberOverrideInfo g reqdTy overrideBy let overridenForThisSlotImplSet = - [ for (RequiredSlot(dispatchSlot,_)) in NameMultiMap.find overrideByInfo.LogicalName dispatchSlotsKeyed do + [ for (RequiredSlot(dispatchSlot, _)) in NameMultiMap.find overrideByInfo.LogicalName dispatchSlotsKeyed do if OverrideImplementsDispatchSlot g amap m dispatchSlot overrideByInfo then if tyconRefEq g overrideByInfo.BoundingTyconRef dispatchSlot.DeclaringTyconRef then match dispatchSlot.ArbitraryValRef with | Some virtMember -> - if virtMember.MemberInfo.Value.IsImplemented then errorR(Error(FSComp.SR.tcDefaultImplementationAlreadyExists(),overrideByInfo.Range)) + if virtMember.MemberInfo.Value.IsImplemented then errorR(Error(FSComp.SR.tcDefaultImplementationAlreadyExists(), overrideByInfo.Range)) virtMember.MemberInfo.Value.IsImplemented <- true | None -> () // not an F# slot @@ -661,9 +661,9 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader:InfoReader, nenv, then (* Warn when we're doing this for class types *) if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals g tycon then - warning(Error(FSComp.SR.typrelTypeImplementsIComparableShouldOverrideObjectEquals(tycon.DisplayName),tycon.Range)) + warning(Error(FSComp.SR.typrelTypeImplementsIComparableShouldOverrideObjectEquals(tycon.DisplayName), tycon.Range)) else - warning(Error(FSComp.SR.typrelTypeImplementsIComparableDefaultObjectEqualsProvided(tycon.DisplayName),tycon.Range)) + warning(Error(FSComp.SR.typrelTypeImplementsIComparableDefaultObjectEqualsProvided(tycon.DisplayName), tycon.Range)) AugmentWithHashCompare.CheckAugmentationAttribs isImplementation g amap tycon // Check some conditions about generic comparison and hashing. We can only check this condition after we've done the augmentation @@ -679,13 +679,13 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader:InfoReader, nenv, if (Option.isSome tycon.GeneratedHashAndEqualsWithComparerValues) && (hasExplicitObjectGetHashCode || hasExplicitObjectEqualsOverride) then - errorR(Error(FSComp.SR.typrelExplicitImplementationOfGetHashCodeOrEquals(tycon.DisplayName),m)) + errorR(Error(FSComp.SR.typrelExplicitImplementationOfGetHashCodeOrEquals(tycon.DisplayName), m)) if not hasExplicitObjectEqualsOverride && hasExplicitObjectGetHashCode then - warning(Error(FSComp.SR.typrelExplicitImplementationOfGetHashCode(tycon.DisplayName),m)) + warning(Error(FSComp.SR.typrelExplicitImplementationOfGetHashCode(tycon.DisplayName), m)) if hasExplicitObjectEqualsOverride && not hasExplicitObjectGetHashCode then - warning(Error(FSComp.SR.typrelExplicitImplementationOfEquals(tycon.DisplayName),m)) + warning(Error(FSComp.SR.typrelExplicitImplementationOfEquals(tycon.DisplayName), m)) // remember these values to ensure we don't generate these methods during codegen @@ -698,29 +698,29 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader:InfoReader, nenv, && not tycon.IsFSharpInterfaceTycon && not tycon.IsFSharpDelegateTycon then - DispatchSlotChecking.CheckImplementationRelationAtEndOfInferenceScope (infoReader,denv,nenv,sink,tycon,isImplementation) + DispatchSlotChecking.CheckImplementationRelationAtEndOfInferenceScope (infoReader, denv, nenv, sink, tycon, isImplementation) /// Get the methods relevant to determining if a uniquely-identified-override exists based on the syntactic information /// at the member signature prior to type inference. This is used to pre-assign type information if it does -let GetAbstractMethInfosForSynMethodDecl(infoReader:InfoReader,ad,memberName:Ident,bindm,typToSearchForAbstractMembers,valSynData) = +let GetAbstractMethInfosForSynMethodDecl(infoReader:InfoReader, ad, memberName:Ident, bindm, typToSearchForAbstractMembers, valSynData) = let minfos = match typToSearchForAbstractMembers with - | _,Some(SlotImplSet(_, dispatchSlotsKeyed,_,_)) -> - NameMultiMap.find memberName.idText dispatchSlotsKeyed |> List.map (fun (RequiredSlot(dispatchSlot,_)) -> dispatchSlot) + | _, Some(SlotImplSet(_, dispatchSlotsKeyed, _, _)) -> + NameMultiMap.find memberName.idText dispatchSlotsKeyed |> List.map (fun (RequiredSlot(dispatchSlot, _)) -> dispatchSlot) | ty, None -> GetIntrinsicMethInfosOfType infoReader (Some(memberName.idText), ad, AllowMultiIntfInstantiations.Yes) IgnoreOverrides bindm ty let dispatchSlots = minfos |> List.filter (fun minfo -> minfo.IsDispatchSlot) let topValSynArities = SynInfo.AritiesOfArgs valSynData let topValSynArities = if List.isEmpty topValSynArities then topValSynArities else topValSynArities.Tail let dispatchSlotsArityMatch = dispatchSlots |> List.filter (fun minfo -> minfo.NumArgs = topValSynArities) - dispatchSlots,dispatchSlotsArityMatch + dispatchSlots, dispatchSlotsArityMatch /// Get the properties relevant to determining if a uniquely-identified-override exists based on the syntactic information /// at the member signature prior to type inference. This is used to pre-assign type information if it does -let GetAbstractPropInfosForSynPropertyDecl(infoReader:InfoReader,ad,memberName:Ident,bindm,typToSearchForAbstractMembers,_k,_valSynData) = +let GetAbstractPropInfosForSynPropertyDecl(infoReader:InfoReader, ad, memberName:Ident, bindm, typToSearchForAbstractMembers, _k, _valSynData) = let pinfos = match typToSearchForAbstractMembers with - | _,Some(SlotImplSet(_,_,_,reqdProps)) -> + | _, Some(SlotImplSet(_, _, _, reqdProps)) -> reqdProps |> List.filter (fun pinfo -> pinfo.PropertyName = memberName.idText) | ty, None -> GetIntrinsicPropInfosOfType infoReader (Some(memberName.idText), ad, AllowMultiIntfInstantiations.Yes) IgnoreOverrides bindm ty diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 61e9a9b77d32d0ef8fe4e5be3830f1d7b451de5c..f179c420993d835ac014b6cbddcc3e2bd563d623 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1,7 +1,7 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -/// Name environment and name resolution +/// Name environment and name resolution module internal FSharp.Compiler.NameResolution open Internal.Utilities @@ -31,61 +31,61 @@ open FSharp.Compiler.ExtensionTyping #endif /// An object that captures the logical context for name resolution. -type NameResolver(g:TcGlobals, - amap: Import.ImportMap, - infoReader: InfoReader, +type NameResolver(g:TcGlobals, + amap: Import.ImportMap, + infoReader: InfoReader, instantiationGenerator: (range -> Typars -> TypeInst)) = - /// Used to transform typars into new inference typars + /// Used to transform typars into new inference typars // instantiationGenerator is a function to help us create the // type parameters by copying them from type parameter specifications read - // from IL code. + // from IL code. // - // When looking up items in generic types we create a fresh instantiation - // of the type, i.e. instantiate the type with inference variables. - // This means the item is returned ready for use by the type inference engine - // without further freshening. However it does mean we end up plumbing 'instantiationGenerator' - // around a bit more than we would like to, which is a bit annoying. + // When looking up items in generic types we create a fresh instantiation + // of the type, i.e. instantiate the type with inference variables. + // This means the item is returned ready for use by the type inference engine + // without further freshening. However it does mean we end up plumbing 'instantiationGenerator' + // around a bit more than we would like to, which is a bit annoying. member nr.InstantiationGenerator = instantiationGenerator member nr.g = g member nr.amap = amap member nr.InfoReader = infoReader - + //------------------------------------------------------------------------- // Helpers for unionconstrs and recdfields -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- /// Get references to all the union cases in the type definition -let UnionCaseRefsInTycon (modref: ModuleOrNamespaceRef) (tycon:Tycon) = +let UnionCaseRefsInTycon (modref: ModuleOrNamespaceRef) (tycon:Tycon) = tycon.UnionCasesAsList |> List.map (mkModuleUnionCaseRef modref tycon) /// Get references to all the union cases defined in the module -let UnionCaseRefsInModuleOrNamespace (modref:ModuleOrNamespaceRef) = +let UnionCaseRefsInModuleOrNamespace (modref:ModuleOrNamespaceRef) = [ for x in modref.ModuleOrNamespaceType.AllEntities do yield! UnionCaseRefsInTycon modref x ] /// Try to find a type with a union case of the given name -let TryFindTypeWithUnionCase (modref:ModuleOrNamespaceRef) (id: Ident) = +let TryFindTypeWithUnionCase (modref:ModuleOrNamespaceRef) (id: Ident) = modref.ModuleOrNamespaceType.AllEntities - |> QueueList.tryFind (fun tycon -> tycon.GetUnionCaseByName id.idText |> Option.isSome) + |> QueueList.tryFind (fun tycon -> tycon.GetUnionCaseByName id.idText |> Option.isSome) /// Try to find a type with a record field of the given name -let TryFindTypeWithRecdField (modref:ModuleOrNamespaceRef) (id: Ident) = +let TryFindTypeWithRecdField (modref:ModuleOrNamespaceRef) (id: Ident) = modref.ModuleOrNamespaceType.AllEntities |> QueueList.tryFind (fun tycon -> tycon.GetFieldByName id.idText |> Option.isSome) /// Get the active pattern elements defined by a given value, if any -let ActivePatternElemsOfValRef vref = +let ActivePatternElemsOfValRef vref = match TryGetActivePatternInfo vref with - | Some apinfo -> apinfo.ActiveTags |> List.mapi (fun i _ -> APElemRef(apinfo,vref, i)) - | None -> [] + | Some apinfo -> apinfo.ActiveTags |> List.mapi (fun i _ -> APElemRef(apinfo, vref, i)) + | None -> [] /// Try to make a reference to a value in a module. // // mkNestedValRef may fail if the assembly load set is // incomplete and the value is an extension member of a type that is not -// available. In some cases we can reasonably recover from this, e.g. by simply not adding +// available. In some cases we can reasonably recover from this, e.g. by simply not adding // an entry to a table. Callsites have to cope with the error (None) condition -// sensibly, e.g. in a way that won't change the way things are compiled as the +// sensibly, e.g. in a way that won't change the way things are compiled as the // assembly set is completed. let TryMkValRefInModRef modref vspec = protectAssemblyExploration @@ -93,31 +93,31 @@ let TryMkValRefInModRef modref vspec = (fun () -> Some (mkNestedValRef modref vspec)) /// Get the active pattern elements defined by a given value, if any -let ActivePatternElemsOfVal modref vspec = +let ActivePatternElemsOfVal modref vspec = // If the assembly load set is incomplete then don't add anything to the table - match TryMkValRefInModRef modref vspec with + match TryMkValRefInModRef modref vspec with | None -> [] | Some vref -> ActivePatternElemsOfValRef vref /// Get the active pattern elements defined in a module, if any. Cache in the slot in the module type. -let ActivePatternElemsOfModuleOrNamespace (modref:ModuleOrNamespaceRef) : NameMap = +let ActivePatternElemsOfModuleOrNamespace (modref:ModuleOrNamespaceRef) : NameMap = let mtyp = modref.ModuleOrNamespaceType cacheOptRef mtyp.ActivePatternElemRefLookupTable (fun () -> - mtyp.AllValsAndMembers - |> Seq.collect (ActivePatternElemsOfVal modref) + mtyp.AllValsAndMembers + |> Seq.collect (ActivePatternElemsOfVal modref) |> Seq.fold (fun acc apref -> NameMap.add apref.Name apref acc) Map.empty) //--------------------------------------------------------------------------- // Name Resolution Items -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- /// Detect a use of a nominal type, including type abbreviations. /// /// When reporting symbols, we care about abbreviations, e.g. 'int' and 'int32' count as two separate symbols -let (|AbbrevOrAppTy|_|) (ty: TType) = - match stripTyparEqns ty with - | TType_app (tcref,_) -> Some tcref +let (|AbbrevOrAppTy|_|) (ty: TType) = + match stripTyparEqns ty with + | TType_app (tcref, _) -> Some tcref | _ -> None [] @@ -131,14 +131,14 @@ type ArgumentContainer = | UnionCase of UnionCaseInfo // Note: Active patterns are encoded like this: -// let (|A|B|) x = if x < 0 then A else B // A and B are reported as results using 'Item.ActivePatternResult' +// let (|A|B|) x = if x < 0 then A else B // A and B are reported as results using 'Item.ActivePatternResult' // match () with | A | B -> () // A and B are reported using 'Item.ActivePatternCase' [] /// Represents an item that results from name resolution -type Item = +type Item = - /// Represents the resolution of a name to an F# value or function. + /// Represents the resolution of a name to an F# value or function. | Value of ValRef /// Represents the resolution of a name to an F# union case. @@ -148,10 +148,10 @@ type Item = | ActivePatternResult of ActivePatternInfo * TType * int * range /// Represents the resolution of a name to an F# active pattern case within the body of an active pattern. - | ActivePatternCase of ActivePatternElemRef + | ActivePatternCase of ActivePatternElemRef /// Represents the resolution of a name to an F# exception definition. - | ExnCase of TyconRef + | ExnCase of TyconRef /// Represents the resolution of a name to an F# record field. | RecdField of RecdFieldInfo @@ -159,13 +159,13 @@ type Item = /// Represents the resolution of a name to a field of an anonymous record type. | AnonRecdField of AnonRecdTypeInfo * TTypes * int * range - // The following are never in the items table but are valid results of binding - // an identifier in different circumstances. + // The following are never in the items table but are valid results of binding + // an identifier in different circumstances. /// Represents the resolution of a name at the point of its own definition. | NewDef of Ident - /// Represents the resolution of a name to a .NET field + /// Represents the resolution of a name to a .NET field | ILField of ILFieldInfo /// Represents the resolution of a name to an event @@ -174,7 +174,7 @@ type Item = /// Represents the resolution of a name to a property | Property of string * PropInfo list - /// Represents the resolution of a name to a group of methods. + /// Represents the resolution of a name to a group of methods. | MethodGroup of displayName: string * methods: MethInfo list * uninstantiatedMethodOpt: MethInfo option /// Represents the resolution of a name to a constructor @@ -190,7 +190,7 @@ type Item = | Types of string * TType list /// CustomOperation(nm, helpText, methInfo) - /// + /// /// Used to indicate the availability or resolution of a custom query operation such as 'sortBy' or 'where' in computation expression syntax | CustomOperation of string * (unit -> string option) * MethInfo option @@ -210,57 +210,57 @@ type Item = | ArgName of Ident * TType * ArgumentContainer option /// Represents the resolution of a name to a named property setter - | SetterArg of Ident * Item + | SetterArg of Ident * Item /// Represents the potential resolution of an unqualified name to a type. | UnqualifiedType of TyconRef list - static member MakeMethGroup (nm,minfos:MethInfo list) = + static member MakeMethGroup (nm, minfos:MethInfo list) = let minfos = minfos |> List.sortBy (fun minfo -> minfo.NumArgs |> List.sum) - Item.MethodGroup (nm,minfos,None) + Item.MethodGroup (nm, minfos, None) - static member MakeCtorGroup (nm,minfos:MethInfo list) = + static member MakeCtorGroup (nm, minfos:MethInfo list) = let minfos = minfos |> List.sortBy (fun minfo -> minfo.NumArgs |> List.sum) - Item.CtorGroup (nm,minfos) + Item.CtorGroup (nm, minfos) member d.DisplayName = match d with | Item.Value v -> v.DisplayName | Item.ActivePatternCase apref -> apref.Name - | Item.UnionCase(uinfo,_) -> DecompileOpName uinfo.UnionCase.DisplayName + | Item.UnionCase(uinfo, _) -> DecompileOpName uinfo.UnionCase.DisplayName | Item.ExnCase tcref -> tcref.LogicalName | Item.RecdField rfinfo -> DecompileOpName rfinfo.RecdField.Name | Item.AnonRecdField (anonInfo, _tys, i, _m) -> anonInfo.SortedNames.[i] | Item.NewDef id -> id.idText | Item.ILField finfo -> finfo.FieldName | Item.Event einfo -> einfo.EventName - | Item.Property(_, FSProp(_,_, Some v,_) :: _) - | Item.Property(_, FSProp(_,_,_, Some v) :: _) -> v.DisplayName + | Item.Property(_, FSProp(_, _, Some v, _) :: _) + | Item.Property(_, FSProp(_, _, _, Some v) :: _) -> v.DisplayName | Item.Property(nm, _) -> PrettyNaming.DemangleOperatorName nm - | Item.MethodGroup(_, (FSMeth(_,_, v,_) :: _), _) -> v.DisplayName + | Item.MethodGroup(_, (FSMeth(_, _, v, _) :: _), _) -> v.DisplayName | Item.MethodGroup(nm, _, _) -> PrettyNaming.DemangleOperatorName nm - | Item.CtorGroup(nm,_) -> DemangleGenericTypeName nm + | Item.CtorGroup(nm, _) -> DemangleGenericTypeName nm | Item.FakeInterfaceCtor (AbbrevOrAppTy tcref) | Item.DelegateCtor (AbbrevOrAppTy tcref) -> DemangleGenericTypeName tcref.DisplayName - | Item.Types(nm,_) -> DemangleGenericTypeName nm + | Item.Types(nm, _) -> DemangleGenericTypeName nm | Item.UnqualifiedType(tcref :: _) -> tcref.DisplayName - | Item.TypeVar (nm,_) -> nm + | Item.TypeVar (nm, _) -> nm | Item.ModuleOrNamespaces(modref :: _) -> modref.DemangledModuleOrNamespaceName | Item.ArgName (id, _, _) -> id.idText | Item.SetterArg (id, _) -> id.idText - | Item.CustomOperation (customOpName,_,_) -> customOpName - | Item.CustomBuilder (nm,_) -> nm + | Item.CustomOperation (customOpName, _, _) -> customOpName + | Item.CustomBuilder (nm, _) -> nm | _ -> "" -let valRefHash (vref: ValRef) = - match vref.TryDeref with - | ValueNone -> 0 +let valRefHash (vref: ValRef) = + match vref.TryDeref with + | ValueNone -> 0 | ValueSome v -> LanguagePrimitives.PhysicalHash v [] -/// Pairs an Item with a TyparInst showing how generic type variables of the item are instantiated at +/// Pairs an Item with a TyparInst showing how generic type variables of the item are instantiated at /// a particular usage point. -type ItemWithInst = +type ItemWithInst = { Item : Item TyparInst: TyparInst } @@ -272,7 +272,7 @@ let (|ItemWithInst|) (x:ItemWithInst) = (x.Item, x.TyparInst) type FieldResolution = FieldResolution of RecdFieldRef * bool /// Information about an extension member held in the name resolution environment -type ExtensionMember = +type ExtensionMember = /// F#-style Extrinsic extension member, defined in F# code | FSExtMem of ValRef * ExtensionMethodPriority @@ -283,97 +283,97 @@ type ExtensionMember = | ILExtMem of TyconRef * MethInfo * ExtensionMethodPriority /// Check if two extension members refer to the same definition - static member Equality g e1 e2 = - match e1, e2 with - | FSExtMem (vref1,_), FSExtMem (vref2,_) -> valRefEq g vref1 vref2 - | ILExtMem (_,md1,_), ILExtMem (_,md2,_) -> MethInfo.MethInfosUseIdenticalDefinitions md1 md2 + static member Equality g e1 e2 = + match e1, e2 with + | FSExtMem (vref1, _), FSExtMem (vref2, _) -> valRefEq g vref1 vref2 + | ILExtMem (_, md1, _), ILExtMem (_, md2, _) -> MethInfo.MethInfosUseIdenticalDefinitions md1 md2 | _ -> false static member Hash e1 = match e1 with | FSExtMem(vref, _) -> valRefHash vref - | ILExtMem(_, m, _) -> + | ILExtMem(_, m, _) -> match m with | ILMeth(_, ilmeth, _) -> LanguagePrimitives.PhysicalHash ilmeth.RawMetadata | FSMeth(_, _, vref, _) -> valRefHash vref | _ -> 0 - + static member Comparer g = HashIdentity.FromFunctions ExtensionMember.Hash (ExtensionMember.Equality g) - + /// Describes the sequence order of the introduction of an extension method. Extension methods that are introduced /// later through 'open' get priority in overload resolution. - member x.Priority = - match x with - | FSExtMem (_,pri) -> pri - | ILExtMem (_,_,pri) -> pri - -type FullyQualifiedFlag = + member x.Priority = + match x with + | FSExtMem (_, pri) -> pri + | ILExtMem (_, _, pri) -> pri + +type FullyQualifiedFlag = /// Only resolve full paths - | FullyQualified + | FullyQualified /// Resolve any paths accessible via 'open' - | OpenQualified + | OpenQualified [] /// The environment of information used to resolve names type NameResolutionEnv = - { /// Display environment information for output - eDisplayEnv: DisplayEnv + { /// Display environment information for output + eDisplayEnv: DisplayEnv - /// Values and Data Tags available by unqualified name - eUnqualifiedItems: LayeredMap + /// Values and Data Tags available by unqualified name + eUnqualifiedItems: LayeredMap - /// Data Tags and Active Pattern Tags available by unqualified name + /// Data Tags and Active Pattern Tags available by unqualified name ePatItems: NameMap - /// Modules accessible via "." notation. Note this is a multi-map. - /// Adding a module abbreviation adds it a local entry to this List.map. - /// Likewise adding a ccu or opening a path adds entries to this List.map. - - + /// Modules accessible via "." notation. Note this is a multi-map. + /// Adding a module abbreviation adds it a local entry to this List.map. + /// Likewise adding a ccu or opening a path adds entries to this List.map. + + /// REVIEW (old comment) - /// "The boolean flag is means the namespace or module entry shouldn't 'really' be in the - /// map, and if it is ever used to resolve a name then we give a warning. - /// This is used to give warnings on unqualified namespace accesses, e.g. - /// open System - /// open Collections <--- give a warning - /// let v = new Collections.Generic.List() <--- give a warning" - + /// "The boolean flag is means the namespace or module entry shouldn't 'really' be in the + /// map, and if it is ever used to resolve a name then we give a warning. + /// This is used to give warnings on unqualified namespace accesses, e.g. + /// open System + /// open Collections <--- give a warning + /// let v = new Collections.Generic.List() <--- give a warning" + eModulesAndNamespaces: NameMultiMap - - /// Fully qualified modules and namespaces. 'open' does not change this. + + /// Fully qualified modules and namespaces. 'open' does not change this. eFullyQualifiedModulesAndNamespaces: NameMultiMap - - /// RecdField labels in scope. RecdField labels are those where type are inferred - /// by label rather than by known type annotation. - /// Bools indicate if from a record, where no warning is given on indeterminate lookup + + /// RecdField labels in scope. RecdField labels are those where type are inferred + /// by label rather than by known type annotation. + /// Bools indicate if from a record, where no warning is given on indeterminate lookup eFieldLabels: NameMultiMap - /// Tycons indexed by the various names that may be used to access them, e.g. - /// "List" --> multiple TyconRef's for the various tycons accessible by this name. - /// "List`1" --> TyconRef - eTyconsByAccessNames: LayeredMultiMap + /// Tycons indexed by the various names that may be used to access them, e.g. + /// "List" --> multiple TyconRef's for the various tycons accessible by this name. + /// "List`1" --> TyconRef + eTyconsByAccessNames: LayeredMultiMap - eFullyQualifiedTyconsByAccessNames: LayeredMultiMap + eFullyQualifiedTyconsByAccessNames: LayeredMultiMap - /// Tycons available by unqualified, demangled names (i.e. (List,1) --> TyconRef) - eTyconsByDemangledNameAndArity: LayeredMap + /// Tycons available by unqualified, demangled names (i.e. (List, 1) --> TyconRef) + eTyconsByDemangledNameAndArity: LayeredMap - /// Tycons available by unqualified, demangled names (i.e. (List,1) --> TyconRef) - eFullyQualifiedTyconsByDemangledNameAndArity: LayeredMap + /// Tycons available by unqualified, demangled names (i.e. (List, 1) --> TyconRef) + eFullyQualifiedTyconsByDemangledNameAndArity: LayeredMap - /// Extension members by type and name + /// Extension members by type and name eIndexedExtensionMembers: TyconRefMultiMap /// Other extension members unindexed by type eUnindexedExtensionMembers: ExtensionMember list - /// Typars (always available by unqualified names). Further typars can be - /// in the tpenv, a structure folded through each top-level definition. + /// Typars (always available by unqualified names). Further typars can be + /// in the tpenv, a structure folded through each top-level definition. eTypars: NameMap - } + } /// The initial, empty name resolution environment. The mother of all things. static member Empty g = @@ -396,46 +396,46 @@ type NameResolutionEnv = member nenv.FindUnqualifiedItem nm = nenv.eUnqualifiedItems.[nm] /// Get the table of types, indexed by name and arity - member nenv.TyconsByDemangledNameAndArity fq = - match fq with + member nenv.TyconsByDemangledNameAndArity fq = + match fq with | FullyQualified -> nenv.eFullyQualifiedTyconsByDemangledNameAndArity | OpenQualified -> nenv.eTyconsByDemangledNameAndArity - /// Get the table of types, indexed by name - member nenv.TyconsByAccessNames fq = - match fq with + /// Get the table of types, indexed by name + member nenv.TyconsByAccessNames fq = + match fq with | FullyQualified -> nenv.eFullyQualifiedTyconsByAccessNames | OpenQualified -> nenv.eTyconsByAccessNames /// Get the table of modules and namespaces - member nenv.ModulesAndNamespaces fq = - match fq with - | FullyQualified -> nenv.eFullyQualifiedModulesAndNamespaces - | OpenQualified -> nenv.eModulesAndNamespaces + member nenv.ModulesAndNamespaces fq = + match fq with + | FullyQualified -> nenv.eFullyQualifiedModulesAndNamespaces + | OpenQualified -> nenv.eModulesAndNamespaces //------------------------------------------------------------------------- // Helpers to do with extension members -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- -/// Allocate the next extension method priority. This is an incrementing sequence of integers +/// Allocate the next extension method priority. This is an incrementing sequence of integers /// during type checking. let NextExtensionMethodPriority() = uint64 (newStamp()) /// Get the info for all the .NET-style extension members listed as static members in the type. -let private GetCSharpStyleIndexedExtensionMembersForTyconRef (amap:Import.ImportMap) m (tcrefOfStaticClass:TyconRef) = +let private GetCSharpStyleIndexedExtensionMembersForTyconRef (amap:Import.ImportMap) m (tcrefOfStaticClass:TyconRef) = let g = amap.g // Type must be non-generic and have 'Extension' attribute if isNil(tcrefOfStaticClass.Typars(m)) && TyconRefHasAttribute g m g.attrib_ExtensionAttribute tcrefOfStaticClass then let pri = NextExtensionMethodPriority() let ty = generalizedTyconRef tcrefOfStaticClass - + // Get the 'plain' methods, not interpreted as extension methods let minfos = GetImmediateIntrinsicMethInfosOfType (None, AccessorDomain.AccessibleFromSomeFSharpCode) g amap m ty [ for minfo in minfos do // Method must be static, have 'Extension' attribute, must not be curried, must have at least one argument - if not minfo.IsInstance && - not minfo.IsExtensionMember && - (match minfo.NumArgs with [x] when x >= 1 -> true | _ -> false) && + if not minfo.IsInstance && + not minfo.IsExtensionMember && + (match minfo.NumArgs with [x] when x >= 1 -> true | _ -> false) && MethInfoHasAttribute g m g.attrib_ExtensionAttribute minfo then let ilExtMem = ILExtMem (tcrefOfStaticClass, minfo, pri) @@ -449,15 +449,15 @@ let private GetCSharpStyleIndexedExtensionMembersForTyconRef (amap:Import.Import // // We don't use the index for the IL extension method for tuple of F# function types (e.g. if extension // methods for tuple occur in C# code) - let thisTyconRef = - try - let rs = - match metadataOfTycon tcrefOfStaticClass.Deref, minfo with - | ILTypeMetadata (TILObjectReprData(scoref,_,_)), ILMeth(_,ILMethInfo(_,_,_,ilMethod,_),_) -> - match ilMethod.ParameterTypes with - | firstTy :: _ -> - match firstTy with - | ILType.Boxed tspec | ILType.Value tspec -> + let thisTyconRef = + try + let rs = + match metadataOfTycon tcrefOfStaticClass.Deref, minfo with + | ILTypeMetadata (TILObjectReprData(scoref, _, _)), ILMeth(_, ILMethInfo(_, _, _, ilMethod, _), _) -> + match ilMethod.ParameterTypes with + | firstTy :: _ -> + match firstTy with + | ILType.Boxed tspec | ILType.Value tspec -> let tref = (tspec |> rescopeILTypeSpec scoref).TypeRef if Import.CanImportILTypeRef amap m tref then let tcref = tref |> Import.ImportILTypeRef amap m @@ -466,14 +466,14 @@ let private GetCSharpStyleIndexedExtensionMembersForTyconRef (amap:Import.Import else None | _ -> None | _ -> None - | _ -> + | _ -> // The results are indexed by the TyconRef of the first 'this' argument, if any. // So we need to go and crack the type of the 'this' argument. - let thisTy = minfo.GetParamTypes(amap,m,generalizeTypars minfo.FormalMethodTypars).Head.Head + let thisTy = minfo.GetParamTypes(amap, m, generalizeTypars minfo.FormalMethodTypars).Head.Head match thisTy with | AppTy g (tcrefOfTypeExtended, _) when not (isByrefTy g thisTy) -> Some tcrefOfTypeExtended | _ -> None - + Some rs with e -> // Import of the ILType may fail, if so report the error and skip on @@ -485,48 +485,48 @@ let private GetCSharpStyleIndexedExtensionMembersForTyconRef (amap:Import.Import | Some (Some tcref) -> yield Choice1Of2(tcref, ilExtMem) | Some None -> yield Choice2Of2 ilExtMem ] else - [] + [] //------------------------------------------------------------------------- // Helpers to do with building environments -//------------------------------------------------------------------------- - -/// For the operations that build the overall name resolution -/// tables, BulkAdd.Yes is set to true when "opening" a -/// namespace. If BulkAdd is true then add-and-collapse -/// is used for the backing maps.Multiple "open" operations are -/// thus coalesced, and the first subsequent lookup after a sequence -/// of opens will collapse the maps and build the backing dictionary. +//------------------------------------------------------------------------- + +/// For the operations that build the overall name resolution +/// tables, BulkAdd.Yes is set to true when "opening" a +/// namespace. If BulkAdd is true then add-and-collapse +/// is used for the backing maps.Multiple "open" operations are +/// thus coalesced, and the first subsequent lookup after a sequence +/// of opens will collapse the maps and build the backing dictionary. [] type BulkAdd = Yes | No /// bulkAddMode: true when adding the values from the 'open' of a namespace /// or module, when we collapse the value table down to a dictionary. -let AddValRefsToItems (bulkAddMode: BulkAdd) (eUnqualifiedItems: LayeredMap<_,_>) (vrefs:ValRef[]) = - // Object model members are not added to the unqualified name resolution environment +let AddValRefsToItems (bulkAddMode: BulkAdd) (eUnqualifiedItems: LayeredMap<_, _>) (vrefs:ValRef[]) = + // Object model members are not added to the unqualified name resolution environment let vrefs = vrefs |> Array.filter (fun vref -> not vref.IsMember) if vrefs.Length = 0 then eUnqualifiedItems else - match bulkAddMode with - | BulkAdd.Yes -> + match bulkAddMode with + | BulkAdd.Yes -> eUnqualifiedItems.AddAndMarkAsCollapsible(vrefs |> Array.map (fun vref -> KeyValuePair(vref.LogicalName, Item.Value vref))) - | BulkAdd.No -> + | BulkAdd.No -> assert (vrefs.Length = 1) let vref = vrefs.[0] - eUnqualifiedItems.Add (vref.LogicalName, Item.Value vref) + eUnqualifiedItems.Add (vref.LogicalName, Item.Value vref) /// Add an F# value to the table of available extension members, if necessary, as an FSharp-style extension member let AddValRefToExtensionMembers pri (eIndexedExtensionMembers: TyconRefMultiMap<_>) (vref:ValRef) = if vref.IsMember && vref.IsExtensionMember then - eIndexedExtensionMembers.Add (vref.MemberApparentEntity, FSExtMem (vref,pri)) + eIndexedExtensionMembers.Add (vref.MemberApparentEntity, FSExtMem (vref, pri)) else eIndexedExtensionMembers -/// This entrypoint is used to add some extra items to the environment for Visual Studio, e.g. static members +/// This entrypoint is used to add some extra items to the environment for Visual Studio, e.g. static members let AddFakeNamedValRefToNameEnv nm nenv vref = {nenv with eUnqualifiedItems = nenv.eUnqualifiedItems.Add (nm, Item.Value vref) } @@ -536,15 +536,15 @@ let AddFakeNameToNameEnv nm nenv item = /// Add an F# value to the table of available active patterns let AddValRefsToActivePatternsNameEnv ePatItems (vref:ValRef) = - let ePatItems = - (ActivePatternElemsOfValRef vref, ePatItems) - ||> List.foldBack (fun apref tab -> + let ePatItems = + (ActivePatternElemsOfValRef vref, ePatItems) + ||> List.foldBack (fun apref tab -> NameMap.add apref.Name (Item.ActivePatternCase apref) tab) - // Add literal constants to the environment available for resolving items in patterns - let ePatItems = - match vref.LiteralValue with - | None -> ePatItems + // Add literal constants to the environment available for resolving items in patterns + let ePatItems = + match vref.LiteralValue with + | None -> ePatItems | Some _ -> NameMap.add vref.LogicalName (Item.Value vref) ePatItems ePatItems @@ -552,18 +552,18 @@ let AddValRefsToActivePatternsNameEnv ePatItems (vref:ValRef) = /// Add a set of F# values to the environment. let AddValRefsToNameEnvWithPriority bulkAddMode pri nenv (vrefs: ValRef []) = if vrefs.Length = 0 then nenv else - { nenv with + { nenv with eUnqualifiedItems = AddValRefsToItems bulkAddMode nenv.eUnqualifiedItems vrefs - eIndexedExtensionMembers = (nenv.eIndexedExtensionMembers,vrefs) ||> Array.fold (AddValRefToExtensionMembers pri) - ePatItems = (nenv.ePatItems,vrefs) ||> Array.fold AddValRefsToActivePatternsNameEnv } + eIndexedExtensionMembers = (nenv.eIndexedExtensionMembers, vrefs) ||> Array.fold (AddValRefToExtensionMembers pri) + ePatItems = (nenv.ePatItems, vrefs) ||> Array.fold AddValRefsToActivePatternsNameEnv } /// Add a single F# value to the environment. -let AddValRefToNameEnv nenv (vref:ValRef) = +let AddValRefToNameEnv nenv (vref:ValRef) = let pri = NextExtensionMethodPriority() - { nenv with - eUnqualifiedItems = - if not vref.IsMember then - nenv.eUnqualifiedItems.Add (vref.LogicalName, Item.Value vref) + { nenv with + eUnqualifiedItems = + if not vref.IsMember then + nenv.eUnqualifiedItems.Add (vref.LogicalName, Item.Value vref) else nenv.eUnqualifiedItems eIndexedExtensionMembers = AddValRefToExtensionMembers pri nenv.eIndexedExtensionMembers vref @@ -575,165 +575,165 @@ let AddActivePatternResultTagsToNameEnv (apinfo: PrettyNaming.ActivePatternInfo) if List.isEmpty apinfo.Names then nenv else let apresl = List.indexed apinfo.Names { nenv with - eUnqualifiedItems = - (apresl,nenv.eUnqualifiedItems) - ||> List.foldBack (fun (j,nm) acc -> acc.Add(nm, Item.ActivePatternResult(apinfo,ty,j,m))) } + eUnqualifiedItems = + (apresl, nenv.eUnqualifiedItems) + ||> List.foldBack (fun (j, nm) acc -> acc.Add(nm, Item.ActivePatternResult(apinfo, ty, j, m))) } /// Generalize a union case, from Cons --> List.Cons -let GeneralizeUnionCaseRef (ucref:UnionCaseRef) = +let GeneralizeUnionCaseRef (ucref:UnionCaseRef) = UnionCaseInfo (fst (generalizeTyconRef ucref.TyconRef), ucref) - - + + /// Add type definitions to the sub-table of the environment indexed by name and arity -let AddTyconsByDemangledNameAndArity (bulkAddMode: BulkAdd) (tcrefs: TyconRef[]) (tab: LayeredMap) = +let AddTyconsByDemangledNameAndArity (bulkAddMode: BulkAdd) (tcrefs: TyconRef[]) (tab: LayeredMap) = if tcrefs.Length = 0 then tab else - let entries = - tcrefs + let entries = + tcrefs |> Array.map (fun tcref -> KeyTyconByDemangledNameAndArity tcref.LogicalName tcref.TyparsNoRange tcref) match bulkAddMode with | BulkAdd.Yes -> tab.AddAndMarkAsCollapsible entries - | BulkAdd.No -> (tab,entries) ||> Array.fold (fun tab (KeyValue(k,v)) -> tab.Add(k,v)) + | BulkAdd.No -> (tab, entries) ||> Array.fold (fun tab (KeyValue(k, v)) -> tab.Add(k, v)) -/// Add type definitions to the sub-table of the environment indexed by access name -let AddTyconByAccessNames bulkAddMode (tcrefs:TyconRef[]) (tab: LayeredMultiMap) = +/// Add type definitions to the sub-table of the environment indexed by access name +let AddTyconByAccessNames bulkAddMode (tcrefs:TyconRef[]) (tab: LayeredMultiMap) = if tcrefs.Length = 0 then tab else - let entries = + let entries = tcrefs |> Array.collect (fun tcref -> KeyTyconByAccessNames tcref.LogicalName tcref) match bulkAddMode with | BulkAdd.Yes -> tab.AddAndMarkAsCollapsible entries - | BulkAdd.No -> (tab,entries) ||> Array.fold (fun tab (KeyValue(k,v)) -> tab.Add (k,v)) + | BulkAdd.No -> (tab, entries) ||> Array.fold (fun tab (KeyValue(k, v)) -> tab.Add (k, v)) -/// Add a record field to the corresponding sub-table of the name resolution environment +/// Add a record field to the corresponding sub-table of the name resolution environment let AddRecdField (rfref:RecdFieldRef) tab = NameMultiMap.add rfref.FieldName rfref tab -/// Add a set of union cases to the corresponding sub-table of the environment -let AddUnionCases1 (tab:Map<_,_>) (ucrefs:UnionCaseRef list) = - (tab, ucrefs) ||> List.fold (fun acc ucref -> - let item = Item.UnionCase(GeneralizeUnionCaseRef ucref,false) +/// Add a set of union cases to the corresponding sub-table of the environment +let AddUnionCases1 (tab:Map<_, _>) (ucrefs:UnionCaseRef list) = + (tab, ucrefs) ||> List.fold (fun acc ucref -> + let item = Item.UnionCase(GeneralizeUnionCaseRef ucref, false) acc.Add (ucref.CaseName, item)) -/// Add a set of union cases to the corresponding sub-table of the environment -let AddUnionCases2 bulkAddMode (eUnqualifiedItems: LayeredMap<_,_>) (ucrefs :UnionCaseRef list) = - match bulkAddMode with - | BulkAdd.Yes -> - let items = - ucrefs |> Array.ofList |> Array.map (fun ucref -> - let item = Item.UnionCase(GeneralizeUnionCaseRef ucref,false) - KeyValuePair(ucref.CaseName,item)) +/// Add a set of union cases to the corresponding sub-table of the environment +let AddUnionCases2 bulkAddMode (eUnqualifiedItems: LayeredMap<_, _>) (ucrefs :UnionCaseRef list) = + match bulkAddMode with + | BulkAdd.Yes -> + let items = + ucrefs |> Array.ofList |> Array.map (fun ucref -> + let item = Item.UnionCase(GeneralizeUnionCaseRef ucref, false) + KeyValuePair(ucref.CaseName, item)) eUnqualifiedItems.AddAndMarkAsCollapsible items - | BulkAdd.No -> - (eUnqualifiedItems,ucrefs) ||> List.fold (fun acc ucref -> - let item = Item.UnionCase(GeneralizeUnionCaseRef ucref,false) + | BulkAdd.No -> + (eUnqualifiedItems, ucrefs) ||> List.fold (fun acc ucref -> + let item = Item.UnionCase(GeneralizeUnionCaseRef ucref, false) acc.Add (ucref.CaseName, item)) /// Add any implied contents of a type definition to the environment. -let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g:TcGlobals) amap m nenv (tcref:TyconRef) = +let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g:TcGlobals) amap m nenv (tcref:TyconRef) = let isIL = tcref.IsILTycon - let ucrefs = if isIL then [] else tcref.UnionCasesAsList |> List.map tcref.MakeNestedUnionCaseRef + let ucrefs = if isIL then [] else tcref.UnionCasesAsList |> List.map tcref.MakeNestedUnionCaseRef let flds = if isIL then [| |] else tcref.AllFieldsArray - let eIndexedExtensionMembers, eUnindexedExtensionMembers = - let ilStyleExtensionMeths = GetCSharpStyleIndexedExtensionMembersForTyconRef amap m tcref - ((nenv.eIndexedExtensionMembers,nenv.eUnindexedExtensionMembers),ilStyleExtensionMeths) ||> List.fold (fun (tab1,tab2) extMemInfo -> - match extMemInfo with - | Choice1Of2 (tcref,extMemInfo) -> tab1.Add (tcref, extMemInfo), tab2 - | Choice2Of2 extMemInfo -> tab1, extMemInfo :: tab2) + let eIndexedExtensionMembers, eUnindexedExtensionMembers = + let ilStyleExtensionMeths = GetCSharpStyleIndexedExtensionMembersForTyconRef amap m tcref + ((nenv.eIndexedExtensionMembers, nenv.eUnindexedExtensionMembers), ilStyleExtensionMeths) ||> List.fold (fun (tab1, tab2) extMemInfo -> + match extMemInfo with + | Choice1Of2 (tcref, extMemInfo) -> tab1.Add (tcref, extMemInfo), tab2 + | Choice2Of2 extMemInfo -> tab1, extMemInfo :: tab2) let isILOrRequiredQualifiedAccess = isIL || (not ownDefinition && HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute tcref.Attribs) - let eFieldLabels = - if isILOrRequiredQualifiedAccess || not tcref.IsRecordTycon || flds.Length = 0 then - nenv.eFieldLabels - else - (nenv.eFieldLabels,flds) ||> Array.fold (fun acc f -> - if f.IsStatic || f.IsCompilerGenerated then acc + let eFieldLabels = + if isILOrRequiredQualifiedAccess || not tcref.IsRecordTycon || flds.Length = 0 then + nenv.eFieldLabels + else + (nenv.eFieldLabels, flds) ||> Array.fold (fun acc f -> + if f.IsStatic || f.IsCompilerGenerated then acc else AddRecdField (tcref.MakeNestedRecdFieldRef f) acc) - - let eUnqualifiedItems = + + let eUnqualifiedItems = let tab = nenv.eUnqualifiedItems // add the type name for potential use as a constructor // The rules are - // - The unqualified lookup table in the environment can contain map names to a set of type names (the set of type names is a new kind of "item"). + // - The unqualified lookup table in the environment can contain map names to a set of type names (the set of type names is a new kind of "item"). // - When the contents of a type definition is added to the environment, an entry is added in this table for all class and struct types. - // - When opening a module, types are added first to the environment, then values, then auto-opened sub-modules. - // - When a value is added by an "open" previously available type names will become inaccessible by this table. - let tab = + // - When opening a module, types are added first to the environment, then values, then auto-opened sub-modules. + // - When a value is added by an "open" previously available type names will become inaccessible by this table. + let tab = // This may explore into an unreferenced assembly if the name // is a type abbreviation. If it does, assume the name does not // have a constructor. - let mayHaveConstruction = - protectAssemblyExploration - false - (fun () -> + let mayHaveConstruction = + protectAssemblyExploration + false + (fun () -> let ty = generalizedTyconRef tcref isClassTy g ty || isStructTy g ty) - if mayHaveConstruction then + if mayHaveConstruction then tab.LinearTryModifyThenLaterFlatten (tcref.DisplayName, (fun prev -> - match prev with + match prev with | Some (Item.UnqualifiedType tcrefs) -> Item.UnqualifiedType (tcref::tcrefs) | _ -> Item.UnqualifiedType [tcref])) else tab - if isILOrRequiredQualifiedAccess || List.isEmpty ucrefs then - tab - else + if isILOrRequiredQualifiedAccess || List.isEmpty ucrefs then + tab + else AddUnionCases2 bulkAddMode tab ucrefs - let ePatItems = - if isILOrRequiredQualifiedAccess || List.isEmpty ucrefs then - nenv.ePatItems - else + let ePatItems = + if isILOrRequiredQualifiedAccess || List.isEmpty ucrefs then + nenv.ePatItems + else AddUnionCases1 nenv.ePatItems ucrefs - { nenv with + { nenv with eFieldLabels = eFieldLabels eUnqualifiedItems = eUnqualifiedItems ePatItems = ePatItems - eIndexedExtensionMembers = eIndexedExtensionMembers + eIndexedExtensionMembers = eIndexedExtensionMembers eUnindexedExtensionMembers = eUnindexedExtensionMembers } -/// Add a set of type definitions to the name resolution environment +/// Add a set of type definitions to the name resolution environment let AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap m root nenv tcrefs = if isNil tcrefs then nenv else let env = List.fold (AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition g amap m) nenv tcrefs // Add most of the contents of the tycons en-masse, then flatten the tables if we're opening a module or namespace let tcrefs = Array.ofList tcrefs { env with - eFullyQualifiedTyconsByDemangledNameAndArity = - if root then + eFullyQualifiedTyconsByDemangledNameAndArity = + if root then AddTyconsByDemangledNameAndArity bulkAddMode tcrefs nenv.eFullyQualifiedTyconsByDemangledNameAndArity - else + else nenv.eFullyQualifiedTyconsByDemangledNameAndArity - eFullyQualifiedTyconsByAccessNames = - if root then + eFullyQualifiedTyconsByAccessNames = + if root then AddTyconByAccessNames bulkAddMode tcrefs nenv.eFullyQualifiedTyconsByAccessNames else nenv.eFullyQualifiedTyconsByAccessNames - eTyconsByDemangledNameAndArity = - AddTyconsByDemangledNameAndArity bulkAddMode tcrefs nenv.eTyconsByDemangledNameAndArity - eTyconsByAccessNames = - AddTyconByAccessNames bulkAddMode tcrefs nenv.eTyconsByAccessNames } + eTyconsByDemangledNameAndArity = + AddTyconsByDemangledNameAndArity bulkAddMode tcrefs nenv.eTyconsByDemangledNameAndArity + eTyconsByAccessNames = + AddTyconByAccessNames bulkAddMode tcrefs nenv.eTyconsByAccessNames } -/// Add an F# exception definition to the name resolution environment -let AddExceptionDeclsToNameEnv bulkAddMode nenv (ecref:TyconRef) = +/// Add an F# exception definition to the name resolution environment +let AddExceptionDeclsToNameEnv bulkAddMode nenv (ecref:TyconRef) = assert ecref.IsExceptionDecl let item = Item.ExnCase ecref - {nenv with + {nenv with eUnqualifiedItems = - match bulkAddMode with - | BulkAdd.Yes -> + match bulkAddMode with + | BulkAdd.Yes -> nenv.eUnqualifiedItems.AddAndMarkAsCollapsible [| KeyValuePair(ecref.LogicalName, item) |] - | BulkAdd.No -> + | BulkAdd.No -> nenv.eUnqualifiedItems.Add (ecref.LogicalName, item) - + ePatItems = nenv.ePatItems.Add (ecref.LogicalName, item) } -/// Add a module abbreviation to the name resolution environment +/// Add a module abbreviation to the name resolution environment let AddModuleAbbrevToNameEnv (id:Ident) nenv modrefs = {nenv with eModulesAndNamespaces = @@ -742,11 +742,11 @@ let AddModuleAbbrevToNameEnv (id:Ident) nenv modrefs = //------------------------------------------------------------------------- -// Open a structure or an IL namespace -//------------------------------------------------------------------------- +// Open a structure or an IL namespace +//------------------------------------------------------------------------- -let MakeNestedModuleRefs (modref: ModuleOrNamespaceRef) = - modref.ModuleOrNamespaceType.ModuleAndNamespaceDefinitions +let MakeNestedModuleRefs (modref: ModuleOrNamespaceRef) = + modref.ModuleOrNamespaceType.ModuleAndNamespaceDefinitions |> List.map modref.NestedTyconRef /// Add a set of module or namespace to the name resolution environment, including any sub-modules marked 'AutoOpen' @@ -755,58 +755,58 @@ let MakeNestedModuleRefs (modref: ModuleOrNamespaceRef) = let rec AddModuleOrNamespaceRefsToNameEnv g amap m root ad nenv (modrefs: ModuleOrNamespaceRef list) = if isNil modrefs then nenv else let modrefsMap = modrefs |> NameMap.ofKeyedList (fun modref -> modref.DemangledModuleOrNamespaceName) - let addModrefs tab = - let add old nw = - if IsEntityAccessible amap m ad nw then + let addModrefs tab = + let add old nw = + if IsEntityAccessible amap m ad nw then nw :: old - else + else old NameMap.layerAdditive add modrefsMap tab - let nenv = + let nenv = {nenv with eModulesAndNamespaces = addModrefs nenv.eModulesAndNamespaces eFullyQualifiedModulesAndNamespaces = - if root then + if root then addModrefs nenv.eFullyQualifiedModulesAndNamespaces - else - nenv.eFullyQualifiedModulesAndNamespaces } - let nenv = - (nenv,modrefs) ||> List.fold (fun nenv modref -> + else + nenv.eFullyQualifiedModulesAndNamespaces } + let nenv = + (nenv, modrefs) ||> List.fold (fun nenv modref -> if modref.IsModule && TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute modref.Attribs = Some true then - AddModuleOrNamespaceContentsToNameEnv g amap ad m false nenv modref + AddModuleOrNamespaceContentsToNameEnv g amap ad m false nenv modref else nenv) nenv /// Add the contents of a module or namespace to the name resolution environment -and AddModuleOrNamespaceContentsToNameEnv (g:TcGlobals) amap (ad:AccessorDomain) m root nenv (modref:ModuleOrNamespaceRef) = +and AddModuleOrNamespaceContentsToNameEnv (g:TcGlobals) amap (ad:AccessorDomain) m root nenv (modref:ModuleOrNamespaceRef) = let pri = NextExtensionMethodPriority() let mty = modref.ModuleOrNamespaceType - + let nenv = let mutable state = { nenv with eDisplayEnv = nenv.eDisplayEnv.AddOpenModuleOrNamespace modref } - + for exnc in mty.ExceptionDefinitions do let tcref = modref.NestedTyconRef exnc - if IsEntityAccessible amap m ad tcref then + if IsEntityAccessible amap m ad tcref then state <- AddExceptionDeclsToNameEnv BulkAdd.Yes state tcref state - let tcrefs = - mty.TypeAndExceptionDefinitions - |> List.choose (fun tycon -> + let tcrefs = + mty.TypeAndExceptionDefinitions + |> List.choose (fun tycon -> let tcref = modref.NestedTyconRef tycon if IsEntityAccessible amap m ad tcref then Some(tcref) else None) - let nenv = (nenv,tcrefs) ||> AddTyconRefsToNameEnv BulkAdd.Yes false g amap m false - let vrefs = - mty.AllValsAndMembers.ToList() + let nenv = (nenv, tcrefs) ||> AddTyconRefsToNameEnv BulkAdd.Yes false g amap m false + let vrefs = + mty.AllValsAndMembers.ToList() |> List.choose (fun x -> if IsAccessible ad x.Accessibility then TryMkValRefInModRef modref x else None) |> List.toArray let nenv = AddValRefsToNameEnvWithPriority BulkAdd.Yes pri nenv vrefs let nestedModules = MakeNestedModuleRefs modref - let nenv = (nenv,nestedModules) ||> AddModuleOrNamespaceRefsToNameEnv g amap m root ad + let nenv = (nenv, nestedModules) ||> AddModuleOrNamespaceRefsToNameEnv g amap m root ad nenv /// Add a set of modules or namespaces to the name resolution environment @@ -815,58 +815,58 @@ and AddModuleOrNamespaceContentsToNameEnv (g:TcGlobals) amap (ad:AccessorDomain) // module M1 = ... // M1a // module M1 = ... // M1b // open M1 -// +// // The list contains [M1b; M1a] and AddModulesAndNamespacesContentsToNameEnv g amap ad m root nenv modrefs = (modrefs, nenv) ||> List.foldBack (fun modref acc -> AddModuleOrNamespaceContentsToNameEnv g amap ad m root acc modref) /// Add a single modules or namespace to the name resolution environment -let AddModuleOrNamespaceRefToNameEnv g amap m root ad nenv (modref:EntityRef) = - AddModuleOrNamespaceRefsToNameEnv g amap m root ad nenv [modref] +let AddModuleOrNamespaceRefToNameEnv g amap m root ad nenv (modref:EntityRef) = + AddModuleOrNamespaceRefsToNameEnv g amap m root ad nenv [modref] + - /// A flag which indicates if it is an error to have two declared type parameters with identical names /// in the name resolution environment. -type CheckForDuplicateTyparFlag = - | CheckForDuplicateTypars +type CheckForDuplicateTyparFlag = + | CheckForDuplicateTypars | NoCheckForDuplicateTypars /// Add some declared type parameters to the name resolution environment -let AddDeclaredTyparsToNameEnv check nenv typars = - let typarmap = - List.foldBack - (fun (tp:Typar) sofar -> +let AddDeclaredTyparsToNameEnv check nenv typars = + let typarmap = + List.foldBack + (fun (tp:Typar) sofar -> match check with - | CheckForDuplicateTypars -> - if Map.containsKey tp.Name sofar then - errorR (Duplicate("type parameter",tp.DisplayName,tp.Range)) + | CheckForDuplicateTypars -> + if Map.containsKey tp.Name sofar then + errorR (Duplicate("type parameter", tp.DisplayName, tp.Range)) | NoCheckForDuplicateTypars -> () - Map.add tp.Name tp sofar) typars Map.empty + Map.add tp.Name tp sofar) typars Map.empty {nenv with eTypars = NameMap.layer typarmap nenv.eTypars } //------------------------------------------------------------------------- // Generating fresh instantiations for type inference. -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- /// Convert a reference to a named type into a type that includes /// a fresh set of inference type variables for the type parameters of the union type. -let FreshenTycon (ncenv: NameResolver) m (tcref:TyconRef) = +let FreshenTycon (ncenv: NameResolver) m (tcref:TyconRef) = let tinst = ncenv.InstantiationGenerator m (tcref.Typars m) let improvedTy = ncenv.g.decompileType tcref tinst improvedTy /// Convert a reference to a union case into a UnionCaseInfo that includes /// a fresh set of inference type variables for the type parameters of the union type. -let FreshenUnionCaseRef (ncenv: NameResolver) m (ucref:UnionCaseRef) = +let FreshenUnionCaseRef (ncenv: NameResolver) m (ucref:UnionCaseRef) = let tinst = ncenv.InstantiationGenerator m (ucref.TyconRef.Typars m) - UnionCaseInfo(tinst,ucref) + UnionCaseInfo(tinst, ucref) /// This must be called after fetching unqualified items that may need to be freshened -let FreshenUnqualifiedItem (ncenv: NameResolver) m res = - match res with - | Item.UnionCase(UnionCaseInfo(_,ucref),_) -> Item.UnionCase(FreshenUnionCaseRef ncenv m ucref,false) +let FreshenUnqualifiedItem (ncenv: NameResolver) m res = + match res with + | Item.UnionCase(UnionCaseInfo(_, ucref), _) -> Item.UnionCase(FreshenUnionCaseRef ncenv m ucref, false) | _ -> res @@ -876,39 +876,39 @@ let FreshenUnqualifiedItem (ncenv: NameResolver) m res = // define some ways of combining multiple results and for carrying // error information. Errors are generally undefined names and are // reported by returning the error that occurs at greatest depth in the -// sequence of Identifiers. -//------------------------------------------------------------------------- - -// Accumulate a set of possible results. -// If neither operations succeed, return an approximate error. -// If one succeeds, return that one. -// Prefer the error associated with the first argument. -let OneResult res = - match res with +// sequence of Identifiers. +//------------------------------------------------------------------------- + +// Accumulate a set of possible results. +// If neither operations succeed, return an approximate error. +// If one succeeds, return that one. +// Prefer the error associated with the first argument. +let OneResult res = + match res with | Result x -> Result [x] | Exception e -> Exception e let OneSuccess x = Result [x] let AddResults res1 res2 = - match res1, res2 with - | Result [],_ -> res2 - | _,Result [] -> res1 - | Result x,Result l -> Result (x @ l) - | Exception _,Result l -> Result l - | Result x,Exception _ -> Result x + match res1, res2 with + | Result [], _ -> res2 + | _, Result [] -> res1 + | Result x, Result l -> Result (x @ l) + | Exception _, Result l -> Result l + | Result x, Exception _ -> Result x // If we have error messages for the same symbol, then we can merge suggestions. - | Exception (UndefinedName(n1,f,id1,suggestions1)),Exception (UndefinedName(n2,_,id2,suggestions2)) when n1 = n2 && id1.idText = id2.idText && Range.equals id1.idRange id2.idRange -> + | Exception (UndefinedName(n1, f, id1, suggestions1)), Exception (UndefinedName(n2, _, id2, suggestions2)) when n1 = n2 && id1.idText = id2.idText && Range.equals id1.idRange id2.idRange -> let suggestions = HashSet(suggestions1()) suggestions.UnionWith(suggestions2()) - Exception(UndefinedName(n1,f,id1,fun () -> suggestions)) - // This prefers error messages coming from deeper failing long identifier paths - | Exception (UndefinedName(n1,_,_,_) as e1),Exception (UndefinedName(n2,_,_,_) as e2) -> + Exception(UndefinedName(n1, f, id1, fun () -> suggestions)) + // This prefers error messages coming from deeper failing long identifier paths + | Exception (UndefinedName(n1, _, _, _) as e1), Exception (UndefinedName(n2, _, _, _) as e2) -> if n1 < n2 then Exception e2 else Exception e1 - // Prefer more concrete errors about things being undefined - | Exception (UndefinedName _ as e1),Exception (Error _) -> Exception e1 - | Exception (Error _),Exception (UndefinedName _ as e2) -> Exception e2 - | Exception e1,Exception _ -> Exception e1 + // Prefer more concrete errors about things being undefined + | Exception (UndefinedName _ as e1), Exception (Error _) -> Exception e1 + | Exception (Error _), Exception (UndefinedName _ as e2) -> Exception e2 + | Exception e1, Exception _ -> Exception e1 let NoResultsOrUsefulErrors = Result [] @@ -931,7 +931,7 @@ let rec CollectAtMostOneResult f = function | Result r -> Result [r] | Exception e -> AddResults (Exception e) (CollectAtMostOneResult f t) -let CollectResults2 resultCollectionSettings f = +let CollectResults2 resultCollectionSettings f = match resultCollectionSettings with | ResultCollectionSettings.AtMostOneResult -> CollectAtMostOneResult f | _ -> CollectResults f @@ -940,10 +940,10 @@ let MapResults f = function | Result xs -> Result (List.map f xs) | Exception err -> Exception err -let AtMostOneResult m res = - match res with +let AtMostOneResult m res = + match res with | Exception err -> raze err - | Result [] -> raze (Error(FSComp.SR.nrInvalidModuleExprType(),m)) + | Result [] -> raze (Error(FSComp.SR.nrInvalidModuleExprType(), m)) | Result (res :: _) -> success res let AtMostOneResultQuery query2 res1 = @@ -956,22 +956,22 @@ let inline (+++) res1 query2 = AtMostOneResultQuery query2 res1 //------------------------------------------------------------------------- // TypeNameResolutionInfo -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- /// Indicates whether we are resolving type names to type definitions or to constructor methods. -type TypeNameResolutionFlag = - | ResolveTypeNamesToCtors +type TypeNameResolutionFlag = + | ResolveTypeNamesToCtors | ResolveTypeNamesToTypeRefs [] [] -/// Represents information about the generic argument count of a type name when resolving it. +/// Represents information about the generic argument count of a type name when resolving it. /// /// In some situations we resolve "List" to any type definition with that name regardless of the number /// of generic arguments. In others, we know precisely how many generic arguments are needed. -type TypeNameResolutionStaticArgsInfo = +type TypeNameResolutionStaticArgsInfo = /// Indicates indefinite knowledge of type arguments - | Indefinite + | Indefinite /// Indicates definite knowledge of type arguments | Definite of int @@ -985,69 +985,69 @@ type TypeNameResolutionStaticArgsInfo = member x.NumStaticArgs = match x with TypeNameResolutionStaticArgsInfo.Indefinite -> 0 | TypeNameResolutionStaticArgsInfo.Definite n -> n // Get the first possible mangled name of the type, assuming the args are generic args - member x.MangledNameForType nm = + member x.MangledNameForType nm = if x.NumStaticArgs = 0 || TryDemangleGenericNameAndPos nm <> ValueNone then nm else nm + "`" + string x.NumStaticArgs [] /// Represents information which guides name resolution of types. -type TypeNameResolutionInfo = +type TypeNameResolutionInfo = | TypeNameResolutionInfo of TypeNameResolutionFlag * TypeNameResolutionStaticArgsInfo - static member Default = TypeNameResolutionInfo (ResolveTypeNamesToCtors,TypeNameResolutionStaticArgsInfo.Indefinite) - static member ResolveToTypeRefs statResInfo = TypeNameResolutionInfo (ResolveTypeNamesToTypeRefs,statResInfo) - member x.StaticArgsInfo = match x with TypeNameResolutionInfo(_,staticResInfo) -> staticResInfo - member x.ResolutionFlag = match x with TypeNameResolutionInfo(flag,_) -> flag - member x.DropStaticArgsInfo = match x with TypeNameResolutionInfo(flag2,_) -> TypeNameResolutionInfo(flag2,TypeNameResolutionStaticArgsInfo.Indefinite) + static member Default = TypeNameResolutionInfo (ResolveTypeNamesToCtors, TypeNameResolutionStaticArgsInfo.Indefinite) + static member ResolveToTypeRefs statResInfo = TypeNameResolutionInfo (ResolveTypeNamesToTypeRefs, statResInfo) + member x.StaticArgsInfo = match x with TypeNameResolutionInfo(_, staticResInfo) -> staticResInfo + member x.ResolutionFlag = match x with TypeNameResolutionInfo(flag, _) -> flag + member x.DropStaticArgsInfo = match x with TypeNameResolutionInfo(flag2, _) -> TypeNameResolutionInfo(flag2, TypeNameResolutionStaticArgsInfo.Indefinite) //------------------------------------------------------------------------- -// Resolve (possibly mangled) type names -//------------------------------------------------------------------------- - -/// Qualified lookups of type names where the number of generic arguments is known -/// from context, e.g. Module.Type. The full names suh as ``List`1`` can -/// be used to qualify access if needed -let LookupTypeNameInEntityHaveArity nm (staticResInfo: TypeNameResolutionStaticArgsInfo) (mty:ModuleOrNamespaceType) = +// Resolve (possibly mangled) type names +//------------------------------------------------------------------------- + +/// Qualified lookups of type names where the number of generic arguments is known +/// from context, e.g. Module.Type. The full names suh as ``List`1`` can +/// be used to qualify access if needed +let LookupTypeNameInEntityHaveArity nm (staticResInfo: TypeNameResolutionStaticArgsInfo) (mty:ModuleOrNamespaceType) = let attempt1 = mty.TypesByMangledName.TryFind (staticResInfo.MangledNameForType nm) match attempt1 with | None -> mty.TypesByMangledName.TryFind nm | _ -> attempt1 -/// Unqualified lookups of type names where the number of generic arguments is known +/// Unqualified lookups of type names where the number of generic arguments is known /// from context, e.g. List. Rebindings due to 'open' may have rebound identifiers. -let LookupTypeNameInEnvHaveArity fq nm numTyArgs (nenv:NameResolutionEnv) = +let LookupTypeNameInEnvHaveArity fq nm numTyArgs (nenv:NameResolutionEnv) = let key = match TryDemangleGenericNameAndPos nm with | ValueSome pos -> DecodeGenericTypeName pos nm - | _ -> NameArityPair(nm,numTyArgs) + | _ -> NameArityPair(nm, numTyArgs) match nenv.TyconsByDemangledNameAndArity(fq).TryFind key with | None -> nenv.TyconsByAccessNames(fq).TryFind nm |> Option.map List.head | res -> res -/// Implements unqualified lookups of type names where the number of generic arguments is NOT known -/// from context. +/// Implements unqualified lookups of type names where the number of generic arguments is NOT known +/// from context. // -// This is used in five places: -// - static member lookups, e.g. MyType.StaticMember(3) -// - e.g. MyModule.MyType.StaticMember(3) -// - type-qualified field names, e.g. { RecordType.field = 3 } -// - type-qualified constructor names, e.g. match x with UnionType.A -> 3 -// - identifiers to constructors for better error messages, e.g. 'String(3)' after 'open System' +// This is used in five places: +// - static member lookups, e.g. MyType.StaticMember(3) +// - e.g. MyModule.MyType.StaticMember(3) +// - type-qualified field names, e.g. { RecordType.field = 3 } +// - type-qualified constructor names, e.g. match x with UnionType.A -> 3 +// - identifiers to constructors for better error messages, e.g. 'String(3)' after 'open System' // - the special single-constructor rule in TcTyconCores -// -// Because of the potential ambiguity multiple results can be returned. -// Explicit type annotations can be added where needed to specify the generic arity. -// -// In theory the full names such as ``RecordType`1`` can -// also be used to qualify access if needed, though this is almost never needed. - -let LookupTypeNameNoArity nm (byDemangledNameAndArity: LayeredMap) (byAccessNames: LayeredMultiMap) = +// +// Because of the potential ambiguity multiple results can be returned. +// Explicit type annotations can be added where needed to specify the generic arity. +// +// In theory the full names such as ``RecordType`1`` can +// also be used to qualify access if needed, though this is almost never needed. + +let LookupTypeNameNoArity nm (byDemangledNameAndArity: LayeredMap) (byAccessNames: LayeredMultiMap) = match TryDemangleGenericNameAndPos nm with - | ValueSome pos -> + | ValueSome pos -> let demangled = DecodeGenericTypeName pos nm - match byDemangledNameAndArity.TryGetValue demangled with + match byDemangledNameAndArity.TryGetValue demangled with | true, res -> [res] | _ -> match byAccessNames.TryGetValue nm with @@ -1057,47 +1057,47 @@ let LookupTypeNameNoArity nm (byDemangledNameAndArity: LayeredMap Option.toList /// A flag which indicates if direct references to generated provided types are allowed. Normally these /// are disallowed. [] -type PermitDirectReferenceToGeneratedType = - | Yes +type PermitDirectReferenceToGeneratedType = + | Yes | No - + #if !NO_EXTENSIONTYPING /// Check for direct references to generated provided types. let CheckForDirectReferenceToGeneratedType (tcref: TyconRef, genOk, m) = - match genOk with + match genOk with | PermitDirectReferenceToGeneratedType.Yes -> () - | PermitDirectReferenceToGeneratedType.No -> - match tcref.TypeReprInfo with - | TProvidedTypeExtensionPoint info when not info.IsErased -> + | PermitDirectReferenceToGeneratedType.No -> + match tcref.TypeReprInfo with + | TProvidedTypeExtensionPoint info when not info.IsErased -> //printfn "checking direct reference to generated type '%s'" tcref.DisplayName - if ExtensionTyping.IsGeneratedTypeDirectReference (info.ProvidedType, m) then - error (Error(FSComp.SR.etDirectReferenceToGeneratedTypeNotAllowed(tcref.DisplayName),m)) + if ExtensionTyping.IsGeneratedTypeDirectReference (info.ProvidedType, m) then + error (Error(FSComp.SR.etDirectReferenceToGeneratedTypeNotAllowed(tcref.DisplayName), m)) | _ -> () /// This adds a new entity for a lazily discovered provided type into the TAST structure. -let AddEntityForProvidedType (amap: Import.ImportMap, modref: ModuleOrNamespaceRef, resolutionEnvironment, st:Tainted, m) = +let AddEntityForProvidedType (amap: Import.ImportMap, modref: ModuleOrNamespaceRef, resolutionEnvironment, st:Tainted, m) = let importProvidedType t = Import.ImportProvidedType amap m t - let isSuppressRelocate = amap.g.isInteractive || st.PUntaint((fun st -> st.IsSuppressRelocate),m) + let isSuppressRelocate = amap.g.isInteractive || st.PUntaint((fun st -> st.IsSuppressRelocate), m) let tycon = Construct.NewProvidedTycon(resolutionEnvironment, st, importProvidedType, isSuppressRelocate, m) modref.ModuleOrNamespaceType.AddProvidedTypeEntity(tycon) let tcref = modref.NestedTyconRef tycon @@ -1107,13 +1107,13 @@ let AddEntityForProvidedType (amap: Import.ImportMap, modref: ModuleOrNamespaceR /// Given a provided type or provided namespace, resolve the type name using the type provider API. /// If necessary, incorporate the provided type or namespace into the entity. -let ResolveProvidedTypeNameInEntity (amap, m, typeName, modref: ModuleOrNamespaceRef) = +let ResolveProvidedTypeNameInEntity (amap, m, typeName, modref: ModuleOrNamespaceRef) = match modref.TypeReprInfo with - | TProvidedNamespaceExtensionPoint(resolutionEnvironment,resolvers) -> + | TProvidedNamespaceExtensionPoint(resolutionEnvironment, resolvers) -> match modref.Deref.PublicPath with | Some(PubPath path) -> - resolvers - |> List.choose (fun r-> ExtensionTyping.TryResolveProvidedType(r,m,path,typeName)) + resolvers + |> List.choose (fun r-> ExtensionTyping.TryResolveProvidedType(r, m, path, typeName)) |> List.map (fun st -> AddEntityForProvidedType (amap, modref, resolutionEnvironment, st, m)) | None -> [] @@ -1121,37 +1121,37 @@ let ResolveProvidedTypeNameInEntity (amap, m, typeName, modref: ModuleOrNamespac | TProvidedTypeExtensionPoint info -> let sty = info.ProvidedType let resolutionEnvironment = info.ResolutionEnvironment - + #if DEBUG if resolutionEnvironment.showResolutionMessages then dprintfn "resolving name '%s' in TProvidedTypeExtensionPoint '%s'" typeName (sty.PUntaint((fun sty -> sty.FullName), m)) #endif match sty.PApply((fun sty -> sty.GetNestedType(typeName)), m) with - | Tainted.Null -> - //if staticResInfo.NumStaticArgs > 0 then - // error(Error(FSComp.SR.etNestedProvidedTypesDoNotTakeStaticArgumentsOrGenericParameters(),m)) + | Tainted.Null -> + //if staticResInfo.NumStaticArgs > 0 then + // error(Error(FSComp.SR.etNestedProvidedTypesDoNotTakeStaticArgumentsOrGenericParameters(), m)) [] - | nestedSty -> + | nestedSty -> [AddEntityForProvidedType (amap, modref, resolutionEnvironment, nestedSty, m) ] | _ -> [] #endif /// Lookup a type name in an entity. -let LookupTypeNameInEntityMaybeHaveArity (amap, m, ad, nm, staticResInfo:TypeNameResolutionStaticArgsInfo, modref: ModuleOrNamespaceRef) = - let mtyp = modref.ModuleOrNamespaceType - let tcrefs = - match staticResInfo with - | TypeNameResolutionStaticArgsInfo.Indefinite -> +let LookupTypeNameInEntityMaybeHaveArity (amap, m, ad, nm, staticResInfo:TypeNameResolutionStaticArgsInfo, modref: ModuleOrNamespaceRef) = + let mtyp = modref.ModuleOrNamespaceType + let tcrefs = + match staticResInfo with + | TypeNameResolutionStaticArgsInfo.Indefinite -> LookupTypeNameInEntityNoArity m nm mtyp - |> List.map modref.NestedTyconRef - | TypeNameResolutionStaticArgsInfo.Definite _ -> + |> List.map modref.NestedTyconRef + | TypeNameResolutionStaticArgsInfo.Definite _ -> match LookupTypeNameInEntityHaveArity nm staticResInfo mtyp with - | Some tycon -> [modref.NestedTyconRef tycon] + | Some tycon -> [modref.NestedTyconRef tycon] | None -> [] #if !NO_EXTENSIONTYPING let tcrefs = - match tcrefs with + match tcrefs with | [] -> ResolveProvidedTypeNameInEntity (amap, m, nm, modref) | _ -> tcrefs #else @@ -1163,9 +1163,9 @@ let LookupTypeNameInEntityMaybeHaveArity (amap, m, ad, nm, staticResInfo:TypeNam /// Make a type that refers to a nested type. /// -/// Handle the .NET/C# business where nested generic types implicitly accumulate the type parameters +/// Handle the .NET/C# business where nested generic types implicitly accumulate the type parameters /// from their enclosing types. -let MakeNestedType (ncenv:NameResolver) (tinst:TType list) m (tcrefNested:TyconRef) = +let MakeNestedType (ncenv:NameResolver) (tinst:TType list) m (tcrefNested:TyconRef) = let tps = List.drop tinst.Length (tcrefNested.Typars m) let tinstNested = ncenv.InstantiationGenerator m tps mkAppTy tcrefNested (tinst @ tinstNested) @@ -1173,72 +1173,72 @@ let MakeNestedType (ncenv:NameResolver) (tinst:TType list) m (tcrefNested:TyconR /// Get all the accessible nested types of an existing type. let GetNestedTypesOfType (ad, ncenv:NameResolver, optFilter, staticResInfo, checkForGenerated, m) ty = let g = ncenv.g - ncenv.InfoReader.GetPrimaryTypeHierachy(AllowMultiIntfInstantiations.Yes,m,ty) |> List.collect (fun ty -> - match ty with - | AppTy g (tcref,tinst) -> + ncenv.InfoReader.GetPrimaryTypeHierachy(AllowMultiIntfInstantiations.Yes, m, ty) |> List.collect (fun ty -> + match ty with + | AppTy g (tcref, tinst) -> let tycon = tcref.Deref let mty = tycon.ModuleOrNamespaceType // No dotting through type generators to get to a nested type! #if !NO_EXTENSIONTYPING - if checkForGenerated then + if checkForGenerated then CheckForDirectReferenceToGeneratedType (tcref, PermitDirectReferenceToGeneratedType.No, m) #else checkForGenerated |> ignore #endif - match optFilter with - | Some nm -> + match optFilter with + | Some nm -> let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, m, ad, nm, staticResInfo, tcref) - tcrefs |> List.map (MakeNestedType ncenv tinst m) - | None -> + tcrefs |> List.map (MakeNestedType ncenv tinst m) + | None -> #if !NO_EXTENSIONTYPING - match tycon.TypeReprInfo with + match tycon.TypeReprInfo with | TProvidedTypeExtensionPoint info -> - [ for nestedType in info.ProvidedType.PApplyArray((fun sty -> sty.GetNestedTypes()), "GetNestedTypes", m) do + [ for nestedType in info.ProvidedType.PApplyArray((fun sty -> sty.GetNestedTypes()), "GetNestedTypes", m) do let nestedTypeName = nestedType.PUntaint((fun t -> t.Name), m) for nestedTcref in LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, m, ad, nestedTypeName, staticResInfo, tcref) do yield MakeNestedType ncenv tinst m nestedTcref ] - - | _ -> + + | _ -> #endif mty.TypesByAccessNames.Values - |> List.choose (fun entity -> + |> List.choose (fun entity -> let ty = tcref.NestedTyconRef entity |> MakeNestedType ncenv tinst m if IsTypeAccessible g ncenv.amap m ad ty then Some ty else None) | _ -> []) //------------------------------------------------------------------------- -// Report environments to visual studio. We stuff intermediary results -// into a global variable. A little unpleasant. -//------------------------------------------------------------------------- +// Report environments to visual studio. We stuff intermediary results +// into a global variable. A little unpleasant. +//------------------------------------------------------------------------- /// Represents the kind of the occurrence when reporting a name in name resolution [] -type ItemOccurence = +type ItemOccurence = /// This is a binding / declaration of the item - | Binding - /// This is a usage of the item - | Use + | Binding + /// This is a usage of the item + | Use /// This is a usage of a type name in a type - | UseInType + | UseInType /// This is a usage of a type name in an attribute - | UseInAttribute + | UseInAttribute /// Inside pattern matching - | Pattern + | Pattern /// Abstract slot gets implemented | Implemented /// Result gets suppressed over this text range | RelatedText /// This is a usage of a module or namespace name in open statement | Open - + type OpenDeclaration = { LongId: Ident list Range: range option - Modules: ModuleOrNamespaceRef list - AppliedScope: range + Modules: ModuleOrNamespaceRef list + AppliedScope: range IsOwnNamespace: bool } - + static member Create(longId: Ident list, modules: ModuleOrNamespaceRef list, appliedScope: range, isOwnNamespace: bool) = { LongId = longId Range = @@ -1269,89 +1269,89 @@ let (|ValRefOfProp|_|) (pi : PropInfo) = pi.ArbitraryValRef let (|ValRefOfMeth|_|) (mi : MethInfo) = mi.ArbitraryValRef let (|ValRefOfEvent|_|) (evt : EventInfo) = evt.ArbitraryValRef -let rec (|RecordFieldUse|_|) (item : Item) = +let rec (|RecordFieldUse|_|) (item : Item) = match item with | Item.RecdField(RecdFieldInfo(_, RFRef(tcref, name))) -> Some (name, tcref) | Item.SetterArg(_, RecordFieldUse(f)) -> Some(f) | _ -> None -let rec (|ILFieldUse|_|) (item : Item) = +let rec (|ILFieldUse|_|) (item : Item) = match item with | Item.ILField(finfo) -> Some(finfo) | Item.SetterArg(_, ILFieldUse(f)) -> Some(f) | _ -> None -let rec (|PropertyUse|_|) (item : Item) = +let rec (|PropertyUse|_|) (item : Item) = match item with | Item.Property(_, pinfo::_) -> Some(pinfo) | Item.SetterArg(_, PropertyUse(pinfo)) -> Some(pinfo) | _ -> None -let rec (|FSharpPropertyUse|_|) (item : Item) = +let rec (|FSharpPropertyUse|_|) (item : Item) = match item with | Item.Property(_, [ValRefOfProp vref]) -> Some(vref) | Item.SetterArg(_, FSharpPropertyUse(propDef)) -> Some(propDef) | _ -> None -let (|MethodUse|_|) (item : Item) = +let (|MethodUse|_|) (item : Item) = match item with - | Item.MethodGroup(_, [minfo],_) -> Some(minfo) + | Item.MethodGroup(_, [minfo], _) -> Some(minfo) | _ -> None -let (|FSharpMethodUse|_|) (item : Item) = +let (|FSharpMethodUse|_|) (item : Item) = match item with - | Item.MethodGroup(_, [ValRefOfMeth vref],_) -> Some(vref) + | Item.MethodGroup(_, [ValRefOfMeth vref], _) -> Some(vref) | Item.Value(vref) when vref.IsMember -> Some(vref) | _ -> None -let (|EntityUse|_|) (item: Item) = - match item with +let (|EntityUse|_|) (item: Item) = + match item with | Item.UnqualifiedType (tcref:: _) -> Some tcref | Item.ExnCase(tcref) -> Some tcref - | Item.Types(_, [AbbrevOrAppTy tcref]) - | Item.DelegateCtor(AbbrevOrAppTy tcref) + | Item.Types(_, [AbbrevOrAppTy tcref]) + | Item.DelegateCtor(AbbrevOrAppTy tcref) | Item.FakeInterfaceCtor(AbbrevOrAppTy tcref) -> Some tcref - | Item.CtorGroup(_, ctor::_) -> - match ctor.ApparentEnclosingType with + | Item.CtorGroup(_, ctor::_) -> + match ctor.ApparentEnclosingType with | AbbrevOrAppTy tcref -> Some tcref | _ -> None | _ -> None -let (|EventUse|_|) (item : Item) = +let (|EventUse|_|) (item : Item) = match item with | Item.Event(einfo) -> Some einfo | _ -> None -let (|FSharpEventUse|_|) (item : Item) = +let (|FSharpEventUse|_|) (item : Item) = match item with | Item.Event(ValRefOfEvent vref) -> Some vref | _ -> None -let (|UnionCaseUse|_|) (item : Item) = +let (|UnionCaseUse|_|) (item : Item) = match item with - | Item.UnionCase(UnionCaseInfo(_, u1),_) -> Some u1 + | Item.UnionCase(UnionCaseInfo(_, u1), _) -> Some u1 | _ -> None -let (|ValUse|_|) (item:Item) = - match item with - | Item.Value vref +let (|ValUse|_|) (item:Item) = + match item with + | Item.Value vref | FSharpPropertyUse vref | FSharpMethodUse vref | FSharpEventUse vref | Item.CustomBuilder(_, vref) -> Some vref | _ -> None -let (|ActivePatternCaseUse|_|) (item:Item) = - match item with +let (|ActivePatternCaseUse|_|) (item:Item) = + match item with | Item.ActivePatternCase(APElemRef(_, vref, idx)) -> Some (vref.SigRange, vref.DefinitionRange, idx) - | Item.ActivePatternResult(ap, _, idx,_) -> Some (ap.Range, ap.Range, idx) + | Item.ActivePatternResult(ap, _, idx, _) -> Some (ap.Range, ap.Range, idx) | _ -> None let tyconRefDefnHash (_g: TcGlobals) (eref1:EntityRef) = - hash eref1.LogicalName + hash eref1.LogicalName let tyconRefDefnEq g (eref1:EntityRef) (eref2: EntityRef) = - tyconRefEq g eref1 eref2 || + tyconRefEq g eref1 eref2 || // Signature items considered equal to implementation items not (Range.equals eref1.DefinitionRange Range.rangeStartup) && @@ -1377,65 +1377,65 @@ let unionCaseRefDefnEq g (uc1:UnionCaseRef) (uc2: UnionCaseRef) = uc1.CaseName = uc2.CaseName && tyconRefDefnEq g uc1.TyconRef uc2.TyconRef /// Given the Item 'orig' - returns function 'other : Item -> bool', that will yield true if other and orig represents the same item and false - otherwise -let ItemsAreEffectivelyEqual g orig other = +let ItemsAreEffectivelyEqual g orig other = match orig, other with - | EntityUse ty1, EntityUse ty2 -> + | EntityUse ty1, EntityUse ty2 -> tyconRefDefnEq g ty1 ty2 - | Item.TypeVar (nm1,tp1), Item.TypeVar (nm2,tp2) -> - nm1 = nm2 && - (typeEquiv g (mkTyparTy tp1) (mkTyparTy tp2) || - match stripTyparEqns (mkTyparTy tp1), stripTyparEqns (mkTyparTy tp2) with - | TType_var tp1, TType_var tp2 -> - not tp1.IsCompilerGenerated && not tp1.IsFromError && - not tp2.IsCompilerGenerated && not tp2.IsFromError && + | Item.TypeVar (nm1, tp1), Item.TypeVar (nm2, tp2) -> + nm1 = nm2 && + (typeEquiv g (mkTyparTy tp1) (mkTyparTy tp2) || + match stripTyparEqns (mkTyparTy tp1), stripTyparEqns (mkTyparTy tp2) with + | TType_var tp1, TType_var tp2 -> + not tp1.IsCompilerGenerated && not tp1.IsFromError && + not tp2.IsCompilerGenerated && not tp2.IsFromError && Range.equals tp1.Range tp2.Range - | AbbrevOrAppTy tcref1, AbbrevOrAppTy tcref2 -> + | AbbrevOrAppTy tcref1, AbbrevOrAppTy tcref2 -> tyconRefDefnEq g tcref1 tcref2 | _ -> false) - | ValUse vref1, ValUse vref2 -> - valRefDefnEq g vref1 vref2 + | ValUse vref1, ValUse vref2 -> + valRefDefnEq g vref1 vref2 - | ActivePatternCaseUse (range1, range1i, idx1), ActivePatternCaseUse (range2, range2i, idx2) -> + | ActivePatternCaseUse (range1, range1i, idx1), ActivePatternCaseUse (range2, range2i, idx2) -> (idx1 = idx2) && (Range.equals range1 range2 || Range.equals range1i range2i) - | MethodUse minfo1, MethodUse minfo2 -> + | MethodUse minfo1, MethodUse minfo2 -> MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2 || // Allow for equality up to signature matching - match minfo1.ArbitraryValRef, minfo2.ArbitraryValRef with - | Some vref1, Some vref2 -> valRefDefnEq g vref1 vref2 + match minfo1.ArbitraryValRef, minfo2.ArbitraryValRef with + | Some vref1, Some vref2 -> valRefDefnEq g vref1 vref2 | _ -> false - | PropertyUse(pinfo1), PropertyUse(pinfo2) -> + | PropertyUse(pinfo1), PropertyUse(pinfo2) -> PropInfo.PropInfosUseIdenticalDefinitions pinfo1 pinfo2 || // Allow for equality up to signature matching - match pinfo1.ArbitraryValRef, pinfo2.ArbitraryValRef with - | Some vref1, Some vref2 -> valRefDefnEq g vref1 vref2 + match pinfo1.ArbitraryValRef, pinfo2.ArbitraryValRef with + | Some vref1, Some vref2 -> valRefDefnEq g vref1 vref2 | _ -> false - | Item.ArgName (id1,_, _), Item.ArgName (id2,_, _) -> + | Item.ArgName (id1, _, _), Item.ArgName (id2, _, _) -> (id1.idText = id2.idText && Range.equals id1.idRange id2.idRange) - | (Item.ArgName (id,_, _), ValUse vref) | (ValUse vref, Item.ArgName (id, _, _)) -> + | (Item.ArgName (id, _, _), ValUse vref) | (ValUse vref, Item.ArgName (id, _, _)) -> ((Range.equals id.idRange vref.DefinitionRange || Range.equals id.idRange vref.SigRange) && id.idText = vref.DisplayName) | Item.AnonRecdField(anon1, _, i1, _), Item.AnonRecdField(anon2, _, i2, _) -> Tastops.anonInfoEquiv anon1 anon2 && i1 = i2 - | ILFieldUse f1, ILFieldUse f2 -> - ILFieldInfo.ILFieldInfosUseIdenticalDefinitions f1 f2 + | ILFieldUse f1, ILFieldUse f2 -> + ILFieldInfo.ILFieldInfosUseIdenticalDefinitions f1 f2 - | UnionCaseUse u1, UnionCaseUse u2 -> + | UnionCaseUse u1, UnionCaseUse u2 -> unionCaseRefDefnEq g u1 u2 - | RecordFieldUse(name1, tcref1), RecordFieldUse(name2, tcref2) -> + | RecordFieldUse(name1, tcref1), RecordFieldUse(name2, tcref2) -> name1 = name2 && tyconRefDefnEq g tcref1 tcref2 - | EventUse evt1, EventUse evt2 -> + | EventUse evt1, EventUse evt2 -> EventInfo.EventInfosUseIdenticalDefintions evt1 evt2 || // Allow for equality up to signature matching - match evt1.ArbitraryValRef, evt2.ArbitraryValRef with - | Some vref1, Some vref2 -> valRefDefnEq g vref1 vref2 + match evt1.ArbitraryValRef, evt2.ArbitraryValRef with + | Some vref1, Some vref2 -> valRefDefnEq g vref1 vref2 | _ -> false | Item.ModuleOrNamespaces modrefs1, Item.ModuleOrNamespaces modrefs2 -> @@ -1444,15 +1444,15 @@ let ItemsAreEffectivelyEqual g orig other = | _ -> false /// Given the Item 'orig' - returns function 'other : Item -> bool', that will yield true if other and orig represents the same item and false - otherwise -let ItemsAreEffectivelyEqualHash (g: TcGlobals) orig = +let ItemsAreEffectivelyEqualHash (g: TcGlobals) orig = match orig with | EntityUse tcref -> tyconRefDefnHash g tcref - | Item.TypeVar (nm,_)-> hash nm + | Item.TypeVar (nm, _)-> hash nm | ValUse vref -> valRefDefnHash g vref | ActivePatternCaseUse (_, _, idx)-> hash idx | MethodUse minfo -> minfo.ComputeHashCode() | PropertyUse pinfo -> pinfo.ComputeHashCode() - | Item.ArgName (id,_, _) -> hash id.idText + | Item.ArgName (id, _, _) -> hash id.idText | ILFieldUse ilfinfo -> ilfinfo.ComputeHashCode() | UnionCaseUse ucase -> hash ucase.CaseName | RecordFieldUse (name, _) -> hash name @@ -1470,7 +1470,7 @@ type CapturedNameResolution(p:pos, i:Item, tpinst, io:ItemOccurence, de:DisplayE member this.NameResolutionEnv = nre member this.AccessorDomain = ad member this.Range = m - member this.DebugToString() = + member this.DebugToString() = sprintf "%A: %+A" (p.Line, p.Column) i /// Represents container for all name resolutions that were met so far when typechecking some particular file @@ -1478,10 +1478,10 @@ type TcResolutions (capturedEnvs : ResizeArray, capturedExprTypes : ResizeArray, capturedNameResolutions : ResizeArray, - capturedMethodGroupResolutions : ResizeArray) = + capturedMethodGroupResolutions : ResizeArray) = + + static let empty = TcResolutions(ResizeArray(0), ResizeArray(0), ResizeArray(0), ResizeArray(0)) - static let empty = TcResolutions(ResizeArray(0),ResizeArray(0),ResizeArray(0),ResizeArray(0)) - member this.CapturedEnvs = capturedEnvs member this.CapturedExpressionTypings = capturedExprTypes member this.CapturedNameResolutions = capturedNameResolutions @@ -1490,7 +1490,7 @@ type TcResolutions static member Empty = empty [] -type TcSymbolUseData = +type TcSymbolUseData = { Item: Item ItemOccurence: ItemOccurence DisplayEnv: DisplayEnv @@ -1508,10 +1508,10 @@ type TcSymbolUses(g, capturedNameResolutions : ResizeArray ResizeArray.mapToSmallArrayChunks (fun cnr -> { Item=cnr.Item; ItemOccurence=cnr.ItemOccurence; DisplayEnv=cnr.DisplayEnv; Range=cnr.Range }) - let capturedNameResolutions = () + let capturedNameResolutions = () do ignore capturedNameResolutions // don't capture this! - member this.GetUsesOfSymbol(item) = + member this.GetUsesOfSymbol(item) = // This member returns what is potentially a very large array, which may approach the size constraints of the Large Object Heap. // This is unlikely in practice, though, because we filter down the set of all symbol uses to those specifically for the given `item`. // Consequently we have a much lesser chance of ending up with an array large enough to be promoted to the LOH. @@ -1530,22 +1530,22 @@ type TcResultsSinkImpl(g, ?sourceText: ISourceText) = let capturedExprTypings = ResizeArray<_>() let capturedNameResolutions = ResizeArray<_>() let capturedFormatSpecifierLocations = ResizeArray<_>() - - let capturedNameResolutionIdentifiers = + + let capturedNameResolutionIdentifiers = new System.Collections.Generic.HashSet - ( { new IEqualityComparer<_> with - member __.GetHashCode((p:pos,i)) = p.Line + 101 * p.Column + hash i - member __.Equals((p1,i1),(p2,i2)) = posEq p1 p2 && i1 = i2 } ) + ( { new IEqualityComparer<_> with + member __.GetHashCode((p:pos, i)) = p.Line + 101 * p.Column + hash i + member __.Equals((p1, i1), (p2, i2)) = posEq p1 p2 && i1 = i2 } ) - let capturedModulesAndNamespaces = + let capturedModulesAndNamespaces = new System.Collections.Generic.HashSet - ( { new IEqualityComparer with + ( { new IEqualityComparer with member __.GetHashCode ((m, _)) = hash m member __.Equals ((m1, item1), (m2, item2)) = Range.equals m1 m2 && ItemsAreEffectivelyEqual g item1 item2 } ) let capturedMethodGroupResolutions = ResizeArray<_>() let capturedOpenDeclarations = ResizeArray() - let allowedRange (m:range) = not m.IsSynthetic + let allowedRange (m:range) = not m.IsSynthetic let formatStringCheckContext = lazy @@ -1560,33 +1560,33 @@ type TcResultsSinkImpl(g, ?sourceText: ISourceText) = elif c = '\n' then yield i yield sourceText.Length |] - { SourceText = sourceText + { SourceText = sourceText LineStartPositions = positions }) - member this.GetResolutions() = + member this.GetResolutions() = TcResolutions(capturedEnvs, capturedExprTypings, capturedNameResolutions, capturedMethodGroupResolutions) - member this.GetSymbolUses() = + member this.GetSymbolUses() = TcSymbolUses(g, capturedNameResolutions, capturedFormatSpecifierLocations.ToArray()) - member this.GetOpenDeclarations() = + member this.GetOpenDeclarations() = capturedOpenDeclarations |> Seq.distinctBy (fun x -> x.Range, x.AppliedScope, x.IsOwnNamespace) |> Seq.toArray interface ITypecheckResultsSink with - member sink.NotifyEnvWithScope(m,nenv,ad) = - if allowedRange m then - capturedEnvs.Add((m,nenv,ad)) + member sink.NotifyEnvWithScope(m, nenv, ad) = + if allowedRange m then + capturedEnvs.Add((m, nenv, ad)) - member sink.NotifyExprHasType(endPos,ty,denv,nenv,ad,m) = - if allowedRange m then - capturedExprTypings.Add((endPos,ty,denv,nenv,ad,m)) + member sink.NotifyExprHasType(endPos, ty, denv, nenv, ad, m) = + if allowedRange m then + capturedExprTypings.Add((endPos, ty, denv, nenv, ad, m)) - member sink.NotifyNameResolution(endPos,item,itemMethodGroup,tpinst,occurenceType,denv,nenv,ad,m,replace) = + member sink.NotifyNameResolution(endPos, item, itemMethodGroup, tpinst, occurenceType, denv, nenv, ad, m, replace) = // Desugaring some F# constructs (notably computation expressions with custom operators) - // results in duplication of textual variables. So we ensure we never record two name resolutions + // results in duplication of textual variables. So we ensure we never record two name resolutions // for the same identifier at the same location. if allowedRange m then - if replace then + if replace then capturedNameResolutions.RemoveAll(fun cnr -> Range.equals cnr.Range m) |> ignore capturedMethodGroupResolutions.RemoveAll(fun cnr -> Range.equals cnr.Range m) |> ignore else @@ -1595,7 +1595,7 @@ type TcResultsSinkImpl(g, ?sourceText: ISourceText) = | Item.ModuleOrNamespaces _ -> not (capturedModulesAndNamespaces.Add (m, item)) | _ -> - let keyOpt = + let keyOpt = match item with | Item.Value vref -> Some (endPos, vref.DisplayName) | Item.ArgName (id, _, _) -> Some (endPos, id.idText) @@ -1605,62 +1605,61 @@ type TcResultsSinkImpl(g, ?sourceText: ISourceText) = | Some key -> not (capturedNameResolutionIdentifiers.Add key) | _ -> false - if not alreadyDone then - capturedNameResolutions.Add(CapturedNameResolution(endPos,item,tpinst,occurenceType,denv,nenv,ad,m)) - capturedMethodGroupResolutions.Add(CapturedNameResolution(endPos,itemMethodGroup,[],occurenceType,denv,nenv,ad,m)) + if not alreadyDone then + capturedNameResolutions.Add(CapturedNameResolution(endPos, item, tpinst, occurenceType, denv, nenv, ad, m)) + capturedMethodGroupResolutions.Add(CapturedNameResolution(endPos, itemMethodGroup, [], occurenceType, denv, nenv, ad, m)) - member sink.NotifyFormatSpecifierLocation(m, numArgs) = + member sink.NotifyFormatSpecifierLocation(m, numArgs) = capturedFormatSpecifierLocations.Add((m, numArgs)) member sink.NotifyOpenDeclaration(openDeclaration) = capturedOpenDeclarations.Add(openDeclaration) member sink.CurrentSourceText = sourceText - member sink.FormatStringCheckContext = formatStringCheckContext.Value /// An abstract type for reporting the results of name resolution and type checking, and which allows /// temporary suspension and/or redirection of reporting. -type TcResultsSink = +type TcResultsSink = { mutable CurrentSink : ITypecheckResultsSink option } static member NoSink = { CurrentSink = None } static member WithSink sink = { CurrentSink = Some sink } /// Temporarily redirect reporting of name resolution and type checking results -let WithNewTypecheckResultsSink (newSink : ITypecheckResultsSink, sink:TcResultsSink) = +let WithNewTypecheckResultsSink (newSink : ITypecheckResultsSink, sink:TcResultsSink) = let old = sink.CurrentSink sink.CurrentSink <- Some newSink { new System.IDisposable with member x.Dispose() = sink.CurrentSink <- old } /// Temporarily suspend reporting of name resolution and type checking results -let TemporarilySuspendReportingTypecheckResultsToSink (sink:TcResultsSink) = +let TemporarilySuspendReportingTypecheckResultsToSink (sink:TcResultsSink) = let old = sink.CurrentSink sink.CurrentSink <- None { new System.IDisposable with member x.Dispose() = sink.CurrentSink <- old } /// Report the active name resolution environment for a specific source range -let CallEnvSink (sink:TcResultsSink) (scopem,nenv,ad) = - match sink.CurrentSink with - | None -> () - | Some sink -> sink.NotifyEnvWithScope(scopem,nenv,ad) +let CallEnvSink (sink:TcResultsSink) (scopem, nenv, ad) = + match sink.CurrentSink with + | None -> () + | Some sink -> sink.NotifyEnvWithScope(scopem, nenv, ad) /// Report a specific name resolution at a source range -let CallNameResolutionSink (sink:TcResultsSink) (m:range,nenv,item,itemMethodGroup,tpinst,occurenceType,denv,ad) = - match sink.CurrentSink with - | None -> () - | Some sink -> sink.NotifyNameResolution(m.End,item,itemMethodGroup,tpinst,occurenceType,denv,nenv,ad,m,false) +let CallNameResolutionSink (sink:TcResultsSink) (m:range, nenv, item, itemMethodGroup, tpinst, occurenceType, denv, ad) = + match sink.CurrentSink with + | None -> () + | Some sink -> sink.NotifyNameResolution(m.End, item, itemMethodGroup, tpinst, occurenceType, denv, nenv, ad, m, false) -let CallNameResolutionSinkReplacing (sink:TcResultsSink) (m:range,nenv,item,itemMethodGroup,tpinst,occurenceType,denv,ad) = - match sink.CurrentSink with - | None -> () - | Some sink -> sink.NotifyNameResolution(m.End,item,itemMethodGroup,tpinst,occurenceType,denv,nenv,ad,m,true) +let CallNameResolutionSinkReplacing (sink:TcResultsSink) (m:range, nenv, item, itemMethodGroup, tpinst, occurenceType, denv, ad) = + match sink.CurrentSink with + | None -> () + | Some sink -> sink.NotifyNameResolution(m.End, item, itemMethodGroup, tpinst, occurenceType, denv, nenv, ad, m, true) /// Report a specific expression typing at a source range -let CallExprHasTypeSink (sink:TcResultsSink) (m:range,nenv,ty,denv,ad) = - match sink.CurrentSink with - | None -> () - | Some sink -> sink.NotifyExprHasType(m.End,ty,denv,nenv,ad,m) +let CallExprHasTypeSink (sink:TcResultsSink) (m:range, nenv, ty, denv, ad) = + match sink.CurrentSink with + | None -> () + | Some sink -> sink.NotifyExprHasType(m.End, ty, denv, nenv, ad, m) let CallOpenDeclarationSink (sink:TcResultsSink) (openDeclaration: OpenDeclaration) = match sink.CurrentSink with @@ -1669,99 +1668,99 @@ let CallOpenDeclarationSink (sink:TcResultsSink) (openDeclaration: OpenDeclarati //------------------------------------------------------------------------- // Check inferability of type parameters in resolved items. -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- /// Checks if the type variables associated with the result of a resolution are inferable, /// i.e. occur in the arguments or return type of the resolution. If not give a warning /// about a type instantiation being needed. type ResultTyparChecker = ResultTyparChecker of (unit -> bool) -let CheckAllTyparsInferrable amap m item = +let CheckAllTyparsInferrable amap m item = match item with - | Item.Property(_,pinfos) -> - pinfos |> List.forall (fun pinfo -> + | Item.Property(_, pinfos) -> + pinfos |> List.forall (fun pinfo -> pinfo.IsExtensionMember || let freeInDeclaringType = freeInType CollectTyparsNoCaching pinfo.ApparentEnclosingType - let freeInArgsAndRetType = - accFreeInTypes CollectTyparsNoCaching (pinfo.GetParamTypes(amap,m)) - (freeInType CollectTyparsNoCaching (pinfo.GetPropertyType(amap,m))) + let freeInArgsAndRetType = + accFreeInTypes CollectTyparsNoCaching (pinfo.GetParamTypes(amap, m)) + (freeInType CollectTyparsNoCaching (pinfo.GetPropertyType(amap, m))) let free = Zset.diff freeInDeclaringType.FreeTypars freeInArgsAndRetType.FreeTypars free.IsEmpty) - | Item.MethodGroup(_,minfos,_) -> - minfos |> List.forall (fun minfo -> + | Item.MethodGroup(_, minfos, _) -> + minfos |> List.forall (fun minfo -> minfo.IsExtensionMember || let fminst = minfo.FormalMethodInst let freeInDeclaringType = freeInType CollectTyparsNoCaching minfo.ApparentEnclosingType - let freeInArgsAndRetType = - List.foldBack (accFreeInTypes CollectTyparsNoCaching) (minfo.GetParamTypes(amap, m, fminst)) - (accFreeInTypes CollectTyparsNoCaching (minfo.GetObjArgTypes(amap, m, fminst)) + let freeInArgsAndRetType = + List.foldBack (accFreeInTypes CollectTyparsNoCaching) (minfo.GetParamTypes(amap, m, fminst)) + (accFreeInTypes CollectTyparsNoCaching (minfo.GetObjArgTypes(amap, m, fminst)) (freeInType CollectTyparsNoCaching (minfo.GetFSharpReturnTy(amap, m, fminst)))) let free = Zset.diff freeInDeclaringType.FreeTypars freeInArgsAndRetType.FreeTypars free.IsEmpty) - | Item.CtorGroup _ - | Item.FakeInterfaceCtor _ - | Item.DelegateCtor _ - | Item.Types _ + | Item.CtorGroup _ + | Item.FakeInterfaceCtor _ + | Item.DelegateCtor _ + | Item.Types _ | Item.ModuleOrNamespaces _ - | Item.CustomOperation _ - | Item.CustomBuilder _ - | Item.TypeVar _ - | Item.ArgName _ + | Item.CustomOperation _ + | Item.CustomBuilder _ + | Item.TypeVar _ + | Item.ArgName _ | Item.ActivePatternResult _ - | Item.Value _ - | Item.ActivePatternCase _ - | Item.UnionCase _ - | Item.ExnCase _ - | Item.RecdField _ - | Item.AnonRecdField _ - | Item.NewDef _ - | Item.ILField _ - | Item.Event _ - | Item.ImplicitOp _ + | Item.Value _ + | Item.ActivePatternCase _ + | Item.UnionCase _ + | Item.ExnCase _ + | Item.RecdField _ + | Item.AnonRecdField _ + | Item.NewDef _ + | Item.ILField _ + | Item.Event _ + | Item.ImplicitOp _ | Item.UnqualifiedType _ | Item.SetterArg _ -> true - + //------------------------------------------------------------------------- // Check inferability of type parameters in resolved items. -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- /// Keeps track of information relevant to the chosen resolution of a long identifier /// /// When we resolve an item such as System.Console.In we /// resolve it in one step to a property/val/method etc. item. However /// Visual Studio needs to know about the exact resolutions of the names -/// System and Console, i.e. the 'entity path' of the resolution. +/// System and Console, i.e. the 'entity path' of the resolution. /// -/// Each of the resolution routines keeps track of the entity path and -/// ultimately calls ResolutionInfo.Method to record it for +/// Each of the resolution routines keeps track of the entity path and +/// ultimately calls ResolutionInfo.Method to record it for /// later use by Visual Studio. -type ResolutionInfo = +type ResolutionInfo = | ResolutionInfo of (*entityPath, reversed*)(range * EntityRef) list * (*warnings/errors*)(ResultTyparChecker -> unit) - static member SendEntityPathToSink(sink, ncenv: NameResolver, nenv, occ, ad, ResolutionInfo(entityPath,warnings), typarChecker) = - entityPath |> List.iter (fun (m,eref:EntityRef) -> - CheckEntityAttributes ncenv.g eref m |> CommitOperationResult + static member SendEntityPathToSink(sink, ncenv: NameResolver, nenv, occ, ad, ResolutionInfo(entityPath, warnings), typarChecker) = + entityPath |> List.iter (fun (m, eref:EntityRef) -> + CheckEntityAttributes ncenv.g eref m |> CommitOperationResult CheckTyconAccessible ncenv.amap m ad eref |> ignore - let item = - if eref.IsModuleOrNamespace then - Item.ModuleOrNamespaces [eref] - else - Item.Types(eref.DisplayName,[FreshenTycon ncenv m eref]) - CallNameResolutionSink sink (m,nenv,item,item,emptyTyparInst,occ,nenv.eDisplayEnv,ad)) + let item = + if eref.IsModuleOrNamespace then + Item.ModuleOrNamespaces [eref] + else + Item.Types(eref.DisplayName, [FreshenTycon ncenv m eref]) + CallNameResolutionSink sink (m, nenv, item, item, emptyTyparInst, occ, nenv.eDisplayEnv, ad)) warnings(typarChecker) - - static member Empty = - ResolutionInfo([],(fun _ -> ())) - member x.AddEntity info = - let (ResolutionInfo(entityPath,warnings)) = x - ResolutionInfo(info::entityPath,warnings) + static member Empty = + ResolutionInfo([], (fun _ -> ())) + + member x.AddEntity info = + let (ResolutionInfo(entityPath, warnings)) = x + ResolutionInfo(info::entityPath, warnings) - member x.AddWarning f = - let (ResolutionInfo(entityPath,warnings)) = x - ResolutionInfo(entityPath,(fun typarChecker -> f typarChecker; warnings typarChecker)) + member x.AddWarning f = + let (ResolutionInfo(entityPath, warnings)) = x + ResolutionInfo(entityPath, (fun typarChecker -> f typarChecker; warnings typarChecker)) @@ -1769,65 +1768,65 @@ type ResolutionInfo = /// Also check that we're not returning direct references to generated provided types. // // Given ambiguous C<>, C<_> we resolve the ambiguous 'C.M' to C<> without warning -// Given ambiguous C<_>, C<_,_> we resolve the ambiguous 'C.M' to C<_> with an ambiguity error +// Given ambiguous C<_>, C<_, _> we resolve the ambiguous 'C.M' to C<_> with an ambiguity error // Given C<_> we resolve the ambiguous 'C.M' to C<_> with a warning if the argument or return types can't be inferred // Given ambiguous C<>, C<_> we resolve the ambiguous 'C()' to C<> without warning -// Given ambiguous C<_>, C<_,_> we resolve the ambiguous 'C()' to C<_> with an ambiguity error +// Given ambiguous C<_>, C<_, _> we resolve the ambiguous 'C()' to C<_> with an ambiguity error // Given C<_> we resolve the ambiguous 'C()' to C<_> with a warning if the argument or return types can't be inferred -let CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities - (tcrefs:(ResolutionInfo * TyconRef) list, - typeNameResInfo:TypeNameResolutionInfo, - genOk:PermitDirectReferenceToGeneratedType, - m) = +let CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities + (tcrefs:(ResolutionInfo * TyconRef) list, + typeNameResInfo:TypeNameResolutionInfo, + genOk:PermitDirectReferenceToGeneratedType, + m) = - let tcrefs = - tcrefs + let tcrefs = + tcrefs // remove later duplicates (if we've opened the same module more than once) - |> List.distinctBy (fun (_,tcref) -> tcref.Stamp) + |> List.distinctBy (fun (_, tcref) -> tcref.Stamp) // List.sortBy is a STABLE sort (the order matters!) - |> List.sortBy (fun (_,tcref) -> tcref.Typars(m).Length) + |> List.sortBy (fun (_, tcref) -> tcref.Typars(m).Length) - let tcrefs = - match tcrefs with - | ((_resInfo,tcref) :: _) when + let tcrefs = + match tcrefs with + | ((_resInfo, tcref) :: _) when // multiple types - tcrefs.Length > 1 && + tcrefs.Length > 1 && // no explicit type instantiation - typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo && + typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo && // some type arguments required on all types (note sorted by typar count above) - not (List.isEmpty (tcref.Typars m)) && + not (List.isEmpty (tcref.Typars m)) && // plausible types have different arities - (tcrefs |> Seq.distinctBy (fun (_,tcref) -> tcref.Typars(m).Length) |> Seq.length > 1) -> - [ for (resInfo,tcref) in tcrefs do - let resInfo = resInfo.AddWarning (fun _typarChecker -> errorR(Error(FSComp.SR.nrTypeInstantiationNeededToDisambiguateTypesWithSameName(tcref.DisplayName, tcref.DisplayNameWithStaticParametersAndUnderscoreTypars),m))) - yield (resInfo,tcref) ] - - | [(resInfo,tcref)] when typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo && not (List.isEmpty (tcref.Typars m)) && typeNameResInfo.ResolutionFlag = ResolveTypeNamesToTypeRefs -> - let resInfo = - resInfo.AddWarning (fun (ResultTyparChecker typarChecker) -> - if not (typarChecker()) then - warning(Error(FSComp.SR.nrTypeInstantiationIsMissingAndCouldNotBeInferred(tcref.DisplayName, tcref.DisplayNameWithStaticParametersAndUnderscoreTypars),m))) - [(resInfo,tcref)] - - | _ -> + (tcrefs |> Seq.distinctBy (fun (_, tcref) -> tcref.Typars(m).Length) |> Seq.length > 1) -> + [ for (resInfo, tcref) in tcrefs do + let resInfo = resInfo.AddWarning (fun _typarChecker -> errorR(Error(FSComp.SR.nrTypeInstantiationNeededToDisambiguateTypesWithSameName(tcref.DisplayName, tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))) + yield (resInfo, tcref) ] + + | [(resInfo, tcref)] when typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo && not (List.isEmpty (tcref.Typars m)) && typeNameResInfo.ResolutionFlag = ResolveTypeNamesToTypeRefs -> + let resInfo = + resInfo.AddWarning (fun (ResultTyparChecker typarChecker) -> + if not (typarChecker()) then + warning(Error(FSComp.SR.nrTypeInstantiationIsMissingAndCouldNotBeInferred(tcref.DisplayName, tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))) + [(resInfo, tcref)] + + | _ -> tcrefs #if !NO_EXTENSIONTYPING - for (_,tcref) in tcrefs do + for (_, tcref) in tcrefs do // Type generators can't be returned by name resolution, unless PermitDirectReferenceToGeneratedType.Yes CheckForDirectReferenceToGeneratedType (tcref, genOk, m) #else genOk |> ignore #endif - tcrefs + tcrefs //------------------------------------------------------------------------- // Consume ids that refer to a namespace -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- /// Perform name resolution for an identifier which must resolve to be a namespace or module. let rec ResolveLongIndentAsModuleOrNamespace sink atMostOne amap m first fullyQualified (nenv:NameResolutionEnv) ad (id:Ident) (rest:Ident list) isOpenDecl = @@ -1847,8 +1846,8 @@ let rec ResolveLongIndentAsModuleOrNamespace sink atMostOne amap m first fullyQu |> Seq.collect (fun e -> [e.DisplayName; e.DemangledModuleOrNamespaceName]) |> HashSet - UndefinedName(0,FSComp.SR.undefinedNameNamespaceOrModule,id,suggestModulesAndNamespaces)) - + UndefinedName(0, FSComp.SR.undefinedNameNamespaceOrModule, id, suggestModulesAndNamespaces)) + let mutable moduleNotFoundErrorCache = None let moduleNotFound (modref: ModuleOrNamespaceRef) (mty:ModuleOrNamespaceType) (id:Ident) depth = match moduleNotFoundErrorCache with @@ -1859,8 +1858,8 @@ let rec ResolveLongIndentAsModuleOrNamespace sink atMostOne amap m first fullyQu |> Seq.filter (fun kv -> IsEntityAccessible amap m ad (modref.NestedTyconRef kv.Value)) |> Seq.collect (fun e -> [e.Value.DisplayName; e.Value.DemangledModuleOrNamespaceName]) |> HashSet - - let error = raze (UndefinedName(depth,FSComp.SR.undefinedNameNamespace,id,suggestNames)) + + let error = raze (UndefinedName(depth, FSComp.SR.undefinedNameNamespace, id, suggestNames)) moduleNotFoundErrorCache <- Some(id.idRange, error) error @@ -1873,8 +1872,8 @@ let rec ResolveLongIndentAsModuleOrNamespace sink atMostOne amap m first fullyQu | true, modrefs -> /// Look through the sub-namespaces and/or modules let rec look depth (modref: ModuleOrNamespaceRef) (mty:ModuleOrNamespaceType) (lid:Ident list) = - match lid with - | [] -> success (depth,modref,mty) + match lid with + | [] -> success (depth, modref, mty) | id :: rest -> match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with | true, mspec -> @@ -1886,13 +1885,13 @@ let rec ResolveLongIndentAsModuleOrNamespace sink atMostOne amap m first fullyQu moduleNotFound modref mty id depth | _ -> moduleNotFound modref mty id depth - - modrefs |> CollectResults2 atMostOne (fun modref -> + + modrefs |> CollectResults2 atMostOne (fun modref -> if IsEntityAccessible amap m ad modref then notifyNameResolution modref id.idRange look 1 modref modref.ModuleOrNamespaceType rest else - raze (namespaceNotFound.Force())) + raze (namespaceNotFound.Force())) | _ -> raze (namespaceNotFound.Force()) @@ -1900,74 +1899,74 @@ let ResolveLongIndentAsModuleOrNamespaceThen sink atMostOne amap m fullyQualifie match ResolveLongIndentAsModuleOrNamespace sink ResultCollectionSettings.AllResults amap m true fullyQualified nenv ad id [] isOpenDecl with | Result modrefs -> match rest with - | [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(),id.idRange)) - | id2::rest2 -> + | [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), id.idRange)) + | id2::rest2 -> modrefs - |> CollectResults2 atMostOne (fun (depth,modref,mty) -> - let resInfo = ResolutionInfo.Empty.AddEntity(id.idRange,modref) + |> CollectResults2 atMostOne (fun (depth, modref, mty) -> + let resInfo = ResolutionInfo.Empty.AddEntity(id.idRange, modref) f resInfo (depth+1) id.idRange modref mty id2 rest2) - | Exception err -> Exception err + | Exception err -> Exception err //------------------------------------------------------------------------- // Bind name used in "new Foo.Bar(...)" constructs -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- -let private ResolveObjectConstructorPrim (ncenv:NameResolver) edenv resInfo m ad ty = +let private ResolveObjectConstructorPrim (ncenv:NameResolver) edenv resInfo m ad ty = let g = ncenv.g let amap = ncenv.amap - if isDelegateTy g ty then - success (resInfo,Item.DelegateCtor ty) - else + if isDelegateTy g ty then + success (resInfo, Item.DelegateCtor ty) + else let ctorInfos = GetIntrinsicConstructorInfosOfType ncenv.InfoReader m ty - if isNil ctorInfos && isInterfaceTy g ty then + if isNil ctorInfos && isInterfaceTy g ty then success (resInfo, Item.FakeInterfaceCtor ty) - else - let defaultStructCtorInfo = + else + let defaultStructCtorInfo = if (not (ctorInfos |> List.exists (fun x -> x.IsNullary)) && - isStructTy g ty && - not (isRecdTy g ty) && - not (isUnionTy g ty)) - then - [DefaultStructCtor(g,ty)] + isStructTy g ty && + not (isRecdTy g ty) && + not (isUnionTy g ty)) + then + [DefaultStructCtor(g, ty)] else [] - if (isNil defaultStructCtorInfo && isNil ctorInfos) || (not (isAppTy g ty) && not (isAnyTupleTy g ty)) then - raze (Error(FSComp.SR.nrNoConstructorsAvailableForType(NicePrint.minimalStringOfType edenv ty),m)) - else - let ctorInfos = ctorInfos |> List.filter (IsMethInfoAccessible amap m ad) + if (isNil defaultStructCtorInfo && isNil ctorInfos) || (not (isAppTy g ty) && not (isAnyTupleTy g ty)) then + raze (Error(FSComp.SR.nrNoConstructorsAvailableForType(NicePrint.minimalStringOfType edenv ty), m)) + else + let ctorInfos = ctorInfos |> List.filter (IsMethInfoAccessible amap m ad) let metadataTy = convertToTypeWithMetadataIfPossible g ty - success (resInfo,Item.MakeCtorGroup ((tcrefOfAppTy g metadataTy).LogicalName, (defaultStructCtorInfo@ctorInfos))) + success (resInfo, Item.MakeCtorGroup ((tcrefOfAppTy g metadataTy).LogicalName, (defaultStructCtorInfo@ctorInfos))) /// Perform name resolution for an identifier which must resolve to be an object constructor. -let ResolveObjectConstructor (ncenv:NameResolver) edenv m ad ty = - ResolveObjectConstructorPrim (ncenv:NameResolver) edenv [] m ad ty |?> (fun (_resInfo,item) -> item) +let ResolveObjectConstructor (ncenv:NameResolver) edenv m ad ty = + ResolveObjectConstructorPrim (ncenv:NameResolver) edenv [] m ad ty |?> (fun (_resInfo, item) -> item) //------------------------------------------------------------------------- // Bind the "." notation (member lookup or lookup in a type) -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- /// Query the declared properties of a type (including inherited properties) let IntrinsicPropInfosOfTypeInScope (infoReader:InfoReader) (optFilter, ad) findFlag m ty = let g = infoReader.g let amap = infoReader.amap let pinfos = GetIntrinsicPropInfoSetsOfType infoReader (optFilter, ad, AllowMultiIntfInstantiations.Yes) findFlag m ty - let pinfos = pinfos |> ExcludeHiddenOfPropInfos g amap m + let pinfos = pinfos |> ExcludeHiddenOfPropInfos g amap m pinfos -/// Select from a list of extension properties -let SelectPropInfosFromExtMembers (infoReader:InfoReader,ad,optFilter) declaringTy m extMemInfos = +/// Select from a list of extension properties +let SelectPropInfosFromExtMembers (infoReader:InfoReader, ad, optFilter) declaringTy m extMemInfos = let g = infoReader.g let amap = infoReader.amap // NOTE: multiple "open"'s push multiple duplicate values into eIndexedExtensionMembers, hence setify. let seen = HashSet(ExtensionMember.Comparer g) - let propCollector = new PropertyCollector(g,amap,m,declaringTy,optFilter,ad) + let propCollector = new PropertyCollector(g, amap, m, declaringTy, optFilter, ad) for emem in extMemInfos do if seen.Add emem then - match emem with - | FSExtMem (vref,_pri) -> - match vref.MemberInfo with + match emem with + | FSExtMem (vref, _pri) -> + match vref.MemberInfo with | None -> () - | Some membInfo -> propCollector.Collect(membInfo,vref) - | ILExtMem _ -> + | Some membInfo -> propCollector.Collect(membInfo, vref) + | ILExtMem _ -> // No extension properties coming from .NET () propCollector.Close() @@ -1975,62 +1974,62 @@ let SelectPropInfosFromExtMembers (infoReader:InfoReader,ad,optFilter) declaring /// Query the available extension properties of a type (including extension properties for inherited types) let ExtensionPropInfosOfTypeInScope (infoReader:InfoReader) (nenv: NameResolutionEnv) (optFilter, ad) m ty = let g = infoReader.g - - let extMemsFromHierarchy = - infoReader.GetEntireTypeHierachy(AllowMultiIntfInstantiations.Yes,m,ty) |> List.collect (fun ty -> - if isAppTy g ty then + + let extMemsFromHierarchy = + infoReader.GetEntireTypeHierachy(AllowMultiIntfInstantiations.Yes, m, ty) |> List.collect (fun ty -> + if isAppTy g ty then let tcref = tcrefOfAppTy g ty let extMemInfos = nenv.eIndexedExtensionMembers.Find tcref - SelectPropInfosFromExtMembers (infoReader,ad,optFilter) ty m extMemInfos + SelectPropInfosFromExtMembers (infoReader, ad, optFilter) ty m extMemInfos else []) - let extMemsDangling = SelectPropInfosFromExtMembers (infoReader,ad,optFilter) ty m nenv.eUnindexedExtensionMembers + let extMemsDangling = SelectPropInfosFromExtMembers (infoReader, ad, optFilter) ty m nenv.eUnindexedExtensionMembers extMemsDangling @ extMemsFromHierarchy /// Get all the available properties of a type (both intrinsic and extension) let AllPropInfosOfTypeInScope infoReader nenv (optFilter, ad) findFlag m ty = IntrinsicPropInfosOfTypeInScope infoReader (optFilter, ad) findFlag m ty - @ ExtensionPropInfosOfTypeInScope infoReader nenv (optFilter, ad) m ty + @ ExtensionPropInfosOfTypeInScope infoReader nenv (optFilter, ad) m ty /// Get the available methods of a type (both declared and inherited) -let IntrinsicMethInfosOfType (infoReader:InfoReader) (optFilter,ad,allowMultiIntfInst) findFlag m ty = +let IntrinsicMethInfosOfType (infoReader:InfoReader) (optFilter, ad, allowMultiIntfInst) findFlag m ty = let g = infoReader.g let amap = infoReader.amap - let minfos = GetIntrinsicMethInfoSetsOfType infoReader (optFilter,ad,allowMultiIntfInst) findFlag m ty + let minfos = GetIntrinsicMethInfoSetsOfType infoReader (optFilter, ad, allowMultiIntfInst) findFlag m ty let minfos = minfos |> ExcludeHiddenOfMethInfos g amap m minfos /// Select from a list of extension methods -let SelectMethInfosFromExtMembers (infoReader:InfoReader) optFilter apparentTy m extMemInfos = +let SelectMethInfosFromExtMembers (infoReader:InfoReader) optFilter apparentTy m extMemInfos = let g = infoReader.g - // NOTE: multiple "open"'s push multiple duplicate values into eIndexedExtensionMembers + // NOTE: multiple "open"'s push multiple duplicate values into eIndexedExtensionMembers let seen = HashSet(ExtensionMember.Comparer g) [ for emem in extMemInfos do if seen.Add emem then - match emem with - | FSExtMem (vref,pri) -> - match vref.MemberInfo with + match emem with + | FSExtMem (vref, pri) -> + match vref.MemberInfo with | None -> () - | Some membInfo -> + | Some membInfo -> match TrySelectMemberVal g optFilter apparentTy (Some pri) membInfo vref with | Some m -> yield m | _ -> () - | ILExtMem (actualParent,minfo,pri) when (match optFilter with None -> true | Some nm -> nm = minfo.LogicalName) -> + | ILExtMem (actualParent, minfo, pri) when (match optFilter with None -> true | Some nm -> nm = minfo.LogicalName) -> // Make a reference to the type containing the extension members - match minfo with - | ILMeth(_,ilminfo,_) -> + match minfo with + | ILMeth(_, ilminfo, _) -> yield (MethInfo.CreateILExtensionMeth (infoReader.amap, m, apparentTy, actualParent, Some pri, ilminfo.RawMetadata)) // F#-defined IL-style extension methods are not seen as extension methods in F# code - | FSMeth(g,_,vref,_) -> + | FSMeth(g, _, vref, _) -> yield (FSMeth(g, apparentTy, vref, Some pri)) #if !NO_EXTENSIONTYPING // // Provided extension methods are not yet supported - | ProvidedMeth(amap,providedMeth,_,m) -> - yield (ProvidedMeth(amap, providedMeth, Some pri,m)) + | ProvidedMeth(amap, providedMeth, _, m) -> + yield (ProvidedMeth(amap, providedMeth, Some pri, m)) #endif - | DefaultStructCtor _ -> + | DefaultStructCtor _ -> () | _ -> () ] @@ -2038,10 +2037,10 @@ let SelectMethInfosFromExtMembers (infoReader:InfoReader) optFilter apparentTy m /// Query the available extension properties of a methods (including extension methods for inherited types) let ExtensionMethInfosOfTypeInScope (infoReader:InfoReader) (nenv: NameResolutionEnv) optFilter m ty = let extMemsDangling = SelectMethInfosFromExtMembers infoReader optFilter ty m nenv.eUnindexedExtensionMembers - let extMemsFromHierarchy = - infoReader.GetEntireTypeHierachy(AllowMultiIntfInstantiations.Yes,m,ty) |> List.collect (fun ty -> + let extMemsFromHierarchy = + infoReader.GetEntireTypeHierachy(AllowMultiIntfInstantiations.Yes, m, ty) |> List.collect (fun ty -> let g = infoReader.g - if isAppTy g ty then + if isAppTy g ty then let tcref = tcrefOfAppTy g ty let extValRefs = nenv.eIndexedExtensionMembers.Find tcref SelectMethInfosFromExtMembers infoReader optFilter ty m extValRefs @@ -2049,9 +2048,9 @@ let ExtensionMethInfosOfTypeInScope (infoReader:InfoReader) (nenv: NameResolutio extMemsDangling @ extMemsFromHierarchy /// Get all the available methods of a type (both intrinsic and extension) -let AllMethInfosOfTypeInScope infoReader nenv (optFilter,ad) findFlag m ty = - IntrinsicMethInfosOfType infoReader (optFilter,ad,AllowMultiIntfInstantiations.Yes) findFlag m ty - @ ExtensionMethInfosOfTypeInScope infoReader nenv optFilter m ty +let AllMethInfosOfTypeInScope infoReader nenv (optFilter, ad) findFlag m ty = + IntrinsicMethInfosOfType infoReader (optFilter, ad, AllowMultiIntfInstantiations.Yes) findFlag m ty + @ ExtensionMethInfosOfTypeInScope infoReader nenv optFilter m ty /// Used to report an error condition where name resolution failed due to an indeterminate type @@ -2059,7 +2058,7 @@ exception IndeterminateType of range /// Indicates the kind of lookup being performed. Note, this type should be made private to nameres.fs. [] -type LookupKind = +type LookupKind = | RecdField | Pattern | Expr @@ -2070,49 +2069,49 @@ type LookupKind = /// Try to find a union case of a type, with the given name let TryFindUnionCaseOfType g ty nm = match tryAppTy g ty with - | ValueSome(tcref,tinst) -> - match tcref.GetUnionCaseByName nm with + | ValueSome(tcref, tinst) -> + match tcref.GetUnionCaseByName nm with | None -> ValueNone - | Some ucase -> ValueSome(UnionCaseInfo(tinst,tcref.MakeNestedUnionCaseRef ucase)) + | Some ucase -> ValueSome(UnionCaseInfo(tinst, tcref.MakeNestedUnionCaseRef ucase)) | _ -> ValueNone /// Try to find a union case of a type, with the given name let TryFindAnonRecdFieldOfType g typ nm = - match tryDestAnonRecdTy g typ with - | ValueSome (anonInfo, tys) -> - match anonInfo.SortedIds |> Array.tryFindIndex (fun x -> x.idText = nm) with + match tryDestAnonRecdTy g typ with + | ValueSome (anonInfo, tys) -> + match anonInfo.SortedIds |> Array.tryFindIndex (fun x -> x.idText = nm) with | Some i -> Some (Item.AnonRecdField(anonInfo, tys, i, anonInfo.SortedIds.[i].idRange)) | None -> None | ValueNone -> None -let CoreDisplayName(pinfo:PropInfo) = +let CoreDisplayName(pinfo:PropInfo) = match pinfo with - | FSProp(_,_,_,Some set) -> set.CoreDisplayName - | FSProp(_,_,Some get,_) -> get.CoreDisplayName + | FSProp(_, _, _, Some set) -> set.CoreDisplayName + | FSProp(_, _, Some get, _) -> get.CoreDisplayName | FSProp _ -> failwith "unexpected (property must have either getter or setter)" - | ILProp(ILPropInfo(_,def)) -> def.Name + | ILProp(ILPropInfo(_, def)) -> def.Name #if !NO_EXTENSIONTYPING - | ProvidedProp(_,pi,m) -> pi.PUntaint((fun pi -> pi.Name), m) + | ProvidedProp(_, pi, m) -> pi.PUntaint((fun pi -> pi.Name), m) #endif let DecodeFSharpEvent (pinfos:PropInfo list) ad g (ncenv:NameResolver) m = - match pinfos with - | [pinfo] when pinfo.IsFSharpEventProperty -> + match pinfos with + | [pinfo] when pinfo.IsFSharpEventProperty -> let nm = CoreDisplayName(pinfo) - let minfos1 = GetImmediateIntrinsicMethInfosOfType (Some("add_"+nm),ad) g ncenv.amap m pinfo.ApparentEnclosingType - let minfos2 = GetImmediateIntrinsicMethInfosOfType (Some("remove_"+nm),ad) g ncenv.amap m pinfo.ApparentEnclosingType - match minfos1,minfos2 with - | [FSMeth(_,_,addValRef,_)],[FSMeth(_,_,removeValRef,_)] -> + let minfos1 = GetImmediateIntrinsicMethInfosOfType (Some("add_"+nm), ad) g ncenv.amap m pinfo.ApparentEnclosingType + let minfos2 = GetImmediateIntrinsicMethInfosOfType (Some("remove_"+nm), ad) g ncenv.amap m pinfo.ApparentEnclosingType + match minfos1, minfos2 with + | [FSMeth(_, _, addValRef, _)], [FSMeth(_, _, removeValRef, _)] -> // FOUND PROPERTY-AS-EVENT AND CORRESPONDING ADD/REMOVE METHODS - Some(Item.Event(FSEvent(g,pinfo,addValRef,removeValRef))) - | _ -> + Some(Item.Event(FSEvent(g, pinfo, addValRef, removeValRef))) + | _ -> // FOUND PROPERTY-AS-EVENT BUT DIDN'T FIND CORRESPONDING ADD/REMOVE METHODS - Some(Item.Property (nm,pinfos)) - | pinfo :: _ -> + Some(Item.Property (nm, pinfos)) + | pinfo :: _ -> let nm = CoreDisplayName(pinfo) - Some(Item.Property (nm,pinfos)) - | _ -> + Some(Item.Property (nm, pinfos)) + | _ -> None /// Returns all record label names for the given type. @@ -2125,104 +2124,104 @@ let GetRecordLabelsForType g nenv ty = result.Add k |> ignore result -// REVIEW: this shows up on performance logs. Consider for example endless resolutions of "List.map" to +// REVIEW: this shows up on performance logs. Consider for example endless resolutions of "List.map" to // the empty set of results, or "x.Length" for a list or array type. This indicates it could be worth adding a cache here. let rec ResolveLongIdentInTypePrim (ncenv:NameResolver) nenv lookupKind (resInfo:ResolutionInfo) depth m ad (id:Ident) (rest:Ident list) findFlag (typeNameResInfo: TypeNameResolutionInfo) ty = let g = ncenv.g let m = unionRanges m id.idRange - let nm = id.idText // used to filter the searches of the tables - let optFilter = Some nm // used to filter the searches of the tables - let contentsSearchAccessible = - let unionCaseSearch = - match lookupKind with - | LookupKind.Expr | LookupKind.Pattern -> TryFindUnionCaseOfType g ty nm + let nm = id.idText // used to filter the searches of the tables + let optFilter = Some nm // used to filter the searches of the tables + let contentsSearchAccessible = + let unionCaseSearch = + match lookupKind with + | LookupKind.Expr | LookupKind.Pattern -> TryFindUnionCaseOfType g ty nm | _ -> ValueNone - // Lookup: datatype constructors take precedence - match unionCaseSearch with - | ValueSome ucase -> - OneResult (success(resInfo,Item.UnionCase(ucase,false),rest)) - | ValueNone -> - let anonRecdSearch = - match lookupKind with + // Lookup: datatype constructors take precedence + match unionCaseSearch with + | ValueSome ucase -> + OneResult (success(resInfo, Item.UnionCase(ucase, false), rest)) + | ValueNone -> + let anonRecdSearch = + match lookupKind with | LookupKind.Expr -> TryFindAnonRecdFieldOfType g ty nm | _ -> None - match anonRecdSearch with - | Some item -> + match anonRecdSearch with + | Some item -> OneResult (success(resInfo, item, rest)) - | None -> + | None -> let isLookUpExpr = (lookupKind = LookupKind.Expr) - match TryFindIntrinsicNamedItemOfType ncenv.InfoReader (nm,ad) findFlag m ty with - | Some (PropertyItem psets) when isLookUpExpr -> + match TryFindIntrinsicNamedItemOfType ncenv.InfoReader (nm, ad) findFlag m ty with + | Some (PropertyItem psets) when isLookUpExpr -> let pinfos = psets |> ExcludeHiddenOfPropInfos g ncenv.amap m - + // fold the available extension members into the overload resolution - let extensionPropInfos = ExtensionPropInfosOfTypeInScope ncenv.InfoReader nenv (optFilter,ad) m ty - + let extensionPropInfos = ExtensionPropInfosOfTypeInScope ncenv.InfoReader nenv (optFilter, ad) m ty + // make sure to keep the intrinsic pinfos before the extension pinfos in the list, // since later on this logic is used when giving preference to intrinsic definitions match DecodeFSharpEvent (pinfos@extensionPropInfos) ad g ncenv m with | Some x -> success [resInfo, x, rest] - | None -> raze (UndefinedName (depth,FSComp.SR.undefinedNameFieldConstructorOrMember, id,NoSuggestions)) + | None -> raze (UndefinedName (depth, FSComp.SR.undefinedNameFieldConstructorOrMember, id, NoSuggestions)) - | Some(MethodItem msets) when isLookUpExpr -> + | Some(MethodItem msets) when isLookUpExpr -> let minfos = msets |> ExcludeHiddenOfMethInfos g ncenv.amap m - + // fold the available extension members into the overload resolution let extensionMethInfos = ExtensionMethInfosOfTypeInScope ncenv.InfoReader nenv optFilter m ty - success [resInfo,Item.MakeMethGroup (nm,minfos@extensionMethInfos),rest] - | Some (ILFieldItem (finfo:: _)) when (match lookupKind with LookupKind.Expr | LookupKind.Pattern -> true | _ -> false) -> - success [resInfo,Item.ILField finfo,rest] + success [resInfo, Item.MakeMethGroup (nm, minfos@extensionMethInfos), rest] + | Some (ILFieldItem (finfo:: _)) when (match lookupKind with LookupKind.Expr | LookupKind.Pattern -> true | _ -> false) -> + success [resInfo, Item.ILField finfo, rest] - | Some (EventItem (einfo :: _)) when isLookUpExpr -> - success [resInfo,Item.Event einfo,rest] + | Some (EventItem (einfo :: _)) when isLookUpExpr -> + success [resInfo, Item.Event einfo, rest] - | Some (RecdFieldItem (rfinfo)) when (match lookupKind with LookupKind.Expr | LookupKind.RecdField | LookupKind.Pattern -> true | _ -> false) -> - success [resInfo,Item.RecdField(rfinfo),rest] + | Some (RecdFieldItem (rfinfo)) when (match lookupKind with LookupKind.Expr | LookupKind.RecdField | LookupKind.Pattern -> true | _ -> false) -> + success [resInfo, Item.RecdField(rfinfo), rest] | _ -> let pinfos = ExtensionPropInfosOfTypeInScope ncenv.InfoReader nenv (optFilter, ad) m ty - if not (isNil pinfos) && isLookUpExpr then OneResult(success (resInfo,Item.Property (nm,pinfos),rest)) else + if not (isNil pinfos) && isLookUpExpr then OneResult(success (resInfo, Item.Property (nm, pinfos), rest)) else let minfos = ExtensionMethInfosOfTypeInScope ncenv.InfoReader nenv optFilter m ty - if not (isNil minfos) && isLookUpExpr then - success [resInfo,Item.MakeMethGroup (nm,minfos),rest] + if not (isNil minfos) && isLookUpExpr then + success [resInfo, Item.MakeMethGroup (nm, minfos), rest] elif isTyparTy g ty then raze (IndeterminateType(unionRanges m id.idRange)) else NoResultsOrUsefulErrors match contentsSearchAccessible with | Result res when not (isNil res) -> contentsSearchAccessible | Exception _ -> contentsSearchAccessible - | _ -> - - let nestedSearchAccessible = + | _ -> + + let nestedSearchAccessible = match rest with | [] -> let nestedTypes = GetNestedTypesOfType (ad, ncenv, Some nm, typeNameResInfo.StaticArgsInfo, true, m) ty - if isNil nestedTypes then + if isNil nestedTypes then NoResultsOrUsefulErrors - else - match typeNameResInfo.ResolutionFlag with - | ResolveTypeNamesToCtors -> - nestedTypes - |> CollectAtMostOneResult (ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo m ad) - |> MapResults (fun (resInfo,item) -> (resInfo,item,[])) - | ResolveTypeNamesToTypeRefs -> - OneSuccess (resInfo,Item.Types (nm,nestedTypes),rest) + else + match typeNameResInfo.ResolutionFlag with + | ResolveTypeNamesToCtors -> + nestedTypes + |> CollectAtMostOneResult (ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo m ad) + |> MapResults (fun (resInfo, item) -> (resInfo, item, [])) + | ResolveTypeNamesToTypeRefs -> + OneSuccess (resInfo, Item.Types (nm, nestedTypes), rest) | id2::rest2 -> let nestedTypes = GetNestedTypesOfType (ad, ncenv, Some nm, TypeNameResolutionStaticArgsInfo.Indefinite, true, m) ty ResolveLongIdentInNestedTypes ncenv nenv lookupKind resInfo (depth+1) id m ad id2 rest2 findFlag typeNameResInfo nestedTypes match nestedSearchAccessible with | Result res when not (isNil res) -> nestedSearchAccessible - | _ -> - let suggestMembers() = + | _ -> + let suggestMembers() = let suggestions1 = - ExtensionPropInfosOfTypeInScope ncenv.InfoReader nenv (None, ad) m ty + ExtensionPropInfosOfTypeInScope ncenv.InfoReader nenv (None, ad) m ty |> List.map (fun p -> p.PropertyName) - + let suggestions2 = ExtensionMethInfosOfTypeInScope ncenv.InfoReader nenv None m ty |> List.map (fun m -> m.DisplayName) @@ -2239,17 +2238,17 @@ let rec ResolveLongIdentInTypePrim (ncenv:NameResolver) nenv lookupKind (resInfo let suggestions5 = GetRecordLabelsForType g nenv ty let suggestions6 = - match lookupKind with + match lookupKind with | LookupKind.Expr | LookupKind.Pattern -> - if isAppTy g ty then + if isAppTy g ty then let tcref = tcrefOfAppTy g ty tcref.UnionCasesArray |> Array.map (fun uc -> uc.DisplayName) - else + else [||] | _ -> [||] - - [ yield! suggestions1 + + [ yield! suggestions1 yield! suggestions2 yield! suggestions3 yield! suggestions4 @@ -2257,24 +2256,24 @@ let rec ResolveLongIdentInTypePrim (ncenv:NameResolver) nenv lookupKind (resInfo yield! suggestions6 ] |> HashSet - raze (UndefinedName (depth,FSComp.SR.undefinedNameFieldConstructorOrMember, id, suggestMembers)) - -and ResolveLongIdentInNestedTypes (ncenv:NameResolver) nenv lookupKind resInfo depth id m ad (id2:Ident) (rest:Ident list) findFlag typeNameResInfo tys = - tys - |> CollectAtMostOneResult (fun ty -> - let resInfo = if isAppTy ncenv.g ty then resInfo.AddEntity(id.idRange,tcrefOfAppTy ncenv.g ty) else resInfo - ResolveLongIdentInTypePrim ncenv nenv lookupKind resInfo depth m ad id2 rest findFlag typeNameResInfo ty - |> AtMostOneResult m) + raze (UndefinedName (depth, FSComp.SR.undefinedNameFieldConstructorOrMember, id, suggestMembers)) + +and ResolveLongIdentInNestedTypes (ncenv:NameResolver) nenv lookupKind resInfo depth id m ad (id2:Ident) (rest:Ident list) findFlag typeNameResInfo tys = + tys + |> CollectAtMostOneResult (fun ty -> + let resInfo = if isAppTy ncenv.g ty then resInfo.AddEntity(id.idRange, tcrefOfAppTy ncenv.g ty) else resInfo + ResolveLongIdentInTypePrim ncenv nenv lookupKind resInfo depth m ad id2 rest findFlag typeNameResInfo ty + |> AtMostOneResult m) /// Resolve a long identifier using type-qualified name resolution. let ResolveLongIdentInType sink ncenv nenv lookupKind m ad id findFlag typeNameResInfo ty = - let resInfo,item,rest = + let resInfo, item, rest = ResolveLongIdentInTypePrim (ncenv:NameResolver) nenv lookupKind ResolutionInfo.Empty 0 m ad id [] findFlag typeNameResInfo ty |> AtMostOneResult m |> ForceRaise - ResolutionInfo.SendEntityPathToSink (sink,ncenv,nenv,ItemOccurence.UseInType,ad,resInfo,ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) - item,rest + ResolutionInfo.SendEntityPathToSink (sink, ncenv, nenv, ItemOccurence.UseInType, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) + item, rest let private ResolveLongIdentInTyconRef (ncenv:NameResolver) nenv lookupKind resInfo depth m ad id rest typeNameResInfo tcref = #if !NO_EXTENSIONTYPING @@ -2282,18 +2281,18 @@ let private ResolveLongIdentInTyconRef (ncenv:NameResolver) nenv lookupKind resI CheckForDirectReferenceToGeneratedType (tcref, PermitDirectReferenceToGeneratedType.No, m) #endif let ty = FreshenTycon ncenv m tcref - ty |> ResolveLongIdentInTypePrim ncenv nenv lookupKind resInfo depth m ad id rest IgnoreOverrides typeNameResInfo + ty |> ResolveLongIdentInTypePrim ncenv nenv lookupKind resInfo depth m ad id rest IgnoreOverrides typeNameResInfo -let private ResolveLongIdentInTyconRefs atMostOne (ncenv:NameResolver) nenv lookupKind depth m ad id rest typeNameResInfo idRange tcrefs = - tcrefs |> CollectResults2 atMostOne (fun (resInfo:ResolutionInfo,tcref) -> - let resInfo = resInfo.AddEntity(idRange,tcref) - tcref |> ResolveLongIdentInTyconRef ncenv nenv lookupKind resInfo depth m ad id rest typeNameResInfo |> AtMostOneResult m) +let private ResolveLongIdentInTyconRefs atMostOne (ncenv:NameResolver) nenv lookupKind depth m ad id rest typeNameResInfo idRange tcrefs = + tcrefs |> CollectResults2 atMostOne (fun (resInfo:ResolutionInfo, tcref) -> + let resInfo = resInfo.AddEntity(idRange, tcref) + tcref |> ResolveLongIdentInTyconRef ncenv nenv lookupKind resInfo depth m ad id rest typeNameResInfo |> AtMostOneResult m) //------------------------------------------------------------------------- -// ResolveExprLongIdentInModuleOrNamespace -//------------------------------------------------------------------------- +// ResolveExprLongIdentInModuleOrNamespace +//------------------------------------------------------------------------- -let (|AccessibleEntityRef|_|) amap m ad (modref: ModuleOrNamespaceRef) mspec = +let (|AccessibleEntityRef|_|) amap m ad (modref: ModuleOrNamespaceRef) mspec = let eref = modref.NestedTyconRef mspec if IsEntityAccessible amap m ad eref then Some eref else None @@ -2301,68 +2300,68 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN // resInfo records the modules or namespaces actually relevant to a resolution let m = unionRanges m id.idRange match mty.AllValsByLogicalName.TryGetValue id.idText with - | true, vspec when IsValAccessible ad (mkNestedValRef modref vspec) -> - success(resInfo,Item.Value (mkNestedValRef modref vspec),rest) + | true, vspec when IsValAccessible ad (mkNestedValRef modref vspec) -> + success(resInfo, Item.Value (mkNestedValRef modref vspec), rest) | _-> match mty.ExceptionDefinitionsByDemangledName.TryGetValue id.idText with - | true, excon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef excon) -> - success (resInfo,Item.ExnCase (modref.NestedTyconRef excon),rest) + | true, excon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef excon) -> + success (resInfo, Item.ExnCase (modref.NestedTyconRef excon), rest) | _ -> // Something in a discriminated union without RequireQualifiedAccess attribute? - let unionSearch,hasRequireQualifiedAccessAttribute = + let unionSearch, hasRequireQualifiedAccessAttribute = match TryFindTypeWithUnionCase modref id with - | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> + | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> let ucref = mkUnionCaseRef (modref.NestedTyconRef tycon) id.idText let ucinfo = FreshenUnionCaseRef ncenv m ucref let hasRequireQualifiedAccessAttribute = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs - success [resInfo,Item.UnionCase(ucinfo,hasRequireQualifiedAccessAttribute),rest],hasRequireQualifiedAccessAttribute - | _ -> NoResultsOrUsefulErrors,false + success [resInfo, Item.UnionCase(ucinfo, hasRequireQualifiedAccessAttribute), rest], hasRequireQualifiedAccessAttribute + | _ -> NoResultsOrUsefulErrors, false match unionSearch with | Result (res :: _) when not hasRequireQualifiedAccessAttribute -> success res | _ -> // Something in a type? - let tyconSearch = + let tyconSearch = let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, id.idRange, ad, id.idText, (if isNil rest then typeNameResInfo.StaticArgsInfo else TypeNameResolutionStaticArgsInfo.Indefinite), modref) if isNil tcrefs then NoResultsOrUsefulErrors else - let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo,tcref)) + let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo, tcref)) match rest with | id2::rest2 -> - let tcrefs = - let typeNameResInfo = TypeNameResolutionInfo (ResolveTypeNamesToTypeRefs,TypeNameResolutionStaticArgsInfo.Indefinite) + let tcrefs = + let typeNameResInfo = TypeNameResolutionInfo (ResolveTypeNamesToTypeRefs, TypeNameResolutionStaticArgsInfo.Indefinite) CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult ncenv nenv LookupKind.Expr (depth+1) m ad id2 rest2 typeNameResInfo id.idRange tcrefs - // Check if we've got some explicit type arguments + // Check if we've got some explicit type arguments | _ -> let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) - match typeNameResInfo.ResolutionFlag with - | ResolveTypeNamesToTypeRefs -> - success [ for (resInfo,tcref) in tcrefs do - let ty = FreshenTycon ncenv m tcref - let item = (resInfo,Item.Types(id.idText,[ty]),[]) + match typeNameResInfo.ResolutionFlag with + | ResolveTypeNamesToTypeRefs -> + success [ for (resInfo, tcref) in tcrefs do + let ty = FreshenTycon ncenv m tcref + let item = (resInfo, Item.Types(id.idText, [ty]), []) yield item ] - | ResolveTypeNamesToCtors -> - tcrefs - |> List.map (fun (resInfo, tcref) -> resInfo, FreshenTycon ncenv m tcref) - |> CollectAtMostOneResult (fun (resInfo,ty) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad ty) - |> MapResults (fun (resInfo,item) -> (resInfo,item,[])) + | ResolveTypeNamesToCtors -> + tcrefs + |> List.map (fun (resInfo, tcref) -> resInfo, FreshenTycon ncenv m tcref) + |> CollectAtMostOneResult (fun (resInfo, ty) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad ty) + |> MapResults (fun (resInfo, item) -> (resInfo, item, [])) - // Something in a sub-namespace or sub-module - let moduleSearch() = + // Something in a sub-namespace or sub-module + let moduleSearch() = match rest with | id2::rest2 -> match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with - | true, AccessibleEntityRef ncenv.amap m ad modref submodref -> - let resInfo = resInfo.AddEntity(id.idRange,submodref) + | true, AccessibleEntityRef ncenv.amap m ad modref submodref -> + let resInfo = resInfo.AddEntity(id.idRange, submodref) OneResult (ResolveExprLongIdentInModuleOrNamespace ncenv nenv typeNameResInfo ad resInfo (depth+1) m submodref submodref.ModuleOrNamespaceType id2 rest2) - | _ -> + | _ -> NoResultsOrUsefulErrors | _ -> NoResultsOrUsefulErrors @@ -2370,7 +2369,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN match tyconSearch +++ moduleSearch +++ (fun _ -> unionSearch) with | Result [] -> let suggestPossibleTypesAndNames() = - let types = + let types = modref.ModuleOrNamespaceType.AllEntities |> Seq.filter (fun e -> IsEntityAccessible ncenv.amap m ad (modref.NestedTyconRef e)) |> Seq.map (fun e -> e.DisplayName) @@ -2379,7 +2378,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN mty.ModulesAndNamespacesByDemangledName |> Seq.filter (fun kv -> IsEntityAccessible ncenv.amap m ad (modref.NestedTyconRef kv.Value)) |> Seq.map (fun e -> e.Value.DisplayName) - + let unions = modref.ModuleOrNamespaceType.AllEntities |> Seq.collect (fun tycon -> @@ -2390,16 +2389,16 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN tycon.UnionCasesArray) |> Seq.map (fun uc -> uc.DisplayName) - let vals = + let vals = modref.ModuleOrNamespaceType.AllValsByLogicalName |> Seq.filter (fun e -> IsValAccessible ad (mkNestedValRef modref e.Value)) |> Seq.map (fun e -> e.Value.DisplayName) - + let exns = modref.ModuleOrNamespaceType.ExceptionDefinitionsByDemangledName |> Seq.filter (fun e -> IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef e.Value)) |> Seq.map (fun e -> e.Value.DisplayName) - + [ yield! types yield! submodules yield! unions @@ -2407,26 +2406,26 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN yield! exns ] |> HashSet - raze (UndefinedName(depth,FSComp.SR.undefinedNameValueConstructorNamespaceOrType,id,suggestPossibleTypesAndNames)) + raze (UndefinedName(depth, FSComp.SR.undefinedNameValueConstructorNamespaceOrType, id, suggestPossibleTypesAndNames)) | results -> AtMostOneResult id.idRange results -/// An identifier has resolved to a type name in an expression (corresponding to one or more TyconRefs). +/// An identifier has resolved to a type name in an expression (corresponding to one or more TyconRefs). /// Return either a set of constructors (later refined by overload resolution), or a set of TyconRefs. let ChooseTyconRefInExpr (ncenv:NameResolver, m, ad, nenv, id:Ident, typeNameResInfo:TypeNameResolutionInfo, resInfo:ResolutionInfo, tcrefs) = - let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo,tcref)) + let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo, tcref)) let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, m) - match typeNameResInfo.ResolutionFlag with + match typeNameResInfo.ResolutionFlag with | ResolveTypeNamesToCtors -> - let tys = tcrefs |> List.map (fun (resInfo,tcref) -> (resInfo,FreshenTycon ncenv m tcref)) - tys - |> CollectAtMostOneResult (fun (resInfo,ty) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad ty) - |> MapResults (fun (resInfo,item) -> (resInfo,item,[])) + let tys = tcrefs |> List.map (fun (resInfo, tcref) -> (resInfo, FreshenTycon ncenv m tcref)) + tys + |> CollectAtMostOneResult (fun (resInfo, ty) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad ty) + |> MapResults (fun (resInfo, item) -> (resInfo, item, [])) | ResolveTypeNamesToTypeRefs -> - let tys = tcrefs |> List.map (fun (resInfo,tcref) -> (resInfo,FreshenTycon ncenv m tcref)) - success (tys |> List.map (fun (resInfo,ty) -> (resInfo,Item.Types(id.idText,[ty]),[]))) + let tys = tcrefs |> List.map (fun (resInfo, tcref) -> (resInfo, FreshenTycon ncenv m tcref)) + success (tys |> List.map (fun (resInfo, ty) -> (resInfo, Item.Types(id.idText, [ty]), []))) /// Resolve F# "A.B.C" syntax in expressions -/// Not all of the sequence will necessarily be swallowed, i.e. we return some identifiers +/// Not all of the sequence will necessarily be swallowed, i.e. we return some identifiers /// that may represent further actions, e.g. further lookups. let rec ResolveExprLongIdentPrim sink (ncenv:NameResolver) first fullyQualified m ad nenv (typeNameResInfo:TypeNameResolutionInfo) (id:Ident) (rest:Ident list) isOpenDecl = let resInfo = ResolutionInfo.Empty @@ -2442,54 +2441,54 @@ let rec ResolveExprLongIdentPrim sink (ncenv:NameResolver) first fullyQualified if isNil rest && fullyQualified <> FullyQualified then let typeError = ref None // Single identifier. Lookup the unqualified names in the environment - let envSearch = + let envSearch = match nenv.eUnqualifiedItems.TryGetValue id.idText with // The name is a type name and it has not been clobbered by some other name - | true, Item.UnqualifiedType tcrefs -> - - // Do not use type names from the environment if an explicit type instantiation is + | true, Item.UnqualifiedType tcrefs -> + + // Do not use type names from the environment if an explicit type instantiation is // given and the number of type parameters do not match - let tcrefs = + let tcrefs = tcrefs |> List.filter (fun tcref -> - typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo || + typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo || typeNameResInfo.StaticArgsInfo.NumStaticArgs = tcref.Typars(m).Length) - + let search = ChooseTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, resInfo, tcrefs) - match AtMostOneResult m search with - | Result _ as res -> - let resInfo,item,rest = ForceRaise res - ResolutionInfo.SendEntityPathToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) - Some(item,rest) + match AtMostOneResult m search with + | Result _ as res -> + let resInfo, item, rest = ForceRaise res + ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) + Some(item, rest) | Exception e -> typeError := Some e; None | true, res -> Some (FreshenUnqualifiedItem ncenv m res, []) - | _ -> + | _ -> None - match envSearch with + match envSearch with | Some res -> res | None -> let innerSearch = // Check if it's a type name, e.g. a constructor call or a type instantiation - let ctorSearch = + let ctorSearch = let tcrefs = LookupTypeNameInEnvMaybeHaveArity fullyQualified id.idText typeNameResInfo nenv ChooseTyconRefInExpr (ncenv, m, ad, nenv, id, typeNameResInfo, resInfo, tcrefs) - let implicitOpSearch() = - if IsMangledOpName id.idText then - success [(resInfo,Item.ImplicitOp(id, ref None),[])] - else + let implicitOpSearch() = + if IsMangledOpName id.idText then + success [(resInfo, Item.ImplicitOp(id, ref None), [])] + else NoResultsOrUsefulErrors ctorSearch +++ implicitOpSearch - let resInfo,item,rest = + let resInfo, item, rest = match AtMostOneResult m innerSearch with | Result _ as res -> ForceRaise res - | _ -> - let failingCase = + | _ -> + let failingCase = match !typeError with | Some e -> raze e | _ -> @@ -2514,7 +2513,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv:NameResolver) first fullyQualified nenv.eTyconsByDemangledNameAndArity |> Seq.choose (fun e -> let hasRequireQualifiedAccessAttribute = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute e.Value.Attribs - if not hasRequireQualifiedAccessAttribute then + if not hasRequireQualifiedAccessAttribute then None else if e.Value.IsUnionTycon && e.Value.UnionCasesArray |> Array.exists (fun c -> c.DisplayName = id.idText) then @@ -2522,53 +2521,53 @@ let rec ResolveExprLongIdentPrim sink (ncenv:NameResolver) first fullyQualified else None) |> Seq.map (fun t -> t.DisplayName + "." + id.idText) - + [ yield! suggestedNames yield! suggestedTypes yield! suggestedModulesAndNamespaces yield! unions ] |> HashSet - raze (UndefinedName(0,FSComp.SR.undefinedNameValueOfConstructor,id,suggestNamesAndTypes)) + raze (UndefinedName(0, FSComp.SR.undefinedNameValueOfConstructor, id, suggestNamesAndTypes)) ForceRaise failingCase - ResolutionInfo.SendEntityPathToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) - item,rest - - - // A compound identifier. - // It still might be a value in the environment, or something in an F# module, namespace, type, or nested type - else + ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) + item, rest + + + // A compound identifier. + // It still might be a value in the environment, or something in an F# module, namespace, type, or nested type + else let m = unionRanges m id.idRange - // Values in the environment take total priority, but constructors do NOT for compound lookups, e.g. if someone in some imported - // module has defined a constructor "String" (common enough) then "String.foo" doesn't give an error saying 'constructors have no members' + // Values in the environment take total priority, but constructors do NOT for compound lookups, e.g. if someone in some imported + // module has defined a constructor "String" (common enough) then "String.foo" doesn't give an error saying 'constructors have no members' // Instead we go lookup the String module or type. - let ValIsInEnv nm = - match fullyQualified with + let ValIsInEnv nm = + match fullyQualified with | FullyQualified -> false - | _ -> - match nenv.eUnqualifiedItems.TryGetValue nm with - | true, Item.Value _ -> true + | _ -> + match nenv.eUnqualifiedItems.TryGetValue nm with + | true, Item.Value _ -> true | _ -> false if ValIsInEnv id.idText then nenv.eUnqualifiedItems.[id.idText], rest else - // Otherwise modules are searched first. REVIEW: modules and types should be searched together. - // For each module referenced by 'id', search the module as if it were an F# module and/or a .NET namespace. - let moduleSearch ad () = + // Otherwise modules are searched first. REVIEW: modules and types should be searched together. + // For each module referenced by 'id', search the module as if it were an F# module and/or a .NET namespace. + let moduleSearch ad () = ResolveLongIndentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m fullyQualified nenv ad id rest isOpenDecl (ResolveExprLongIdentInModuleOrNamespace ncenv nenv typeNameResInfo ad) // REVIEW: somewhat surprisingly, this shows up on performance traces, with tcrefs non-nil. // This seems strange since we would expect in the vast majority of cases tcrefs is empty here. - let tyconSearch ad () = + let tyconSearch ad () = let tcrefs = LookupTypeNameInEnvNoArity fullyQualified id.idText nenv - if isNil tcrefs then NoResultsOrUsefulErrors else + if isNil tcrefs then NoResultsOrUsefulErrors else match rest with | id2::rest2 -> - let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo,tcref)) - let tcrefs = + let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo, tcref)) + let tcrefs = let typeNameResInfo = TypeNameResolutionInfo.ResolveToTypeRefs (TypeNameResolutionStaticArgsInfo.Indefinite) CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange) ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult ncenv nenv LookupKind.Expr 1 m ad id2 rest2 typeNameResInfo id.idRange tcrefs @@ -2576,58 +2575,58 @@ let rec ResolveExprLongIdentPrim sink (ncenv:NameResolver) first fullyQualified NoResultsOrUsefulErrors let search = - let envSearch () = - match fullyQualified with - | FullyQualified -> + let envSearch () = + match fullyQualified with + | FullyQualified -> NoResultsOrUsefulErrors - | OpenQualified -> + | OpenQualified -> match nenv.eUnqualifiedItems.TryGetValue id.idText with - | true, Item.UnqualifiedType _ + | true, Item.UnqualifiedType _ | false, _ -> NoResultsOrUsefulErrors - | true, res -> OneSuccess (resInfo,FreshenUnqualifiedItem ncenv m res,rest) - + | true, res -> OneSuccess (resInfo, FreshenUnqualifiedItem ncenv m res, rest) + moduleSearch ad () +++ tyconSearch ad +++ envSearch - let resInfo,item,rest = - match AtMostOneResult m search with + let resInfo, item, rest = + match AtMostOneResult m search with | Result _ as res -> ForceRaise res | _ -> let innerSearch = search +++ (moduleSearch AccessibleFromSomeFSharpCode) +++ (tyconSearch AccessibleFromSomeFSharpCode) let suggestEverythingInScope() = - seq { yield! + seq { yield! nenv.ModulesAndNamespaces fullyQualified |> Seq.collect (fun kv -> kv.Value) |> Seq.filter (fun modref -> IsEntityAccessible ncenv.amap m ad modref) |> Seq.collect (fun e -> [e.DisplayName; e.DemangledModuleOrNamespaceName]) - + yield! nenv.TyconsByDemangledNameAndArity fullyQualified |> Seq.filter (fun e -> IsEntityAccessible ncenv.amap m ad e.Value) |> Seq.map (fun e -> e.Value.DisplayName) - yield! + yield! nenv.eUnqualifiedItems |> Seq.map (fun e -> e.Value.DisplayName) } |> HashSet match innerSearch with - | Exception (UndefinedName(0,_,id1,suggestionsF)) when Range.equals id.idRange id1.idRange -> + | Exception (UndefinedName(0, _, id1, suggestionsF)) when Range.equals id.idRange id1.idRange -> let mergeSuggestions() = let res = suggestEverythingInScope() res.UnionWith(suggestionsF()) res - let failingCase = raze (UndefinedName(0,FSComp.SR.undefinedNameValueNamespaceTypeOrModule,id,mergeSuggestions)) + let failingCase = raze (UndefinedName(0, FSComp.SR.undefinedNameValueNamespaceTypeOrModule, id, mergeSuggestions)) ForceRaise failingCase | Exception err -> ForceRaise(Exception err) | Result (res :: _) -> ForceRaise(Result res) | Result [] -> - let failingCase = raze (UndefinedName(0,FSComp.SR.undefinedNameValueNamespaceTypeOrModule,id,suggestEverythingInScope)) + let failingCase = raze (UndefinedName(0, FSComp.SR.undefinedNameValueNamespaceTypeOrModule, id, suggestEverythingInScope)) ForceRaise failingCase - ResolutionInfo.SendEntityPathToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) - item,rest + ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) + item, rest let ResolveExprLongIdent sink (ncenv:NameResolver) m ad nenv typeNameResInfo lid = match lid with @@ -2636,37 +2635,37 @@ let ResolveExprLongIdent sink (ncenv:NameResolver) m ad nenv typeNameResInfo lid //------------------------------------------------------------------------- // Resolve F#/IL "." syntax in patterns -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- -let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv numTyArgsOpt ad resInfo depth m modref (mty:ModuleOrNamespaceType) (id:Ident) (rest: Ident list) = +let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv numTyArgsOpt ad resInfo depth m modref (mty:ModuleOrNamespaceType) (id:Ident) (rest: Ident list) = let m = unionRanges m id.idRange match TryFindTypeWithUnionCase modref id with - | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> + | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> let tcref = modref.NestedTyconRef tycon let ucref = mkUnionCaseRef tcref id.idText let showDeprecated = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs let ucinfo = FreshenUnionCaseRef ncenv m ucref - success (resInfo,Item.UnionCase(ucinfo,showDeprecated),rest) - | _ -> + success (resInfo, Item.UnionCase(ucinfo, showDeprecated), rest) + | _ -> match mty.ExceptionDefinitionsByDemangledName.TryGetValue id.idText with - | true, exnc when IsEntityAccessible ncenv.amap m ad (modref.NestedTyconRef exnc) -> - success (resInfo,Item.ExnCase (modref.NestedTyconRef exnc),rest) + | true, exnc when IsEntityAccessible ncenv.amap m ad (modref.NestedTyconRef exnc) -> + success (resInfo, Item.ExnCase (modref.NestedTyconRef exnc), rest) | _ -> - // An active pattern constructor in a module + // An active pattern constructor in a module match (ActivePatternElemsOfModuleOrNamespace modref).TryGetValue id.idText with - | true, (APElemRef(_,vref,_) as apref) when IsValAccessible ad vref -> - success (resInfo,Item.ActivePatternCase apref,rest) - | _ -> + | true, (APElemRef(_, vref, _) as apref) when IsValAccessible ad vref -> + success (resInfo, Item.ActivePatternCase apref, rest) + | _ -> match mty.AllValsByLogicalName.TryGetValue id.idText with - | true, vspec when IsValAccessible ad (mkNestedValRef modref vspec) -> - success(resInfo,Item.Value (mkNestedValRef modref vspec),rest) + | true, vspec when IsValAccessible ad (mkNestedValRef modref vspec) -> + success(resInfo, Item.Value (mkNestedValRef modref vspec), rest) | _ -> let tcrefs = lazy ( LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, id.idRange, ad, id.idText, TypeNameResolutionStaticArgsInfo.Indefinite, modref) - |> List.map (fun tcref -> (resInfo,tcref))) + |> List.map (fun tcref -> (resInfo, tcref))) - // Something in a type? e.g. a literal field - let tyconSearch = + // Something in a type? e.g. a literal field + let tyconSearch = match rest with | id2::rest2 -> let tcrefs = tcrefs.Force() @@ -2674,36 +2673,36 @@ let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv num | _ -> NoResultsOrUsefulErrors - // Constructor of a type? - let ctorSearch() = + // Constructor of a type? + let ctorSearch() = if isNil rest then tcrefs.Force() - |> List.map (fun (resInfo,tcref) -> (resInfo,FreshenTycon ncenv m tcref)) - |> CollectAtMostOneResult (fun (resInfo,ty) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad ty) - |> MapResults (fun (resInfo,item) -> (resInfo,item,[])) + |> List.map (fun (resInfo, tcref) -> (resInfo, FreshenTycon ncenv m tcref)) + |> CollectAtMostOneResult (fun (resInfo, ty) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad ty) + |> MapResults (fun (resInfo, item) -> (resInfo, item, [])) else NoResultsOrUsefulErrors - // Something in a sub-namespace or sub-module or nested-type - let moduleSearch() = + // Something in a sub-namespace or sub-module or nested-type + let moduleSearch() = match rest with | id2::rest2 -> match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with - | true, AccessibleEntityRef ncenv.amap m ad modref submodref -> - let resInfo = resInfo.AddEntity(id.idRange,submodref) + | true, AccessibleEntityRef ncenv.amap m ad modref submodref -> + let resInfo = resInfo.AddEntity(id.idRange, submodref) OneResult (ResolvePatternLongIdentInModuleOrNamespace ncenv nenv numTyArgsOpt ad resInfo (depth+1) m submodref submodref.ModuleOrNamespaceType id2 rest2) - | _ -> + | _ -> NoResultsOrUsefulErrors | [] -> NoResultsOrUsefulErrors match tyconSearch +++ ctorSearch +++ moduleSearch with - | Result [] -> + | Result [] -> let suggestPossibleTypes() = let submodules = mty.ModulesAndNamespacesByDemangledName |> Seq.filter (fun kv -> IsEntityAccessible ncenv.amap m ad (modref.NestedTyconRef kv.Value)) |> Seq.collect (fun e -> [e.Value.DisplayName; e.Value.DemangledModuleOrNamespaceName]) - + let suggestedTypes = nenv.TyconsByDemangledNameAndArity FullyQualifiedFlag.OpenQualified |> Seq.filter (fun e -> IsEntityAccessible ncenv.amap m ad e.Value) @@ -2713,16 +2712,16 @@ let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv num yield! suggestedTypes ] |> HashSet - raze (UndefinedName(depth,FSComp.SR.undefinedNameConstructorModuleOrNamespace,id,suggestPossibleTypes)) + raze (UndefinedName(depth, FSComp.SR.undefinedNameConstructorModuleOrNamespace, id, suggestPossibleTypes)) | results -> AtMostOneResult id.idRange results - + /// Used to report a warning condition for the use of upper-case identifiers in patterns exception UpperCaseIdentifierInPattern of range /// Indicates if a warning should be given for the use of upper-case identifiers in patterns type WarnOnUpperFlag = WarnOnUpperCase | AllIdsOK -// Long ID in a pattern +// Long ID in a pattern let rec ResolvePatternLongIdentPrim sink (ncenv:NameResolver) fullyQualified warnOnUpper newDef m ad nenv numTyArgsOpt (id:Ident) (rest:Ident list) = if id.idText = MangledGlobalName then match rest with @@ -2731,39 +2730,39 @@ let rec ResolvePatternLongIdentPrim sink (ncenv:NameResolver) fullyQualified war | id2::rest2 -> ResolvePatternLongIdentPrim sink ncenv FullyQualified warnOnUpper newDef m ad nenv numTyArgsOpt id2 rest2 else - // Single identifiers in patterns + // Single identifiers in patterns if isNil rest && fullyQualified <> FullyQualified then - // Single identifiers in patterns - bind to constructors and active patterns - // For the special case of - // let C = x + // Single identifiers in patterns - bind to constructors and active patterns + // For the special case of + // let C = x match nenv.ePatItems.TryGetValue id.idText with | true, res when not newDef -> FreshenUnqualifiedItem ncenv m res - | _ -> - // Single identifiers in patterns - variable bindings + | _ -> + // Single identifiers in patterns - variable bindings if not newDef && - (warnOnUpper = WarnOnUpperCase) && - id.idText.Length >= 3 && - System.Char.ToLowerInvariant id.idText.[0] <> id.idText.[0] then + (warnOnUpper = WarnOnUpperCase) && + id.idText.Length >= 3 && + System.Char.ToLowerInvariant id.idText.[0] <> id.idText.[0] then warning(UpperCaseIdentifierInPattern(m)) Item.NewDef id - // Long identifiers in patterns + // Long identifiers in patterns else let moduleSearch ad () = ResolveLongIndentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m fullyQualified nenv ad id rest false (ResolvePatternLongIdentInModuleOrNamespace ncenv nenv numTyArgsOpt ad) - - let tyconSearch ad = - match rest with + + let tyconSearch ad = + match rest with | id2 :: rest2 -> let tcrefs = LookupTypeNameInEnvNoArity fullyQualified id.idText nenv if isNil tcrefs then NoResultsOrUsefulErrors else - let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty,tcref)) + let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty, tcref)) ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult ncenv nenv LookupKind.Pattern 1 id.idRange ad id2 rest2 numTyArgsOpt id.idRange tcrefs - | _ -> + | _ -> NoResultsOrUsefulErrors - let resInfo,res,rest = + let resInfo, res, rest = match AtMostOneResult m (tyconSearch ad +++ (moduleSearch ad)) with | Result _ as res -> ForceRaise res | _ -> @@ -2772,31 +2771,31 @@ let rec ResolvePatternLongIdentPrim sink (ncenv:NameResolver) fullyQualified war |> AtMostOneResult m |> ForceRaise - ResolutionInfo.SendEntityPathToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> true)) - + ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> true)) + match rest with | [] -> res - | element :: _ -> error(Error(FSComp.SR.nrIsNotConstructorOrLiteral(),element.idRange)) + | element :: _ -> error(Error(FSComp.SR.nrIsNotConstructorOrLiteral(), element.idRange)) /// Resolve a long identifier when used in a pattern. let ResolvePatternLongIdent sink (ncenv:NameResolver) warnOnUpper newDef m ad nenv numTyArgsOpt (lid:Ident list) = match lid with - | [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(),m)) + | [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), m)) | id::rest -> ResolvePatternLongIdentPrim sink ncenv OpenQualified warnOnUpper newDef m ad nenv numTyArgsOpt id rest //------------------------------------------------------------------------- // Resolve F#/IL "." syntax in types -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- /// Resolve nested types referenced through a .NET abbreviation. // -// Note the generic case is not supported by F#, so +// Note the generic case is not supported by F#, so // type X = List // // X.ListEnumerator // does not resolve // let ResolveNestedTypeThroughAbbreviation (ncenv:NameResolver) (tcref: TyconRef) m = - if tcref.IsTypeAbbrev && tcref.Typars(m).IsEmpty && isAppTy ncenv.g tcref.TypeAbbrev.Value && isNil (argsOfAppTy ncenv.g tcref.TypeAbbrev.Value) then + if tcref.IsTypeAbbrev && tcref.Typars(m).IsEmpty && isAppTy ncenv.g tcref.TypeAbbrev.Value && isNil (argsOfAppTy ncenv.g tcref.TypeAbbrev.Value) then tcrefOfAppTy ncenv.g tcref.TypeAbbrev.Value else tcref @@ -2812,9 +2811,9 @@ let rec ResolveTypeLongIdentInTyconRefPrim (ncenv:NameResolver) (typeNameResInfo #endif let m = unionRanges m id.idRange let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, id.idRange, ad, id.idText, typeNameResInfo.StaticArgsInfo, tcref) - let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo,tcref)) - let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, genOk, m) - match tcrefs with + let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo, tcref)) + let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, genOk, m) + match tcrefs with | tcref :: _ -> success tcref | [] -> let suggestTypes() = @@ -2822,7 +2821,7 @@ let rec ResolveTypeLongIdentInTyconRefPrim (ncenv:NameResolver) (typeNameResInfo |> Seq.map (fun e -> e.Value.DisplayName) |> HashSet - raze (UndefinedName(depth,FSComp.SR.undefinedNameType,id,suggestTypes)) + raze (UndefinedName(depth, FSComp.SR.undefinedNameType, id, suggestTypes)) | id2::rest2 -> #if !NO_EXTENSIONTYPING // No dotting through type generators to get to a nested type! @@ -2830,37 +2829,37 @@ let rec ResolveTypeLongIdentInTyconRefPrim (ncenv:NameResolver) (typeNameResInfo #endif let m = unionRanges m id.idRange // Search nested types - let tyconSearch = + let tyconSearch = let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, id.idRange, ad, id.idText, TypeNameResolutionStaticArgsInfo.Indefinite, tcref) if isNil tcrefs then NoResultsOrUsefulErrors else - let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo,tcref)) + let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo, tcref)) let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo.DropStaticArgsInfo, genOk, m) - match tcrefs with - | _ :: _ -> tcrefs |> CollectAtMostOneResult (fun (resInfo,tcref) -> ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad resInfo genOk (depth+1) m tcref id2 rest2) - | [] -> + match tcrefs with + | _ :: _ -> tcrefs |> CollectAtMostOneResult (fun (resInfo, tcref) -> ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad resInfo genOk (depth+1) m tcref id2 rest2) + | [] -> let suggestTypes() = tcref.ModuleOrNamespaceType.TypesByDemangledNameAndArity id.idRange |> Seq.map (fun e -> e.Value.DisplayName) |> HashSet - raze (UndefinedName(depth,FSComp.SR.undefinedNameType,id,suggestTypes)) - + raze (UndefinedName(depth, FSComp.SR.undefinedNameType, id, suggestTypes)) + AtMostOneResult m tyconSearch /// Resolve a long identifier representing a type name and report the result let ResolveTypeLongIdentInTyconRef sink (ncenv:NameResolver) nenv typeNameResInfo ad m tcref (lid: Ident list) = - let resInfo,tcref = + let resInfo, tcref = match lid with - | [] -> - error(Error(FSComp.SR.nrUnexpectedEmptyLongId(),m)) + | [] -> + error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), m)) | id::rest -> ForceRaise (ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad ResolutionInfo.Empty PermitDirectReferenceToGeneratedType.No 0 m tcref id rest) - ResolutionInfo.SendEntityPathToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> true)) - let item = Item.Types(tcref.DisplayName,[FreshenTycon ncenv m tcref]) - CallNameResolutionSink sink (rangeOfLid lid,nenv,item,item,emptyTyparInst,ItemOccurence.UseInType,nenv.eDisplayEnv,ad) + ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> true)) + let item = Item.Types(tcref.DisplayName, [FreshenTycon ncenv m tcref]) + CallNameResolutionSink sink (rangeOfLid lid, nenv, item, item, emptyTyparInst, ItemOccurence.UseInType, nenv.eDisplayEnv, ad) tcref -/// Create an UndefinedName error with details +/// Create an UndefinedName error with details let SuggestTypeLongIdentInModuleOrNamespace depth (modref:ModuleOrNamespaceRef) amap ad m (id:Ident) = let suggestPossibleTypes() = modref.ModuleOrNamespaceType.AllEntities @@ -2868,26 +2867,26 @@ let SuggestTypeLongIdentInModuleOrNamespace depth (modref:ModuleOrNamespaceRef) |> Seq.collect (fun e -> [e.DisplayName; e.DemangledModuleOrNamespaceName]) |> HashSet - let errorTextF s = FSComp.SR.undefinedNameTypeIn(s,fullDisplayTextOfModRef modref) - UndefinedName(depth,errorTextF,id,suggestPossibleTypes) + let errorTextF s = FSComp.SR.undefinedNameTypeIn(s, fullDisplayTextOfModRef modref) + UndefinedName(depth, errorTextF, id, suggestPossibleTypes) /// Resolve a long identifier representing a type in a module or namespace let rec private ResolveTypeLongIdentInModuleOrNamespace sink nenv (ncenv:NameResolver) (typeNameResInfo: TypeNameResolutionInfo) ad genOk (resInfo:ResolutionInfo) depth m modref _mty (id:Ident) (rest: Ident list) = match rest with | [] -> - // On all paths except error reporting we have isSome(staticResInfo), hence get at most one result back + // On all paths except error reporting we have isSome(staticResInfo), hence get at most one result back let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, id.idRange, ad, id.idText, typeNameResInfo.StaticArgsInfo, modref) - match tcrefs with - | _ :: _ -> tcrefs |> CollectResults (fun tcref -> success(resInfo,tcref)) + match tcrefs with + | _ :: _ -> tcrefs |> CollectResults (fun tcref -> success(resInfo, tcref)) | [] -> raze (SuggestTypeLongIdentInModuleOrNamespace depth modref ncenv.amap ad m id) | id2::rest2 -> let m = unionRanges m id.idRange - let modulSearch = + let modulSearch = match modref.ModuleOrNamespaceType.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with - | true, AccessibleEntityRef ncenv.amap m ad modref submodref -> + | true, AccessibleEntityRef ncenv.amap m ad modref submodref -> let item = Item.ModuleOrNamespaces [submodref] - CallNameResolutionSink sink (id.idRange, nenv, item, item, emptyTyparInst, ItemOccurence.Use, nenv.DisplayEnv, ad) - let resInfo = resInfo.AddEntity(id.idRange,submodref) + CallNameResolutionSink sink (id.idRange, nenv, item, item, emptyTyparInst, ItemOccurence.Use, nenv.DisplayEnv, ad) + let resInfo = resInfo.AddEntity(id.idRange, submodref) ResolveTypeLongIdentInModuleOrNamespace sink nenv ncenv typeNameResInfo ad genOk resInfo (depth+1) m submodref submodref.ModuleOrNamespaceType id2 rest2 | _ -> let suggestPossibleModules() = @@ -2895,11 +2894,11 @@ let rec private ResolveTypeLongIdentInModuleOrNamespace sink nenv (ncenv:NameRes |> Seq.filter (fun kv -> IsEntityAccessible ncenv.amap m ad (modref.NestedTyconRef kv.Value)) |> Seq.collect (fun e -> [e.Value.DisplayName; e.Value.DemangledModuleOrNamespaceName]) |> HashSet - raze (UndefinedName(depth,FSComp.SR.undefinedNameNamespaceOrModule,id,suggestPossibleModules)) + raze (UndefinedName(depth, FSComp.SR.undefinedNameNamespaceOrModule, id, suggestPossibleModules)) - let tyconSearch = + let tyconSearch = let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, id.idRange, ad, id.idText, TypeNameResolutionStaticArgsInfo.Indefinite, modref) - match tcrefs with + match tcrefs with | _ :: _ -> tcrefs |> CollectResults (fun tcref -> ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad resInfo genOk (depth+1) m tcref id2 rest2) | [] -> let suggestTypes() = @@ -2907,11 +2906,11 @@ let rec private ResolveTypeLongIdentInModuleOrNamespace sink nenv (ncenv:NameRes |> Seq.map (fun e -> e.Value.DisplayName) |> HashSet - raze (UndefinedName(depth,FSComp.SR.undefinedNameType,id,suggestTypes)) + raze (UndefinedName(depth, FSComp.SR.undefinedNameType, id, suggestTypes)) AddResults tyconSearch modulSearch -/// Resolve a long identifier representing a type +/// Resolve a long identifier representing a type let rec ResolveTypeLongIdentPrim sink (ncenv:NameResolver) occurence first fullyQualified m nenv ad (id:Ident) (rest: Ident list) (staticResInfo: TypeNameResolutionStaticArgsInfo) genOk = let typeNameResInfo = TypeNameResolutionInfo.ResolveToTypeRefs staticResInfo if first && id.idText = MangledGlobalName then @@ -2924,73 +2923,73 @@ let rec ResolveTypeLongIdentPrim sink (ncenv:NameResolver) occurence first fully match rest with | [] -> match LookupTypeNameInEnvHaveArity fullyQualified id.idText staticResInfo.NumStaticArgs nenv with - | Some res -> - let res = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities ([(ResolutionInfo.Empty,res)], typeNameResInfo, genOk, unionRanges m id.idRange) + | Some res -> + let res = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities ([(ResolutionInfo.Empty, res)], typeNameResInfo, genOk, unionRanges m id.idRange) assert (res.Length = 1) success res.Head - | None -> - // For Good Error Reporting! + | None -> + // For Good Error Reporting! let tcrefs = LookupTypeNameInEnvNoArity fullyQualified id.idText nenv match tcrefs with - | tcref :: _tcrefs -> + | tcref :: _tcrefs -> // Note: This path is only for error reporting //CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities tcref rest typeNameResInfo m - success(ResolutionInfo.Empty,tcref) - | [] -> + success(ResolutionInfo.Empty, tcref) + | [] -> let suggestPossibleTypes() = nenv.TyconsByDemangledNameAndArity(fullyQualified) |> Seq.filter (fun kv -> IsEntityAccessible ncenv.amap m ad kv.Value) - |> Seq.collect (fun e -> + |> Seq.collect (fun e -> match occurence with - | ItemOccurence.UseInAttribute -> + | ItemOccurence.UseInAttribute -> [yield e.Value.DisplayName yield e.Value.DemangledModuleOrNamespaceName if e.Value.DisplayName.EndsWithOrdinal("Attribute") then - yield e.Value.DisplayName.Replace("Attribute","")] + yield e.Value.DisplayName.Replace("Attribute", "")] | _ -> [e.Value.DisplayName; e.Value.DemangledModuleOrNamespaceName]) |> HashSet - raze (UndefinedName(0,FSComp.SR.undefinedNameType,id,suggestPossibleTypes)) + raze (UndefinedName(0, FSComp.SR.undefinedNameType, id, suggestPossibleTypes)) | id2::rest2 -> let m2 = unionRanges m id.idRange - let tyconSearch = - match fullyQualified with + let tyconSearch = + match fullyQualified with | FullyQualified -> NoResultsOrUsefulErrors - | OpenQualified -> + | OpenQualified -> match LookupTypeNameInEnvHaveArity fullyQualified id.idText staticResInfo.NumStaticArgs nenv with - | Some tcref when IsEntityAccessible ncenv.amap m2 ad tcref -> + | Some tcref when IsEntityAccessible ncenv.amap m2 ad tcref -> let resInfo = ResolutionInfo.Empty.AddEntity(id.idRange, tcref) OneResult (ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad resInfo genOk 1 m2 tcref id2 rest2) - | _ -> + | _ -> NoResultsOrUsefulErrors - let modulSearch = + let modulSearch = ResolveLongIndentAsModuleOrNamespaceThen sink ResultCollectionSettings.AllResults ncenv.amap m2 fullyQualified nenv ad id rest false (ResolveTypeLongIdentInModuleOrNamespace sink nenv ncenv typeNameResInfo ad genOk) - |?> List.concat + |?> List.concat - let modulSearchFailed() = + let modulSearchFailed() = ResolveLongIndentAsModuleOrNamespaceThen sink ResultCollectionSettings.AllResults ncenv.amap m2 fullyQualified nenv AccessibleFromSomeFSharpCode id rest false (ResolveTypeLongIdentInModuleOrNamespace sink nenv ncenv typeNameResInfo.DropStaticArgsInfo AccessibleFromSomeFSharpCode genOk) - |?> List.concat + |?> List.concat let searchSoFar = AddResults tyconSearch modulSearch - match searchSoFar with - | Result results -> + match searchSoFar with + | Result results -> // NOTE: we delay checking the CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities condition until right at the end after we've // collected all possible resolutions of the type let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (results, typeNameResInfo, genOk, m) - match tcrefs with - | (resInfo,tcref) :: _ -> + match tcrefs with + | (resInfo, tcref) :: _ -> // We've already reported the ambiguity, possibly as an error. Now just take the first possible result. - success(resInfo,tcref) - | [] -> + success(resInfo, tcref) + | [] -> // failing case - report nice ambiguity errors even in this case let r = AddResults searchSoFar (modulSearchFailed()) AtMostOneResult m2 (r |?> (fun tcrefs -> CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, genOk, m))) - | _ -> + | _ -> // failing case - report nice ambiguity errors even in this case let r = AddResults searchSoFar (modulSearchFailed()) AtMostOneResult m2 (r |?> (fun tcrefs -> CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, genOk, m))) @@ -3001,84 +3000,84 @@ let ResolveTypeLongIdent sink (ncenv:NameResolver) occurence fullyQualified nenv let m = rangeOfLid lid let res = match lid with - | [] -> - error(Error(FSComp.SR.nrUnexpectedEmptyLongId(),m)) + | [] -> + error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), m)) | id::rest -> - ResolveTypeLongIdentPrim sink ncenv occurence true fullyQualified m nenv ad id rest staticResInfo genOk + ResolveTypeLongIdentPrim sink ncenv occurence true fullyQualified m nenv ad id rest staticResInfo genOk // Register the result as a name resolution - match res with - | Result (resInfo,tcref) -> - ResolutionInfo.SendEntityPathToSink(sink,ncenv,nenv,ItemOccurence.UseInType, ad,resInfo,ResultTyparChecker(fun () -> true)) - let item = Item.Types(tcref.DisplayName,[FreshenTycon ncenv m tcref]) - CallNameResolutionSink sink (m,nenv,item,item,emptyTyparInst,occurence,nenv.eDisplayEnv,ad) + match res with + | Result (resInfo, tcref) -> + ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.UseInType, ad, resInfo, ResultTyparChecker(fun () -> true)) + let item = Item.Types(tcref.DisplayName, [FreshenTycon ncenv m tcref]) + CallNameResolutionSink sink (m, nenv, item, item, emptyTyparInst, occurence, nenv.eDisplayEnv, ad) | _ -> () res |?> snd //------------------------------------------------------------------------- // Resolve F#/IL "." syntax in records etc. -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- /// Resolve a long identifier representing a record field in a module or namespace -let rec ResolveFieldInModuleOrNamespace (ncenv:NameResolver) nenv ad (resInfo:ResolutionInfo) depth m (modref: ModuleOrNamespaceRef) _mty (id:Ident) (rest: Ident list) = +let rec ResolveFieldInModuleOrNamespace (ncenv:NameResolver) nenv ad (resInfo:ResolutionInfo) depth m (modref: ModuleOrNamespaceRef) _mty (id:Ident) (rest: Ident list) = let typeNameResInfo = TypeNameResolutionInfo.Default let m = unionRanges m id.idRange - // search for module-qualified names, e.g. { Microsoft.FSharp.Core.contents = 1 } - let modulScopedFieldNames = + // search for module-qualified names, e.g. { Microsoft.FSharp.Core.contents = 1 } + let modulScopedFieldNames = match TryFindTypeWithRecdField modref id with - | Some tycon when IsEntityAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> + | Some tycon when IsEntityAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> let showDeprecated = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs - success [resInfo, FieldResolution(modref.RecdFieldRefInNestedTycon tycon id,showDeprecated), rest] - | _ -> raze (UndefinedName(depth,FSComp.SR.undefinedNameRecordLabelOrNamespace,id,NoSuggestions)) + success [resInfo, FieldResolution(modref.RecdFieldRefInNestedTycon tycon id, showDeprecated), rest] + | _ -> raze (UndefinedName(depth, FSComp.SR.undefinedNameRecordLabelOrNamespace, id, NoSuggestions)) - // search for type-qualified names, e.g. { Microsoft.FSharp.Core.Ref.contents = 1 } - let tyconSearch() = + // search for type-qualified names, e.g. { Microsoft.FSharp.Core.Ref.contents = 1 } + let tyconSearch() = match rest with | id2::rest2 -> let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, id.idRange, ad, id.idText, TypeNameResolutionStaticArgsInfo.Indefinite, modref) if isNil tcrefs then NoResultsOrUsefulErrors else - let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty,tcref)) + let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty, tcref)) let tyconSearch = ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField (depth+1) m ad id2 rest2 typeNameResInfo id.idRange tcrefs - // choose only fields - let tyconSearch = tyconSearch |?> List.choose (function (resInfo,Item.RecdField(RecdFieldInfo(_,rfref)),rest) -> Some(resInfo,FieldResolution(rfref,false),rest) | _ -> None) + // choose only fields + let tyconSearch = tyconSearch |?> List.choose (function (resInfo, Item.RecdField(RecdFieldInfo(_, rfref)), rest) -> Some(resInfo, FieldResolution(rfref, false), rest) | _ -> None) tyconSearch | _ -> NoResultsOrUsefulErrors - // search for names in nested modules, e.g. { Microsoft.FSharp.Core.contents = 1 } - let modulSearch() = + // search for names in nested modules, e.g. { Microsoft.FSharp.Core.contents = 1 } + let modulSearch() = match rest with | id2::rest2 -> match modref.ModuleOrNamespaceType.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with - | true, AccessibleEntityRef ncenv.amap m ad modref submodref -> - let resInfo = resInfo.AddEntity(id.idRange,submodref) + | true, AccessibleEntityRef ncenv.amap m ad modref submodref -> + let resInfo = resInfo.AddEntity(id.idRange, submodref) ResolveFieldInModuleOrNamespace ncenv nenv ad resInfo (depth+1) m submodref submodref.ModuleOrNamespaceType id2 rest2 |> OneResult - | _ -> raze (UndefinedName(depth,FSComp.SR.undefinedNameRecordLabelOrNamespace,id,NoSuggestions)) - | _ -> raze (UndefinedName(depth,FSComp.SR.undefinedNameRecordLabelOrNamespace,id,NoSuggestions)) - + | _ -> raze (UndefinedName(depth, FSComp.SR.undefinedNameRecordLabelOrNamespace, id, NoSuggestions)) + | _ -> raze (UndefinedName(depth, FSComp.SR.undefinedNameRecordLabelOrNamespace, id, NoSuggestions)) + modulScopedFieldNames +++ tyconSearch +++ modulSearch |> AtMostOneResult m /// Suggest other labels of the same record -let SuggestOtherLabelsOfSameRecordType g (nenv:NameResolutionEnv) ty (id:Ident) (allFields:Ident list) = +let SuggestOtherLabelsOfSameRecordType g (nenv:NameResolutionEnv) ty (id:Ident) (allFields:Ident list) = let labelsOfPossibleRecord = GetRecordLabelsForType g nenv ty - let givenFields = - allFields - |> List.map (fun fld -> fld.idText) + let givenFields = + allFields + |> List.map (fun fld -> fld.idText) |> List.filter ((<>) id.idText) labelsOfPossibleRecord.ExceptWith givenFields labelsOfPossibleRecord - + let SuggestLabelsOfRelatedRecords g (nenv:NameResolutionEnv) (id:Ident) (allFields:Ident list) = let suggestLabels() = let givenFields = allFields |> List.map (fun fld -> fld.idText) |> List.filter ((<>) id.idText) |> HashSet let fullyQualfied = - if givenFields.Count = 0 then + if givenFields.Count = 0 then // return labels from all records - let result = NameMap.domainL nenv.eFieldLabels |> HashSet + let result = NameMap.domainL nenv.eFieldLabels |> HashSet result.Remove "contents" |> ignore result else @@ -3088,15 +3087,15 @@ let SuggestLabelsOfRelatedRecords g (nenv:NameResolutionEnv) (id:Ident) (allFiel | true, recordTypes -> yield! (recordTypes |> List.map (fun r -> r.TyconRef.DisplayName, fld)) | _ -> () ] |> List.groupBy fst - |> List.map (fun (r,fields) -> r, fields |> List.map snd) - |> List.filter (fun (_,fields) -> givenFields.IsSubsetOf fields) + |> List.map (fun (r, fields) -> r, fields |> List.map snd) + |> List.filter (fun (_, fields) -> givenFields.IsSubsetOf fields) |> List.map fst |> HashSet let labelsOfPossibleRecords = nenv.eFieldLabels - |> Seq.filter (fun kv -> - kv.Value + |> Seq.filter (fun kv -> + kv.Value |> List.map (fun r -> r.TyconRef.DisplayName) |> List.exists possibleRecords.Contains) |> Seq.map (fun kv -> kv.Key) @@ -3104,14 +3103,14 @@ let SuggestLabelsOfRelatedRecords g (nenv:NameResolutionEnv) (id:Ident) (allFiel labelsOfPossibleRecords.ExceptWith givenFields labelsOfPossibleRecords - + if fullyQualfied.Count > 0 then fullyQualfied else // check if the user forgot to use qualified access nenv.eTyconsByDemangledNameAndArity |> Seq.choose (fun e -> let hasRequireQualifiedAccessAttribute = HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute e.Value.Attribs - if not hasRequireQualifiedAccessAttribute then + if not hasRequireQualifiedAccessAttribute then None else if e.Value.IsRecordTycon && e.Value.AllFieldsArray |> Seq.exists (fun x -> x.Name = id.idText) then @@ -3121,53 +3120,53 @@ let SuggestLabelsOfRelatedRecords g (nenv:NameResolutionEnv) (id:Ident) (allFiel |> Seq.map (fun t -> t.DisplayName + "." + id.idText) |> HashSet - UndefinedName(0,FSComp.SR.undefinedNameRecordLabel, id, suggestLabels) + UndefinedName(0, FSComp.SR.undefinedNameRecordLabel, id, suggestLabels) -/// Resolve a long identifier representing a record field -let ResolveFieldPrim sink (ncenv:NameResolver) nenv ad ty (mp,id:Ident) allFields = +/// Resolve a long identifier representing a record field +let ResolveFieldPrim sink (ncenv:NameResolver) nenv ad ty (mp, id:Ident) allFields = let typeNameResInfo = TypeNameResolutionInfo.Default let g = ncenv.g let m = id.idRange - match mp with - | [] -> + match mp with + | [] -> let lookup() = - let frefs = - try Map.find id.idText nenv.eFieldLabels + let frefs = + try Map.find id.idText nenv.eFieldLabels with :? KeyNotFoundException -> // record label is unknown -> suggest related labels and give a hint to the user error(SuggestLabelsOfRelatedRecords g nenv id allFields) - // Eliminate duplicates arising from multiple 'open' - frefs + // Eliminate duplicates arising from multiple 'open' + frefs |> ListSet.setify (fun fref1 fref2 -> tyconRefEq g fref1.TyconRef fref2.TyconRef) - |> List.map (fun x -> ResolutionInfo.Empty, FieldResolution(x,false)) + |> List.map (fun x -> ResolutionInfo.Empty, FieldResolution(x, false)) - if isAppTy g ty then - match ncenv.InfoReader.TryFindRecdOrClassFieldInfoOfType(id.idText,m,ty) with - | ValueSome (RecdFieldInfo(_,rfref)) -> [ResolutionInfo.Empty, FieldResolution(rfref,false)] + if isAppTy g ty then + match ncenv.InfoReader.TryFindRecdOrClassFieldInfoOfType(id.idText, m, ty) with + | ValueSome (RecdFieldInfo(_, rfref)) -> [ResolutionInfo.Empty, FieldResolution(rfref, false)] | _ -> if isRecdTy g ty then // record label doesn't belong to record type -> suggest other labels of same record let suggestLabels() = SuggestOtherLabelsOfSameRecordType g nenv ty id allFields let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty - let errorText = FSComp.SR.nrRecordDoesNotContainSuchLabel(typeName,id.idText) + let errorText = FSComp.SR.nrRecordDoesNotContainSuchLabel(typeName, id.idText) error(ErrorWithSuggestions(errorText, m, id.idText, suggestLabels)) else lookup() - else - lookup() - | _ -> + else + lookup() + | _ -> let lid = (mp@[id]) - let tyconSearch ad () = - match lid with - | tn :: id2 :: rest2 -> + let tyconSearch ad () = + match lid with + | tn :: id2 :: rest2 -> let m = tn.idRange let tcrefs = LookupTypeNameInEnvNoArity OpenQualified tn.idText nenv if isNil tcrefs then NoResultsOrUsefulErrors else - let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty,tcref)) + let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty, tcref)) let tyconSearch = ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField 1 m ad id2 rest2 typeNameResInfo tn.idRange tcrefs - // choose only fields - let tyconSearch = tyconSearch |?> List.choose (function (resInfo,Item.RecdField(RecdFieldInfo(_,rfref)),rest) -> Some(resInfo,FieldResolution(rfref,false),rest) | _ -> None) + // choose only fields + let tyconSearch = tyconSearch |?> List.choose (function (resInfo, Item.RecdField(RecdFieldInfo(_, rfref)), rest) -> Some(resInfo, FieldResolution(rfref, false), rest) | _ -> None) tyconSearch | _ -> NoResultsOrUsefulErrors @@ -3178,24 +3177,24 @@ let ResolveFieldPrim sink (ncenv:NameResolver) nenv ad ty (mp,id:Ident) allField ResolveLongIndentAsModuleOrNamespaceThen sink ResultCollectionSettings.AtMostOneResult ncenv.amap m OpenQualified nenv ad id2 rest2 false (ResolveFieldInModuleOrNamespace ncenv nenv ad) - let resInfo,item,rest = + let resInfo, item, rest = modulSearch ad () +++ tyconSearch ad +++ modulSearch AccessibleFromSomeFSharpCode +++ tyconSearch AccessibleFromSomeFSharpCode |> AtMostOneResult m |> ForceRaise - if not (isNil rest) then - errorR(Error(FSComp.SR.nrInvalidFieldLabel(),(List.head rest).idRange)) + if not (isNil rest) then + errorR(Error(FSComp.SR.nrInvalidFieldLabel(), (List.head rest).idRange)) - [(resInfo,item)] + [(resInfo, item)] -let ResolveField sink ncenv nenv ad ty (mp,id) allFields = - let res = ResolveFieldPrim sink ncenv nenv ad ty (mp,id) allFields +let ResolveField sink ncenv nenv ad ty (mp, id) allFields = + let res = ResolveFieldPrim sink ncenv nenv ad ty (mp, id) allFields // Register the results of any field paths "Module.Type" in "Module.Type.field" as a name resolution. (Note, the path resolution // info is only non-empty if there was a unique resolution of the field) let checker = ResultTyparChecker(fun () -> true) - res - |> List.map (fun (resInfo,rfref) -> - ResolutionInfo.SendEntityPathToSink(sink,ncenv,nenv,ItemOccurence.UseInType,ad,resInfo,checker) + res + |> List.map (fun (resInfo, rfref) -> + ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.UseInType, ad, resInfo, checker) rfref) /// Generate a new reference to a record field with a fresh type instantiation @@ -3205,47 +3204,47 @@ let FreshenRecdFieldRef (ncenv:NameResolver) m (rfref:RecdFieldRef) = /// Resolve F#/IL "." syntax in expressions (2). /// -/// We have an expr. on the left, and we do an access, e.g. -/// (f obj).field or (f obj).meth. The basic rule is that if l-r type -/// inference has determined the outer type then we can proceed in a simple fashion. The exception -/// to the rule is for field types, which applies if l-r was insufficient to -/// determine any valid members +/// We have an expr. on the left, and we do an access, e.g. +/// (f obj).field or (f obj).meth. The basic rule is that if l-r type +/// inference has determined the outer type then we can proceed in a simple fashion. The exception +/// to the rule is for field types, which applies if l-r was insufficient to +/// determine any valid members // -// QUERY (instantiationGenerator cleanup): it would be really nice not to flow instantiationGenerator to here. +// QUERY (instantiationGenerator cleanup): it would be really nice not to flow instantiationGenerator to here. let private ResolveExprDotLongIdent (ncenv:NameResolver) m ad nenv ty (id:Ident) rest findFlag = let typeNameResInfo = TypeNameResolutionInfo.Default let adhoctDotSearchAccessible = AtMostOneResult m (ResolveLongIdentInTypePrim ncenv nenv LookupKind.Expr ResolutionInfo.Empty 1 m ad id rest findFlag typeNameResInfo ty) - match adhoctDotSearchAccessible with - | Exception _ -> - // If the dot is not resolved by adhoc overloading then look for a record field - // that can resolve the name. + match adhoctDotSearchAccessible with + | Exception _ -> + // If the dot is not resolved by adhoc overloading then look for a record field + // that can resolve the name. let dotFieldIdSearch = // If the type is already known, we should not try to lookup a record field - if isAppTy ncenv.g ty then + if isAppTy ncenv.g ty then NoResultsOrUsefulErrors - else - match nenv.eFieldLabels.TryGetValue id.idText with + else + match nenv.eFieldLabels.TryGetValue id.idText with | true, rfref :: _ -> - // NOTE (instantiationGenerator cleanup): we need to freshen here because we don't know the type. - // But perhaps the caller should freshen?? + // NOTE (instantiationGenerator cleanup): we need to freshen here because we don't know the type. + // But perhaps the caller should freshen?? let item = FreshenRecdFieldRef ncenv m rfref - OneSuccess (ResolutionInfo.Empty,item,rest) + OneSuccess (ResolutionInfo.Empty, item, rest) | _ -> NoResultsOrUsefulErrors - - let adhocDotSearchAll () = ResolveLongIdentInTypePrim ncenv nenv LookupKind.Expr ResolutionInfo.Empty 1 m AccessibleFromSomeFSharpCode id rest findFlag typeNameResInfo ty + + let adhocDotSearchAll () = ResolveLongIdentInTypePrim ncenv nenv LookupKind.Expr ResolutionInfo.Empty 1 m AccessibleFromSomeFSharpCode id rest findFlag typeNameResInfo ty dotFieldIdSearch +++ adhocDotSearchAll |> AtMostOneResult m |> ForceRaise - | _ -> + | _ -> ForceRaise adhoctDotSearchAccessible let ComputeItemRange wholem (lid: Ident list) rest = match rest with | [] -> wholem - | _ -> + | _ -> let ids = List.truncate (max 0 (lid.Length - rest.Length)) lid - match ids with + match ids with | [] -> wholem | _ -> rangeOfLid ids @@ -3254,20 +3253,20 @@ let ComputeItemRange wholem (lid: Ident list) rest = let FilterMethodGroups (ncenv:NameResolver) itemRange item staticOnly = match item with - | Item.MethodGroup(nm, minfos, orig) -> - let minfos = minfos |> List.filter (fun minfo -> + | Item.MethodGroup(nm, minfos, orig) -> + let minfos = minfos |> List.filter (fun minfo -> staticOnly = isNil (minfo.GetObjArgTypes(ncenv.amap, itemRange, minfo.FormalMethodInst))) Item.MethodGroup(nm, minfos, orig) | item -> item let NeedsWorkAfterResolution namedItem = match namedItem with - | Item.MethodGroup(_,minfos,_) - | Item.CtorGroup(_,minfos) -> minfos.Length > 1 || minfos |> List.exists (fun minfo -> not (isNil minfo.FormalMethodInst)) - | Item.Property(_,pinfos) -> pinfos.Length > 1 - | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(_, vref, _)) }) - | Item.Value vref | Item.CustomBuilder (_,vref) -> not (List.isEmpty vref.Typars) - | Item.CustomOperation (_,_,Some minfo) -> not (isNil minfo.FormalMethodInst) + | Item.MethodGroup(_, minfos, _) + | Item.CtorGroup(_, minfos) -> minfos.Length > 1 || minfos |> List.exists (fun minfo -> not (isNil minfo.FormalMethodInst)) + | Item.Property(_, pinfos) -> pinfos.Length > 1 + | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(_, vref, _)) }) + | Item.Value vref | Item.CustomBuilder (_, vref) -> not (List.isEmpty vref.Typars) + | Item.CustomOperation (_, _, Some minfo) -> not (isNil minfo.FormalMethodInst) | Item.ActivePatternCase apref -> not (List.isEmpty apref.ActivePatternVal.Typars) | _ -> false @@ -3284,15 +3283,15 @@ type AfterResolution = /// Resolve a long identifier occurring in an expression position. /// /// Called for 'TypeName.Bar' - for VS IntelliSense, we can filter out instance members from method groups -let ResolveLongIdentAsExprAndComputeRange (sink:TcResultsSink) (ncenv:NameResolver) wholem ad nenv typeNameResInfo lid = - let item1,rest = ResolveExprLongIdent sink ncenv wholem ad nenv typeNameResInfo lid +let ResolveLongIdentAsExprAndComputeRange (sink:TcResultsSink) (ncenv:NameResolver) wholem ad nenv typeNameResInfo lid = + let item1, rest = ResolveExprLongIdent sink ncenv wholem ad nenv typeNameResInfo lid let itemRange = ComputeItemRange wholem lid rest - + let item = FilterMethodGroups ncenv itemRange item1 true - match item1,item with - | Item.MethodGroup(name, minfos1, _), Item.MethodGroup(_, [], _) when not (isNil minfos1) -> - error(Error(FSComp.SR.methodIsNotStatic(name),wholem)) + match item1, item with + | Item.MethodGroup(name, minfos1, _), Item.MethodGroup(_, [], _) when not (isNil minfos1) -> + error(Error(FSComp.SR.methodIsNotStatic(name), wholem)) | _ -> () // Fake idents e.g. 'Microsoft.FSharp.Core.None' have identical ranges for each part @@ -3304,22 +3303,22 @@ let ResolveLongIdentAsExprAndComputeRange (sink:TcResultsSink) (ncenv:NameResolv let callSink (refinedItem, tpinst) = if not isFakeIdents then - let occurence = + let occurence = match item with // It's r.h.s. `Case1` in `let (|Case1|Case1|) _ = if true then Case1 else Case2` // We return `Binding` for it because it's actually not usage, but definition. If we did not // it confuses detecting unused definitions. - | Item.ActivePatternResult _ -> ItemOccurence.Binding + | Item.ActivePatternResult _ -> ItemOccurence.Binding | _ -> ItemOccurence.Use CallNameResolutionSink sink (itemRange, nenv, refinedItem, item, tpinst, occurence, nenv.DisplayEnv, ad) let callSinkWithSpecificOverload (minfo: MethInfo, pinfoOpt: PropInfo option, tpinst) = - let refinedItem = - match pinfoOpt with - | None when minfo.IsConstructor -> Item.CtorGroup(minfo.LogicalName,[minfo]) - | None -> Item.MethodGroup(minfo.LogicalName,[minfo],None) - | Some pinfo -> Item.Property(pinfo.PropertyName,[pinfo]) + let refinedItem = + match pinfoOpt with + | None when minfo.IsConstructor -> Item.CtorGroup(minfo.LogicalName, [minfo]) + | None -> Item.MethodGroup(minfo.LogicalName, [minfo], None) + | Some pinfo -> Item.Property(pinfo.PropertyName, [pinfo]) callSink (refinedItem, tpinst) @@ -3328,7 +3327,7 @@ let ResolveLongIdentAsExprAndComputeRange (sink:TcResultsSink) (ncenv:NameResolv | None -> AfterResolution.DoNothing | Some _ -> if NeedsWorkAfterResolution item then - AfterResolution.RecordResolution(None, (fun tpinst -> callSink(item,tpinst)), callSinkWithSpecificOverload, (fun () -> callSink (item, emptyTyparInst))) + AfterResolution.RecordResolution(None, (fun tpinst -> callSink(item, tpinst)), callSinkWithSpecificOverload, (fun () -> callSink (item, emptyTyparInst))) else callSink (item, emptyTyparInst) AfterResolution.DoNothing @@ -3337,62 +3336,62 @@ let ResolveLongIdentAsExprAndComputeRange (sink:TcResultsSink) (ncenv:NameResolv let (|NonOverridable|_|) namedItem = match namedItem with - | Item.MethodGroup(_,minfos,_) when minfos |> List.exists(fun minfo -> minfo.IsVirtual || minfo.IsAbstract) -> None - | Item.Property(_,pinfos) when pinfos |> List.exists(fun pinfo -> pinfo.IsVirtualProperty) -> None + | Item.MethodGroup(_, minfos, _) when minfos |> List.exists(fun minfo -> minfo.IsVirtual || minfo.IsAbstract) -> None + | Item.Property(_, pinfos) when pinfos |> List.exists(fun pinfo -> pinfo.IsVirtualProperty) -> None | _ -> Some () /// Called for 'expression.Bar' - for VS IntelliSense, we can filter out static members from method groups /// Also called for 'GenericType.Bar' - for VS IntelliSense, we can filter out non-static members from method groups -let ResolveExprDotLongIdentAndComputeRange (sink:TcResultsSink) (ncenv:NameResolver) wholem ad nenv ty lid findFlag thisIsActuallyATyAppNotAnExpr = +let ResolveExprDotLongIdentAndComputeRange (sink:TcResultsSink) (ncenv:NameResolver) wholem ad nenv ty lid findFlag thisIsActuallyATyAppNotAnExpr = let resolveExpr findFlag = - let resInfo,item,rest = - match lid with + let resInfo, item, rest = + match lid with | id::rest -> ResolveExprDotLongIdent ncenv wholem ad nenv ty id rest findFlag - | _ -> error(InternalError("ResolveExprDotLongIdentAndComputeRange",wholem)) + | _ -> error(InternalError("ResolveExprDotLongIdentAndComputeRange", wholem)) let itemRange = ComputeItemRange wholem lid rest - resInfo,item,rest,itemRange + resInfo, item, rest, itemRange // "true" resolution - let resInfo,item,rest,itemRange = resolveExpr findFlag - ResolutionInfo.SendEntityPathToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap itemRange item)) - + let resInfo, item, rest, itemRange = resolveExpr findFlag + ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap itemRange item)) + // Record the precise resolution of the field for intellisense/goto definition let afterResolution = - match sink.CurrentSink with + match sink.CurrentSink with | None -> AfterResolution.DoNothing // do not refine the resolution if nobody listens | Some _ -> // resolution for goto definition - let unrefinedItem,itemRange,overrides = + let unrefinedItem, itemRange, overrides = match findFlag, item with - | FindMemberFlag.PreferOverrides, _ - | _, NonOverridable() -> item,itemRange,false - | FindMemberFlag.IgnoreOverrides,_ -> - let _,item,_,itemRange = resolveExpr FindMemberFlag.PreferOverrides - item, itemRange,true + | FindMemberFlag.PreferOverrides, _ + | _, NonOverridable() -> item, itemRange, false + | FindMemberFlag.IgnoreOverrides, _ -> + let _, item, _, itemRange = resolveExpr FindMemberFlag.PreferOverrides + item, itemRange, true - let callSink (refinedItem, tpinst) = + let callSink (refinedItem, tpinst) = let staticOnly = thisIsActuallyATyAppNotAnExpr let refinedItem = FilterMethodGroups ncenv itemRange refinedItem staticOnly let unrefinedItem = FilterMethodGroups ncenv itemRange unrefinedItem staticOnly - CallNameResolutionSink sink (itemRange, nenv, refinedItem, unrefinedItem, tpinst, ItemOccurence.Use, nenv.DisplayEnv, ad) + CallNameResolutionSink sink (itemRange, nenv, refinedItem, unrefinedItem, tpinst, ItemOccurence.Use, nenv.DisplayEnv, ad) let callSinkWithSpecificOverload (minfo: MethInfo, pinfoOpt: PropInfo option, tpinst) = - let refinedItem = - match pinfoOpt with - | None when minfo.IsConstructor -> Item.CtorGroup(minfo.LogicalName,[minfo]) - | None -> Item.MethodGroup(minfo.LogicalName,[minfo],None) - | Some pinfo -> Item.Property(pinfo.PropertyName,[pinfo]) + let refinedItem = + match pinfoOpt with + | None when minfo.IsConstructor -> Item.CtorGroup(minfo.LogicalName, [minfo]) + | None -> Item.MethodGroup(minfo.LogicalName, [minfo], None) + | Some pinfo -> Item.Property(pinfo.PropertyName, [pinfo]) callSink (refinedItem, tpinst) match overrides, NeedsWorkAfterResolution unrefinedItem with - | false, true -> - AfterResolution.RecordResolution (None, (fun tpinst -> callSink(item,tpinst)), callSinkWithSpecificOverload, (fun () -> callSink (unrefinedItem, emptyTyparInst))) - | true, true -> - AfterResolution.RecordResolution (Some unrefinedItem, (fun tpinst -> callSink(item,tpinst)), callSinkWithSpecificOverload, (fun () -> callSink (unrefinedItem, emptyTyparInst))) - | _ , false -> + | false, true -> + AfterResolution.RecordResolution (None, (fun tpinst -> callSink(item, tpinst)), callSinkWithSpecificOverload, (fun () -> callSink (unrefinedItem, emptyTyparInst))) + | true, true -> + AfterResolution.RecordResolution (Some unrefinedItem, (fun tpinst -> callSink(item, tpinst)), callSinkWithSpecificOverload, (fun () -> callSink (unrefinedItem, emptyTyparInst))) + | _ , false -> callSink (unrefinedItem, emptyTyparInst) AfterResolution.DoNothing @@ -3406,79 +3405,79 @@ let ResolveExprDotLongIdentAndComputeRange (sink:TcResultsSink) (ncenv:NameResol // ptc = partial type check // ptci = partial type check item // -// There are some inefficiencies in this code - e.g. we often +// There are some inefficiencies in this code - e.g. we often // create potentially large lists of methods/fields/properties and then // immediately List.filter them. We also use lots of "map/concats". Doesn't // seem to hit the interactive experience too badly though. -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- /// A generator of type instantiations used when no more specific type instantiation is known. -let FakeInstantiationGenerator (_m:range) gps = List.map mkTyparTy gps +let FakeInstantiationGenerator (_m:range) gps = List.map mkTyparTy gps -// note: using local refs is ok since it is only used by VS +// note: using local refs is ok since it is only used by VS let ItemForModuleOrNamespaceRef v = Item.ModuleOrNamespaces [v] let ItemForPropInfo (pinfo:PropInfo) = Item.Property (pinfo.PropertyName, [pinfo]) -let IsTyconUnseenObsoleteSpec ad g amap m (x:TyconRef) allowObsolete = +let IsTyconUnseenObsoleteSpec ad g amap m (x:TyconRef) allowObsolete = not (IsEntityAccessible amap m ad x) || ((not allowObsolete) && - (if x.IsILTycon then + (if x.IsILTycon then CheckILAttributesForUnseen g x.ILTyconRawMetadata.CustomAttrs m - else + else CheckFSharpAttributesForUnseen g x.Attribs m)) let IsTyconUnseen ad g amap m (x:TyconRef) = IsTyconUnseenObsoleteSpec ad g amap m x false -let IsValUnseen ad g m (v:ValRef) = +let IsValUnseen ad g m (v:ValRef) = v.IsCompilerGenerated || v.Deref.IsClassConstructor || not (IsValAccessible ad v) || CheckFSharpAttributesForUnseen g v.Attribs m -let IsUnionCaseUnseen ad g amap m (ucref:UnionCaseRef) = +let IsUnionCaseUnseen ad g amap m (ucref:UnionCaseRef) = not (IsUnionCaseAccessible amap m ad ucref) || - IsTyconUnseen ad g amap m ucref.TyconRef || + IsTyconUnseen ad g amap m ucref.TyconRef || CheckFSharpAttributesForUnseen g ucref.Attribs m -let ItemIsUnseen ad g amap m item = - match item with +let ItemIsUnseen ad g amap m item = + match item with | Item.Value x -> IsValUnseen ad g m x - | Item.UnionCase(x,_) -> IsUnionCaseUnseen ad g amap m x.UnionCaseRef + | Item.UnionCase(x, _) -> IsUnionCaseUnseen ad g amap m x.UnionCaseRef | Item.ExnCase x -> IsTyconUnseen ad g amap m x | _ -> false -let ItemOfTyconRef ncenv m (x:TyconRef) = - Item.Types (x.DisplayName,[FreshenTycon ncenv m x]) +let ItemOfTyconRef ncenv m (x:TyconRef) = + Item.Types (x.DisplayName, [FreshenTycon ncenv m x]) -let ItemOfTy g x = +let ItemOfTy g x = let nm = if isAppTy g x then (tcrefOfAppTy g x).DisplayName else "?" - Item.Types (nm,[x]) + Item.Types (nm, [x]) // Filter out 'PrivateImplementationDetail' classes let IsInterestingModuleName nm = not (System.String.IsNullOrEmpty nm) && nm.[0] <> '<' let rec PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThen f plid (modref:ModuleOrNamespaceRef) = let mty = modref.ModuleOrNamespaceType - match plid with + match plid with | [] -> f modref - | id:: rest -> + | id:: rest -> match mty.ModulesAndNamespacesByDemangledName.TryGetValue id with - | true, mty -> PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThen f rest (modref.NestedTyconRef mty) + | true, mty -> PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThen f rest (modref.NestedTyconRef mty) | _ -> [] let PartialResolveLongIndentAsModuleOrNamespaceThen (nenv:NameResolutionEnv) plid f = match plid with - | id:: rest -> + | id:: rest -> match nenv.eModulesAndNamespaces.TryGetValue id with - | true, modrefs -> + | true, modrefs -> List.collect (PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThen f rest) modrefs | _ -> [] | [] -> [] /// Returns fields for the given class or record -let ResolveRecordOrClassFieldsOfType (ncenv: NameResolver) m ad ty statics = - ncenv.InfoReader.GetRecordOrClassFieldsOfType(None,ad,m,ty) +let ResolveRecordOrClassFieldsOfType (ncenv: NameResolver) m ad ty statics = + ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ty) |> List.filter (fun rfref -> rfref.IsStatic = statics && IsFieldInfoAccessible ad rfref) |> List.map Item.RecdField @@ -3486,116 +3485,116 @@ let ResolveRecordOrClassFieldsOfType (ncenv: NameResolver) m ad ty statics = type ResolveCompletionTargets = | All of (MethInfo -> TType -> bool) | SettablePropertiesAndFields - member this.ResolveAll = + member this.ResolveAll = match this with | All _ -> true | SettablePropertiesAndFields -> false /// Resolve a (possibly incomplete) long identifier to a set of possible resolutions, qualified by type. let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: ResolveCompletionTargets) m ad statics ty = - protectAssemblyExploration [] <| fun () -> + protectAssemblyExploration [] <| fun () -> let g = ncenv.g let amap = ncenv.amap - - let rfinfos = - ncenv.InfoReader.GetRecordOrClassFieldsOfType(None,ad,m,ty) + + let rfinfos = + ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ty) |> List.filter (fun rfref -> rfref.IsStatic = statics && IsFieldInfoAccessible ad rfref) let ucinfos = if completionTargets.ResolveAll && statics then match tryAppTy g ty with - | ValueSome (tc,tinst) -> + | ValueSome (tc, tinst) -> tc.UnionCasesAsRefList |> List.filter (IsUnionCaseUnseen ad g ncenv.amap m >> not) - |> List.map (fun ucref -> Item.UnionCase(UnionCaseInfo(tinst,ucref),false)) + |> List.map (fun ucref -> Item.UnionCase(UnionCaseInfo(tinst, ucref), false)) | _ -> [] else [] - let einfos = + let einfos = if completionTargets.ResolveAll then - ncenv.InfoReader.GetEventInfosOfType(None,ad,m,ty) - |> List.filter (fun x -> + ncenv.InfoReader.GetEventInfosOfType(None, ad, m, ty) + |> List.filter (fun x -> IsStandardEventInfo ncenv.InfoReader m ad x && x.IsStatic = statics) else [] - let nestedTypes = + let nestedTypes = if completionTargets.ResolveAll && statics then ty - |> GetNestedTypesOfType (ad, ncenv, None, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) - else + |> GetNestedTypesOfType (ad, ncenv, None, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) + else [] - let finfos = - ncenv.InfoReader.GetILFieldInfosOfType(None,ad,m,ty) - |> List.filter (fun x -> + let finfos = + ncenv.InfoReader.GetILFieldInfosOfType(None, ad, m, ty) + |> List.filter (fun x -> not x.IsSpecialName && - x.IsStatic = statics && + x.IsStatic = statics && IsILFieldInfoAccessible g amap m ad x) - let pinfosIncludingUnseen = - AllPropInfosOfTypeInScope ncenv.InfoReader nenv (None,ad) PreferOverrides m ty - |> List.filter (fun x -> - x.IsStatic = statics && + let pinfosIncludingUnseen = + AllPropInfosOfTypeInScope ncenv.InfoReader nenv (None, ad) PreferOverrides m ty + |> List.filter (fun x -> + x.IsStatic = statics && IsPropInfoAccessible g amap m ad x) - // Exclude get_ and set_ methods accessed by properties - let pinfoMethNames = - (pinfosIncludingUnseen + // Exclude get_ and set_ methods accessed by properties + let pinfoMethNames = + (pinfosIncludingUnseen |> List.filter (fun pinfo -> pinfo.HasGetter) |> List.map (fun pinfo -> pinfo.GetterMethod.LogicalName)) @ - (pinfosIncludingUnseen + (pinfosIncludingUnseen |> List.filter (fun pinfo -> pinfo.HasSetter) |> List.map (fun pinfo -> pinfo.SetterMethod.LogicalName)) - - let einfoMethNames = + + let einfoMethNames = if completionTargets.ResolveAll then - [ for einfo in einfos do - let delegateType = einfo.GetDelegateType(amap,m) - let (SigOfFunctionForDelegate(invokeMethInfo,_,_,_)) = GetSigOfFunctionForDelegate ncenv.InfoReader delegateType m ad + [ for einfo in einfos do + let delegateType = einfo.GetDelegateType(amap, m) + let (SigOfFunctionForDelegate(invokeMethInfo, _, _, _)) = GetSigOfFunctionForDelegate ncenv.InfoReader delegateType m ad // Only events with void return types are suppressed in intellisense. - if slotSigHasVoidReturnTy (invokeMethInfo.GetSlotSig(amap, m)) then + if slotSigHasVoidReturnTy (invokeMethInfo.GetSlotSig(amap, m)) then yield einfo.AddMethod.DisplayName yield einfo.RemoveMethod.DisplayName ] else [] - let pinfos = + let pinfos = pinfosIncludingUnseen |> List.filter (fun x -> not (PropInfoIsUnseen m x)) - let minfoFilter (suppressedMethNames:Zset<_>) (minfo:MethInfo) = + let minfoFilter (suppressedMethNames:Zset<_>) (minfo:MethInfo) = let isApplicableMeth = match completionTargets with | ResolveCompletionTargets.All x -> x | _ -> failwith "internal error: expected completionTargets = ResolveCompletionTargets.All" - // Only show the Finalize, MemberwiseClose etc. methods on System.Object for values whose static type really is - // System.Object. Few of these are typically used from F#. + // Only show the Finalize, MemberwiseClose etc. methods on System.Object for values whose static type really is + // System.Object. Few of these are typically used from F#. // // Don't show GetHashCode or Equals for F# types that admit equality as an abnormal operation - let isUnseenDueToBasicObjRules = + let isUnseenDueToBasicObjRules = not (isObjTy g ty) && not minfo.IsExtensionMember && match minfo.LogicalName with | "GetType" -> false | "GetHashCode" -> isObjTy g minfo.ApparentEnclosingType && not (AugmentWithHashCompare.TypeDefinitelyHasEquality g ty) | "ToString" -> false - | "Equals" -> - if not (isObjTy g minfo.ApparentEnclosingType) then + | "Equals" -> + if not (isObjTy g minfo.ApparentEnclosingType) then // declaring type is not System.Object - show it - false + false elif minfo.IsInstance then // System.Object has only one instance Equals method and we want to suppress it unless Augment.TypeDefinitelyHasEquality is true not (AugmentWithHashCompare.TypeDefinitelyHasEquality g ty) else // System.Object has only one static Equals method and we always want to suppress it true - | _ -> + | _ -> // filter out self methods of obj type isObjTy g minfo.ApparentEnclosingType - let result = + let result = not isUnseenDueToBasicObjRules && not minfo.IsInstance = statics && IsMethInfoAccessible amap m ad minfo && @@ -3609,8 +3608,8 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso result - let pinfoItems = - let pinfos = + let pinfoItems = + let pinfos = match completionTargets with | ResolveCompletionTargets.SettablePropertiesAndFields -> pinfos |> List.filter (fun p -> p.HasSetter) | _ -> pinfos @@ -3623,9 +3622,9 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso | _ -> pinfoOpt) // REVIEW: add a name filter here in the common cases? - let minfos = + let minfos = if completionTargets.ResolveAll then - let minfos = AllMethInfosOfTypeInScope ncenv.InfoReader nenv (None,ad) PreferOverrides m ty + let minfos = AllMethInfosOfTypeInScope ncenv.InfoReader nenv (None, ad) PreferOverrides m ty if isNil minfos then [] else @@ -3643,7 +3642,7 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso let hashSet = HashSet() for item in pinfoItems do match item with - | Item.Event(FSEvent(_,_,addValRef,removeValRef)) -> + | Item.Event(FSEvent(_, _, addValRef, removeValRef)) -> hashSet.Add addValRef.LogicalName |> ignore hashSet.Add removeValRef.LogicalName |> ignore | _ -> () @@ -3654,40 +3653,40 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso #if !NO_EXTENSIONTYPING // Filter out the ones with mangled names from applying static parameters - let minfos = - let methsWithStaticParams = - minfos - |> List.filter (fun minfo -> - match minfo.ProvidedStaticParameterInfo with + let minfos = + let methsWithStaticParams = + minfos + |> List.filter (fun minfo -> + match minfo.ProvidedStaticParameterInfo with | Some (_methBeforeArguments, staticParams) -> staticParams.Length <> 0 | _ -> false) |> List.map (fun minfo -> minfo.DisplayName) if methsWithStaticParams.IsEmpty then minfos - else minfos |> List.filter (fun minfo -> + else minfos |> List.filter (fun minfo -> let nm = minfo.LogicalName not (nm.Contains "," && methsWithStaticParams |> List.exists (fun m -> nm.StartsWithOrdinal(m)))) #endif - minfos + minfos - else + else [] // Partition methods into overload sets - let rec partitionl (l:MethInfo list) acc = + let rec partitionl (l:MethInfo list) acc = match l with | [] -> acc - | h::t -> + | h::t -> let nm = h.LogicalName partitionl t (NameMultiMap.add nm h acc) let anonFields = if statics then [] else - match tryDestAnonRecdTy g ty with - | ValueSome (anonInfo, tys) -> - [ for (i,id) in Array.indexed anonInfo.SortedIds do + match tryDestAnonRecdTy g ty with + | ValueSome (anonInfo, tys) -> + [ for (i, id) in Array.indexed anonInfo.SortedIds do yield Item.AnonRecdField(anonInfo, tys, i, id.idRange) ] | _ -> [] @@ -3700,7 +3699,7 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso List.map Item.Event einfos @ List.map (ItemOfTy g) nestedTypes @ List.map Item.MakeMethGroup (NameMap.toList (partitionl minfos Map.empty)) - + let rec ResolvePartialLongIdentInType (ncenv: NameResolver) nenv isApplicableMeth m ad statics plid ty = let g = ncenv.g @@ -3708,79 +3707,79 @@ let rec ResolvePartialLongIdentInType (ncenv: NameResolver) nenv isApplicableMet match plid with | [] -> ResolveCompletionsInType ncenv nenv isApplicableMeth m ad statics ty | id :: rest -> - - let rfinfos = - ncenv.InfoReader.GetRecordOrClassFieldsOfType(None,ad,m,ty) + + let rfinfos = + ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ty) |> List.filter (fun fref -> fref.Name = id && IsRecdFieldAccessible ncenv.amap m ad fref.RecdFieldRef && fref.RecdField.IsStatic = statics) - - let nestedTypes = - ty - |> GetNestedTypesOfType (ad, ncenv, Some id, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) - // e.g. .. + let nestedTypes = + ty + |> GetNestedTypesOfType (ad, ncenv, Some id, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) + + // e.g. .. (rfinfos |> List.collect (fun x -> x.FieldType |> ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad false rest)) @ - // e.g. .. - let FullTypeOfPinfo(pinfo:PropInfo) = - let rty = pinfo.GetPropertyType(amap,m) - let rty = if pinfo.IsIndexer then mkRefTupledTy g (pinfo.GetParamTypes(amap, m)) --> rty else rty + // e.g. .. + let FullTypeOfPinfo(pinfo:PropInfo) = + let rty = pinfo.GetPropertyType(amap, m) + let rty = if pinfo.IsIndexer then mkRefTupledTy g (pinfo.GetParamTypes(amap, m)) --> rty else rty rty (ty - |> AllPropInfosOfTypeInScope ncenv.InfoReader nenv (Some id,ad) IgnoreOverrides m - |> List.filter (fun pinfo -> pinfo.IsStatic = statics && IsPropInfoAccessible g amap m ad pinfo) + |> AllPropInfosOfTypeInScope ncenv.InfoReader nenv (Some id, ad) IgnoreOverrides m + |> List.filter (fun pinfo -> pinfo.IsStatic = statics && IsPropInfoAccessible g amap m ad pinfo) |> List.collect (fun pinfo -> (FullTypeOfPinfo pinfo) |> ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad false rest)) @ - (if statics then [] - else - match TryFindAnonRecdFieldOfType g ty id with + (if statics then [] + else + match TryFindAnonRecdFieldOfType g ty id with | Some (Item.AnonRecdField(_anonInfo, tys, i, _)) -> ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad false rest tys.[i] | _ -> []) @ - // e.g. .. - (ncenv.InfoReader.GetEventInfosOfType(Some id,ad,m,ty) + // e.g. .. + (ncenv.InfoReader.GetEventInfosOfType(Some id, ad, m, ty) |> List.collect (PropTypOfEventInfo ncenv.InfoReader m ad >> ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad false rest)) @ - // nested types! - (nestedTypes + // nested types! + (nestedTypes |> List.collect (ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad statics rest)) @ - // e.g. .. - (ncenv.InfoReader.GetILFieldInfosOfType(Some id,ad,m,ty) - |> List.filter (fun x -> + // e.g. .. + (ncenv.InfoReader.GetILFieldInfosOfType(Some id, ad, m, ty) + |> List.filter (fun x -> not x.IsSpecialName && - x.IsStatic = statics && + x.IsStatic = statics && IsILFieldInfoAccessible g amap m ad x) - |> List.collect (fun x -> x.FieldType(amap,m) |> ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad false rest)) - -let InfosForTyconConstructors (ncenv:NameResolver) m ad (tcref:TyconRef) = + |> List.collect (fun x -> x.FieldType(amap, m) |> ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad false rest)) + +let InfosForTyconConstructors (ncenv:NameResolver) m ad (tcref:TyconRef) = let g = ncenv.g let amap = ncenv.amap // Don't show constructors for type abbreviations. See FSharp 1.0 bug 2881 - if tcref.IsTypeAbbrev then + if tcref.IsTypeAbbrev then [] - else + else let ty = FreshenTycon ncenv m tcref - match ResolveObjectConstructor ncenv (DisplayEnv.Empty g) m ad ty with - | Result item -> - match item with + match ResolveObjectConstructor ncenv (DisplayEnv.Empty g) m ad ty with + | Result item -> + match item with | Item.FakeInterfaceCtor _ -> [] - | Item.CtorGroup(nm,ctorInfos) -> - let ctors = - ctorInfos + | Item.CtorGroup(nm, ctorInfos) -> + let ctors = + ctorInfos |> List.filter (fun minfo -> IsMethInfoAccessible amap m ad minfo && not (MethInfoIsUnseen g m ty minfo)) match ctors with | [] -> [] - | _ -> [Item.MakeCtorGroup(nm,ctors)] - | item -> + | _ -> [Item.MakeCtorGroup(nm, ctors)] + | item -> [item] | Exception _ -> [] -/// import.fs creates somewhat fake modules for nested members of types (so that +/// import.fs creates somewhat fake modules for nested members of types (so that /// types never contain other types) -let inline notFakeContainerModule (tyconNames:HashSet<_>) nm = +let inline notFakeContainerModule (tyconNames:HashSet<_>) nm = not (tyconNames.Contains nm) let getFakeContainerModulesFromTycons (tycons:#seq) = @@ -3797,52 +3796,52 @@ let getFakeContainerModulesFromTyconRefs (tyconRefs:#seq) = hashSet.Add tyconRef.DisplayName |> ignore hashSet -/// Check is a namespace or module contains something accessible -let rec private EntityRefContainsSomethingAccessible (ncenv: NameResolver) m ad (modref:ModuleOrNamespaceRef) = +/// Check is a namespace or module contains something accessible +let rec private EntityRefContainsSomethingAccessible (ncenv: NameResolver) m ad (modref:ModuleOrNamespaceRef) = let g = ncenv.g let mty = modref.ModuleOrNamespaceType - // Search the values in the module for an accessible value + // Search the values in the module for an accessible value (mty.AllValsAndMembers - |> Seq.exists (fun v -> + |> Seq.exists (fun v -> // This may explore assemblies that are not in the reference set, - // e.g. for extension members that extend a type not in the reference set. - // In this case assume it is accessible. The user may later explore this module + // e.g. for extension members that extend a type not in the reference set. + // In this case assume it is accessible. The user may later explore this module // but will not see the extension members anyway. // // Note: this is the only use of protectAssemblyExplorationNoReraise. // REVIEW: consider changing this to protectAssemblyExploration. We shouldn't need // to catch arbitrary exceptions here. protectAssemblyExplorationNoReraise true false - (fun () -> + (fun () -> let vref = mkNestedValRef modref v - not vref.IsCompilerGenerated && + not vref.IsCompilerGenerated && not (IsValUnseen ad g m vref) && (vref.IsExtensionMember || not vref.IsMember)))) || - // Search the types in the namespace/module for an accessible tycon + // Search the types in the namespace/module for an accessible tycon (mty.AllEntities - |> QueueList.exists (fun tc -> - not tc.IsModuleOrNamespace && + |> QueueList.exists (fun tc -> + not tc.IsModuleOrNamespace && not (IsTyconUnseen ad g ncenv.amap m (modref.NestedTyconRef tc)))) || - // Search the sub-modules of the namespace/module for something accessible - (mty.ModulesAndNamespacesByDemangledName - |> NameMap.exists (fun _ submod -> + // Search the sub-modules of the namespace/module for something accessible + (mty.ModulesAndNamespacesByDemangledName + |> NameMap.exists (fun _ submod -> let submodref = modref.NestedTyconRef submod - EntityRefContainsSomethingAccessible ncenv m ad submodref)) + EntityRefContainsSomethingAccessible ncenv m ad submodref)) let rec ResolvePartialLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv isApplicableMeth m ad (modref:ModuleOrNamespaceRef) plid allowObsolete = let g = ncenv.g let mty = modref.ModuleOrNamespaceType - - match plid with - | [] -> - let tycons = + + match plid with + | [] -> + let tycons = mty.TypeDefinitions |> List.filter (fun tcref -> - not (tcref.LogicalName.Contains(",")) && + not (tcref.LogicalName.Contains ",") && not (IsTyconUnseen ad g ncenv.amap m (modref.NestedTyconRef tcref))) - + let accessibleSubModules = let moduleOrNamespaces = mty.ModulesAndNamespacesByDemangledName @@ -3853,7 +3852,7 @@ let rec ResolvePartialLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv is let ilTyconNames = getFakeContainerModulesFromTycons mty.TypesByAccessNames.Values moduleOrNamespaces - |> List.filter (fun x -> + |> List.filter (fun x -> let demangledName = x.DemangledModuleOrNamespaceName notFakeContainerModule ilTyconNames demangledName && IsInterestingModuleName demangledName) |> List.map modref.NestedTyconRef @@ -3869,35 +3868,35 @@ let rec ResolvePartialLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv is |> List.filter (fun vref -> not vref.IsMember && not (IsValUnseen ad g m vref)) |> List.map Item.Value) - // Collect up the accessible discriminated union cases in the module - @ (UnionCaseRefsInModuleOrNamespace modref + // Collect up the accessible discriminated union cases in the module + @ (UnionCaseRefsInModuleOrNamespace modref |> List.filter (IsUnionCaseUnseen ad g ncenv.amap m >> not) - |> List.map (fun x -> Item.UnionCase(GeneralizeUnionCaseRef x,false))) + |> List.map (fun x -> Item.UnionCase(GeneralizeUnionCaseRef x, false))) - // Collect up the accessible active patterns in the module - @ (ActivePatternElemsOfModuleOrNamespace modref + // Collect up the accessible active patterns in the module + @ (ActivePatternElemsOfModuleOrNamespace modref |> NameMap.range - |> List.filter (fun apref -> apref.ActivePatternVal |> IsValUnseen ad g m |> not) + |> List.filter (fun apref -> apref.ActivePatternVal |> IsValUnseen ad g m |> not) |> List.map Item.ActivePatternCase) - // Collect up the accessible F# exception declarations in the module - @ (mty.ExceptionDefinitionsByDemangledName - |> NameMap.range + // Collect up the accessible F# exception declarations in the module + @ (mty.ExceptionDefinitionsByDemangledName + |> NameMap.range |> List.map modref.NestedTyconRef |> List.filter (IsTyconUnseen ad g ncenv.amap m >> not) |> List.map Item.ExnCase) @ accessibleSubModules - // Get all the types and .NET constructor groups accessible from here - @ (tycons + // Get all the types and .NET constructor groups accessible from here + @ (tycons |> List.map (modref.NestedTyconRef >> ItemOfTyconRef ncenv m) ) - @ (tycons + @ (tycons |> List.collect (modref.NestedTyconRef >> InfosForTyconConstructors ncenv m ad)) - | id :: rest -> + | id :: rest -> (match mty.ModulesAndNamespacesByDemangledName.TryGetValue id with | true, mspec -> @@ -3910,10 +3909,10 @@ let rec ResolvePartialLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv is @ (LookupTypeNameInEntityNoArity m id modref.ModuleOrNamespaceType |> List.collect (fun tycon -> - let tcref = modref.NestedTyconRef tycon - if not (IsTyconUnseenObsoleteSpec ad g ncenv.amap m tcref allowObsolete) then + let tcref = modref.NestedTyconRef tycon + if not (IsTyconUnseenObsoleteSpec ad g ncenv.amap m tcref allowObsolete) then tcref |> generalizedTyconRef |> ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad true rest - else + else [])) /// Try to resolve a long identifier as type. @@ -3922,13 +3921,13 @@ let TryToResolveLongIdentAsType (ncenv: NameResolver) (nenv: NameResolutionEnv) match List.tryLast plid with | Some id -> - // Look for values called 'id' that accept the dot-notation - let ty = + // Look for values called 'id' that accept the dot-notation + let ty = match nenv.eUnqualifiedItems.TryGetValue id with // v.lookup : member of a value | true, v -> - match v with - | Item.Value x -> + match v with + | Item.Value x -> let ty = x.Type let ty = if x.BaseOrThisInfo = CtorThisVal && isRefCellTy g ty then destRefCellTy g ty else ty Some ty @@ -3943,12 +3942,12 @@ let TryToResolveLongIdentAsType (ncenv: NameResolver) (nenv: NameResolutionEnv) |> List.tryHead |> Option.map (fun tcref -> let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m - FreshenTycon ncenv m tcref) + FreshenTycon ncenv m tcref) | _ -> None -/// allowObsolete - specifies whether we should return obsolete types & modules +/// allowObsolete - specifies whether we should return obsolete types & modules /// as (no other obsolete items are returned) -let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionEnv) isApplicableMeth fullyQualified m ad plid allowObsolete : Item list = +let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionEnv) isApplicableMeth fullyQualified m ad plid allowObsolete : Item list = let g = ncenv.g match plid with @@ -3956,23 +3955,23 @@ let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionE ResolvePartialLongIdentPrim ncenv nenv isApplicableMeth FullyQualified m ad plid allowObsolete - | [] -> - - - /// Include all the entries in the eUnqualifiedItems table. - let unqualifiedItems = - match fullyQualified with + | [] -> + + + /// Include all the entries in the eUnqualifiedItems table. + let unqualifiedItems = + match fullyQualified with | FullyQualified -> [] | OpenQualified -> nenv.eUnqualifiedItems.Values - |> List.filter (function - | Item.UnqualifiedType _ -> false + |> List.filter (function + | Item.UnqualifiedType _ -> false | Item.Value v -> not v.IsMember | _ -> true) |> List.filter (ItemIsUnseen ad g ncenv.amap m >> not) - let activePatternItems = - match fullyQualified with + let activePatternItems = + match fullyQualified with | FullyQualified -> [] | OpenQualified -> nenv.ePatItems @@ -3980,10 +3979,10 @@ let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionE |> List.filter (function Item.ActivePatternCase _v -> true | _ -> false) let moduleAndNamespaceItems = - let moduleOrNamespaceRefs = + let moduleOrNamespaceRefs = nenv.ModulesAndNamespaces fullyQualified |> NameMultiMap.range - + if isNil moduleOrNamespaceRefs then [] else let ilTyconNames = getFakeContainerModulesFromTyconRefs (nenv.TyconsByAccessNames(fullyQualified).Values) @@ -3995,84 +3994,84 @@ let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionE not (IsTyconUnseen ad g ncenv.amap m modref)) |> List.map ItemForModuleOrNamespaceRef - let tycons = + let tycons = nenv.TyconsByDemangledNameAndArity(fullyQualified).Values |> List.filter (fun tcref -> - not (tcref.LogicalName.Contains(",")) && + not (tcref.LogicalName.Contains ",") && not tcref.IsExceptionDecl && not (IsTyconUnseen ad g ncenv.amap m tcref)) |> List.map (ItemOfTyconRef ncenv m) // Get all the constructors accessible from here - let constructors = + let constructors = nenv.TyconsByDemangledNameAndArity(fullyQualified).Values |> List.filter (IsTyconUnseen ad g ncenv.amap m >> not) |> List.collect (InfosForTyconConstructors ncenv m ad) unqualifiedItems @ activePatternItems @ moduleAndNamespaceItems @ tycons @ constructors - | id :: rest -> - - // Look in the namespaces 'id' - let namespaces = - PartialResolveLongIndentAsModuleOrNamespaceThen nenv [id] (fun modref -> + | id :: rest -> + + // Look in the namespaces 'id' + let namespaces = + PartialResolveLongIndentAsModuleOrNamespaceThen nenv [id] (fun modref -> let allowObsolete = rest <> [] && allowObsolete - if EntityRefContainsSomethingAccessible ncenv m ad modref then + if EntityRefContainsSomethingAccessible ncenv m ad modref then ResolvePartialLongIdentInModuleOrNamespace ncenv nenv isApplicableMeth m ad modref rest allowObsolete - else + else []) - // Look for values called 'id' that accept the dot-notation - let values, isItemVal = + // Look for values called 'id' that accept the dot-notation + let values, isItemVal = (match nenv.eUnqualifiedItems.TryGetValue id with // v.lookup : member of a value | true, v -> - match v with - | Item.Value x -> + match v with + | Item.Value x -> let ty = x.Type let ty = if x.BaseOrThisInfo = CtorThisVal && isRefCellTy g ty then destRefCellTy g ty else ty (ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad false rest ty), true | _ -> [], false | _ -> [], false) - let staticSometingInType = - [ if not isItemVal then - // type.lookup : lookup a static something in a type + let staticSometingInType = + [ if not isItemVal then + // type.lookup : lookup a static something in a type for tcref in LookupTypeNameInEnvNoArity OpenQualified id nenv do let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m let ty = FreshenTycon ncenv m tcref yield! ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad true rest ty ] - + namespaces @ values @ staticSometingInType /// Resolve a (possibly incomplete) long identifier to a set of possible resolutions. -let ResolvePartialLongIdent ncenv nenv isApplicableMeth m ad plid allowObsolete = - ResolvePartialLongIdentPrim ncenv nenv (ResolveCompletionTargets.All isApplicableMeth) OpenQualified m ad plid allowObsolete +let ResolvePartialLongIdent ncenv nenv isApplicableMeth m ad plid allowObsolete = + ResolvePartialLongIdentPrim ncenv nenv (ResolveCompletionTargets.All isApplicableMeth) OpenQualified m ad plid allowObsolete // REVIEW: has much in common with ResolvePartialLongIdentInModuleOrNamespace - probably they should be united let rec ResolvePartialLongIdentInModuleOrNamespaceForRecordFields (ncenv: NameResolver) nenv m ad (modref:ModuleOrNamespaceRef) plid allowObsolete = let g = ncenv.g let mty = modref.ModuleOrNamespaceType - match plid with - | [] -> + match plid with + | [] -> // get record type constructors - let tycons = + let tycons = mty.TypeDefinitions |> List.filter (fun tcref -> - not (tcref.LogicalName.Contains(",")) && + not (tcref.LogicalName.Contains ",") && tcref.IsRecordTycon && not (IsTyconUnseen ad g ncenv.amap m (modref.NestedTyconRef tcref))) let accessibleSubModules = let moduleOrNamespaces = - mty.ModulesAndNamespacesByDemangledName + mty.ModulesAndNamespacesByDemangledName |> NameMap.range if isNil moduleOrNamespaces then [] else - let ilTyconNames = getFakeContainerModulesFromTycons mty.TypesByAccessNames.Values - + let ilTyconNames = getFakeContainerModulesFromTycons mty.TypesByAccessNames.Values + moduleOrNamespaces |> List.filter (fun x -> let demangledName = x.DemangledModuleOrNamespaceName @@ -4082,7 +4081,7 @@ let rec ResolvePartialLongIdentInModuleOrNamespaceForRecordFields (ncenv: NameRe not (IsTyconUnseen ad g ncenv.amap m tcref) && EntityRefContainsSomethingAccessible ncenv m ad tcref) |> List.map ItemForModuleOrNamespaceRef - + accessibleSubModules // Collect all accessible record types @@ -4092,14 +4091,14 @@ let rec ResolvePartialLongIdentInModuleOrNamespaceForRecordFields (ncenv: NameRe let nested = modref.NestedTyconRef tycon if IsEntityAccessible ncenv.amap m ad nested then let ttype = FreshenTycon ncenv m nested - yield! + yield! ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ttype) |> List.map Item.RecdField ] - | id :: rest -> + | id :: rest -> (match mty.ModulesAndNamespacesByDemangledName.TryGetValue id with - | true, mspec -> + | true, mspec -> let nested = modref.NestedTyconRef mspec if IsTyconUnseenObsoleteSpec ad g ncenv.amap m nested allowObsolete then [] else let allowObsolete = allowObsolete && not (isNil rest) @@ -4107,7 +4106,7 @@ let rec ResolvePartialLongIdentInModuleOrNamespaceForRecordFields (ncenv: NameRe | _ -> []) @ ( match rest with - | [] -> + | [] -> // get all fields from the type named 'id' located in current modref let tycons = LookupTypeNameInEntityNoArity m id modref.ModuleOrNamespaceType tycons @@ -4120,27 +4119,27 @@ let rec ResolvePartialLongIdentInModuleOrNamespaceForRecordFields (ncenv: NameRe | _ -> [] ) -/// allowObsolete - specifies whether we should return obsolete types & modules +/// allowObsolete - specifies whether we should return obsolete types & modules /// as (no other obsolete items are returned) -let rec ResolvePartialLongIdentToClassOrRecdFields (ncenv: NameResolver) (nenv: NameResolutionEnv) m ad plid (allowObsolete : bool) = +let rec ResolvePartialLongIdentToClassOrRecdFields (ncenv: NameResolver) (nenv: NameResolutionEnv) m ad plid (allowObsolete : bool) = ResolvePartialLongIdentToClassOrRecdFieldsImpl ncenv nenv OpenQualified m ad plid allowObsolete -and ResolvePartialLongIdentToClassOrRecdFieldsImpl (ncenv: NameResolver) (nenv: NameResolutionEnv) fullyQualified m ad plid allowObsolete = +and ResolvePartialLongIdentToClassOrRecdFieldsImpl (ncenv: NameResolver) (nenv: NameResolutionEnv) fullyQualified m ad plid allowObsolete = let g = ncenv.g match plid with | id :: plid when id = "global" -> // this is deliberately not the mangled name // dive deeper ResolvePartialLongIdentToClassOrRecdFieldsImpl ncenv nenv FullyQualified m ad plid allowObsolete - | [] -> - + | [] -> + // empty plid - return namespaces\modules\record types\accessible fields - let mods = + let mods = let moduleOrNamespaceRefs = nenv.ModulesAndNamespaces fullyQualified - |> NameMultiMap.range + |> NameMultiMap.range if isNil moduleOrNamespaceRefs then [] else @@ -4154,34 +4153,34 @@ and ResolvePartialLongIdentToClassOrRecdFieldsImpl (ncenv: NameResolver) (nenv: not (IsTyconUnseen ad g ncenv.amap m modref)) |> List.map ItemForModuleOrNamespaceRef - let recdTyCons = + let recdTyCons = nenv.TyconsByDemangledNameAndArity(fullyQualified).Values |> List.filter (fun tcref -> - not (tcref.LogicalName.Contains(",")) && + not (tcref.LogicalName.Contains ",") && tcref.IsRecordTycon && not (IsTyconUnseen ad g ncenv.amap m tcref)) |> List.map (ItemOfTyconRef ncenv m) - let recdFields = + let recdFields = nenv.eFieldLabels |> Seq.collect (fun (KeyValue(_, v)) -> v) - |> Seq.map (fun fref -> + |> Seq.map (fun fref -> let typeInsts = fref.TyconRef.TyparsNoRange |> List.map (fun tyar -> tyar.AsType) Item.RecdField(RecdFieldInfo(typeInsts, fref))) |> List.ofSeq mods @ recdTyCons @ recdFields - | id::rest -> + | id::rest -> // Get results - let modsOrNs = - PartialResolveLongIndentAsModuleOrNamespaceThen nenv [id] (fun modref -> + let modsOrNs = + PartialResolveLongIndentAsModuleOrNamespaceThen nenv [id] (fun modref -> let allowObsolete = rest <> [] && allowObsolete - if EntityRefContainsSomethingAccessible ncenv m ad modref then + if EntityRefContainsSomethingAccessible ncenv m ad modref then ResolvePartialLongIdentInModuleOrNamespaceForRecordFields ncenv nenv m ad modref rest allowObsolete - else + else []) - let qualifiedFields = + let qualifiedFields = match rest with | [] -> // get record types accessible in given nenv @@ -4198,11 +4197,11 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty ( seq { let g = ncenv.g let amap = ncenv.amap - + match item with | Item.RecdField _ -> yield! - ncenv.InfoReader.GetRecordOrClassFieldsOfType(None,ad,m,ty) + ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ty) |> List.filter (fun rfref -> rfref.IsStatic = statics && IsFieldInfoAccessible ad rfref) |> List.map Item.RecdField | Item.UnionCase _ -> @@ -4210,23 +4209,23 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty ( match tryAppTy g ty with | ValueSome(tc, tinst) -> yield! - tc.UnionCasesAsRefList + tc.UnionCasesAsRefList |> List.filter (IsUnionCaseUnseen ad g ncenv.amap m >> not) - |> List.map (fun ucref -> Item.UnionCase(UnionCaseInfo(tinst,ucref),false)) + |> List.map (fun ucref -> Item.UnionCase(UnionCaseInfo(tinst, ucref), false)) | _ -> () | Item.Event _ -> yield! - ncenv.InfoReader.GetEventInfosOfType(None,ad,m,ty) - |> List.filter (fun x -> + ncenv.InfoReader.GetEventInfosOfType(None, ad, m, ty) + |> List.filter (fun x -> IsStandardEventInfo ncenv.InfoReader m ad x && x.IsStatic = statics) |> List.map Item.Event | Item.ILField _ -> yield! - ncenv.InfoReader.GetILFieldInfosOfType(None,ad,m,ty) - |> List.filter (fun x -> + ncenv.InfoReader.GetILFieldInfosOfType(None, ad, m, ty) + |> List.filter (fun x -> not x.IsSpecialName && - x.IsStatic = statics && + x.IsStatic = statics && IsILFieldInfoAccessible g amap m ad x) |> List.map Item.ILField | Item.Types _ -> @@ -4234,74 +4233,74 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty ( yield! ty |> GetNestedTypesOfType (ad, ncenv, None, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) |> List.map (ItemOfTy g) | _ -> if not statics then - match tryDestAnonRecdTy g ty with - | ValueSome (anonInfo, tys) -> - for (i,id) in Array.indexed anonInfo.SortedIds do + match tryDestAnonRecdTy g ty with + | ValueSome (anonInfo, tys) -> + for (i, id) in Array.indexed anonInfo.SortedIds do yield Item.AnonRecdField(anonInfo, tys, i, id.idRange) | _ -> () - let pinfosIncludingUnseen = - AllPropInfosOfTypeInScope ncenv.InfoReader nenv (None,ad) PreferOverrides m ty - |> List.filter (fun x -> - x.IsStatic = statics && + let pinfosIncludingUnseen = + AllPropInfosOfTypeInScope ncenv.InfoReader nenv (None, ad) PreferOverrides m ty + |> List.filter (fun x -> + x.IsStatic = statics && IsPropInfoAccessible g amap m ad x) - - // Exclude get_ and set_ methods accessed by properties - let pinfoMethNames = - (pinfosIncludingUnseen + + // Exclude get_ and set_ methods accessed by properties + let pinfoMethNames = + (pinfosIncludingUnseen |> List.filter (fun pinfo -> pinfo.HasGetter) |> List.map (fun pinfo -> pinfo.GetterMethod.LogicalName)) @ - (pinfosIncludingUnseen + (pinfosIncludingUnseen |> List.filter (fun pinfo -> pinfo.HasSetter) |> List.map (fun pinfo -> pinfo.SetterMethod.LogicalName)) - - let einfoMethNames = - let einfos = - ncenv.InfoReader.GetEventInfosOfType(None,ad,m,ty) - |> List.filter (fun x -> + + let einfoMethNames = + let einfos = + ncenv.InfoReader.GetEventInfosOfType(None, ad, m, ty) + |> List.filter (fun x -> IsStandardEventInfo ncenv.InfoReader m ad x && x.IsStatic = statics) - - [ for einfo in einfos do + + [ for einfo in einfos do let delegateType = einfo.GetDelegateType(amap, m) - let (SigOfFunctionForDelegate(invokeMethInfo,_,_,_)) = GetSigOfFunctionForDelegate ncenv.InfoReader delegateType m ad + let (SigOfFunctionForDelegate(invokeMethInfo, _, _, _)) = GetSigOfFunctionForDelegate ncenv.InfoReader delegateType m ad // Only events with void return types are suppressed in intellisense. - if slotSigHasVoidReturnTy (invokeMethInfo.GetSlotSig(amap, m)) then + if slotSigHasVoidReturnTy (invokeMethInfo.GetSlotSig(amap, m)) then yield einfo.AddMethod.DisplayName yield einfo.RemoveMethod.DisplayName ] - - - let pinfos = + + + let pinfos = pinfosIncludingUnseen |> List.filter (fun x -> not (PropInfoIsUnseen m x)) - - let minfoFilter (suppressedMethNames:Zset<_>) (minfo: MethInfo) = - // Only show the Finalize, MemberwiseClose etc. methods on System.Object for values whose static type really is - // System.Object. Few of these are typically used from F#. + + let minfoFilter (suppressedMethNames:Zset<_>) (minfo: MethInfo) = + // Only show the Finalize, MemberwiseClose etc. methods on System.Object for values whose static type really is + // System.Object. Few of these are typically used from F#. // // Don't show GetHashCode or Equals for F# types that admit equality as an abnormal operation - let isUnseenDueToBasicObjRules = + let isUnseenDueToBasicObjRules = not (isObjTy g ty) && not minfo.IsExtensionMember && match minfo.LogicalName with | "GetType" -> false | "GetHashCode" -> isObjTy g minfo.ApparentEnclosingType && not (AugmentWithHashCompare.TypeDefinitelyHasEquality g ty) | "ToString" -> false - | "Equals" -> - if not (isObjTy g minfo.ApparentEnclosingType) then + | "Equals" -> + if not (isObjTy g minfo.ApparentEnclosingType) then // declaring type is not System.Object - show it - false + false elif minfo.IsInstance then // System.Object has only one instance Equals method and we want to suppress it unless Augment.TypeDefinitelyHasEquality is true not (AugmentWithHashCompare.TypeDefinitelyHasEquality g ty) else // System.Object has only one static Equals method and we always want to suppress it true - | _ -> + | _ -> // filter out self methods of obj type isObjTy g minfo.ApparentEnclosingType - let result = + let result = not isUnseenDueToBasicObjRules && not minfo.IsInstance = statics && IsMethInfoAccessible amap m ad minfo && @@ -4312,7 +4311,7 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty ( not (minfo.LogicalName = ".ctor") && not (suppressedMethNames.Contains minfo.LogicalName) result - + let pinfoItems = pinfos |> List.choose (fun pinfo-> @@ -4326,59 +4325,59 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty ( match item with | Item.MethodGroup _ -> // REVIEW: add a name filter here in the common cases? - let minfos = - let minfos = AllMethInfosOfTypeInScope ncenv.InfoReader nenv (None,ad) PreferOverrides m ty + let minfos = + let minfos = AllMethInfosOfTypeInScope ncenv.InfoReader nenv (None, ad) PreferOverrides m ty if isNil minfos then [] else - + let suppressedMethNames = Zset.ofList String.order (pinfoMethNames @ einfoMethNames) - let minfos = + let minfos = minfos |> List.filter (minfoFilter suppressedMethNames) - - if isNil minfos then + + if isNil minfos then [] else - let minfos = - let addersAndRemovers = + let minfos = + let addersAndRemovers = let hashSet = HashSet() for item in pinfoItems do match item with - | Item.Event(FSEvent(_,_,addValRef,removeValRef)) -> + | Item.Event(FSEvent(_, _, addValRef, removeValRef)) -> hashSet.Add addValRef.LogicalName |> ignore hashSet.Add removeValRef.LogicalName |> ignore | _ -> () hashSet - + if addersAndRemovers.Count = 0 then minfos else minfos |> List.filter (fun minfo -> not (addersAndRemovers.Contains minfo.LogicalName)) - + #if !NO_EXTENSIONTYPING // Filter out the ones with mangled names from applying static parameters - let minfos = - let methsWithStaticParams = - minfos - |> List.filter (fun minfo -> - match minfo.ProvidedStaticParameterInfo with + let minfos = + let methsWithStaticParams = + minfos + |> List.filter (fun minfo -> + match minfo.ProvidedStaticParameterInfo with | Some (_methBeforeArguments, staticParams) -> staticParams.Length <> 0 | _ -> false) |> List.map (fun minfo -> minfo.DisplayName) - + if methsWithStaticParams.IsEmpty then minfos - else minfos |> List.filter (fun minfo -> + else minfos |> List.filter (fun minfo -> let nm = minfo.LogicalName not (nm.Contains "," && methsWithStaticParams |> List.exists (fun m -> nm.StartsWithOrdinal(m)))) #endif - - minfos - + + minfos + // Partition methods into overload sets - let rec partitionl (l:MethInfo list) acc = + let rec partitionl (l:MethInfo list) acc = match l with | [] -> acc - | h::t -> + | h::t -> let nm = h.LogicalName partitionl t (NameMultiMap.add nm h acc) - + yield! List.map Item.MakeMethGroup (NameMap.toList (partitionl minfos Map.empty)) | _ -> () } @@ -4387,51 +4386,51 @@ let rec ResolvePartialLongIdentInTypeForItem (ncenv: NameResolver) nenv m ad sta seq { let g = ncenv.g let amap = ncenv.amap - + match plid with | [] -> yield! ResolveCompletionsInTypeForItem ncenv nenv m ad statics ty item | id :: rest -> - - let rfinfos = - ncenv.InfoReader.GetRecordOrClassFieldsOfType(None,ad,m,ty) + + let rfinfos = + ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ty) |> List.filter (fun fref -> fref.Name = id && IsRecdFieldAccessible ncenv.amap m ad fref.RecdFieldRef && fref.RecdField.IsStatic = statics) - - let nestedTypes = ty |> GetNestedTypesOfType (ad, ncenv, Some id, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) - - // e.g. .. + + let nestedTypes = ty |> GetNestedTypesOfType (ad, ncenv, Some id, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) + + // e.g. .. for rfinfo in rfinfos do yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item rfinfo.FieldType - - // e.g. .. - let fullTypeOfPinfo (pinfo: PropInfo) = - let rty = pinfo.GetPropertyType(amap,m) - let rty = if pinfo.IsIndexer then mkRefTupledTy g (pinfo.GetParamTypes(amap, m)) --> rty else rty - rty - + + // e.g. .. + let fullTypeOfPinfo (pinfo: PropInfo) = + let rty = pinfo.GetPropertyType(amap, m) + let rty = if pinfo.IsIndexer then mkRefTupledTy g (pinfo.GetParamTypes(amap, m)) --> rty else rty + rty + let pinfos = ty - |> AllPropInfosOfTypeInScope ncenv.InfoReader nenv (Some id,ad) IgnoreOverrides m - |> List.filter (fun pinfo -> pinfo.IsStatic = statics && IsPropInfoAccessible g amap m ad pinfo) + |> AllPropInfosOfTypeInScope ncenv.InfoReader nenv (Some id, ad) IgnoreOverrides m + |> List.filter (fun pinfo -> pinfo.IsStatic = statics && IsPropInfoAccessible g amap m ad pinfo) for pinfo in pinfos do yield! (fullTypeOfPinfo pinfo) |> ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item - - match TryFindAnonRecdFieldOfType g ty id with - | Some (Item.AnonRecdField(_anonInfo, tys, i, _)) -> + + match TryFindAnonRecdFieldOfType g ty id with + | Some (Item.AnonRecdField(_anonInfo, tys, i, _)) -> let tyinfo = tys.[i] yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item tyinfo | _ -> () - - // e.g. .. + + // e.g. .. for einfo in ncenv.InfoReader.GetEventInfosOfType(Some id, ad, m, ty) do let tyinfo = PropTypOfEventInfo ncenv.InfoReader m ad einfo yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item tyinfo - + // nested types! for ty in nestedTypes do yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad statics rest item ty - - // e.g. .. + + // e.g. .. for finfo in ncenv.InfoReader.GetILFieldInfosOfType(Some id, ad, m, ty) do if not finfo.IsSpecialName && finfo.IsStatic = statics && IsILFieldInfoAccessible g amap m ad finfo then yield! finfo.FieldType(amap, m) |> ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item @@ -4440,10 +4439,10 @@ let rec ResolvePartialLongIdentInTypeForItem (ncenv: NameResolver) nenv m ad sta let rec ResolvePartialLongIdentInModuleOrNamespaceForItem (ncenv: NameResolver) nenv m ad (modref: ModuleOrNamespaceRef) plid (item: Item) = let g = ncenv.g let mty = modref.ModuleOrNamespaceType - + seq { - match plid with - | [] -> + match plid with + | [] -> match item with | Item.Value _ -> // Collect up the accessible values in the module, excluding the members @@ -4453,41 +4452,41 @@ let rec ResolvePartialLongIdentInModuleOrNamespaceForItem (ncenv: NameResolver) |> List.choose (TryMkValRefInModRef modref) // if the assembly load set is incomplete and we get a None value here, then ignore the value |> List.filter (fun vref -> not vref.IsMember && not (IsValUnseen ad g m vref)) |> List.map Item.Value - | Item.UnionCase _ -> - // Collect up the accessible discriminated union cases in the module - yield! - UnionCaseRefsInModuleOrNamespace modref + | Item.UnionCase _ -> + // Collect up the accessible discriminated union cases in the module + yield! + UnionCaseRefsInModuleOrNamespace modref |> List.filter (IsUnionCaseUnseen ad g ncenv.amap m >> not) |> List.map (fun x -> Item.UnionCase(GeneralizeUnionCaseRef x, false)) | Item.ActivePatternCase _ -> - // Collect up the accessible active patterns in the module + // Collect up the accessible active patterns in the module yield! - ActivePatternElemsOfModuleOrNamespace modref + ActivePatternElemsOfModuleOrNamespace modref |> NameMap.range - |> List.filter (fun apref -> apref.ActivePatternVal |> IsValUnseen ad g m |> not) + |> List.filter (fun apref -> apref.ActivePatternVal |> IsValUnseen ad g m |> not) |> List.map Item.ActivePatternCase | Item.ExnCase _ -> - // Collect up the accessible F# exception declarations in the module + // Collect up the accessible F# exception declarations in the module yield! - mty.ExceptionDefinitionsByDemangledName - |> NameMap.range + mty.ExceptionDefinitionsByDemangledName + |> NameMap.range |> List.map modref.NestedTyconRef |> List.filter (IsTyconUnseen ad g ncenv.amap m >> not) |> List.map Item.ExnCase | _ -> - // Collect up the accessible sub-modules. We must yield them even though `item` is not a module or namespace, + // Collect up the accessible sub-modules. We must yield them even though `item` is not a module or namespace, // otherwise we would not resolve long idents which have modules and namespaces in the middle (i.e. all long idents) - - let moduleOrNamespaces = - mty.ModulesAndNamespacesByDemangledName + + let moduleOrNamespaces = + mty.ModulesAndNamespacesByDemangledName |> NameMap.range if not (isNil moduleOrNamespaces) then let ilTyconNames = getFakeContainerModulesFromTycons mty.TypesByAccessNames.Values - + yield! moduleOrNamespaces - |> List.filter (fun x -> + |> List.filter (fun x -> let demangledName = x.DemangledModuleOrNamespaceName notFakeContainerModule ilTyconNames demangledName && IsInterestingModuleName demangledName) |> List.map modref.NestedTyconRef @@ -4496,48 +4495,48 @@ let rec ResolvePartialLongIdentInModuleOrNamespaceForItem (ncenv: NameResolver) EntityRefContainsSomethingAccessible ncenv m ad tcref) |> List.map ItemForModuleOrNamespaceRef - let tycons = + let tycons = mty.TypeDefinitions |> List.filter (fun tcref -> - not (tcref.LogicalName.Contains(",")) && + not (tcref.LogicalName.Contains ",") && not (IsTyconUnseen ad g ncenv.amap m (modref.NestedTyconRef tcref))) // Get all the types and .NET constructor groups accessible from here let nestedTycons = tycons |> List.map modref.NestedTyconRef yield! nestedTycons |> List.map (ItemOfTyconRef ncenv m) yield! nestedTycons |> List.collect (InfosForTyconConstructors ncenv m ad) - - | id :: rest -> - + + | id :: rest -> + match mty.ModulesAndNamespacesByDemangledName.TryGetValue id with - | true, mspec -> + | true, mspec -> let nested = modref.NestedTyconRef mspec if not (IsTyconUnseenObsoleteSpec ad g ncenv.amap m nested true) then yield! ResolvePartialLongIdentInModuleOrNamespaceForItem ncenv nenv m ad nested rest item | _ -> () - + for tycon in LookupTypeNameInEntityNoArity m id modref.ModuleOrNamespaceType do - let tcref = modref.NestedTyconRef tycon - if not (IsTyconUnseenObsoleteSpec ad g ncenv.amap m tcref true) then + let tcref = modref.NestedTyconRef tycon + if not (IsTyconUnseenObsoleteSpec ad g ncenv.amap m tcref true) then yield! tcref |> generalizedTyconRef |> ResolvePartialLongIdentInTypeForItem ncenv nenv m ad true rest item } let rec PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f plid (modref: ModuleOrNamespaceRef) = let mty = modref.ModuleOrNamespaceType - match plid with + match plid with | [] -> f modref - | id :: rest -> + | id :: rest -> match mty.ModulesAndNamespacesByDemangledName.TryGetValue id with - | true, mty -> - PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f rest (modref.NestedTyconRef mty) + | true, mty -> + PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f rest (modref.NestedTyconRef mty) | _ -> Seq.empty let PartialResolveLongIndentAsModuleOrNamespaceThenLazy (nenv:NameResolutionEnv) plid f = seq { - match plid with - | id :: rest -> + match plid with + | id :: rest -> match nenv.eModulesAndNamespaces.TryGetValue id with - | true, modrefs -> + | true, modrefs -> for modref in modrefs do yield! PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f rest modref | _ -> () @@ -4547,15 +4546,15 @@ let PartialResolveLongIndentAsModuleOrNamespaceThenLazy (nenv:NameResolutionEnv) let rec GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolutionEnv) m ad plid (item: Item) : seq = seq { let g = ncenv.g - + match plid with | "global" :: plid -> // this is deliberately not the mangled name - + yield! GetCompletionForItem ncenv nenv m ad plid item - - | [] -> - /// Include all the entries in the eUnqualifiedItems table. + | [] -> + + /// Include all the entries in the eUnqualifiedItems table. for uitem in nenv.eUnqualifiedItems.Values do match uitem with | Item.UnqualifiedType _ -> () @@ -4568,20 +4567,20 @@ let rec GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolutionEnv) m a let moduleOrNamespaceRefs = nenv.ModulesAndNamespaces OpenQualified |> NameMultiMap.range - + if not (isNil moduleOrNamespaceRefs) then let ilTyconNames = getFakeContainerModulesFromTyconRefs (nenv.TyconsByAccessNames(OpenQualified).Values) - + for ns in moduleOrNamespaceRefs do let demangledName = ns.DemangledModuleOrNamespaceName if IsInterestingModuleName demangledName && notFakeContainerModule ilTyconNames demangledName && EntityRefContainsSomethingAccessible ncenv m ad ns && not (IsTyconUnseen ad g ncenv.amap m ns) then yield ItemForModuleOrNamespaceRef ns - + | Item.Types _ -> for tcref in nenv.TyconsByDemangledNameAndArity(OpenQualified).Values do - if not tcref.IsExceptionDecl + if not tcref.IsExceptionDecl && not (tcref.LogicalName.Contains ",") && not (IsTyconUnseen ad g ncenv.amap m tcref) then yield ItemOfTyconRef ncenv m tcref @@ -4595,40 +4594,40 @@ let rec GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolutionEnv) m a | Item.DelegateCtor _ | Item.FakeInterfaceCtor _ - | Item.CtorGroup _ + | Item.CtorGroup _ | Item.UnqualifiedType _ -> for tcref in nenv.TyconsByDemangledNameAndArity(OpenQualified).Values do if not (IsTyconUnseen ad g ncenv.amap m tcref) then yield! InfosForTyconConstructors ncenv m ad tcref - + | _ -> () - | id :: rest -> - - // Look in the namespaces 'id' + | id :: rest -> + + // Look in the namespaces 'id' yield! - PartialResolveLongIndentAsModuleOrNamespaceThenLazy nenv [id] (fun modref -> - if EntityRefContainsSomethingAccessible ncenv m ad modref then + PartialResolveLongIndentAsModuleOrNamespaceThenLazy nenv [id] (fun modref -> + if EntityRefContainsSomethingAccessible ncenv m ad modref then ResolvePartialLongIdentInModuleOrNamespaceForItem ncenv nenv m ad modref rest item else Seq.empty) - - // Look for values called 'id' that accept the dot-notation + + // Look for values called 'id' that accept the dot-notation match nenv.eUnqualifiedItems.TryGetValue id with | true, Item.Value x -> let ty = x.Type let ty = if x.BaseOrThisInfo = CtorThisVal && isRefCellTy g ty then destRefCellTy g ty else ty yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item ty | _ -> - // type.lookup : lookup a static something in a type + // type.lookup : lookup a static something in a type for tcref in LookupTypeNameInEnvNoArity OpenQualified id nenv do let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m let ty = FreshenTycon ncenv m tcref yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad true rest item ty } -let IsItemResolvable (ncenv: NameResolver) (nenv: NameResolutionEnv) m ad plid (item: Item) : bool = - protectAssemblyExploration false (fun () -> - GetCompletionForItem ncenv nenv m ad plid item +let IsItemResolvable (ncenv: NameResolver) (nenv: NameResolutionEnv) m ad plid (item: Item) : bool = + protectAssemblyExploration false (fun () -> + GetCompletionForItem ncenv nenv m ad plid item |> Seq.exists (ItemsAreEffectivelyEqual ncenv.g item) ) @@ -4637,13 +4636,13 @@ let GetVisibleNamespacesAndModulesAtPoint (ncenv: NameResolver) (nenv: NameResol let items = nenv.ModulesAndNamespaces FullyQualifiedFlag.OpenQualified |> NameMultiMap.range - + if isNil items then [] else let ilTyconNames = getFakeContainerModulesFromTyconRefs (nenv.TyconsByAccessNames(FullyQualifiedFlag.OpenQualified).Values) items - |> List.filter (fun x -> + |> List.filter (fun x -> let demangledName = x.DemangledModuleOrNamespaceName IsInterestingModuleName demangledName && notFakeContainerModule ilTyconNames demangledName && EntityRefContainsSomethingAccessible ncenv m ad x diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index d201758b73bf994d1dab10e5481852f43c9449fe..5cd213918c4c5ed65ec68b96c67d57474a371d5b 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -37,17 +37,17 @@ module internal PrintUtilities = let comment str = wordL (tagText (sprintf "(* %s *)" str)) - let layoutsL (ls : layout list) : layout = + let layoutsL (ls: layout list) : layout = match ls with - | [] -> emptyL - | [x] -> x + | [] -> emptyL + | [x] -> x | x :: xs -> List.fold (^^) x xs let suppressInheritanceAndInterfacesForTyInSimplifiedDisplays g amap m ty = isEnumTy g ty || isDelegateTy g ty || ExistsHeadTypeInEntireHierarchy g amap m ty g.exn_tcr || ExistsHeadTypeInEntireHierarchy g amap m ty g.tcref_System_Attribute - let applyMaxMembers maxMembers (alldecls : _ list) = + let applyMaxMembers maxMembers (alldecls: _ list) = match maxMembers with | Some n when alldecls.Length > n -> (alldecls |> List.truncate n) @ [wordL (tagPunctuation "...")] | _ -> alldecls @@ -88,9 +88,10 @@ module internal PrintUtilities = if denv.includeStaticParametersInTypeNames then path else - path |> List.map (fun s -> let i = s.IndexOf(',') - if i <> -1 then s.Substring(0,i)+"<...>" // apparently has static params, shorten - else s) + path |> List.map (fun s -> + let i = s.IndexOf(',') + if i <> -1 then s.Substring(0,i)+"<...>" // apparently has static params, shorten + else s) let pathText = trimPathByDisplayEnv denv path if pathText = "" then tyconTextL else leftL (tagUnknownEntity pathText) ^^ tyconTextL @@ -100,33 +101,31 @@ module internal PrintUtilities = module private PrintIL = - open FSharp.Compiler.AbstractIL.IL - let fullySplitILTypeRef (tref:ILTypeRef) = (List.collect IL.splitNamespace (tref.Enclosing @ [PrettyNaming.DemangleGenericTypeName tref.Name])) let layoutILTypeRefName denv path = let path = match path with - | [ "System"; "Void" ] -> ["unit"] + | [ "System"; "Void" ] -> ["unit"] | [ "System"; "Object" ] -> ["obj"] | [ "System"; "String" ] -> ["string"] | [ "System"; "Single" ] -> ["float32"] | [ "System"; "Double" ] -> ["float"] | [ "System"; "Decimal"] -> ["decimal"] - | [ "System"; "Char" ] -> ["char"] - | [ "System"; "Byte" ] -> ["byte"] - | [ "System"; "SByte" ] -> ["sbyte"] - | [ "System"; "Int16" ] -> ["int16"] - | [ "System"; "Int32" ] -> ["int" ] - | [ "System"; "Int64" ] -> ["int64" ] + | [ "System"; "Char" ] -> ["char"] + | [ "System"; "Byte" ] -> ["byte"] + | [ "System"; "SByte" ] -> ["sbyte"] + | [ "System"; "Int16" ] -> ["int16"] + | [ "System"; "Int32" ] -> ["int" ] + | [ "System"; "Int64" ] -> ["int64" ] | [ "System"; "UInt16" ] -> ["uint16" ] | [ "System"; "UInt32" ] -> ["uint32" ] | [ "System"; "UInt64" ] -> ["uint64" ] | [ "System"; "IntPtr" ] -> ["nativeint" ] | [ "System"; "UIntPtr" ] -> ["unativeint" ] | [ "System"; "Boolean"] -> ["bool"] - | _ -> path + | _ -> path let p2,n = List.frontAndBack path let tagged = if n = "obj" || n = "string" then tagClass n else tagStruct n if denv.shortTypeNames then @@ -140,106 +139,106 @@ module private PrintIL = /// this fixes up a name just like adjustILName but also handles F# /// operators - let private adjustILMethodName n = + let adjustILMethodName n = let demangleOperatorNameIfNeeded s = if IsMangledOpName s then DemangleOperatorName s else s n |> Lexhelp.Keywords.QuoteIdentifierIfNeeded |> demangleOperatorNameIfNeeded - let private isStaticILEvent (e: ILEventDef) = + let isStaticILEvent (e: ILEventDef) = e.AddMethod.CallingSignature.CallingConv.IsStatic || e.RemoveMethod.CallingSignature.CallingConv.IsStatic - let private layoutILArrayShape (ILArrayShape sh) = + let layoutILArrayShape (ILArrayShape sh) = SepL.leftBracket ^^ wordL (tagPunctuation (sh |> List.tail |> List.map (fun _ -> ",") |> String.concat "")) ^^ RightL.rightBracket // drop off one "," so that a n-dimensional array has n - 1 ","'s - let private layoutILGenericParameterDefs (ps: ILGenericParameterDefs) = + let layoutILGenericParameterDefs (ps: ILGenericParameterDefs) = ps |> List.map (fun x -> "'" + x.Name |> (tagTypeParameter >> wordL)) - let private paramsL (ps: layout list) : layout = + let paramsL (ps: layout list) : layout = match ps with | [] -> emptyL - | _ -> + | _ -> let body = Layout.commaListL ps SepL.leftAngle ^^ body ^^ RightL.rightAngle - let private pruneParms (className: string) (ilTyparSubst: layout list) = - let numParms = + let pruneParams (className: string) (ilTyparSubst: layout list) = + let numParams = // can't find a way to see the number of generic parameters for *this* class (the GenericParams also include type variables for enclosing classes); this will have to do let rightMost = className |> SplitNamesForILPath |> List.last match System.Int32.TryParse(rightMost, System.Globalization.NumberStyles.Integer, System.Globalization.CultureInfo.InvariantCulture) with | true, n -> n | false, _ -> 0 // looks like it's non-generic - ilTyparSubst |> List.rev |> List.truncate numParms |> List.rev - + ilTyparSubst |> List.rev |> List.truncate numParams |> List.rev + let rec layoutILType (denv: DisplayEnv) (ilTyparSubst: layout list) (ty: ILType) : layout = match ty with - | ILType.Void -> WordL.structUnit // These are type-theoretically totally different type-theoretically `void` is Fin 0 and `unit` is Fin (S 0) ... but, this looks like as close as we can get. - | ILType.Array (sh, t) -> layoutILType denv ilTyparSubst t ^^ layoutILArrayShape sh + | ILType.Void -> WordL.structUnit // These are type-theoretically totally different type-theoretically `void` is Fin 0 and `unit` is Fin (S 0) ... but, this looks like as close as we can get. + | ILType.Array (sh, t) -> layoutILType denv ilTyparSubst t ^^ layoutILArrayShape sh | ILType.Value t - | ILType.Boxed t -> layoutILTypeRef denv t.TypeRef ^^ (t.GenericArgs |> List.map (layoutILType denv ilTyparSubst) |> paramsL) + | ILType.Boxed t -> layoutILTypeRef denv t.TypeRef ^^ (t.GenericArgs |> List.map (layoutILType denv ilTyparSubst) |> paramsL) | ILType.Ptr t - | ILType.Byref t -> layoutILType denv ilTyparSubst t - | ILType.FunctionPointer t -> layoutILCallingSignature denv ilTyparSubst None t - | ILType.TypeVar n -> List.item (int n) ilTyparSubst + | ILType.Byref t -> layoutILType denv ilTyparSubst t + | ILType.FunctionPointer t -> layoutILCallingSignature denv ilTyparSubst None t + | ILType.TypeVar n -> List.item (int n) ilTyparSubst | ILType.Modified (_, _, t) -> layoutILType denv ilTyparSubst t // Just recurse through them to the contained ILType /// Layout a function pointer signature using type-only-F#-style. No argument names are printed. - and private layoutILCallingSignature denv ilTyparSubst cons (signatur : ILCallingSignature) = + and private layoutILCallingSignature denv ilTyparSubst cons (signatur: ILCallingSignature) = // We need a special case for // constructors (Their return types are reported as `void`, but this is // incorrect; so if we're dealing with a constructor we require that the // return type be passed along as the `cons` parameter.) let args = signatur.ArgTypes |> List.map (layoutILType denv ilTyparSubst) - let res = + let res = match cons with | Some className -> let names = SplitNamesForILPath (PrettyNaming.DemangleGenericTypeName className) // special case for constructor return-type (viz., the class itself) - layoutILTypeRefName denv names ^^ (pruneParms className ilTyparSubst |> paramsL) + layoutILTypeRefName denv names ^^ (pruneParams className ilTyparSubst |> paramsL) | None -> signatur.ReturnType |> layoutILType denv ilTyparSubst match args with - | [] -> WordL.structUnit ^^ WordL.arrow ^^ res - | [x] -> x ^^ WordL.arrow ^^ res - | _ -> sepListL WordL.star args ^^ WordL.arrow ^^ res + | [] -> WordL.structUnit ^^ WordL.arrow ^^ res + | [x] -> x ^^ WordL.arrow ^^ res + | _ -> sepListL WordL.star args ^^ WordL.arrow ^^ res /// Layout a function pointer signature using type-only-F#-style. No argument names are printed. // // Note, this duplicates functionality in formatParamDataToBuffer - and private layoutILParameter denv ilTyparSubst (p: ILParameter) = + and layoutILParameter denv ilTyparSubst (p: ILParameter) = let preL = let isParamArray = TryFindILAttribute denv.g.attrib_ParamArrayAttribute p.CustomAttrs match isParamArray, p.Name, p.IsOptional with // Layout an optional argument - | _, Some nm, true -> LeftL.questionMark ^^ sepL (tagParameter nm) ^^ SepL.colon + | _, Some nm, true -> LeftL.questionMark ^^ sepL (tagParameter nm) ^^ SepL.colon // Layout an unnamed argument | _, None, _ -> LeftL.colon // Layout a named argument - | true, Some nm,_ -> + | true, Some nm,_ -> layoutBuiltinAttribute denv denv.g.attrib_ParamArrayAttribute ^^ wordL (tagParameter nm) ^^ SepL.colon | false, Some nm,_ -> leftL (tagParameter nm) ^^ SepL.colon preL ^^ (layoutILType denv ilTyparSubst p.Type) - + /// Layout a function pointer signature using type-only-F#-style. No argument names are printed. - and private layoutILParameters denv ilTyparSubst cons (parameters: ILParameters, retType: ILType) = + and layoutILParameters denv ilTyparSubst cons (parameters: ILParameters, retType: ILType) = // We need a special case for constructors (Their return types are reported as `void`, but this is // incorrect; so if we're dealing with a constructor we require that the // return type be passed along as the `cons` parameter.) - let res = + let res = match cons with | Some className -> let names = SplitNamesForILPath (PrettyNaming.DemangleGenericTypeName className) - layoutILTypeRefName denv names ^^ (pruneParms className ilTyparSubst |> paramsL) + layoutILTypeRefName denv names ^^ (pruneParams className ilTyparSubst |> paramsL) | None -> retType |> layoutILType denv ilTyparSubst match parameters with - | [] -> WordL.structUnit ^^ WordL.arrow ^^ res - | [x] -> layoutILParameter denv ilTyparSubst x ^^ WordL.arrow ^^ res - | args -> sepListL WordL.star (List.map (layoutILParameter denv ilTyparSubst) args) ^^ WordL.arrow ^^ res + | [] -> WordL.structUnit ^^ WordL.arrow ^^ res + | [x] -> layoutILParameter denv ilTyparSubst x ^^ WordL.arrow ^^ res + | args -> sepListL WordL.star (List.map (layoutILParameter denv ilTyparSubst) args) ^^ WordL.arrow ^^ res /// Layout a method's signature using type-only-F#-style. No argument names are printed. @@ -249,29 +248,29 @@ module private PrintIL = /// most-deeply-nested element. // // For C# and provided members: - // new : argType1 * ... * argTypeN -> retType - // Method : argType1 * ... * argTypeN -> retType + // new: argType1 * ... * argTypeN -> retType + // Method: argType1 * ... * argTypeN -> retType // - let private layoutILMethodDef denv ilTyparSubst className (m: ILMethodDef) = - let myParms = m.GenericParams |> layoutILGenericParameterDefs - let ilTyparSubst = ilTyparSubst @ myParms - let name = adjustILMethodName m.Name + let layoutILMethodDef denv ilTyparSubst className (m: ILMethodDef) = + let myParms = m.GenericParams |> layoutILGenericParameterDefs + let ilTyparSubst = ilTyparSubst @ myParms + let name = adjustILMethodName m.Name let (nameL, isCons) = match () with | _ when m.IsConstructor -> (WordL.keywordNew, Some className) // we need the unadjusted name here to be able to grab the number of generic parameters - | _ when m.IsStatic -> (WordL.keywordStatic ^^ WordL.keywordMember ^^ wordL (tagMethod name) ^^ (myParms |> paramsL), None) - | _ -> (WordL.keywordMember ^^ wordL (tagMethod name) ^^ (myParms |> paramsL), None) - let signaturL = (m.Parameters, m.Return.Type) |> layoutILParameters denv ilTyparSubst isCons - nameL ^^ WordL.colon ^^ signaturL - - let private layoutILFieldDef (denv: DisplayEnv) (ilTyparSubst: layout list) (f: ILFieldDef) = - let staticL = if f.IsStatic then WordL.keywordStatic else emptyL - let name = adjustILName f.Name - let nameL = wordL (tagField name) - let typL = layoutILType denv ilTyparSubst f.FieldType - staticL ^^ WordL.keywordVal ^^ nameL ^^ WordL.colon ^^ typL + | _ when m.IsStatic -> (WordL.keywordStatic ^^ WordL.keywordMember ^^ wordL (tagMethod name) ^^ (myParms |> paramsL), None) + | _ -> (WordL.keywordMember ^^ wordL (tagMethod name) ^^ (myParms |> paramsL), None) + let signatureL = (m.Parameters, m.Return.Type) |> layoutILParameters denv ilTyparSubst isCons + nameL ^^ WordL.colon ^^ signatureL + + let layoutILFieldDef (denv: DisplayEnv) (ilTyparSubst: layout list) (f: ILFieldDef) = + let staticL = if f.IsStatic then WordL.keywordStatic else emptyL + let name = adjustILName f.Name + let nameL = wordL (tagField name) + let typL = layoutILType denv ilTyparSubst f.FieldType + staticL ^^ WordL.keywordVal ^^ nameL ^^ WordL.colon ^^ typL - let private layoutILEventDef denv ilTyparSubst (e: ILEventDef) = + let layoutILEventDef denv ilTyparSubst (e: ILEventDef) = let staticL = if isStaticILEvent e then WordL.keywordStatic else emptyL let name = adjustILName e.Name let nameL = wordL (tagEvent name) @@ -279,12 +278,12 @@ module private PrintIL = match e.EventType with | Some t -> layoutILType denv ilTyparSubst t | _ -> emptyL - staticL ^^ WordL.keywordEvent ^^ nameL ^^ WordL.colon ^^ typL - - let private layoutILPropertyDef denv ilTyparSubst (p : ILPropertyDef) = - let staticL = if p.CallingConv = ILThisConvention.Static then WordL.keywordStatic else emptyL - let name = adjustILName p.Name - let nameL = wordL (tagProperty name) + staticL ^^ WordL.keywordEvent ^^ nameL ^^ WordL.colon ^^ typL + + let layoutILPropertyDef denv ilTyparSubst (p: ILPropertyDef) = + let staticL = if p.CallingConv = ILThisConvention.Static then WordL.keywordStatic else emptyL + let name = adjustILName p.Name + let nameL = wordL (tagProperty name) let layoutGetterType (getterRef:ILMethodRef) = if isNil getterRef.ArgTypes then @@ -320,63 +319,62 @@ module private PrintIL = match x with | Some init -> match init with - | ILFieldInit.Bool x -> + | ILFieldInit.Bool x -> if x then Some Literals.keywordTrue else Some Literals.keywordFalse - | ILFieldInit.Char c -> ("'" + (char c).ToString () + "'") |> (tagStringLiteral >> Some) - | ILFieldInit.Int8 x -> ((x |> int32 |> string) + "y") |> (tagNumericLiteral >> Some) - | ILFieldInit.Int16 x -> ((x |> int32 |> string) + "s") |> (tagNumericLiteral >> Some) - | ILFieldInit.Int32 x -> x |> (string >> tagNumericLiteral >> Some) - | ILFieldInit.Int64 x -> ((x |> string) + "L") |> (tagNumericLiteral >> Some) - | ILFieldInit.UInt8 x -> ((x |> int32 |> string) + "uy") |> (tagNumericLiteral >> Some) - | ILFieldInit.UInt16 x -> ((x |> int32 |> string) + "us") |> (tagNumericLiteral >> Some) + | ILFieldInit.Char c -> ("'" + (char c).ToString () + "'") |> (tagStringLiteral >> Some) + | ILFieldInit.Int8 x -> ((x |> int32 |> string) + "y") |> (tagNumericLiteral >> Some) + | ILFieldInit.Int16 x -> ((x |> int32 |> string) + "s") |> (tagNumericLiteral >> Some) + | ILFieldInit.Int32 x -> x |> (string >> tagNumericLiteral >> Some) + | ILFieldInit.Int64 x -> ((x |> string) + "L") |> (tagNumericLiteral >> Some) + | ILFieldInit.UInt8 x -> ((x |> int32 |> string) + "uy") |> (tagNumericLiteral >> Some) + | ILFieldInit.UInt16 x -> ((x |> int32 |> string) + "us") |> (tagNumericLiteral >> Some) | ILFieldInit.UInt32 x -> (x |> int64 |> string) + "u" |> (tagNumericLiteral >> Some) - | ILFieldInit.UInt64 x -> ((x |> int64 |> string) + "UL") |> (tagNumericLiteral >> Some) + | ILFieldInit.UInt64 x -> ((x |> int64 |> string) + "UL") |> (tagNumericLiteral >> Some) | ILFieldInit.Single d -> let s = d.ToString ("g12", System.Globalization.CultureInfo.InvariantCulture) let s = - if String.forall (fun c -> System.Char.IsDigit c || c = '-') s + if String.forall (fun c -> System.Char.IsDigit c || c = '-') s then s + ".0" else s (s + "f") |> (tagNumericLiteral >> Some) | ILFieldInit.Double d -> let s = d.ToString ("g12", System.Globalization.CultureInfo.InvariantCulture) let s = - if String.forall (fun c -> System.Char.IsDigit c || c = '-') s + if String.forall (fun c -> System.Char.IsDigit c || c = '-') s then (s + ".0") else s s |> (tagNumericLiteral >> Some) - | _ -> None - | None -> None + | _ -> None + | None -> None match textOpt with - | None -> WordL.equals ^^ (comment "value unavailable") + | None -> WordL.equals ^^ (comment "value unavailable") | Some s -> WordL.equals ^^ wordL s let layoutILEnumDefParts nm litVal = WordL.bar ^^ wordL (tagEnum (adjustILName nm)) ^^ layoutILFieldInit litVal - let private layoutILEnumDef (f : ILFieldDef) = layoutILEnumDefParts f.Name f.LiteralValue + let layoutILEnumDef (f: ILFieldDef) = layoutILEnumDefParts f.Name f.LiteralValue // filtering methods for hiding things we oughtn't show - let private isStaticILProperty (p : ILPropertyDef) = + let isStaticILProperty (p: ILPropertyDef) = match p.GetMethod,p.SetMethod with - | Some getter, _ -> getter.CallingSignature.CallingConv.IsStatic + | Some getter, _ -> getter.CallingSignature.CallingConv.IsStatic | None, Some setter -> setter.CallingSignature.CallingConv.IsStatic - | None, None -> true + | None, None -> true - - let private isPublicILMethod (m : ILMethodDef) = + let isPublicILMethod (m: ILMethodDef) = (m.Access = ILMemberAccess.Public) - let private isPublicILEvent typeDef (e: ILEventDef) = + let isPublicILEvent typeDef (e: ILEventDef) = try isPublicILMethod(resolveILMethodRef typeDef e.AddMethod) && isPublicILMethod(resolveILMethodRef typeDef e.RemoveMethod) with _ -> false - let private isPublicILProperty typeDef (m : ILPropertyDef) = + let isPublicILProperty typeDef (m: ILPropertyDef) = try match m.GetMethod with | Some ilMethRef -> isPublicILMethod (resolveILMethodRef typeDef ilMethRef) @@ -392,36 +390,36 @@ module private PrintIL = with _ -> false - let private isPublicILCtor (m : ILMethodDef) = + let isPublicILCtor (m: ILMethodDef) = (m.Access = ILMemberAccess.Public && m.IsConstructor) - let private isNotSpecialName (m : ILMethodDef) = + let isNotSpecialName (m: ILMethodDef) = not m.IsSpecialName - let private isPublicILField (f : ILFieldDef) = + let isPublicILField (f: ILFieldDef) = (f.Access = ILMemberAccess.Public) - let private isPublicILTypeDef (c : ILTypeDef) : bool = + let isPublicILTypeDef (c: ILTypeDef) : bool = match c.Access with | ILTypeDefAccess.Public | ILTypeDefAccess.Nested ILMemberAccess.Public -> true - | _ -> false + | _ -> false - let private isShowEnumField (f : ILFieldDef) : bool = f.Name <> "value__" // this appears to be the hard-coded underlying storage field - let private noShow = set [ "System.Object" ; "Object"; "System.ValueType" ; "ValueType"; "obj" ] // hide certain 'obvious' base classes - let private isShowBase (n : layout) : bool = + let isShowEnumField (f: ILFieldDef) : bool = f.Name <> "value__" // this appears to be the hard-coded underlying storage field + let noShow = set [ "System.Object" ; "Object"; "System.ValueType" ; "ValueType"; "obj" ] // hide certain 'obvious' base classes + let isShowBase (n: layout) : bool = not (noShow.Contains(showL n)) - let rec layoutILTypeDef (denv: DisplayEnv) (typeDef : ILTypeDef) : layout = - let ilTyparSubst = typeDef.GenericParams |> layoutILGenericParameterDefs + let rec layoutILTypeDef (denv: DisplayEnv) (typeDef: ILTypeDef) : layout = + let ilTyparSubst = typeDef.GenericParams |> layoutILGenericParameterDefs let renderL pre body post = match pre with | Some pre -> match body with | [] -> emptyL // empty type - | _ -> (pre @@-- aboveListL body) @@ post - | None -> + | _ -> (pre @@-- aboveListL body) @@ post + | None -> aboveListL body if typeDef.IsClass || typeDef.IsStruct || typeDef.IsInterface then @@ -429,26 +427,22 @@ module private PrintIL = if typeDef.IsStruct then Some WordL.keywordStruct else None - let baseT = - match typeDef.Extends with - | Some b -> + let baseTypeL = + [ match typeDef.Extends with + | Some b -> let baseName = layoutILType denv ilTyparSubst b - if isShowBase baseName - then [ WordL.keywordInherit ^^ baseName ] - else [] - | None -> + if isShowBase baseName then + yield WordL.keywordInherit ^^ baseName + | None -> // for interface show inherited interfaces if typeDef.IsInterface then - typeDef.Implements |> List.choose (fun b -> + for b in typeDef.Implements do let baseName = layoutILType denv ilTyparSubst b - if isShowBase baseName - then Some (WordL.keywordInherit ^^ baseName) - else None - ) - else [] + if isShowBase baseName then + yield WordL.keywordInherit ^^ baseName ] let memberBlockLs (fieldDefs:ILFieldDefs, methodDefs:ILMethodDefs, propertyDefs:ILPropertyDefs, eventDefs:ILEventDefs) = - let ctors = + let ctors = methodDefs.AsList |> List.filter isPublicILCtor |> List.sortBy (fun md -> md.Parameters.Length) @@ -456,7 +450,7 @@ module private PrintIL = let fields = fieldDefs.AsList - |> List.filter isPublicILField + |> List.filter isPublicILField |> List.map (layoutILFieldDef denv ilTyparSubst) let props = @@ -483,34 +477,35 @@ module private PrintIL = |> List.sortBy fst |> List.map snd // (properties and members) are sorted by name/arity - ctors @ fields @ members @ events - let bodyStatic = - memberBlockLs (typeDef.Fields.AsList |> List.filter (fun fd -> fd.IsStatic) |> mkILFields, - typeDef.Methods.AsList |> List.filter (fun md -> md.IsStatic) |> mkILMethods, - typeDef.Properties.AsList |> List.filter (fun pd -> isStaticILProperty pd) |> mkILProperties, - typeDef.Events.AsList |> List.filter (fun ed -> isStaticILEvent ed) |> mkILEvents) + let bodyStatic = + memberBlockLs + (typeDef.Fields.AsList |> List.filter (fun fd -> fd.IsStatic) |> mkILFields, + typeDef.Methods.AsList |> List.filter (fun md -> md.IsStatic) |> mkILMethods, + typeDef.Properties.AsList |> List.filter isStaticILProperty |> mkILProperties, + typeDef.Events.AsList |> List.filter isStaticILEvent |> mkILEvents) let bodyInstance = - memberBlockLs (typeDef.Fields.AsList |> List.filter (fun fd -> not(fd.IsStatic)) |> mkILFields, - typeDef.Methods.AsList |> List.filter (fun md -> not(md.IsStatic)) |> mkILMethods, - typeDef.Properties.AsList |> List.filter (fun pd -> not(isStaticILProperty pd)) |> mkILProperties, - typeDef.Events.AsList |> List.filter (fun ed -> not(isStaticILEvent ed)) |> mkILEvents ) + memberBlockLs + (typeDef.Fields.AsList |> List.filter (fun fd -> not (fd.IsStatic)) |> mkILFields, + typeDef.Methods.AsList |> List.filter (fun md -> not (md.IsStatic)) |> mkILMethods, + typeDef.Properties.AsList |> List.filter (fun pd -> not (isStaticILProperty pd)) |> mkILProperties, + typeDef.Events.AsList |> List.filter (fun ed -> not (isStaticILEvent ed)) |> mkILEvents ) let body = bodyInstance @ bodyStatic // instance "member" before "static member" // Only show at most maxMembers members... let body = applyMaxMembers denv.maxMembers body - let types = + let types = typeDef.NestedTypes.AsList |> List.filter isPublicILTypeDef - |> List.sortBy(fun t -> adjustILName t.Name) + |> List.sortBy(fun t -> adjustILName t.Name) |> List.map (layoutILNestedClassDef denv) - let post = WordL.keywordEnd - renderL pre (baseT @ body @ types ) post + let post = WordL.keywordEnd + renderL pre (baseTypeL @ body @ types ) post elif typeDef.IsEnum then let fldsL = @@ -525,57 +520,57 @@ module private PrintIL = let rhs = match typeDef.Methods.AsList |> List.filter (fun m -> m.Name = "Invoke") with // the delegate delegates to the type of `Invoke` | m :: _ -> layoutILCallingSignature denv ilTyparSubst None m.CallingSignature - | _ -> comment "`Invoke` method could not be found" + | _ -> comment "`Invoke` method could not be found" WordL.keywordDelegate ^^ WordL.keywordOf ^^ rhs - and layoutILNestedClassDef (denv: DisplayEnv) (typeDef : ILTypeDef) = - let name = adjustILName typeDef.Name - let nameL = wordL (tagClass name) - let ilTyparSubst = typeDef.GenericParams |> layoutILGenericParameterDefs - let paramsL = pruneParms typeDef.Name ilTyparSubst |> paramsL + and layoutILNestedClassDef (denv: DisplayEnv) (typeDef: ILTypeDef) = + let name = adjustILName typeDef.Name + let nameL = wordL (tagClass name) + let ilTyparSubst = typeDef.GenericParams |> layoutILGenericParameterDefs + let paramsL = pruneParams typeDef.Name ilTyparSubst |> paramsL if denv.suppressNestedTypes then WordL.keywordNested ^^ WordL.keywordType ^^ nameL ^^ paramsL else - let pre = WordL.keywordNested ^^ WordL.keywordType ^^ nameL ^^ paramsL - let body = layoutILTypeDef denv typeDef + let pre = WordL.keywordNested ^^ WordL.keywordType ^^ nameL ^^ paramsL + let body = layoutILTypeDef denv typeDef (pre ^^ WordL.equals) @@-- body - + module private PrintTypes = // Note: We need nice printing of constants in order to print literals and attributes let layoutConst g ty c = let str = match c with - | Const.Bool x -> if x then Literals.keywordTrue else Literals.keywordFalse - | Const.SByte x -> (x |> string)+"y" |> tagNumericLiteral - | Const.Byte x -> (x |> string)+"uy" |> tagNumericLiteral - | Const.Int16 x -> (x |> string)+"s" |> tagNumericLiteral - | Const.UInt16 x -> (x |> string)+"us" |> tagNumericLiteral - | Const.Int32 x -> (x |> string) |> tagNumericLiteral - | Const.UInt32 x -> (x |> string)+"u" |> tagNumericLiteral - | Const.Int64 x -> (x |> string)+"L" |> tagNumericLiteral - | Const.UInt64 x -> (x |> string)+"UL" |> tagNumericLiteral - | Const.IntPtr x -> (x |> string)+"n" |> tagNumericLiteral - | Const.UIntPtr x -> (x |> string)+"un" |> tagNumericLiteral - | Const.Single d -> + | Const.Bool x -> if x then Literals.keywordTrue else Literals.keywordFalse + | Const.SByte x -> (x |> string)+"y" |> tagNumericLiteral + | Const.Byte x -> (x |> string)+"uy" |> tagNumericLiteral + | Const.Int16 x -> (x |> string)+"s" |> tagNumericLiteral + | Const.UInt16 x -> (x |> string)+"us" |> tagNumericLiteral + | Const.Int32 x -> (x |> string) |> tagNumericLiteral + | Const.UInt32 x -> (x |> string)+"u" |> tagNumericLiteral + | Const.Int64 x -> (x |> string)+"L" |> tagNumericLiteral + | Const.UInt64 x -> (x |> string)+"UL" |> tagNumericLiteral + | Const.IntPtr x -> (x |> string)+"n" |> tagNumericLiteral + | Const.UIntPtr x -> (x |> string)+"un" |> tagNumericLiteral + | Const.Single d -> ((let s = d.ToString("g12",System.Globalization.CultureInfo.InvariantCulture) - if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s + if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s then s + ".0" else s) + "f") |> tagNumericLiteral - | Const.Double d -> + | Const.Double d -> let s = d.ToString("g12",System.Globalization.CultureInfo.InvariantCulture) - (if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s + (if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s then s + ".0" else s) |> tagNumericLiteral - | Const.Char c -> "'" + c.ToString() + "'" |> tagStringLiteral - | Const.String bs -> "\"" + bs + "\"" |> tagNumericLiteral - | Const.Unit -> "()" |> tagPunctuation - | Const.Decimal bs -> string bs + "M" |> tagNumericLiteral + | Const.Char c -> "'" + c.ToString() + "'" |> tagStringLiteral + | Const.String bs -> "\"" + bs + "\"" |> tagNumericLiteral + | Const.Unit -> "()" |> tagPunctuation + | Const.Decimal bs -> string bs + "M" |> tagNumericLiteral // either "null" or "the defaut value for a struct" - | Const.Zero -> tagKeyword(if isRefTy g ty then "null" else "default") + | Const.Zero -> tagKeyword(if isRefTy g ty then "null" else "default") wordL str - let layoutAccessibility (denv:DisplayEnv) accessibility itemL = + let layoutAccessibility (denv:DisplayEnv) accessibility itemL = let isInternalCompPath x = match x with | CompPath(ILScopeRef.Local,[]) -> true @@ -583,12 +578,12 @@ module private PrintTypes = let (|Public|Internal|Private|) (TAccess p) = match p with | [] -> Public - | _ when List.forall isInternalCompPath p -> Internal + | _ when List.forall isInternalCompPath p -> Internal | _ -> Private match denv.contextAccessibility,accessibility with - | Public,Internal -> WordL.keywordInternal ++ itemL // print modifier, since more specific than context - | Public,Private -> WordL.keywordPrivate ++ itemL // print modifier, since more specific than context - | Internal,Private -> WordL.keywordPrivate ++ itemL // print modifier, since more specific than context + | Public,Internal -> WordL.keywordInternal ++ itemL // print modifier, since more specific than context + | Public,Private -> WordL.keywordPrivate ++ itemL // print modifier, since more specific than context + | Internal,Private -> WordL.keywordPrivate ++ itemL // print modifier, since more specific than context | _ -> itemL /// Layout a reference to a type @@ -596,23 +591,24 @@ module private PrintTypes = /// Layout the flags of a member let layoutMemberFlags memFlags = - let stat = if memFlags.IsInstance || (memFlags.MemberKind = MemberKind.Constructor) then emptyL else WordL.keywordStatic - let stat = if memFlags.IsDispatchSlot then stat ++ WordL.keywordAbstract - elif memFlags.IsOverrideOrExplicitImpl then stat ++ WordL.keywordOverride - else stat let stat = - - if memFlags.IsOverrideOrExplicitImpl then stat - else - match memFlags.MemberKind with - | MemberKind.ClassConstructor - | MemberKind.Constructor - | MemberKind.PropertyGetSet -> stat - | MemberKind.Member - | MemberKind.PropertyGet - | MemberKind.PropertySet -> stat ++ WordL.keywordMember - - // let stat = if memFlags.IsFinal then stat ++ wordL "final" else stat in + if memFlags.IsInstance || (memFlags.MemberKind = MemberKind.Constructor) then emptyL + else WordL.keywordStatic + let stat = + if memFlags.IsDispatchSlot then stat ++ WordL.keywordAbstract + elif memFlags.IsOverrideOrExplicitImpl then stat ++ WordL.keywordOverride + else stat + let stat = + if memFlags.IsOverrideOrExplicitImpl then stat else + match memFlags.MemberKind with + | MemberKind.ClassConstructor + | MemberKind.Constructor + | MemberKind.PropertyGetSet -> stat + | MemberKind.Member + | MemberKind.PropertyGet + | MemberKind.PropertySet -> stat ++ WordL.keywordMember + + // let stat = if memFlags.IsFinal then stat ++ wordL "final" else stat in stat /// Layout a single attribute arg, following the cases of 'gen_attr_arg' in ilxgen.fs @@ -679,41 +675,41 @@ module private PrintTypes = and layoutILAttribElement denv arg = match arg with - | ILAttribElem.String (Some x) -> wordL (tagStringLiteral ("\"" + x + "\"")) - | ILAttribElem.String None -> wordL (tagStringLiteral "") - | ILAttribElem.Bool x -> if x then WordL.keywordTrue else WordL.keywordFalse - | ILAttribElem.Char x -> wordL (tagStringLiteral ("'" + x.ToString() + "'" )) - | ILAttribElem.SByte x -> wordL (tagNumericLiteral ((x |> string)+"y")) - | ILAttribElem.Int16 x -> wordL (tagNumericLiteral ((x |> string)+"s")) - | ILAttribElem.Int32 x -> wordL (tagNumericLiteral ((x |> string))) - | ILAttribElem.Int64 x -> wordL (tagNumericLiteral ((x |> string)+"L")) - | ILAttribElem.Byte x -> wordL (tagNumericLiteral ((x |> string)+"uy")) - | ILAttribElem.UInt16 x -> wordL (tagNumericLiteral ((x |> string)+"us")) - | ILAttribElem.UInt32 x -> wordL (tagNumericLiteral ((x |> string)+"u")) - | ILAttribElem.UInt64 x -> wordL (tagNumericLiteral ((x |> string)+"UL")) - | ILAttribElem.Single x -> + | ILAttribElem.String (Some x) -> wordL (tagStringLiteral ("\"" + x + "\"")) + | ILAttribElem.String None -> wordL (tagStringLiteral "") + | ILAttribElem.Bool x -> if x then WordL.keywordTrue else WordL.keywordFalse + | ILAttribElem.Char x -> wordL (tagStringLiteral ("'" + x.ToString() + "'" )) + | ILAttribElem.SByte x -> wordL (tagNumericLiteral ((x |> string)+"y")) + | ILAttribElem.Int16 x -> wordL (tagNumericLiteral ((x |> string)+"s")) + | ILAttribElem.Int32 x -> wordL (tagNumericLiteral ((x |> string))) + | ILAttribElem.Int64 x -> wordL (tagNumericLiteral ((x |> string)+"L")) + | ILAttribElem.Byte x -> wordL (tagNumericLiteral ((x |> string)+"uy")) + | ILAttribElem.UInt16 x -> wordL (tagNumericLiteral ((x |> string)+"us")) + | ILAttribElem.UInt32 x -> wordL (tagNumericLiteral ((x |> string)+"u")) + | ILAttribElem.UInt64 x -> wordL (tagNumericLiteral ((x |> string)+"UL")) + | ILAttribElem.Single x -> let str = let s = x.ToString("g12",System.Globalization.CultureInfo.InvariantCulture) - (if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s + (if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s then s + ".0" else s) + "f" wordL (tagNumericLiteral str) - | ILAttribElem.Double x -> + | ILAttribElem.Double x -> let str = let s = x.ToString("g12",System.Globalization.CultureInfo.InvariantCulture) - if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s + if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s then s + ".0" else s wordL (tagNumericLiteral str) - | ILAttribElem.Null -> wordL (tagKeyword "null") - | ILAttribElem.Array (_, xs) -> - leftL (tagPunctuation "[|") ^^ semiListL (List.map (layoutILAttribElement denv) xs) ^^ RightL.rightBracketBar - | ILAttribElem.Type (Some ty) -> + | ILAttribElem.Null -> wordL (tagKeyword "null") + | ILAttribElem.Array (_, xs) -> + leftL (tagPunctuation "[|") ^^ semiListL (List.map (layoutILAttribElement denv) xs) ^^ RightL.rightBracketBar + | ILAttribElem.Type (Some ty) -> LeftL.keywordTypeof ^^ SepL.leftAngle ^^ PrintIL.layoutILType denv [] ty ^^ RightL.rightAngle - | ILAttribElem.Type None -> wordL (tagText "") + | ILAttribElem.Type None -> wordL (tagText "") | ILAttribElem.TypeRef (Some ty) -> LeftL.keywordTypedefof ^^ SepL.leftAngle ^^ PrintIL.layoutILTypeRef denv ty ^^ RightL.rightAngle - | ILAttribElem.TypeRef None -> emptyL + | ILAttribElem.TypeRef None -> emptyL and layoutILAttrib denv (ty, args) = let argsL = bracketL (sepListL (rightL (tagPunctuation ",")) (List.map (layoutILAttribElement denv) args)) @@ -723,7 +719,7 @@ module private PrintTypes = and layoutAttribs denv ty kind attrs restL = if denv.showAttributes then - // Don't display DllImport attributes in generated signatures + // Don't display DllImport attributes in generated signatures let attrs = attrs |> List.filter (IsMatchingFSharpAttributeOpt denv.g denv.g.attrib_DllImportAttribute >> not) let attrs = attrs |> List.filter (IsMatchingFSharpAttributeOpt denv.g denv.g.attrib_ContextStaticAttribute >> not) let attrs = attrs |> List.filter (IsMatchingFSharpAttributeOpt denv.g denv.g.attrib_ThreadStaticAttribute >> not) @@ -735,35 +731,38 @@ module private PrintTypes = match attrs with | [] -> restL - | _ -> squareAngleL (sepListL (rightL (tagPunctuation ";")) (List.map (layoutAttrib denv) attrs)) @@ - restL + | _ -> + squareAngleL (sepListL (rightL (tagPunctuation ";")) (List.map (layoutAttrib denv) attrs)) @@ + restL elif Tastops.isStructRecordOrUnionTyconTy denv.g ty || - ((Tastops.isUnionTy denv.g ty || Tastops.isRecdTy denv.g ty) && HasFSharpAttribute denv.g denv.g.attrib_StructAttribute attrs) then + ((Tastops.isUnionTy denv.g ty || Tastops.isRecdTy denv.g ty) && HasFSharpAttribute denv.g denv.g.attrib_StructAttribute attrs) then squareAngleL (wordL (tagClass "Struct")) @@ restL else match kind with | TyparKind.Type -> restL | TyparKind.Measure -> squareAngleL (wordL (tagClass "Measure")) @@ restL - and layoutTyparAttribs denv kind attrs restL = + and layoutTyparAttribs denv kind attrs restL = match attrs, kind with | [], TyparKind.Type -> restL - | _, _ -> squareAngleL (sepListL (rightL (tagPunctuation ";")) ((match kind with TyparKind.Type -> [] | TyparKind.Measure -> [wordL (tagText "Measure")]) @ List.map (layoutAttrib denv) attrs)) ^^ restL + | _, _ -> squareAngleL (sepListL (rightL (tagPunctuation ";")) ((match kind with TyparKind.Type -> [] | TyparKind.Measure -> [wordL (tagText "Measure")]) @ List.map (layoutAttrib denv) attrs)) ^^ restL and private layoutTyparRef denv (typar:Typar) = - wordL (tagTypeParameter (sprintf "%s%s%s" - (if denv.showConstraintTyparAnnotations then prefixOfStaticReq typar.StaticReq else "'") - (if denv.showImperativeTyparAnnotations then prefixOfRigidTypar typar else "") - typar.DisplayName)) - - /// Layout a single type parameter declaration, taking TypeSimplificationInfo into account + wordL + (tagTypeParameter + (sprintf "%s%s%s" + (if denv.showConstraintTyparAnnotations then prefixOfStaticReq typar.StaticReq else "'") + (if denv.showImperativeTyparAnnotations then prefixOfRigidTypar typar else "") + typar.DisplayName)) + + /// Layout a single type parameter declaration, taking TypeSimplificationInfo into account /// There are several printing-cases for a typar: /// - /// 'a - is multiple occurrence. + /// 'a - is multiple occurrence. /// _ - singleton occurrence, an underscore preferred over 'b. (OCaml accepts but does not print) /// #Type - inplace coercion constraint and singleton. /// ('a :> Type) - inplace coercion constraint not singleton. - /// ('a.opM : S->T) - inplace operator constraint. + /// ('a.opM: S->T) - inplace operator constraint. /// and private layoutTyparRefWithInfo denv (env:SimplifyTypes.TypeSimplificationInfo) (typar:Typar) = let varL = layoutTyparRef denv typar @@ -782,18 +781,17 @@ module private PrintTypes = /// Layout type parameter constraints, taking TypeSimplificationInfo into account and layoutConstraintsWithInfo denv env cxs = - // Internally member constraints get attached to each type variable in their support. // This means we get too many constraints being printed. // So we normalize the constraints to eliminate duplicate member constraints let cxs = - cxs + cxs |> ListSet.setify (fun (_,cx1) (_,cx2) -> - match cx1,cx2 with - | TyparConstraint.MayResolveMember(traitInfo1,_), - TyparConstraint.MayResolveMember(traitInfo2,_) -> traitsAEquiv denv.g TypeEquivEnv.Empty traitInfo1 traitInfo2 - | _ -> false) - + match cx1,cx2 with + | TyparConstraint.MayResolveMember(traitInfo1,_), + TyparConstraint.MayResolveMember(traitInfo2,_) -> traitsAEquiv denv.g TypeEquivEnv.Empty traitInfo1 traitInfo2 + | _ -> false) + let cxsL = List.collect (layoutConstraintWithInfo denv env) cxs match cxsL with | [] -> emptyL @@ -830,7 +828,7 @@ module private PrintTypes = if denv.shortConstraints then [wordL (tagKeyword "equality")] else - [wordL (tagKeyword "equality") |> longConstraintPrefix] + [wordL (tagKeyword "equality") |> longConstraintPrefix] | TyparConstraint.IsDelegate(aty,bty,_) -> if denv.shortConstraints then [WordL.keywordDelegate] @@ -878,7 +876,7 @@ module private PrintTypes = match tys with | [ty] -> layoutTypeWithInfo denv env ty | tys -> bracketL (layoutTypesWithInfoAndPrec denv env 2 (wordL (tagKeyword "or")) tys) - tysL ^^ wordL (tagPunctuation ":") --- + tysL ^^ wordL (tagPunctuation ":") --- bracketL (stat ++ wordL (tagMember nm) ^^ wordL (tagPunctuation ":") --- ((layoutTypesWithInfoAndPrec denv env 2 (wordL (tagPunctuation "*")) argtys --- wordL (tagPunctuation "->")) --- (layoutTypeWithInfo denv env rty))) @@ -887,14 +885,14 @@ module private PrintTypes = and private layoutMeasure denv unt = let sortVars vs = vs |> List.sortBy (fun (v:Typar,_) -> v.DisplayName) let sortCons cs = cs |> List.sortBy (fun (c:TyconRef,_) -> c.DisplayName) - let negvs,posvs = ListMeasureVarOccsWithNonZeroExponents unt |> sortVars |> List.partition (fun (_,e) -> SignRational e < 0) + let negvs,posvs = ListMeasureVarOccsWithNonZeroExponents unt |> sortVars |> List.partition (fun (_,e) -> SignRational e < 0) let negcs,poscs = ListMeasureConOccsWithNonZeroExponents denv.g false unt |> sortCons |> List.partition (fun (_,e) -> SignRational e < 0) let unparL uv = layoutTyparRef denv uv let unconL tc = layoutTyconRef denv tc let rationalL e = wordL (tagNumericLiteral (RationalToString e)) let measureToPowerL x e = if e = OneRational then x else x -- wordL (tagPunctuation "^") -- rationalL e - let prefix = spaceListL (List.map (fun (v,e) -> measureToPowerL (unparL v) e) posvs @ - List.map (fun (c,e) -> measureToPowerL (unconL c) e) poscs) + let prefix = spaceListL (List.map (fun (v,e) -> measureToPowerL (unparL v) e) posvs @ + List.map (fun (c,e) -> measureToPowerL (unconL c) e) poscs) let postfix = spaceListL (List.map (fun (v,e) -> measureToPowerL (unparL v) (NegRational e)) negvs @ List.map (fun (c,e) -> measureToPowerL (unconL c) (NegRational e)) negcs) match (negvs,negcs) with @@ -903,16 +901,16 @@ module private PrintTypes = /// Layout type arguments, either NAME or (ty,...,ty) NAME *) and private layoutTypeAppWithInfoAndPrec denv env tcL prec prefix args = - if prefix then + if prefix then match args with | [] -> tcL | [arg] -> tcL ^^ sepL (tagPunctuation "<") ^^ (layoutTypeWithInfoAndPrec denv env 4 arg) ^^ rightL (tagPunctuation">") | args -> bracketIfL (prec <= 1) (tcL ^^ angleL (layoutTypesWithInfoAndPrec denv env 2 (sepL (tagPunctuation ",")) args)) else match args with - | [] -> tcL - | [arg] -> layoutTypeWithInfoAndPrec denv env 2 arg ^^ tcL - | args -> bracketIfL (prec <= 1) (bracketL (layoutTypesWithInfoAndPrec denv env 2 (sepL (tagPunctuation ",")) args) --- tcL) + | [] -> tcL + | [arg] -> layoutTypeWithInfoAndPrec denv env 2 arg ^^ tcL + | args -> bracketIfL (prec <= 1) (bracketL (layoutTypesWithInfoAndPrec denv env 2 (sepL (tagPunctuation ",")) args) --- tcL) /// Layout a type, taking precedence into account to insert brackets where needed and layoutTypeWithInfoAndPrec denv env prec ty = @@ -920,15 +918,15 @@ module private PrintTypes = match stripTyparEqns ty with // Always prefer to format 'byref' as 'inref' - | ty when isInByrefTy denv.g ty && (match ty with TType_app (tc, _) when denv.g.inref_tcr.CanDeref && tyconRefEq denv.g tc denv.g.byref2_tcr -> true | _ -> false) -> + | ty when isInByrefTy denv.g ty && (match ty with TType_app (tc, _) when denv.g.inref_tcr.CanDeref && tyconRefEq denv.g tc denv.g.byref2_tcr -> true | _ -> false) -> layoutTypeWithInfoAndPrec denv env prec (mkInByrefTy denv.g (destByrefTy denv.g ty)) // Always prefer to format 'byref' as 'outref' - | ty when isOutByrefTy denv.g ty && (match ty with TType_app (tc, _) when denv.g.outref_tcr.CanDeref && tyconRefEq denv.g tc denv.g.byref2_tcr -> true | _ -> false) -> + | ty when isOutByrefTy denv.g ty && (match ty with TType_app (tc, _) when denv.g.outref_tcr.CanDeref && tyconRefEq denv.g tc denv.g.byref2_tcr -> true | _ -> false) -> layoutTypeWithInfoAndPrec denv env prec (mkOutByrefTy denv.g (destByrefTy denv.g ty)) // Always prefer to format 'byref' as 'byref' - | ty when isByrefTy denv.g ty && (match ty with TType_app (tc, _) when denv.g.byref_tcr.CanDeref && tyconRefEq denv.g tc denv.g.byref2_tcr -> true | _ -> false) -> + | ty when isByrefTy denv.g ty && (match ty with TType_app (tc, _) when denv.g.byref_tcr.CanDeref && tyconRefEq denv.g tc denv.g.byref2_tcr -> true | _ -> false) -> layoutTypeWithInfoAndPrec denv env prec (mkByrefTy denv.g (destByrefTy denv.g ty)) // Always prefer 'float' to 'float<1>' @@ -943,7 +941,7 @@ module private PrintTypes = layoutTypeAppWithInfoAndPrec denv env (layoutTyconRef denv tc) prec tc.IsPrefixDisplay args // Layout a tuple type - | TType_anon (anonInfo,tys) -> + | TType_anon (anonInfo,tys) -> let core = sepListL (wordL (tagPunctuation ";")) (List.map2 (fun nm ty -> wordL (tagField nm) ^^ wordL (tagPunctuation ":") ^^ layoutTypeWithInfoAndPrec denv env prec ty) (Array.toList anonInfo.SortedNames) tys) if evalAnonInfoIsStruct anonInfo then WordL.keywordStruct --- braceBarL core @@ -951,7 +949,7 @@ module private PrintTypes = braceBarL core // Layout a tuple type - | TType_tuple (tupInfo,t) -> + | TType_tuple (tupInfo,t) -> if evalTupInfoIsStruct tupInfo then WordL.keywordStruct --- bracketL (layoutTypesWithInfoAndPrec denv env 2 (wordL (tagPunctuation "*")) t) else @@ -961,7 +959,7 @@ module private PrintTypes = | TType_forall (tps,tau) -> let tauL = layoutTypeWithInfoAndPrec denv env prec tau match tps with - | [] -> tauL + | [] -> tauL | [h] -> layoutTyparRefWithInfo denv env h ^^ rightL (tagPunctuation ".") --- tauL | (h::t) -> spaceListL (List.map (layoutTyparRefWithInfo denv env) (h::t)) ^^ rightL (tagPunctuation ".") --- tauL @@ -987,17 +985,17 @@ module private PrintTypes = and private layoutTypeWithInfo denv env ty = layoutTypeWithInfoAndPrec denv env 5 ty - and layoutType denv ty = + and layoutType denv ty = layoutTypeWithInfo denv SimplifyTypes.typeSimplificationInfo0 ty /// Layout a single type used as the type of a member or value let layoutTopType denv env argInfos rty cxs = // Parenthesize the return type to match the topValInfo - let rtyL = layoutTypeWithInfoAndPrec denv env 4 rty + let rtyL = layoutTypeWithInfoAndPrec denv env 4 rty let cxsL = layoutConstraintsWithInfo denv env cxs match argInfos with | [] -> rtyL --- cxsL - | _ -> + | _ -> // Format each argument, including its name and type let argL (ty,argInfo: ArgReprInfo) = @@ -1008,14 +1006,14 @@ module private PrintTypes = match argInfo.Name, isOptionalArg, isParamArray, tryDestOptionTy denv.g ty with // Layout an optional argument | Some(id), true, _, ValueSome ty -> - leftL (tagPunctuation "?") ^^ sepL (tagParameter id.idText) ^^ SepL.colon ^^ layoutTypeWithInfoAndPrec denv env 2 ty + leftL (tagPunctuation "?") ^^ sepL (tagParameter id.idText) ^^ SepL.colon ^^ layoutTypeWithInfoAndPrec denv env 2 ty // Layout an unnamed argument | None, _,_, _ -> layoutTypeWithInfoAndPrec denv env 2 ty // Layout a named argument | Some id,_,isParamArray,_ -> let prefix = - if isParamArray then + if isParamArray then layoutBuiltinAttribute denv denv.g.attrib_ParamArrayAttribute ^^ leftL (tagParameter id.idText) else leftL (tagParameter id.idText) @@ -1095,7 +1093,7 @@ module private PrintTypes = let prettyLayoutOfMemberType denv v typarInst argInfos retTy = match PartitionValRefTypars denv.g v with - | Some(_,_,memberMethodTypars,memberToParentInst,_) -> + | Some(_,_,memberMethodTypars,memberToParentInst,_) -> prettyLayoutOfMemberSigCore denv memberToParentInst (typarInst, memberMethodTypars, argInfos, retTy) | None -> let prettyTyparInst, layout = prettyLayoutOfUncurriedSig denv typarInst (List.concat argInfos) retTy @@ -1113,11 +1111,11 @@ module private PrintTypes = let ty,cxs = PrettyTypes.PrettifyType denv.g ty let env = SimplifyTypes.CollectInfo true [ty] cxs let cxsL = layoutConstraintsWithInfo denv env env.postfixConstraints - layoutTypeWithInfoAndPrec denv env 2 ty --- cxsL + layoutTypeWithInfoAndPrec denv env 2 ty --- cxsL let prettyLayoutOfTypeNoConstraints denv ty = let ty,_cxs = PrettyTypes.PrettifyType denv.g ty - layoutTypeWithInfoAndPrec denv SimplifyTypes.typeSimplificationInfo0 5 ty + layoutTypeWithInfoAndPrec denv SimplifyTypes.typeSimplificationInfo0 5 ty let layoutAssemblyName _denv (ty: TType) = ty.GetAssemblyName() @@ -1149,7 +1147,7 @@ module private PrintTastMemberOrVals = let nameL = mkNameL niceMethodTypars tagMember v.LogicalName let resL = stat --- (nameL ^^ WordL.colon ^^ tauL) prettyTyparInst, resL - | MemberKind.ClassConstructor + | MemberKind.ClassConstructor | MemberKind.Constructor -> let prettyTyparInst, _, tauL = prettyLayoutOfMemberType denv v typarInst argInfos rty let newL = layoutAccessibility denv v.Accessibility WordL.keywordNew @@ -1188,7 +1186,7 @@ module private PrintTastMemberOrVals = let resL = stat --- (nameL ^^ wordL (tagPunctuation ":") ^^ (tauL --- (WordL.keywordWith ^^ WordL.keywordSet))) prettyTyparInst, resL - let private layoutNonMemberVal denv (tps,v:Val,tau,cxs) = + let private layoutNonMemberVal denv (tps,v:Val,tau,cxs) = let env = SimplifyTypes.CollectInfo true [tau] cxs let cxs = env.postfixConstraints let argInfos,rty = GetTopTauTypeInFSharpForm denv.g (arityOfVal v).ArgInfos tau v.Range @@ -1209,14 +1207,14 @@ module private PrintTastMemberOrVals = nameL let isOverGeneric = List.length (Zset.elements (freeInType CollectTyparsNoCaching tau).FreeTypars) < List.length tps // Bug: 1143 - let isTyFunction = v.IsTypeFunction // Bug: 1143, and innerpoly tests + let isTyFunction = v.IsTypeFunction // Bug: 1143, and innerpoly tests let typarBindingsL = if isTyFunction || isOverGeneric || denv.showTyparBinding then layoutTyparDecls denv nameL true tps else nameL - let valAndTypeL = (WordL.keywordVal ^^ typarBindingsL --- wordL (tagPunctuation ":")) --- layoutTopType denv env argInfos rty cxs + let valAndTypeL = (WordL.keywordVal ^^ typarBindingsL --- wordL (tagPunctuation ":")) --- layoutTopType denv env argInfos rty cxs match denv.generatedValueLayout v with - | None -> valAndTypeL + | None -> valAndTypeL | Some rhsL -> (valAndTypeL ++ wordL (tagPunctuation"=")) --- rhsL let prettyLayoutOfValOrMember denv typarInst (v:Val) = @@ -1239,10 +1237,10 @@ module private PrintTastMemberOrVals = prettyLayoutOfValOrMember denv emptyTyparInst v |> snd let layoutTyparConstraint denv x = x |> PrintTypes.layoutTyparConstraint denv -let outputType denv os x = x |> PrintTypes.layoutType denv |> bufferL os +let outputType denv os x = x |> PrintTypes.layoutType denv |> bufferL os let layoutType denv x = x |> PrintTypes.layoutType denv -let outputTypars denv nm os x = x |> PrintTypes.layoutTyparDecls denv (wordL nm) true |> bufferL os -let outputTyconRef denv os x = x |> PrintTypes.layoutTyconRef denv |> bufferL os +let outputTypars denv nm os x = x |> PrintTypes.layoutTyparDecls denv (wordL nm) true |> bufferL os +let outputTyconRef denv os x = x |> PrintTypes.layoutTyconRef denv |> bufferL os let layoutTyconRef denv x = x |> PrintTypes.layoutTyconRef denv let layoutConst g ty c = PrintTypes.layoutConst g ty c @@ -1287,8 +1285,8 @@ module InfoMemberPrinting = /// Format a method info using "F# style". // // That is, this style: - // new : argName1:argType1 * ... * argNameN:argTypeN -> retType - // Method : argName1:argType1 * ... * argNameN:argTypeN -> retType + // new: argName1:argType1 * ... * argNameN:argTypeN -> retType + // Method: argName1:argType1 * ... * argNameN:argTypeN -> retType let private layoutMethInfoFSharpStyleCore amap m denv (minfo:MethInfo) minst = let layout = if not minfo.IsConstructor && not minfo.IsInstance then WordL.keywordStatic @@ -1335,11 +1333,11 @@ module InfoMemberPrinting = emptyL let layout = layout ^^ - if minfo.IsConstructor then + if minfo.IsConstructor then SepL.leftParen else SepL.dot ^^ - PrintTypes.layoutTyparDecls denv (wordL (tagMethod minfo.LogicalName)) true minfo.FormalMethodTypars ^^ + PrintTypes.layoutTyparDecls denv (wordL (tagMethod minfo.LogicalName)) true minfo.FormalMethodTypars ^^ SepL.leftParen let paramDatas = minfo.GetParamDatas (amap, m, minst) @@ -1354,7 +1352,7 @@ module InfoMemberPrinting = let prettyApparentTy, prettyFormalMethInst = List.headAndTail prettyTys let prettyMethInfo = match dty with - | None -> MethInfo.CreateILMeth (amap, m, prettyApparentTy, mdef) + | None -> MethInfo.CreateILMeth (amap, m, prettyApparentTy, mdef) | Some declaringTyconRef -> MethInfo.CreateILExtensionMeth(amap, m, prettyApparentTy, declaringTyconRef, minfo.ExtensionMemberPriorityOption, mdef) prettyTyparInst, prettyMethInfo, prettyFormalMethInst @@ -1366,13 +1364,13 @@ module InfoMemberPrinting = /// to notice this, or they find it helpful. It feels that moving from this position should not be done lightly. // // For F# members: - // new : unit -> retType - // new : argName1:argType1 * ... * argNameN:argTypeN -> retType - // Container.Method : unit -> retType - // Container.Method : argName1:argType1 * ... * argNameN:argTypeN -> retType + // new: unit -> retType + // new: argName1:argType1 * ... * argNameN:argTypeN -> retType + // Container.Method: unit -> retType + // Container.Method: argName1:argType1 * ... * argNameN:argTypeN -> retType // // For F# extension members: - // ApparentContainer.Method : argName1:argType1 * ... * argNameN:argTypeN -> retType + // ApparentContainer.Method: argName1:argType1 * ... * argNameN:argTypeN -> retType // // For C# and provided members: // Container(argName1:argType1, ..., argNameN:argTypeN) : retType @@ -1393,14 +1391,14 @@ module InfoMemberPrinting = let resL = layoutMethInfoCSharpStyle amap m denv prettyMethInfo minst prettyTyparInst, resL #if !NO_EXTENSIONTYPING - | ProvidedMeth _ -> + | ProvidedMeth _ -> let prettyTyparInst, _ = PrettyTypes.PrettifyInst amap.g typarInst prettyTyparInst, layoutMethInfoCSharpStyle amap m denv methInfo methInfo.FormalMethodInst #endif - let prettyLayoutOfPropInfoFreeStyle g amap m denv (pinfo: PropInfo) = + let prettyLayoutOfPropInfoFreeStyle g amap m denv (pinfo: PropInfo) = let rty = pinfo.GetPropertyType(amap,m) - let rty = if pinfo.IsIndexer then mkRefTupledTy g (pinfo.GetParamTypes(amap, m)) --> rty else rty + let rty = if pinfo.IsIndexer then mkRefTupledTy g (pinfo.GetParamTypes(amap, m)) --> rty else rty let rty, _ = PrettyTypes.PrettifyType g rty let tagProp = match pinfo.ArbitraryValRef with @@ -1441,9 +1439,9 @@ module private TastDefinitionPrinting = (lhsL ^^ WordL.keywordWith) @@-- memberL let layoutExtensionMembers denv vs = - aboveListL (List.map (layoutExtensionMember denv) vs) + aboveListL (List.map (layoutExtensionMember denv) vs) - let layoutRecdField addAccess denv (fld:RecdField) = + let layoutRecdField addAccess denv (fld:RecdField) = let lhs = tagRecordField fld.Name |> mkNav fld.DefinitionRange @@ -1452,15 +1450,15 @@ module private TastDefinitionPrinting = let lhs = if fld.IsMutable then wordL (tagKeyword "mutable") --- lhs else lhs (lhs ^^ RightL.colon) --- layoutType denv fld.FormalType - let layoutUnionOrExceptionField denv isGenerated i (fld : RecdField) = + let layoutUnionOrExceptionField denv isGenerated i (fld: RecdField) = if isGenerated i fld then layoutTypeWithInfoAndPrec denv SimplifyTypes.typeSimplificationInfo0 2 fld.FormalType else layoutRecdField false denv fld - let isGeneratedUnionCaseField pos (f : RecdField) = + let isGeneratedUnionCaseField pos (f: RecdField) = if pos < 0 then f.Name = "Item" else f.Name = "Item" + string (pos + 1) - let isGeneratedExceptionField pos (f : RecdField) = + let isGeneratedExceptionField pos (f: RecdField) = f.Name = "Data" + (string pos) let layoutUnionCaseFields denv isUnionCase fields = @@ -1470,14 +1468,14 @@ module private TastDefinitionPrinting = let isGenerated = if isUnionCase then isGeneratedUnionCaseField else isGeneratedExceptionField sepListL (wordL (tagPunctuation "*")) (List.mapi (layoutUnionOrExceptionField denv isGenerated) fields) - let layoutUnionCase denv prefixL (ucase:UnionCase) = + let layoutUnionCase denv prefixL (ucase:UnionCase) = let nmL = DemangleOperatorNameAsLayout (tagUnionCase >> mkNav ucase.DefinitionRange) ucase.Id.idText //let nmL = layoutAccessibility denv ucase.Accessibility nmL match ucase.RecdFields with | [] -> (prefixL ^^ nmL) | fields -> (prefixL ^^ nmL ^^ WordL.keywordOf) --- layoutUnionCaseFields denv true fields - let layoutUnionCases denv ucases = + let layoutUnionCases denv ucases = let prefixL = WordL.bar // See bug://2964 - always prefix in case preceded by accessibility modifier List.map (layoutUnionCase denv prefixL) ucases @@ -1489,13 +1487,13 @@ module private TastDefinitionPrinting = | TUnionRepr r -> not (isNilOrSingleton r.CasesTable.UnionCasesAsList) | TRecdRepr _ -> true | TAsmRepr _ - | TILObjectRepr _ + | TILObjectRepr _ | TMeasureableRepr _ #if !NO_EXTENSIONTYPING | TProvidedTypeExtensionPoint _ | TProvidedNamespaceExtensionPoint _ #endif - | TNoRepr -> false + | TNoRepr -> false @@ -1504,25 +1502,25 @@ module private TastDefinitionPrinting = let staticL = if e.IsStatic then WordL.keywordStatic else emptyL let nameL = wordL (tagField (adjustILName e.FieldName)) let typL = layoutType denv (e.FieldType(amap,m)) - staticL ^^ WordL.keywordVal ^^ nameL ^^ WordL.colon ^^ typL + staticL ^^ WordL.keywordVal ^^ nameL ^^ WordL.colon ^^ typL let private layoutEventInfo denv amap m (e: EventInfo) = let staticL = if e.IsStatic then WordL.keywordStatic else emptyL let nameL = wordL (tagEvent (adjustILName e.EventName)) let typL = layoutType denv (e.GetDelegateType(amap,m)) - staticL ^^ WordL.keywordEvent ^^ nameL ^^ WordL.colon ^^ typL + staticL ^^ WordL.keywordEvent ^^ nameL ^^ WordL.colon ^^ typL - let private layoutPropInfo denv amap m (p : PropInfo) = - let staticL = if p.IsStatic then WordL.keywordStatic else emptyL - let nameL = wordL (tagProperty (adjustILName p.PropertyName)) + let private layoutPropInfo denv amap m (p: PropInfo) = + let staticL = if p.IsStatic then WordL.keywordStatic else emptyL + let nameL = wordL (tagProperty (adjustILName p.PropertyName)) let typL = layoutType denv (p.GetPropertyType(amap,m)) // shouldn't happen let specGetSetL = match p.HasGetter, p.HasSetter with - | false,false | true,false -> emptyL - | false, true -> WordL.keywordWith ^^ WordL.keywordSet - | true, true -> WordL.keywordWith ^^ WordL.keywordGet^^ SepL.comma ^^ WordL.keywordSet + | false,false | true,false -> emptyL + | false, true -> WordL.keywordWith ^^ WordL.keywordSet + | true, true -> WordL.keywordWith ^^ WordL.keywordGet^^ SepL.comma ^^ WordL.keywordSet staticL ^^ WordL.keywordMember ^^ nameL ^^ WordL.colon ^^ typL ^^ specGetSetL @@ -1542,12 +1540,12 @@ module private TastDefinitionPrinting = let amap = infoReader.amap let sortKey (v:MethInfo) = (not v.IsConstructor, - not v.IsInstance, // instance first - v.DisplayName, // sort by name + not v.IsInstance, // instance first + v.DisplayName, // sort by name List.sum v.NumArgs , // sort by #curried - v.NumArgs.Length) // sort by arity + v.NumArgs.Length) // sort by arity - let shouldShow (valRef : ValRef option) = + let shouldShow (valRef: ValRef option) = match valRef with | None -> true | Some(vr) -> @@ -1569,7 +1567,7 @@ module private TastDefinitionPrinting = GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes g amap m ty |> List.map (fun ity -> wordL (tagKeyword (if isInterfaceTy g ty then "inherit" else "interface")) --- layoutType denv ity) let props = - GetIntrinsicPropInfosOfType infoReader (None,ad,AllowMultiIntfInstantiations.Yes) PreferOverrides m ty + GetIntrinsicPropInfosOfType infoReader (None,ad,AllowMultiIntfInstantiations.Yes) PreferOverrides m ty |> List.filter (fun v -> shouldShow v.ArbitraryValRef) let events = @@ -1580,7 +1578,7 @@ module private TastDefinitionPrinting = try Set.ofList [ for p in props do if p.HasGetter then yield p.GetterMethod.DisplayName - if p.HasSetter then yield p.SetterMethod.DisplayName + if p.HasSetter then yield p.SetterMethod.DisplayName for e in events do yield e.AddMethod.DisplayName yield e.RemoveMethod.DisplayName ] @@ -1590,7 +1588,7 @@ module private TastDefinitionPrinting = ctors |> shrinkOverloads (InfoMemberPrinting.layoutMethInfoFSharpStyle amap m denv) (fun _ xL -> xL) - let methLs = + let methLs = meths |> List.filter (fun md -> not (impliedNames.Contains md.DisplayName)) |> List.groupBy (fun md -> md.DisplayName) @@ -1609,9 +1607,9 @@ module private TastDefinitionPrinting = events |> List.map (fun x -> (true,x.IsStatic,x.EventName,0,0), layoutEventInfo denv amap m x) - let membLs = (methLs @ fieldLs @ propLs @ eventLs) |> List.sortBy fst |> List.map snd + let membLs = (methLs @ fieldLs @ propLs @ eventLs) |> List.sortBy fst |> List.map snd - let nestedTypeLs = + let nestedTypeLs = match tcref.TypeReprInfo with | TProvidedTypeExtensionPoint info -> [ @@ -1628,7 +1626,7 @@ module private TastDefinitionPrinting = [] else match GetSuperTypeOfType g amap m ty with - | Some super when not (isObjTy g super) -> [wordL (tagKeyword "inherit") ^^ (layoutType denv super)] + | Some super when not (isObjTy g super) -> [wordL (tagKeyword "inherit") ^^ (layoutType denv super)] | _ -> [] let erasedL = @@ -1688,11 +1686,11 @@ module private TastDefinitionPrinting = |> List.filter (fun v -> denv.showObsoleteMembers || not (CheckFSharpAttributesForObsolete denv.g v.Attribs)) |> List.filter (fun v -> denv.showHiddenMembers || not (CheckFSharpAttributesForHidden denv.g v.Attribs)) // sort - let sortKey (v:ValRef) = (not v.IsConstructor, // constructors before others - v.Id.idText, // sort by name - (if v.IsCompiledAsTopLevel then v.ValReprInfo.Value.NumCurriedArgs else 0), // sort by #curried - (if v.IsCompiledAsTopLevel then v.ValReprInfo.Value.AritiesOfArgs else []) // sort by arity - ) + let sortKey (v:ValRef) = + (not v.IsConstructor, // constructors before others + v.Id.idText, // sort by name + (if v.IsCompiledAsTopLevel then v.ValReprInfo.Value.NumCurriedArgs else 0), // sort by #curried + (if v.IsCompiledAsTopLevel then v.ValReprInfo.Value.AritiesOfArgs else [])) // sort by arity let adhoc = adhoc |> List.sortBy sortKey let iimpls = match tycon.TypeReprInfo with @@ -1701,9 +1699,9 @@ module private TastDefinitionPrinting = let iimpls = iimpls |> List.filter (fun (_,compgen,_) -> not compgen) // if TTyconInterface, the iimpls should be printed as inherited interfaces let iimplsLs = iimpls |> List.map (fun (ty,_,_) -> wordL (tagKeyword "interface") --- layoutType denv ty) - let adhocCtorsLs = adhoc |> List.filter (fun v -> v.IsConstructor) |> List.map (fun vref -> PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv vref.Deref) - let adhocInstanceLs = adhoc |> List.filter (fun v -> not v.IsConstructor && v.IsInstanceMember) |> List.map (fun vref -> PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv vref.Deref) - let adhocStaticLs = adhoc |> List.filter (fun v -> not v.IsConstructor && not v.IsInstanceMember) |> List.map (fun vref -> PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv vref.Deref) + let adhocCtorsLs = adhoc |> List.filter (fun v -> v.IsConstructor) |> List.map (fun vref -> PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv vref.Deref) + let adhocInstanceLs = adhoc |> List.filter (fun v -> not v.IsConstructor && v.IsInstanceMember) |> List.map (fun vref -> PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv vref.Deref) + let adhocStaticLs = adhoc |> List.filter (fun v -> not v.IsConstructor && not v.IsInstanceMember) |> List.map (fun vref -> PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv vref.Deref) iimplsLs,adhocCtorsLs,adhocInstanceLs,adhocStaticLs let memberLs = memberImplementLs @ memberCtorLs @ memberInstanceLs @ memberStaticLs let addMembersAsWithEnd reprL = @@ -1717,13 +1715,13 @@ module private TastDefinitionPrinting = let repr = tycon.TypeReprInfo match repr with | TRecdRepr _ - | TUnionRepr _ + | TUnionRepr _ | TFSharpObjectRepr _ - | TAsmRepr _ + | TAsmRepr _ | TMeasureableRepr _ | TILObjectRepr _ -> - let brk = not (isNil memberLs) || breakTypeDefnEqn repr - let rhsL = + let brk = not (isNil memberLs) || breakTypeDefnEqn repr + let rhsL = let addReprAccessL l = layoutAccessibility denv tycon.TypeReprAccessibility l let denv = denv.AddAccessibility tycon.TypeReprAccessibility match repr with @@ -1753,22 +1751,22 @@ module private TastDefinitionPrinting = | _ -> let inherits = match r.fsobjmodel_kind, tycon.TypeContents.tcaug_super with - | TTyconClass,Some super -> [wordL (tagKeyword "inherit") ^^ (layoutType denv super)] + | TTyconClass,Some super -> [wordL (tagKeyword "inherit") ^^ (layoutType denv super)] | TTyconInterface,_ -> tycon.ImmediateInterfacesOfFSharpTycon |> List.filter (fun (_,compgen,_) -> not compgen) - |> List.map (fun (ity,_,_) -> wordL (tagKeyword "inherit") ^^ (layoutType denv ity)) + |> List.map (fun (ity,_,_) -> wordL (tagKeyword "inherit") ^^ (layoutType denv ity)) | _ -> [] let vsprs = tycon.MembersOfFSharpTyconSorted |> List.filter (fun v -> isNil (Option.get v.MemberInfo).ImplementedSlotSigs) |> List.filter (fun v -> v.IsDispatchSlot) |> List.map (fun vref -> PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv vref.Deref) - let staticValsLs = + let staticValsLs = tycon.TrueFieldsAsList |> List.filter (fun f -> f.IsStatic) |> List.map (fun f -> WordL.keywordStatic ^^ WordL.keywordVal ^^ layoutRecdField true denv f) - let instanceValsLs = + let instanceValsLs = tycon.TrueFieldsAsList |> List.filter (fun f -> not f.IsStatic) |> List.map (fun f -> WordL.keywordVal ^^ layoutRecdField true denv f) @@ -1780,28 +1778,28 @@ module private TastDefinitionPrinting = let emptyMeasure = match tycon.TypeOrMeasureKind with TyparKind.Measure -> isNil alldecls | _ -> false if emptyMeasure then None else let declsL = aboveListL alldecls - let declsL = match start with Some s -> (wordL s @@-- declsL) @@ wordL (tagKeyword "end") | None -> declsL + let declsL = match start with Some s -> (wordL s @@-- declsL) @@ wordL (tagKeyword "end") | None -> declsL Some declsL - | TUnionRepr _ -> + | TUnionRepr _ -> let layoutUnionCases = tycon.UnionCasesAsList |> layoutUnionCases denv |> applyMaxMembers denv.maxMembers |> aboveListL Some (addMembersAsWithEnd (addReprAccessL layoutUnionCases)) - | TAsmRepr _ -> + | TAsmRepr _ -> Some (wordL (tagText "(# \"\" #)")) - | TMeasureableRepr ty -> + | TMeasureableRepr ty -> Some (layoutType denv ty) | TILObjectRepr _ -> let td = tycon.ILTyconRawMetadata Some (PrintIL.layoutILTypeDef denv td) - | _ -> None + | _ -> None - let brk = match tycon.TypeReprInfo with | TILObjectRepr _ -> true | _ -> brk + let brk = match tycon.TypeReprInfo with | TILObjectRepr _ -> true | _ -> brk match rhsL with - | None -> lhsL + | None -> lhsL | Some rhsL -> if brk then (lhsL ^^ WordL.equals) @@-- rhsL else - (lhsL ^^ WordL.equals) --- rhsL + (lhsL ^^ WordL.equals) --- rhsL | _ -> match tycon.TypeAbbrev with @@ -1812,7 +1810,7 @@ module private TastDefinitionPrinting = layoutAttribs denv ty tycon.TypeOrMeasureKind tycon.Attribs reprL // Layout: exception definition - let layoutExnDefn denv (exnc:Entity) = + let layoutExnDefn denv (exnc:Entity) = let nm = exnc.LogicalName let nmL = wordL (tagClass nm) let nmL = layoutAccessibility denv exnc.TypeReprAccessibility nmL @@ -1820,23 +1818,23 @@ module private TastDefinitionPrinting = let reprL = match exnc.ExceptionInfo with | TExnAbbrevRepr ecref -> WordL.equals --- layoutTyconRef denv ecref - | TExnAsmRepr _ -> WordL.equals --- wordL (tagText "(# ... #)") - | TExnNone -> emptyL - | TExnFresh r -> + | TExnAsmRepr _ -> WordL.equals --- wordL (tagText "(# ... #)") + | TExnNone -> emptyL + | TExnFresh r -> match r.TrueFieldsAsList with - | [] -> emptyL + | [] -> emptyL | r -> WordL.keywordOf --- layoutUnionCaseFields denv false r exnL ^^ reprL // Layout: module spec - let layoutTyconDefns denv infoReader ad m (tycons:Tycon list) = + let layoutTyconDefns denv infoReader ad m (tycons:Tycon list) = match tycons with | [] -> emptyL | [h] when h.IsExceptionDecl -> layoutExnDefn denv h | h :: t -> - let x = layoutTycon denv infoReader ad m false WordL.keywordType h + let x = layoutTycon denv infoReader ad m false WordL.keywordType h let xs = List.map (layoutTycon denv infoReader ad m false (wordL (tagKeyword "and"))) t aboveListL (x::xs) @@ -1853,19 +1851,19 @@ module private InferredSigPrinting = match x with | TMDefRec(_,tycons,mbinds,_) -> not (isNil tycons) || (mbinds |> List.exists (function ModuleOrNamespaceBinding.Binding _ -> true | ModuleOrNamespaceBinding.Module(x,_) -> not x.IsNamespace)) - | TMDefLet _ -> true - | TMDefDo _ -> true + | TMDefLet _ -> true + | TMDefDo _ -> true | TMDefs defs -> defs |> List.exists isConcreteNamespace | TMAbstract(ModuleOrNamespaceExprWithSig(_, def, _)) -> isConcreteNamespace def - let rec imexprLP denv (ModuleOrNamespaceExprWithSig(_, def, _)) = imdefL denv def + let rec imexprLP denv (ModuleOrNamespaceExprWithSig(_, def, _)) = imdefL denv def and imexprL denv (ModuleOrNamespaceExprWithSig(mty, def, m)) = imexprLP denv (ModuleOrNamespaceExprWithSig(mty, def, m)) - and imdefsL denv x = aboveListL (x |> List.map (imdefL denv)) + and imdefsL denv x = aboveListL (x |> List.map (imdefL denv)) - and imdefL denv x = - let filterVal (v:Val) = not v.IsCompilerGenerated && Option.isNone v.MemberInfo + and imdefL denv x = + let filterVal (v:Val) = not v.IsCompilerGenerated && Option.isNone v.MemberInfo let filterExtMem (v:Val) = v.IsExtensionMember match x with @@ -1880,8 +1878,8 @@ module private InferredSigPrinting = (mbinds |> List.choose (function ModuleOrNamespaceBinding.Binding bind -> Some bind | _ -> None) |> valsOfBinds - |> List.filter filterVal - |> List.map (PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv) + |> List.filter filterVal + |> List.map (PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv) |> aboveListL) @@ (mbinds @@ -1891,23 +1889,23 @@ module private InferredSigPrinting = | TMDefLet(bind,_) -> ([bind.Var] - |> List.filter filterVal + |> List.filter filterVal |> List.map (PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv) |> aboveListL) | TMDefs defs -> imdefsL denv defs - | TMDefDo _ -> emptyL + | TMDefDo _ -> emptyL | TMAbstract mexpr -> imexprLP denv mexpr - and imbindL denv (mspec, def) = - let nm = mspec.DemangledModuleOrNamespaceName + and imbindL denv (mspec, def) = + let nm = mspec.DemangledModuleOrNamespaceName let innerPath = (fullCompPathOfModuleOrNamespace mspec).AccessPath let outerPath = mspec.CompilationPath.AccessPath let denv = denv.AddOpenPath (List.map fst innerPath) - if mspec.IsNamespace then + if mspec.IsNamespace then let basic = imdefL denv def // Check if this namespace contains anything interesting if isConcreteNamespace def then @@ -1920,8 +1918,8 @@ module private InferredSigPrinting = basic else // This is a module - let nmL = layoutAccessibility denv mspec.Accessibility (wordL (tagModule nm)) - let denv = denv.AddAccessibility mspec.Accessibility + let nmL = layoutAccessibility denv mspec.Accessibility (wordL (tagModule nm)) + let denv = denv.AddAccessibility mspec.Accessibility let basic = imdefL denv def // Check if its an outer module or a nested module if (outerPath |> List.forall (fun (_,istype) -> istype = Namespace) ) then @@ -1934,7 +1932,7 @@ module private InferredSigPrinting = (wordL (tagKeyword "module") ^^ nmL) @@ basic else // Otherwise this is an outer module contained immediately in a namespace - // We already printed the namespace declaration earlier. So just print the + // We already printed the namespace declaration earlier. So just print the // module now. ((wordL (tagKeyword"module") ^^ nmL ^^ WordL.equals ^^ wordL (tagKeyword "begin")) @@-- basic) @@ WordL.keywordEnd else @@ -1955,15 +1953,15 @@ module private PrintData = and private dataExprWrapL denv isAtomic expr = match expr with - | Expr.Const (c,_,ty) -> + | Expr.Const (c,_,ty) -> if isEnumTy denv.g ty then wordL (tagKeyword "enum") ^^ angleL (layoutType denv ty) ^^ bracketL (layoutConst denv.g ty c) else layoutConst denv.g ty c - | Expr.Val (v,_,_) -> wordL (tagLocal v.DisplayName) - | Expr.Link rX -> dataExprWrapL denv isAtomic (!rX) - | Expr.Op (TOp.UnionCase(c),_,args,_) -> + | Expr.Val (v,_,_) -> wordL (tagLocal v.DisplayName) + | Expr.Link rX -> dataExprWrapL denv isAtomic (!rX) + | Expr.Op (TOp.UnionCase(c),_,args,_) -> if denv.g.unionCaseRefEq c denv.g.nil_ucref then wordL (tagPunctuation "[]") elif denv.g.unionCaseRefEq c denv.g.cons_ucref then let rec strip = function (Expr.Op (TOp.UnionCase _,_,[h;t],_)) -> h::strip t | _ -> [] @@ -1973,15 +1971,15 @@ module private PrintData = else (wordL (tagUnionCase c.CaseName) ++ bracketL (commaListL (dataExprsL denv args))) - | Expr.Op (TOp.ExnConstr(c),_,args,_) -> (wordL (tagMethod c.LogicalName) ++ bracketL (commaListL (dataExprsL denv args))) - | Expr.Op (TOp.Tuple _,_,xs,_) -> tupleL (dataExprsL denv xs) + | Expr.Op (TOp.ExnConstr(c),_,args,_) -> (wordL (tagMethod c.LogicalName) ++ bracketL (commaListL (dataExprsL denv args))) + | Expr.Op (TOp.Tuple _,_,xs,_) -> tupleL (dataExprsL denv xs) | Expr.Op (TOp.Recd (_,tc),_,xs,_) -> let fields = tc.TrueInstanceFieldsAsList let lay fs x = (wordL (tagRecordField fs.rfield_id.idText) ^^ sepL (tagPunctuation "=")) --- (dataExprL denv x) leftL (tagPunctuation "{") ^^ semiListL (List.map2 lay fields xs) ^^ rightL (tagPunctuation "}") | Expr.Op (TOp.ValFieldGet (RecdFieldRef.RFRef (tcref, name)), _, _, _) -> (layoutTyconRef denv tcref) ^^ sepL (tagPunctuation ".") ^^ wordL (tagField name) - | Expr.Op (TOp.Array,[_],xs,_) -> leftL (tagPunctuation "[|") ^^ semiListL (dataExprsL denv xs) ^^ RightL.rightBracketBar + | Expr.Op (TOp.Array,[_],xs,_) -> leftL (tagPunctuation "[|") ^^ semiListL (dataExprsL denv xs) ^^ RightL.rightBracketBar | _ -> wordL (tagPunctuation "?") and private dataExprsL denv xs = List.map (dataExprL denv) xs @@ -1992,20 +1990,20 @@ let dataExprL denv expr = PrintData.dataExprL denv expr //-------------------------------------------------------------------------- -let outputValOrMember denv os x = x |> PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv |> bufferL os -let stringValOrMember denv x = x |> PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv |> showL +let outputValOrMember denv os x = x |> PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv |> bufferL os +let stringValOrMember denv x = x |> PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv |> showL /// Print members with a qualification showing the type they are contained in let layoutQualifiedValOrMember denv typarInst v = PrintTastMemberOrVals.prettyLayoutOfValOrMember { denv with showMemberContainers=true; } typarInst v let outputQualifiedValOrMember denv os v = outputValOrMember { denv with showMemberContainers=true; } os v let outputQualifiedValSpec denv os v = outputQualifiedValOrMember denv os v let stringOfQualifiedValOrMember denv v = PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst { denv with showMemberContainers=true; } v |> showL - + /// Convert a MethInfo to a string let formatMethInfoToBufferFreeStyle amap m denv buf d = InfoMemberPrinting.formatMethInfoToBufferFreeStyle amap m denv buf d let prettyLayoutOfMethInfoFreeStyle amap m denv typarInst minfo = InfoMemberPrinting.prettyLayoutOfMethInfoFreeStyle amap m denv typarInst minfo /// Convert a PropInfo to a string -let prettyLayoutOfPropInfoFreeStyle g amap m denv d = InfoMemberPrinting.prettyLayoutOfPropInfoFreeStyle g amap m denv d +let prettyLayoutOfPropInfoFreeStyle g amap m denv d = InfoMemberPrinting.prettyLayoutOfPropInfoFreeStyle g amap m denv d /// Convert a MethInfo to a string let stringOfMethInfo amap m denv d = bufs (fun buf -> InfoMemberPrinting.formatMethInfoToBufferFreeStyle amap m denv buf d) @@ -2013,34 +2011,34 @@ let stringOfMethInfo amap m denv d = bufs (fun buf -> InfoMemberPrinting.formatM /// Convert a ParamData to a string let stringOfParamData denv paramData = bufs (fun buf -> InfoMemberPrinting.formatParamDataToBuffer denv buf paramData) let layoutOfParamData denv paramData = InfoMemberPrinting.layoutParamData denv paramData -let outputILTypeRef denv os x = x |> PrintIL.layoutILTypeRef denv |> bufferL os -let layoutILTypeRef denv x = x |> PrintIL.layoutILTypeRef denv -let outputExnDef denv os x = x |> TastDefinitionPrinting.layoutExnDefn denv |> bufferL os -let layoutExnDef denv x = x |> TastDefinitionPrinting.layoutExnDefn denv -let stringOfTyparConstraints denv x = x |> PrintTypes.layoutConstraintsWithInfo denv SimplifyTypes.typeSimplificationInfo0 |> showL -let outputTycon denv infoReader ad m (* width *) os x = TastDefinitionPrinting.layoutTycon denv infoReader ad m true WordL.keywordType x (* |> Layout.squashTo width *) |> bufferL os -let layoutTycon denv infoReader ad m (* width *) x = TastDefinitionPrinting.layoutTycon denv infoReader ad m true WordL.keywordType x (* |> Layout.squashTo width *) -let layoutUnionCases denv x = x |> TastDefinitionPrinting.layoutUnionCaseFields denv true -let outputUnionCases denv os x = x |> TastDefinitionPrinting.layoutUnionCaseFields denv true |> bufferL os +let outputILTypeRef denv os x = x |> PrintIL.layoutILTypeRef denv |> bufferL os +let layoutILTypeRef denv x = x |> PrintIL.layoutILTypeRef denv +let outputExnDef denv os x = x |> TastDefinitionPrinting.layoutExnDefn denv |> bufferL os +let layoutExnDef denv x = x |> TastDefinitionPrinting.layoutExnDefn denv +let stringOfTyparConstraints denv x = x |> PrintTypes.layoutConstraintsWithInfo denv SimplifyTypes.typeSimplificationInfo0 |> showL +let outputTycon denv infoReader ad m (* width *) os x = TastDefinitionPrinting.layoutTycon denv infoReader ad m true WordL.keywordType x (* |> Layout.squashTo width *) |> bufferL os +let layoutTycon denv infoReader ad m (* width *) x = TastDefinitionPrinting.layoutTycon denv infoReader ad m true WordL.keywordType x (* |> Layout.squashTo width *) +let layoutUnionCases denv x = x |> TastDefinitionPrinting.layoutUnionCaseFields denv true +let outputUnionCases denv os x = x |> TastDefinitionPrinting.layoutUnionCaseFields denv true |> bufferL os /// Pass negative number as pos in case of single cased discriminated unions -let isGeneratedUnionCaseField pos f = TastDefinitionPrinting.isGeneratedUnionCaseField pos f -let isGeneratedExceptionField pos f = TastDefinitionPrinting.isGeneratedExceptionField pos f -let stringOfTyparConstraint denv tpc = stringOfTyparConstraints denv [tpc] -let stringOfTy denv x = x |> PrintTypes.layoutType denv |> showL -let prettyLayoutOfType denv x = x |> PrintTypes.prettyLayoutOfType denv -let prettyLayoutOfTypeNoCx denv x = x |> PrintTypes.prettyLayoutOfTypeNoConstraints denv -let prettyStringOfTy denv x = x |> PrintTypes.prettyLayoutOfType denv |> showL -let prettyStringOfTyNoCx denv x = x |> PrintTypes.prettyLayoutOfTypeNoConstraints denv |> showL -let stringOfRecdField denv x = x |> TastDefinitionPrinting.layoutRecdField false denv |> showL -let stringOfUnionCase denv x = x |> TastDefinitionPrinting.layoutUnionCase denv (WordL.bar) |> showL -let stringOfExnDef denv x = x |> TastDefinitionPrinting.layoutExnDefn denv |> showL - -let stringOfFSAttrib denv x = x |> PrintTypes.layoutAttrib denv |> squareAngleL |> showL -let stringOfILAttrib denv x = x |> PrintTypes.layoutILAttrib denv |> squareAngleL |> showL +let isGeneratedUnionCaseField pos f = TastDefinitionPrinting.isGeneratedUnionCaseField pos f +let isGeneratedExceptionField pos f = TastDefinitionPrinting.isGeneratedExceptionField pos f +let stringOfTyparConstraint denv tpc = stringOfTyparConstraints denv [tpc] +let stringOfTy denv x = x |> PrintTypes.layoutType denv |> showL +let prettyLayoutOfType denv x = x |> PrintTypes.prettyLayoutOfType denv +let prettyLayoutOfTypeNoCx denv x = x |> PrintTypes.prettyLayoutOfTypeNoConstraints denv +let prettyStringOfTy denv x = x |> PrintTypes.prettyLayoutOfType denv |> showL +let prettyStringOfTyNoCx denv x = x |> PrintTypes.prettyLayoutOfTypeNoConstraints denv |> showL +let stringOfRecdField denv x = x |> TastDefinitionPrinting.layoutRecdField false denv |> showL +let stringOfUnionCase denv x = x |> TastDefinitionPrinting.layoutUnionCase denv WordL.bar |> showL +let stringOfExnDef denv x = x |> TastDefinitionPrinting.layoutExnDefn denv |> showL + +let stringOfFSAttrib denv x = x |> PrintTypes.layoutAttrib denv |> squareAngleL |> showL +let stringOfILAttrib denv x = x |> PrintTypes.layoutILAttrib denv |> squareAngleL |> showL let layoutInferredSigOfModuleExpr showHeader denv infoReader ad m expr = InferredSigPrinting.layoutInferredSigOfModuleExpr showHeader denv infoReader ad m expr -let prettyLayoutOfValOrMember denv typarInst v = PrintTastMemberOrVals.prettyLayoutOfValOrMember denv typarInst v -let prettyLayoutOfValOrMemberNoInst denv v = PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv v +let prettyLayoutOfValOrMember denv typarInst v = PrintTastMemberOrVals.prettyLayoutOfValOrMember denv typarInst v +let prettyLayoutOfValOrMemberNoInst denv v = PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv v let prettyLayoutOfInstAndSig denv x = PrintTypes.prettyLayoutOfInstAndSig denv x /// Generate text for comparing two types. @@ -2051,7 +2049,7 @@ let minimalStringsOfTwoTypes denv t1 t2= let (t1,t2),tpcs = PrettyTypes.PrettifyTypePair denv.g (t1,t2) // try denv + no type annotations let attempt1 = - let denv = { denv with showImperativeTyparAnnotations=false; showConstraintTyparAnnotations=false } + let denv = { denv with showImperativeTyparAnnotations=false; showConstraintTyparAnnotations=false } let min1 = stringOfTy denv t1 let min2 = stringOfTy denv t2 if min1 <> min2 then Some (min1,min2,"") else None @@ -2060,7 +2058,7 @@ let minimalStringsOfTwoTypes denv t1 t2= | None -> // try denv + no type annotations + show full paths let attempt2 = - let denv = { denv with showImperativeTyparAnnotations=false; showConstraintTyparAnnotations=false }.SetOpenPaths [] + let denv = { denv with showImperativeTyparAnnotations=false; showConstraintTyparAnnotations=false }.SetOpenPaths [] let min1 = stringOfTy denv t1 let min2 = stringOfTy denv t2 if min1 <> min2 then Some (min1,min2,"") else None @@ -2098,20 +2096,20 @@ let minimalStringsOfTwoTypes denv t1 t2= // Note: Always show imperative annotations when comparing value signatures let minimalStringsOfTwoValues denv v1 v2= - let denvMin = { denv with showImperativeTyparAnnotations=true; showConstraintTyparAnnotations=false } + let denvMin = { denv with showImperativeTyparAnnotations=true; showConstraintTyparAnnotations=false } let min1 = bufs (fun buf -> outputQualifiedValOrMember denvMin buf v1) let min2 = bufs (fun buf -> outputQualifiedValOrMember denvMin buf v2) if min1 <> min2 then (min1,min2) else - let denvMax = { denv with showImperativeTyparAnnotations=true; showConstraintTyparAnnotations=true } + let denvMax = { denv with showImperativeTyparAnnotations=true; showConstraintTyparAnnotations=true } let max1 = bufs (fun buf -> outputQualifiedValOrMember denvMax buf v1) let max2 = bufs (fun buf -> outputQualifiedValOrMember denvMax buf v2) max1,max2 let minimalStringOfType denv ty = let ty, _cxs = PrettyTypes.PrettifyType denv.g ty - let denvMin = { denv with showImperativeTyparAnnotations=false; showConstraintTyparAnnotations=false } + let denvMin = { denv with showImperativeTyparAnnotations=false; showConstraintTyparAnnotations=false } showL (PrintTypes.layoutTypeWithInfoAndPrec denvMin SimplifyTypes.typeSimplificationInfo0 2 ty) @@ -2123,7 +2121,7 @@ type DeclSpec = | DModul of ModuleOrNamespace let rangeOfDeclSpec = function - | DVal v -> v.Range + | DVal v -> v.Range | DTycon t -> t.Range | DException t -> t.Range | DModul m -> m.Range @@ -2131,41 +2129,41 @@ let rangeOfDeclSpec = function /// modul - provides (valspec)* - and also types, exns and submodules. /// Each defines a decl block on a given range. /// Can sort on the ranges to recover the original declaration order. -let rec moduleOrNamespaceTypeLP (topLevel : bool) (denv: DisplayEnv) (mtype : ModuleOrNamespaceType) = +let rec moduleOrNamespaceTypeLP (topLevel: bool) (denv: DisplayEnv) (mtype: ModuleOrNamespaceType) = // REVIEW: consider a better way to keep decls in order. - let declSpecs : DeclSpec list = + let declSpecs: DeclSpec list = List.concat - [mtype.AllValsAndMembers |> Seq.toList |> List.filter (fun v -> not v.IsCompilerGenerated && v.MemberInfo.IsNone) |> List.map DVal; - mtype.TypeDefinitions |> List.map DTycon; - mtype.ExceptionDefinitions |> List.map DException; - mtype.ModuleAndNamespaceDefinitions |> List.map DModul; + [ mtype.AllValsAndMembers |> Seq.toList |> List.filter (fun v -> not v.IsCompilerGenerated && v.MemberInfo.IsNone) |> List.map DVal + mtype.TypeDefinitions |> List.map DTycon + mtype.ExceptionDefinitions |> List.map DException + mtype.ModuleAndNamespaceDefinitions |> List.map DModul ] let declSpecs = List.sortWithOrder (Order.orderOn rangeOfDeclSpec rangeOrder) declSpecs let declSpecL = function // only show namespaces / modules at the top level; this is because we've no global namespace - | DVal vspec when not topLevel -> prettyLayoutOfValOrMember denv vspec - | DTycon tycon when not topLevel -> tyconL denv (wordL "type") tycon - | DException tycon when not topLevel -> layoutExnDefn denv tycon - | DModul mspec -> moduleOrNamespaceLP false denv mspec - | _ -> emptyL // this catches non-namespace / modules at the top-level + | DVal vspec when not topLevel -> prettyLayoutOfValOrMember denv vspec + | DTycon tycon when not topLevel -> tyconL denv (wordL "type") tycon + | DException tycon when not topLevel -> layoutExnDefn denv tycon + | DModul mspec -> moduleOrNamespaceLP false denv mspec + | _ -> emptyL // this catches non-namespace / modules at the top-level aboveListL (List.map declSpecL declSpecs) and moduleOrNamespaceLP (topLevel: bool) (denv: DisplayEnv) (mspec: ModuleOrNamespace) = let istype = mspec.ModuleOrNamespaceType.ModuleOrNamespaceKind - let nm = mspec.DemangledModuleOrNamespaceName - let denv = denv.AddOpenModuleOrNamespace (mkLocalModRef mspec) - let nmL = layoutAccessibility denv mspec.Accessibility (wordL nm) - let denv = denv.AddAccessibility mspec.Accessibility - let path = path.Add nm // tack on the current module to be used in calls to linearise all subterms - let body = moduleOrNamespaceTypeLP topLevel denv path mspec.ModuleOrNamespaceType + let nm = mspec.DemangledModuleOrNamespaceName + let denv = denv.AddOpenModuleOrNamespace (mkLocalModRef mspec) + let nmL = layoutAccessibility denv mspec.Accessibility (wordL nm) + let denv = denv.AddAccessibility mspec.Accessibility + let path = path.Add nm // tack on the current module to be used in calls to linearise all subterms + let body = moduleOrNamespaceTypeLP topLevel denv path mspec.ModuleOrNamespaceType if istype = Namespace then (wordL "namespace" ^^ nmL) @@-- body else (wordL "module" ^^ nmL ^^ wordL "= begin") @@-- body @@ wordL "end" -let moduleOrNamespaceTypeL (denv: DisplayEnv) (mtype : ModuleOrNamespaceType) = moduleOrNamespaceTypeLP false denv Path.Empty mtype +let moduleOrNamespaceTypeL (denv: DisplayEnv) (mtype: ModuleOrNamespaceType) = moduleOrNamespaceTypeLP false denv Path.Empty mtype let moduleOrNamespaceL denv mspec = moduleOrNamespaceLP false denv Path.Empty mspec -let assemblyL denv (mspec : ModuleOrNamespace) = moduleOrNamespaceTypeLP true denv Path.Empty mspec.ModuleOrNamespaceType // we seem to get the *assembly* name as an outer module, this strips this off +let assemblyL denv (mspec: ModuleOrNamespace) = moduleOrNamespaceTypeLP true denv Path.Empty mspec.ModuleOrNamespaceType // we seem to get the *assembly* name as an outer module, this strips this off #endif diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index be7f4049743c076054a1e07bf1a47d016d83b066..e7db8f505abadc6a10b5c73a8bd55d0d864f0a79 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -45,23 +45,31 @@ let [] verboseOptimizations = false let i_ldlen = [ I_ldlen; (AI_conv DT_I4) ] -let [] callSize = 1 // size of a function call -let [] forAndWhileLoopSize = 5 // size of a for/while loop -let [] tryCatchSize = 5 // size of a try/catch -let [] tryFinallySize = 5 // size of a try/finally -let [] closureTotalSize = 10 // Total cost of a closure. Each closure adds a class definition -let [] methodDefnTotalSize = 1 // Total cost of a method definition +/// size of a function call +let [] callSize = 1 -//------------------------------------------------------------------------- -// Partial information about an expression. -// -// We store one of these for each value in the environment, including values -// which we know little or nothing about. -//------------------------------------------------------------------------- +/// size of a for/while loop +let [] forAndWhileLoopSize = 5 + +/// size of a try/catch +let [] tryCatchSize = 5 + +/// size of a try/finally +let [] tryFinallySize = 5 + +/// Total cost of a closure. Each closure adds a class definition +let [] closureTotalSize = 10 + +/// Total cost of a method definition +let [] methodDefnTotalSize = 1 type TypeValueInfo = | UnknownTypeValue +/// Partial information about an expression. +/// +/// We store one of these for each value in the environment, including values +/// which we know little or nothing about. type ExprValueInfo = | UnknownValue @@ -74,20 +82,20 @@ type ExprValueInfo = /// /// Records that a value is equal to another value, along with additional /// information. - | ValValue of ValRef * ExprValueInfo + | ValValue of ValRef * ExprValueInfo - | TupleValue of ExprValueInfo[] + | TupleValue of ExprValueInfo[] /// RecdValue(tycon, values) /// /// INVARIANT: values are in field definition order . - | RecdValue of TyconRef * ExprValueInfo[] + | RecdValue of TyconRef * ExprValueInfo[] | UnionCaseValue of UnionCaseRef * ExprValueInfo[] | ConstValue of Const * TType - /// CurriedLambdaValue(id, arity, sz, expr, ty) + /// CurriedLambdaValue(id, arity, size, lambdaExpression, ty) /// /// arities: The number of bunches of untupled args and type args, and /// the number of args in each bunch. NOTE: This include type arguments. @@ -100,7 +108,9 @@ type ExprValueInfo = type ValInfo = { ValMakesNoCriticalTailcalls: bool - ValExprInfo: ExprValueInfo } + + ValExprInfo: ExprValueInfo + } //------------------------------------------------------------------------- // Partial information about entire namespace fragments or modules @@ -117,7 +127,6 @@ type ValInfo = // It doesn't yet feel like we've got this data structure as good as it could be //------------------------------------------------------------------------- - /// Table of the values contained in one module type ValInfos(entries) = @@ -139,9 +148,13 @@ type ValInfos(entries) = dict) member x.Entries = valInfoTable.Force().Values + member x.Map f = ValInfos(Seq.map f x.Entries) + member x.Filter f = ValInfos(Seq.filter f x.Entries) + member x.TryFind (v:ValRef) = valInfoTable.Force().TryFind v.Deref + member x.TryFindForFslib (v:ValRef) = valInfosForFslib.Force().TryGetValue(v.Deref.GetLinkagePartialKey()) type ModuleInfo = @@ -149,7 +162,9 @@ type ModuleInfo = ModuleOrNamespaceInfos: NameMap } and LazyModuleInfo = Lazy + type ImplFileOptimizationInfo = LazyModuleInfo + type CcuOptimizationInfo = LazyModuleInfo #if DEBUG @@ -166,7 +181,7 @@ let rec exprValueInfoL g exprVal = | TupleValue vinfos -> bracketL (exprValueInfosL g vinfos) | RecdValue (_, vinfos) -> braceL (exprValueInfosL g vinfos) | UnionCaseValue (ucr, vinfos) -> unionCaseRefL ucr ^^ bracketL (exprValueInfosL g vinfos) - | CurriedLambdaValue(_lambdaId, _arities, _bsize, expr', _ety) -> wordL (tagText "lam") ++ exprL expr' (* (sprintf "lam(size=%d)" bsize) *) + | CurriedLambdaValue(_lambdaId, _arities, _bsize, expr, _ety) -> wordL (tagText "lam") ++ exprL expr (* (sprintf "lam(size=%d)" bsize) *) | ConstExprValue (_size, x) -> exprL x and exprValueInfosL g vinfos = commaListL (List.map (exprValueInfoL g) (Array.toList vinfos)) @@ -183,14 +198,18 @@ and valInfoL g (x:ValInfo) = type Summary<'Info> = { Info: 'Info + /// What's the contribution to the size of this function? FunctionSize: int + /// What's the total contribution to the size of the assembly, including closure classes etc.? TotalSize: int + /// Meaning: could mutate, could non-terminate, could raise exception /// One use: an effect expr can not be eliminated as dead code (e.g. sequencing) /// One use: an effect=false expr can not throw an exception? so try-catch is removed. HasEffect: bool + /// Indicates that a function may make a useful tailcall, hence when called should itself be tailcalled MightMakeCriticalTailcall: bool } @@ -205,17 +224,17 @@ let rec SizeOfValueInfos (arr:_[]) = and SizeOfValueInfo x = match x with - | SizeValue (vdepth, _v) -> vdepth (* terminate recursion at CACHED size nodes *) + | SizeValue (vdepth, _v) -> vdepth // terminate recursion at CACHED size nodes | ConstValue (_x, _) -> 1 | UnknownValue -> 1 | ValValue (_vr, vinfo) -> SizeOfValueInfo vinfo + 1 | TupleValue vinfos | RecdValue (_, vinfos) | UnionCaseValue (_, vinfos) -> 1 + SizeOfValueInfos vinfos - | CurriedLambdaValue(_lambdaId, _arities, _bsize, _expr', _ety) -> 1 + | CurriedLambdaValue(_lambdaId, _arities, _bsize, _expr, _ety) -> 1 | ConstExprValue (_size, _) -> 1 -let [] minDepthForASizeNode = 5 (* for small vinfos do not record size info, save space *) +let [] minDepthForASizeNode = 5 // for small vinfos do not record size info, save space let rec MakeValueInfoWithCachedSize vdepth v = match v with @@ -233,13 +252,13 @@ let BoundValueInfoBySize vinfo = else match x with | SizeValue (vdepth, vinfo) -> if vdepth < depth then x else MakeSizedValueInfo (bound depth vinfo) - | ValValue (vr, vinfo) -> ValValue (vr, bound (depth-1) vinfo) + | ValValue (vr, vinfo) -> ValValue (vr, bound (depth-1) vinfo) | TupleValue vinfos -> TupleValue (Array.map (bound (depth-1)) vinfos) | RecdValue (tcref, vinfos) -> RecdValue (tcref, Array.map (bound (depth-1)) vinfos) | UnionCaseValue (ucr, vinfos) -> UnionCaseValue (ucr, Array.map (bound (depth-1)) vinfos) - | ConstValue _ -> x - | UnknownValue -> x - | CurriedLambdaValue(_lambdaId, _arities, _bsize, _expr', _ety) -> x + | ConstValue _ -> x + | UnknownValue -> x + | CurriedLambdaValue(_lambdaId, _arities, _bsize, _expr, _ety) -> x | ConstExprValue (_size, _) -> x let maxDepth = 6 (* beware huge constants! *) let trimDepth = 3 @@ -249,41 +268,52 @@ let BoundValueInfoBySize vinfo = else MakeValueInfoWithCachedSize vdepth vinfo //------------------------------------------------------------------------- -// What we know about the world +// Settings and optimizations //------------------------------------------------------------------------- let [] jitOptDefault = true + let [] localOptDefault = true + let [] crossModuleOptDefault = true type OptimizationSettings = { abstractBigTargets : bool + jitOptUser : bool option + localOptUser : bool option + crossModuleOptUser : bool option + /// size after which we start chopping methods in two, though only at match targets bigTargetSize : int + /// size after which we start enforcing splitting sub-expressions to new methods, to avoid hitting .NET IL limitations veryBigExprSize : int + /// The size after which we don't inline lambdaInlineThreshold : int + /// For unit testing reportingPhase : bool + reportNoNeedToTailcall: bool + reportFunctionSizes : bool + reportHasEffect : bool - reportTotalSizes : bool } + + reportTotalSizes : bool + } static member Defaults = { abstractBigTargets = false jitOptUser = None localOptUser = None - /// size after which we start chopping methods in two, though only at match targets bigTargetSize = 100 - /// size after which we start enforcing splitting sub-expressions to new methods, to avoid hitting .NET IL limitations veryBigExprSize = 3000 crossModuleOptUser = None - /// The size after which we don't inline lambdaInlineThreshold = 6 reportingPhase = false reportNoNeedToTailcall = false @@ -293,58 +323,85 @@ type OptimizationSettings = } member x.jitOpt() = match x.jitOptUser with Some f -> f | None -> jitOptDefault + member x.localOpt () = match x.localOptUser with Some f -> f | None -> localOptDefault + member x.crossModuleOpt () = x.localOpt () && (match x.crossModuleOptUser with Some f -> f | None -> crossModuleOptDefault) member x.KeepOptimizationValues() = x.crossModuleOpt () - /// inline calls * + + /// inline calls? member x.InlineLambdas () = x.localOpt () + /// eliminate unused bindings with no effect member x.EliminateUnusedBindings () = x.localOpt () + /// eliminate try around expr with no effect member x.EliminateTryCatchAndTryFinally () = false // deemed too risky, given tiny overhead of including try/catch. See https://github.com/Microsoft/visualfsharp/pull/376 + /// eliminate first part of seq if no effect member x.EliminateSequential () = x.localOpt () + /// determine branches in pattern matching member x.EliminateSwitch () = x.localOpt () + member x.EliminateRecdFieldGet () = x.localOpt () + member x.EliminateTupleFieldGet () = x.localOpt () + member x.EliminatUnionCaseFieldGet () = x.localOpt () + /// eliminate non-compiler generated immediate bindings member x.EliminateImmediatelyConsumedLocals() = x.localOpt () + /// expand "let x = (exp1, exp2, ...)" bind fields as prior tmps member x.ExpandStructrualValues() = x.localOpt () type cenv = { g: TcGlobals + TcVal : ConstraintSolver.TcValF + amap: Import.ImportMap + optimizing: bool + scope: CcuThunk + localInternalVals: System.Collections.Generic.Dictionary + settings: OptimizationSettings + emitTailcalls: bool - // cache methods with SecurityAttribute applied to them, to prevent unnecessary calls to ExistsInEntireHierarchyOfType - casApplied : Dictionary} - - + + /// cache methods with SecurityAttribute applied to them, to prevent unnecessary calls to ExistsInEntireHierarchyOfType + casApplied : Dictionary + } type IncrementalOptimizationEnv = - { // An identifier to help with name generation + { /// An identifier to help with name generation latestBoundId: Ident option - // The set of lambda IDs we've inlined to reach this point. Helps to prevent recursive inlining + + /// The set of lambda IDs we've inlined to reach this point. Helps to prevent recursive inlining dontInline: Zset - // Recursively bound vars. If an sub-expression that is a candidate for method splitting - // contains any of these variables then don't split it, for fear of mucking up tailcalls. - // See FSharp 1.0 bug 2892 + + /// Recursively bound vars. If an sub-expression that is a candidate for method splitting + /// contains any of these variables then don't split it, for fear of mucking up tailcalls. + /// See FSharp 1.0 bug 2892 dontSplitVars: ValMap - // Disable method splitting in loops + + /// Disable method splitting in loops inLoop: bool + /// The Val for the function binding being generated, if any. functionVal: (Val * Tast.ValReprInfo) option + typarInfos: (Typar * TypeValueInfo) list + localExternalVals: LayeredMap - globalModuleInfos: LayeredMap } + + globalModuleInfos: LayeredMap + } static member Empty = { latestBoundId = None @@ -360,7 +417,8 @@ type IncrementalOptimizationEnv = // IsPartialExprVal - is the expr fully known? //------------------------------------------------------------------------- -let rec IsPartialExprVal x = (* IsPartialExprVal can not rebuild to an expr *) +/// IsPartialExprVal indicates the cases where we cant rebuild an expression +let rec IsPartialExprVal x = match x with | UnknownValue -> true | TupleValue args | RecdValue (_, args) | UnionCaseValue (_, args) -> Array.exists IsPartialExprVal args @@ -381,12 +439,18 @@ let check (vref: ValRef) (res:ValInfo) = // Bind information about values //------------------------------------------------------------------------- -let EmptyModuleInfo = notlazy { ValInfos = ValInfos([]); ModuleOrNamespaceInfos = Map.empty } +let EmptyModuleInfo = + notlazy { ValInfos = ValInfos([]); ModuleOrNamespaceInfos = Map.empty } let rec UnionOptimizationInfos (minfos : seq) = notlazy - { ValInfos = ValInfos(seq { for minfo in minfos do yield! minfo.Force().ValInfos.Entries }) - ModuleOrNamespaceInfos = minfos |> Seq.map (fun m -> m.Force().ModuleOrNamespaceInfos) |> NameMap.union UnionOptimizationInfos } + { ValInfos = + ValInfos(seq { for minfo in minfos do yield! minfo.Force().ValInfos.Entries }) + + ModuleOrNamespaceInfos = + minfos + |> Seq.map (fun m -> m.Force().ModuleOrNamespaceInfos) + |> NameMap.union UnionOptimizationInfos } let FindOrCreateModuleInfo n (ss: Map<_, _>) = match ss.TryFind n with @@ -503,15 +567,9 @@ let BindTypeVarsToUnknown (tps:Typar list) env = let BindCcu (ccu:Tast.CcuThunk) mval env (_g:TcGlobals) = { env with globalModuleInfos=env.globalModuleInfos.Add(ccu.AssemblyName, mval) } - - -//------------------------------------------------------------------------- -// Lookup information about values -//------------------------------------------------------------------------- - - +/// Lookup information about values let GetInfoForLocalValue cenv env (v:Val) m = - (* Abstract slots do not have values *) + // Abstract slots do not have values if v.IsDispatchSlot then UnknownValInfo else let mutable res = Unchecked.defaultof<_> @@ -549,7 +607,7 @@ let GetInfoForNonLocalVal cenv env (vref:ValRef) = if vref.IsDispatchSlot then UnknownValInfo // REVIEW: optionally turn x-module on/off on per-module basis or - elif cenv.settings.crossModuleOpt () || vref.MustInline then + elif cenv.settings.crossModuleOpt () || vref.MustInline then match TryGetInfoForNonLocalEntityRef env vref.nlr.EnclosingEntity.nlr with | Some(structInfo) -> match structInfo.ValInfos.TryFind(vref) with @@ -577,7 +635,7 @@ let GetInfoForVal cenv env m (vref:ValRef) = else GetInfoForNonLocalVal cenv env vref - check (* "its stored value was incomplete" m *) vref res |> ignore + check vref res |> ignore res //------------------------------------------------------------------------- @@ -615,21 +673,25 @@ let (|StripUnionCaseValue|_|) ev = | _ -> None let mkBoolVal (g: TcGlobals) n = ConstValue(Const.Bool n, g.bool_ty) + let mkInt8Val (g: TcGlobals) n = ConstValue(Const.SByte n, g.sbyte_ty) + let mkInt16Val (g: TcGlobals) n = ConstValue(Const.Int16 n, g.int16_ty) + let mkInt32Val (g: TcGlobals) n = ConstValue(Const.Int32 n, g.int32_ty) + let mkInt64Val (g: TcGlobals) n = ConstValue(Const.Int64 n, g.int64_ty) + let mkUInt8Val (g: TcGlobals) n = ConstValue(Const.Byte n, g.byte_ty) + let mkUInt16Val (g: TcGlobals) n = ConstValue(Const.UInt16 n, g.uint16_ty) + let mkUInt32Val (g: TcGlobals) n = ConstValue(Const.UInt32 n, g.uint32_ty) + let mkUInt64Val (g: TcGlobals) n = ConstValue(Const.UInt64 n, g.uint64_ty) let (|StripInt32Value|_|) = function StripConstValue(Const.Int32 n) -> Some n | _ -> None -//------------------------------------------------------------------------- -// mk value_infos -//------------------------------------------------------------------------- - let MakeValueInfoForValue g m vref vinfo = #if DEBUG let rec check x = @@ -643,12 +705,18 @@ let MakeValueInfoForValue g m vref vinfo = #endif ValValue (vref, vinfo) |> BoundValueInfoBySize -let MakeValueInfoForRecord tcref argvals = RecdValue (tcref, argvals) |> BoundValueInfoBySize -let MakeValueInfoForTuple argvals = TupleValue argvals |> BoundValueInfoBySize -let MakeValueInfoForUnionCase cspec argvals = UnionCaseValue (cspec, argvals) |> BoundValueInfoBySize -let MakeValueInfoForConst c ty = ConstValue(c, ty) +let MakeValueInfoForRecord tcref argvals = + RecdValue (tcref, argvals) |> BoundValueInfoBySize -// Helper to evaluate a unary integer operation over known values +let MakeValueInfoForTuple argvals = + TupleValue argvals |> BoundValueInfoBySize + +let MakeValueInfoForUnionCase cspec argvals = + UnionCaseValue (cspec, argvals) |> BoundValueInfoBySize + +let MakeValueInfoForConst c ty = ConstValue(c, ty) + +/// Helper to evaluate a unary integer operation over known values let inline IntegerUnaryOp g f8 f16 f32 f64 fu8 fu16 fu32 fu64 a = match a with | StripConstValue(c) -> @@ -665,7 +733,7 @@ let inline IntegerUnaryOp g f8 f16 f32 f64 fu8 fu16 fu32 fu64 a = | _ -> None | _ -> None -// Helper to evaluate a unary signed integer operation over known values +/// Helper to evaluate a unary signed integer operation over known values let inline SignedIntegerUnaryOp g f8 f16 f32 f64 a = match a with | StripConstValue(c) -> @@ -677,7 +745,7 @@ let inline SignedIntegerUnaryOp g f8 f16 f32 f64 a = | _ -> None | _ -> None -// Helper to evaluate a binary integer operation over known values +/// Helper to evaluate a binary integer operation over known values let inline IntegerBinaryOp g f8 f16 f32 f64 fu8 fu16 fu32 fu64 a b = match a, b with | StripConstValue(c1), StripConstValue(c2) -> @@ -697,11 +765,10 @@ let inline IntegerBinaryOp g f8 f16 f32 f64 fu8 fu16 fu32 fu64 a b = module Unchecked = Microsoft.FSharp.Core.Operators /// Evaluate primitives based on interpretation of IL instructions. -// -// The implementation -// utilizes F# arithmetic extensively, so a mistake in the implementation of F# arithmetic -// in the core library used by the F# compiler will propagate to be a mistake in optimization. -// The IL instructions appear in the tree through inlining. +/// +/// The implementation utilizes F# arithmetic extensively, so a mistake in the implementation of F# arithmetic +/// in the core library used by the F# compiler will propagate to be a mistake in optimization. +/// The IL instructions appear in the tree through inlining. let mkAssemblyCodeValueInfo g instrs argvals tys = match instrs, argvals, tys with | [ AI_add ], [t1;t2], _ -> @@ -939,24 +1006,20 @@ let mkAssemblyCodeValueInfo g instrs argvals tys = let [] localVarSize = 1 -let inline AddTotalSizes l = l |> List.sumBy (fun x -> x.TotalSize) -let inline AddFunctionSizes l = l |> List.sumBy (fun x -> x.FunctionSize) +let AddTotalSizes l = l |> List.sumBy (fun x -> x.TotalSize) -//------------------------------------------------------------------------- -// opt list/array combinators - zipping (_, _) return type -//------------------------------------------------------------------------- -let inline OrEffects l = List.exists (fun x -> x.HasEffect) l +let AddFunctionSizes l = l |> List.sumBy (fun x -> x.FunctionSize) + +/// list/array combinators - zipping (_, _) return type +let OrEffects l = List.exists (fun x -> x.HasEffect) l -let inline OrTailcalls l = List.exists (fun x -> x.MightMakeCriticalTailcall) l +let OrTailcalls l = List.exists (fun x -> x.MightMakeCriticalTailcall) l let OptimizeList f l = l |> List.map f |> List.unzip let NoExprs : (Expr list * list>) = [], [] -//------------------------------------------------------------------------- -// Common ways of building new value infos -//------------------------------------------------------------------------- - +/// Common ways of building new value infos let CombineValueInfos einfos res = { TotalSize = AddTotalSizes einfos FunctionSize = AddFunctionSizes einfos @@ -966,10 +1029,7 @@ let CombineValueInfos einfos res = let CombineValueInfosUnknown einfos = CombineValueInfos einfos UnknownValue -//------------------------------------------------------------------------- -// Hide information because of a signature -//------------------------------------------------------------------------- - +/// Hide information because of a signature let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = // The freevars and FreeTyvars can indicate if the non-public (hidden) items have been used. @@ -984,17 +1044,18 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = let rec abstractExprInfo ivalue = match ivalue with - (* Check for escaping value. Revert to old info if possible *) + // Check for escaping value. Revert to old info if possible | ValValue (vref2, detail) -> - let detail' = abstractExprInfo detail + let detailR = abstractExprInfo detail let v2 = vref2.Deref let tyvars = freeInVal CollectAll v2 if (isAssemblyBoundary && not (freeTyvarsAllPublic tyvars)) || Zset.exists hiddenTycon tyvars.FreeTycons || hiddenVal v2 - then detail' - else ValValue (vref2, detail') + then detailR + else ValValue (vref2, detailR) + // Check for escape in lambda | CurriedLambdaValue (_, _, _, expr, _) | ConstExprValue(_, expr) when (let fvs = freeInExpr CollectAll expr @@ -1005,37 +1066,47 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = Zset.exists hiddenRecdField fvs.FreeRecdFields || Zset.exists hiddenUnionCase fvs.FreeUnionCases ) -> UnknownValue + // Check for escape in constant | ConstValue(_, ty) when (let ftyvs = freeInType CollectAll ty (isAssemblyBoundary && not (freeTyvarsAllPublic ftyvs)) || Zset.exists hiddenTycon ftyvs.FreeTycons) -> UnknownValue + | TupleValue vinfos -> TupleValue (Array.map abstractExprInfo vinfos) + | RecdValue (tcref, vinfos) -> if hiddenTyconRepr tcref.Deref || Array.exists (tcref.MakeNestedRecdFieldRef >> hiddenRecdField) tcref.AllFieldsArray then UnknownValue else RecdValue (tcref, Array.map abstractExprInfo vinfos) + | UnionCaseValue(ucref, vinfos) -> let tcref = ucref.TyconRef if hiddenTyconRepr ucref.Tycon || tcref.UnionCasesArray |> Array.exists (tcref.MakeNestedUnionCaseRef >> hiddenUnionCase) then UnknownValue else UnionCaseValue (ucref, Array.map abstractExprInfo vinfos) - | SizeValue(_vdepth, vinfo) -> MakeSizedValueInfo (abstractExprInfo vinfo) + + | SizeValue(_vdepth, vinfo) -> + MakeSizedValueInfo (abstractExprInfo vinfo) + | UnknownValue | ConstExprValue _ | CurriedLambdaValue _ | ConstValue _ -> ivalue + and abstractValInfo v = { ValExprInfo=abstractExprInfo v.ValExprInfo ValMakesNoCriticalTailcalls=v.ValMakesNoCriticalTailcalls } + and abstractModulInfo ss = { ModuleOrNamespaceInfos = NameMap.map abstractLazyModulInfo ss.ModuleOrNamespaceInfos ValInfos = ValInfos(ss.ValInfos.Entries |> Seq.filter (fun (vref, _) -> not (hiddenVal vref.Deref)) |> Seq.map (fun (vref, e) -> check (* "its implementation uses a binding hidden by a signature" m *) vref (abstractValInfo e) )) } + and abstractLazyModulInfo (ss:LazyModuleInfo) = ss.Force() |> abstractModulInfo |> notlazy @@ -1047,15 +1118,12 @@ let AbstractOptimizationInfoToEssentials = let rec abstractModulInfo (ss:ModuleInfo) = { ModuleOrNamespaceInfos = NameMap.map (Lazy.force >> abstractModulInfo >> notlazy) ss.ModuleOrNamespaceInfos ValInfos = ss.ValInfos.Filter (fun (v, _) -> v.MustInline) } + and abstractLazyModulInfo ss = ss |> Lazy.force |> abstractModulInfo |> notlazy abstractLazyModulInfo - -//------------------------------------------------------------------------- -// Hide information because of a "let ... in ..." or "let rec ... in ... " -//------------------------------------------------------------------------- - +/// Hide information because of a "let ... in ..." or "let rec ... in ... " let AbstractExprInfoByVars (boundVars:Val list, boundTyVars) ivalue = // Module and member bindings can be skipped when checking abstraction, since abstraction of these values has already been done when // we hit the end of the module and called AbstractLazyModulInfoByHiding. If we don't skip these then we end up quadtratically retraversing @@ -1079,8 +1147,8 @@ let AbstractExprInfoByVars (boundVars:Val list, boundTyVars) ivalue = abstractExprInfo detail | ValValue (v2, detail) -> - let detail' = abstractExprInfo detail - ValValue (v2, detail') + let detailR = abstractExprInfo detail + ValValue (v2, detailR) // Check for escape in lambda | CurriedLambdaValue (_, _, _, expr, _) | ConstExprValue(_, expr) when @@ -1120,10 +1188,8 @@ let AbstractExprInfoByVars (boundVars:Val list, boundTyVars) ivalue = abstractExprInfo ivalue -//------------------------------------------------------------------------- -// Remap optimization information, e.g. to use public stable references so we can pickle it -// to disk. -//------------------------------------------------------------------------- +/// Remap optimization information, e.g. to use public stable references so we can pickle it +/// to disk. let RemapOptimizationInfo g tmenv = let rec remapExprInfo ivalue = @@ -1138,25 +1204,26 @@ let RemapOptimizationInfo g tmenv = | ConstValue (c, ty) -> ConstValue (c, remapPossibleForallTy g tmenv ty) | ConstExprValue (sz, expr) -> ConstExprValue (sz, remapExpr g CloneAll tmenv expr) - let remapValInfo v = { ValExprInfo=remapExprInfo v.ValExprInfo; ValMakesNoCriticalTailcalls=v.ValMakesNoCriticalTailcalls } + let remapValInfo v = + { ValExprInfo=remapExprInfo v.ValExprInfo + ValMakesNoCriticalTailcalls=v.ValMakesNoCriticalTailcalls } + let rec remapModulInfo ss = { ModuleOrNamespaceInfos = ss.ModuleOrNamespaceInfos |> NameMap.map remapLazyModulInfo - ValInfos = ss.ValInfos.Map (fun (vref, vinfo) -> - let vref' = remapValRef tmenv vref - let vinfo = remapValInfo vinfo - // Propagate any inferred ValMakesNoCriticalTailcalls flag from implementation to signature information - if vinfo.ValMakesNoCriticalTailcalls then vref'.Deref.SetMakesNoCriticalTailcalls() - (vref', vinfo)) } + ValInfos = + ss.ValInfos.Map (fun (vref, vinfo) -> + let vrefR = remapValRef tmenv vref + let vinfo = remapValInfo vinfo + // Propagate any inferred ValMakesNoCriticalTailcalls flag from implementation to signature information + if vinfo.ValMakesNoCriticalTailcalls then vrefR.Deref.SetMakesNoCriticalTailcalls() + (vrefR, vinfo)) } and remapLazyModulInfo ss = ss |> Lazy.force |> remapModulInfo |> notlazy remapLazyModulInfo -//------------------------------------------------------------------------- -// Hide information when a value is no longer visible -//------------------------------------------------------------------------- - +/// Hide information when a value is no longer visible let AbstractAndRemapModulInfo msg g m (repackage, hidden) info = let mrpi = mkRepackageRemapping repackage #if DEBUG @@ -1217,6 +1284,16 @@ let ValueOfExpr expr = // member x.Next = let (SingleUnion i) = x in SingleUnion (i+1) // // See https://github.com/Microsoft/visualfsharp/issues/5136 +// +// +// note: allocating an object with observable identity (i.e. a name) +// or reading from a mutable field counts as an 'effect', i.e. +// this context 'effect' has it's usual meaning in the effect analysis literature of +// read-from-mutable +// write-to-mutable +// name-generation +// arbitrary-side-effect (e.g. 'non-termination' or 'fire the missiles') + let IsDiscardableEffectExpr expr = match expr with | Expr.Op (TOp.LValueOp (LByrefGet _, _), [], [], _) -> true @@ -1234,10 +1311,6 @@ let ValueIsUsedOrHasEffect cenv fvs (b:Binding, binfo) = let rec SplitValuesByIsUsedOrHasEffect cenv fvs x = x |> List.filter (ValueIsUsedOrHasEffect cenv fvs) |> List.unzip -//------------------------------------------------------------------------- -// -//------------------------------------------------------------------------- - let IlAssemblyCodeInstrHasEffect i = match i with | ( AI_nop | AI_ldc _ | AI_add | AI_sub | AI_mul | AI_xor | AI_and | AI_or @@ -1248,18 +1321,6 @@ let IlAssemblyCodeInstrHasEffect i = let IlAssemblyCodeHasEffect instrs = List.exists IlAssemblyCodeInstrHasEffect instrs -//------------------------------------------------------------------------- -// Effects -// -// note: allocating an object with observable identity (i.e. a name) -// or reading from a mutable field counts as an 'effect', i.e. -// this context 'effect' has it's usual meaning in the effect analysis literature of -// read-from-mutable -// write-to-mutable -// name-generation -// arbitrary-side-effect (e.g. 'non-termination' or 'fire the missiles') -//------------------------------------------------------------------------- - let rec ExprHasEffect g expr = match expr with | Expr.Val (vref, _, _) -> vref.IsTypeFunction || (vref.IsMutable) @@ -1274,9 +1335,13 @@ let rec ExprHasEffect g expr = | Expr.Let(bind, body, _, _) -> BindingHasEffect g bind || ExprHasEffect g body // REVIEW: could add Expr.Obj on an interface type - these are similar to records of lambda expressions | _ -> true + and ExprsHaveEffect g exprs = List.exists (ExprHasEffect g) exprs + and BindingsHaveEffect g binds = List.exists (BindingHasEffect g) binds + and BindingHasEffect g bind = bind.Expr |> ExprHasEffect g + and OpHasEffect g m op = match op with | TOp.Tuple _ -> false @@ -1393,11 +1458,9 @@ let TryEliminateBinding cenv _env (TBind(vspec1, e1, spBind)) e2 _m = let TryEliminateLet cenv env bind e2 m = match TryEliminateBinding cenv env bind e2 m with - | Some e2' -> e2', -localVarSize (* eliminated a let, hence reduce size estimate *) + | Some e2R -> e2R, -localVarSize (* eliminated a let, hence reduce size estimate *) | None -> mkLetBind m bind e2 , 0 -//------------------------------------------------------------------------- - /// Detect the application of a value to an arbitrary number of arguments let rec (|KnownValApp|_|) expr = match stripExpr expr with @@ -1482,7 +1545,6 @@ let rec CombineBoolLogic expr = | _ -> expr - //------------------------------------------------------------------------- // ExpandStructuralBinding // @@ -1499,6 +1561,7 @@ let CanExpandStructuralBinding (v: Val) = not v.IsMutable let ExprIsValue = function Expr.Val _ -> true | _ -> false + let ExpandStructuralBindingRaw cenv expr = match expr with | Expr.Let (TBind(v, rhs, tgtSeqPtOpt), body, m, _) @@ -1517,7 +1580,6 @@ let ExpandStructuralBindingRaw cenv expr = let ves, binds = List.mapi2 argBind args argTys |> List.unzip let tuple = mkRefTupled cenv.g m ves argTys mkLetsBind m binds (mkLet tgtSeqPtOpt m v tuple body) - (* REVIEW: other cases - records, explicit lists etc. *) | expr -> expr // Moves outer tuple binding inside near the tupled expression: @@ -1548,16 +1610,8 @@ let ExpandStructuralBinding cenv expr = | None -> expr | e -> ExpandStructuralBindingRaw cenv e -//------------------------------------------------------------------------- -// QueryBuilder.Run elimination helpers -//------------------------------------------------------------------------- - /// Detect a query { ... } let (|QueryRun|_|) g expr = -//#if DEBUG -// g.query_run_value_vref.Deref |> ignore -// g.query_run_enumerable_vref.Deref |> ignore -//#endif match expr with | Expr.App(Expr.Val (vref, _, _), _, _, [_builder; arg], _) when valRefEq g vref g.query_run_value_vref -> Some (arg, None) @@ -1567,16 +1621,13 @@ let (|QueryRun|_|) g expr = None let (|MaybeRefTupled|) e = tryDestRefTupleExpr e + let (|AnyInstanceMethodApp|_|) e = match e with | Expr.App(Expr.Val (vref, _, _), _, tyargs, [obj; MaybeRefTupled args], _) -> Some (vref, tyargs, obj, args) | _ -> None let (|InstanceMethodApp|_|) g (expectedValRef:ValRef) e = -//#if DEBUG -// expectedValRef.Deref |> ignore -//#endif - //printfn "for vref = %A" (expectedValRef.TryDeref |> Option.map (fun x -> x.DisplayName)) match e with | AnyInstanceMethodApp (vref, tyargs, obj, args) when valRefEq g vref expectedValRef -> Some (tyargs, obj, args) | _ -> None @@ -1589,7 +1640,6 @@ let (|QueryFor|_|) g = function | InstanceMethodApp g g.query_for_vref ([srcTy;qTy;resTy;_qInnerTy], _builder, [src;selector]) -> Some (qTy, srcTy, resTy, src, selector) | _ -> None - let (|QueryYield|_|) g = function | InstanceMethodApp g g.query_yield_vref ([resTy;qTy], _builder, [res]) -> Some (qTy, resTy, res) | _ -> None @@ -1623,7 +1673,7 @@ let mkUnitDelayLambda (g: TcGlobals) m e = let uv, _ = mkCompGenLocal m "unitVar" g.unit_ty mkLambda m uv (e, tyOfExpr g e) - +/// If this returns "Some" then the source is not IQueryable. // := // | query.Select(, ) --> Seq.map(qexprInner', ...) // | query.For(, ) --> IQueryable if qexprInner is IQueryable, otherwise Seq.collect(qexprInner', ...) @@ -1638,9 +1688,6 @@ let mkUnitDelayLambda (g: TcGlobals) m e = // | query.Yield --> not IQueryable, seq { } // | query.YieldFrom --> not IQueryable, seq { yield! } // | query.Op(, ) --> IQueryable if qexprOuter is IQueryable, otherwise query.Op(qexpOuter', ) - -//printfn "found Query.Quote" -// If this returns "Some" then the source is not IQueryable. let rec tryRewriteToSeqCombinators g (e: Expr) = let m = e.Range match e with @@ -1690,13 +1737,11 @@ let rec tryRewriteToSeqCombinators g (e: Expr) = None -// This detects forms arising from query expressions, i.e. -// query.Run <@ query.Op(, ) @> -// -// We check if the combinators are marked with tag IEnumerable - if do, we optimize the "Run" and quotation away, since RunQueryAsEnumerable simply performs -// an eval. - - +/// This detects forms arising from query expressions, i.e. +/// query.Run <@ query.Op(, ) @> +/// +/// We check if the combinators are marked with tag IEnumerable - if do, we optimize the "Run" and quotation away, since RunQueryAsEnumerable simply performs +/// an eval. let TryDetectQueryQuoteAndRun cenv (expr:Expr) = let g = cenv.g match expr with @@ -1781,10 +1826,7 @@ let IsILMethodRefSystemStringConcatArray (ilg: ILGlobals) (mref: ILMethodRef) = mref.ReturnType.BasicQualifiedName = ilg.typ_String.BasicQualifiedName && mref.ArgCount = 1 && mref.ArgTypes.Head.BasicQualifiedName = "System.String[]" -//------------------------------------------------------------------------- -// The traversal -//------------------------------------------------------------------------- - +/// Optimize/analyze an expression let rec OptimizeExpr cenv (env:IncrementalOptimizationEnv) expr = // Eliminate subsumption coercions for functions. This must be done post-typechecking because we need @@ -1795,10 +1837,18 @@ let rec OptimizeExpr cenv (env:IncrementalOptimizationEnv) expr = match expr with // treat the common linear cases to avoid stack overflows, using an explicit continuation - | Expr.Sequential _ | Expr.Let _ -> OptimizeLinearExpr cenv env expr (fun x -> x) + | LinearOpExpr _ + | LinearMatchExpr _ + | Expr.Sequential _ + | Expr.Let _ -> + OptimizeLinearExpr cenv env expr (fun x -> x) + + | Expr.Const (c, m, ty) -> + OptimizeConst cenv env expr (c, m, ty) + + | Expr.Val (v, _vFlags, m) -> + OptimizeVal cenv env expr (v, m) - | Expr.Const (c, m, ty) -> OptimizeConst cenv env expr (c, m, ty) - | Expr.Val (v, _vFlags, m) -> OptimizeVal cenv env expr (v, m) | Expr.Quote(ast, splices, isFromQueryExpression, m, ty) -> let splices = ref (splices.Value |> Option.map (map3Of4 (List.map (OptimizeExpr cenv env >> fst)))) Expr.Quote(ast, splices, isFromQueryExpression, m, ty), @@ -1807,94 +1857,101 @@ let rec OptimizeExpr cenv (env:IncrementalOptimizationEnv) expr = HasEffect = false MightMakeCriticalTailcall=false Info=UnknownValue } - | Expr.Obj (_, ty, basev, expr, overrides, iimpls, m) -> OptimizeObjectExpr cenv env (ty, basev, expr, overrides, iimpls, m) - | Expr.Op (c, tyargs, args, m) -> OptimizeExprOp cenv env (c, tyargs, args, m) + + | Expr.Obj (_, ty, basev, createExpr, overrides, iimpls, m) -> + OptimizeObjectExpr cenv env (ty, basev, createExpr, overrides, iimpls, m) + + | Expr.Op (op, tyargs, args, m) -> + OptimizeExprOp cenv env (op, tyargs, args, m) + | Expr.App(f, fty, tyargs, argsl, m) -> // eliminate uses of query match TryDetectQueryQuoteAndRun cenv expr with | Some newExpr -> OptimizeExpr cenv env newExpr | None -> OptimizeApplication cenv env (f, fty, tyargs, argsl, m) - (* REVIEW: fold the next two cases together *) + | Expr.Lambda(_lambdaId, _, _, argvs, _body, m, rty) -> let topValInfo = ValReprInfo ([], [argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)], ValReprInfo.unnamedRetVal) let ty = mkMultiLambdaTy m argvs rty OptimizeLambdas None cenv env topValInfo expr ty + | Expr.TyLambda(_lambdaId, tps, _body, _m, rty) -> let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps, [], ValReprInfo.unnamedRetVal) let ty = mkForallTyIfNeeded tps rty OptimizeLambdas None cenv env topValInfo expr ty - | Expr.TyChoose _ -> OptimizeExpr cenv env (TypeRelations.ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr) - | Expr.Match(spMatch, exprm, dtree, targets, m, ty) -> OptimizeMatch cenv env (spMatch, exprm, dtree, targets, m, ty) - | Expr.LetRec (binds, e, m, _) -> OptimizeLetRec cenv env (binds, e, m) - | Expr.StaticOptimization (constraints, e2, e3, m) -> - let e2', e2info = OptimizeExpr cenv env e2 - let e3', e3info = OptimizeExpr cenv env e3 - Expr.StaticOptimization(constraints, e2', e3', m), + + | Expr.TyChoose _ -> + OptimizeExpr cenv env (TypeRelations.ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr) + + | Expr.Match(spMatch, exprm, dtree, targets, m, ty) -> + OptimizeMatch cenv env (spMatch, exprm, dtree, targets, m, ty) + + | Expr.LetRec (binds, bodyExpr, m, _) -> + OptimizeLetRec cenv env (binds, bodyExpr, m) + + | Expr.StaticOptimization (constraints, expr2, expr3, m) -> + let expr2R, e2info = OptimizeExpr cenv env expr2 + let expr3R, e3info = OptimizeExpr cenv env expr3 + Expr.StaticOptimization(constraints, expr2R, expr3R, m), { TotalSize = min e2info.TotalSize e3info.TotalSize FunctionSize = min e2info.FunctionSize e3info.FunctionSize HasEffect = e2info.HasEffect || e3info.HasEffect MightMakeCriticalTailcall=e2info.MightMakeCriticalTailcall || e3info.MightMakeCriticalTailcall // seems conservative Info= UnknownValue } + | Expr.Link _eref -> assert ("unexpected reclink" = "") failwith "Unexpected reclink" -//------------------------------------------------------------------------- -// Optimize/analyze an object expression -//------------------------------------------------------------------------- - +/// Optimize/analyze an object expression and OptimizeObjectExpr cenv env (ty, baseValOpt, basecall, overrides, iimpls, m) = - let basecall', basecallinfo = OptimizeExpr cenv env basecall - let overrides', overrideinfos = OptimizeMethods cenv env baseValOpt overrides - let iimpls', iimplsinfos = OptimizeInterfaceImpls cenv env baseValOpt iimpls - let expr'=mkObjExpr(ty, baseValOpt, basecall', overrides', iimpls', m) - expr', { TotalSize=closureTotalSize + basecallinfo.TotalSize + AddTotalSizes overrideinfos + AddTotalSizes iimplsinfos + let basecallR, basecallinfo = OptimizeExpr cenv env basecall + let overridesR, overrideinfos = OptimizeMethods cenv env baseValOpt overrides + let iimplsR, iimplsinfos = OptimizeInterfaceImpls cenv env baseValOpt iimpls + let exprR=mkObjExpr(ty, baseValOpt, basecallR, overridesR, iimplsR, m) + exprR, { TotalSize=closureTotalSize + basecallinfo.TotalSize + AddTotalSizes overrideinfos + AddTotalSizes iimplsinfos FunctionSize=1 (* a newobj *) HasEffect=true MightMakeCriticalTailcall=false // creating an object is not a useful tailcall Info=UnknownValue} -//------------------------------------------------------------------------- -// Optimize/analyze the methods that make up an object expression -//------------------------------------------------------------------------- +/// Optimize/analyze the methods that make up an object expression +and OptimizeMethods cenv env baseValOpt methods = + OptimizeList (OptimizeMethod cenv env baseValOpt) methods -and OptimizeMethods cenv env baseValOpt l = OptimizeList (OptimizeMethod cenv env baseValOpt) l and OptimizeMethod cenv env baseValOpt (TObjExprMethod(slotsig, attribs, tps, vs, e, m) as tmethod) = let env = {env with latestBoundId=Some tmethod.Id; functionVal = None} let env = BindTypeVarsToUnknown tps env let env = BindInternalValsToUnknown cenv vs env let env = Option.foldBack (BindInternalValToUnknown cenv) baseValOpt env - let e', einfo = OptimizeExpr cenv env e - (* REVIEW: if we ever change this from being UnknownValue then we should call AbstractExprInfoByVars *) - TObjExprMethod(slotsig, attribs, tps, vs, e', m), + let eR, einfo = OptimizeExpr cenv env e + // Note: if we ever change this from being UnknownValue then we should call AbstractExprInfoByVars + TObjExprMethod(slotsig, attribs, tps, vs, eR, m), { TotalSize = einfo.TotalSize FunctionSize = 0 HasEffect = false MightMakeCriticalTailcall=false Info=UnknownValue} -//------------------------------------------------------------------------- -// Optimize/analyze the interface implementations that form part of an object expression -//------------------------------------------------------------------------- +/// Optimize/analyze the interface implementations that form part of an object expression +and OptimizeInterfaceImpls cenv env baseValOpt iimpls = + OptimizeList (OptimizeInterfaceImpl cenv env baseValOpt) iimpls -and OptimizeInterfaceImpls cenv env baseValOpt l = OptimizeList (OptimizeInterfaceImpl cenv env baseValOpt) l +/// Optimize/analyze the interface implementations that form part of an object expression and OptimizeInterfaceImpl cenv env baseValOpt (ty, overrides) = - let overrides', overridesinfos = OptimizeMethods cenv env baseValOpt overrides - (ty, overrides'), + let overridesR, overridesinfos = OptimizeMethods cenv env baseValOpt overrides + (ty, overridesR), { TotalSize = AddTotalSizes overridesinfos FunctionSize = 1 HasEffect = false MightMakeCriticalTailcall=false Info=UnknownValue} -//------------------------------------------------------------------------- -// Make and optimize String.Concat calls -//------------------------------------------------------------------------- - +/// Make and optimize String.Concat calls and MakeOptimizedSystemStringConcatCall cenv env m args = - let rec optimizeArg e accArgs = - match e, accArgs with - | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, mref, _, _, _), _, [ Expr.Op(TOp.Array, _, args, _) ], _), _ when IsILMethodRefSystemStringConcatArray cenv.g.ilg mref -> + let rec optimizeArg argExpr accArgs = + match argExpr, accArgs with + | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, methRef, _, _, _), _, [ Expr.Op(TOp.Array, _, args, _) ], _), _ when IsILMethodRefSystemStringConcatArray cenv.g.ilg methRef -> optimizeArgs args accArgs | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, mref, _, _, _), _, args, _), _ when IsILMethodRefSystemStringConcatOverload cenv.g.ilg mref -> @@ -1912,7 +1969,7 @@ and MakeOptimizedSystemStringConcatCall cenv env m args = let args = optimizeArgs args [] - let e = + let expr = match args with | [ arg ] -> arg @@ -1926,25 +1983,22 @@ and MakeOptimizedSystemStringConcatCall cenv env m args = let arg = mkArray (cenv.g.string_ty, args, m) mkStaticCall_String_Concat_Array cenv.g m arg - match e with - | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, mref, _, _, _) as op, tyargs, args, m) when IsILMethodRefSystemStringConcatOverload cenv.g.ilg mref || IsILMethodRefSystemStringConcatArray cenv.g.ilg mref -> + match expr with + | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, methRef, _, _, _) as op, tyargs, args, m) when IsILMethodRefSystemStringConcatOverload cenv.g.ilg methRef || IsILMethodRefSystemStringConcatArray cenv.g.ilg methRef -> OptimizeExprOpReductions cenv env (op, tyargs, args, m) | _ -> - OptimizeExpr cenv env e - -//------------------------------------------------------------------------- -// Optimize/analyze an application of an intrinsic operator to arguments -//------------------------------------------------------------------------- + OptimizeExpr cenv env expr +/// Optimize/analyze an application of an intrinsic operator to arguments and OptimizeExprOp cenv env (op, tyargs, args, m) = // Special cases match op, tyargs, args with - | TOp.Coerce, [toty;fromty], [e] -> - let e', einfo = OptimizeExpr cenv env e - if typeEquiv cenv.g toty fromty then e', einfo + | TOp.Coerce, [toty;fromty], [arg] -> + let argR, einfo = OptimizeExpr cenv env arg + if typeEquiv cenv.g toty fromty then argR, einfo else - mkCoerceExpr(e', toty, m, fromty), + mkCoerceExpr(argR, toty, m, fromty), { TotalSize=einfo.TotalSize + 1 FunctionSize=einfo.FunctionSize + 1 HasEffect = true @@ -1994,7 +2048,6 @@ and OptimizeExprOp cenv env (op, tyargs, args, m) = isArray1DTy cenv.g (tyOfExpr cenv.g arg)) -> OptimizeExpr cenv env (Expr.Op(TOp.ILAsm(i_ldlen, [cenv.g.int_ty]), [], [arg], m)) - // Empty IL instruction lists are used as casts in prim-types.fs. But we can get rid of them // if the types match up. | TOp.ILAsm([], [ty]), _, [a] when typeEquiv cenv.g (tyOfExpr cenv.g a) ty -> OptimizeExpr cenv env a @@ -2010,7 +2063,10 @@ and OptimizeExprOp cenv env (op, tyargs, args, m) = OptimizeExprOpReductions cenv env (op, tyargs, args, m) and OptimizeExprOpReductions cenv env (op, tyargs, args, m) = - let args', arginfos = OptimizeExprsThenConsiderSplits cenv env args + let argsR, arginfos = OptimizeExprsThenConsiderSplits cenv env args + OptimizeExprOpReductionsAfter cenv env (op, tyargs, argsR, arginfos, m) + +and OptimizeExprOpReductionsAfter cenv env (op, tyargs, argsR, arginfos, m) = let knownValue = match op, arginfos with | TOp.ValFieldGet (rf), [e1info] -> TryOptimizeRecordFieldGet cenv env (e1info, rf, tyargs, m) @@ -2021,11 +2077,11 @@ and OptimizeExprOpReductions cenv env (op, tyargs, args, m) = | Some valu -> match TryOptimizeVal cenv env (false, valu, m) with | Some res -> OptimizeExpr cenv env res (* discard e1 since guard ensures it has no effects *) - | None -> OptimizeExprOpFallback cenv env (op, tyargs, args', m) arginfos valu - | None -> OptimizeExprOpFallback cenv env (op, tyargs, args', m) arginfos UnknownValue + | None -> OptimizeExprOpFallback cenv env (op, tyargs, argsR, m) arginfos valu + | None -> OptimizeExprOpFallback cenv env (op, tyargs, argsR, m) arginfos UnknownValue -and OptimizeExprOpFallback cenv env (op, tyargs, args', m) arginfos valu = - // The generic case - we may collect information, but the construction/projection doesn't disappear +and OptimizeExprOpFallback cenv env (op, tyargs, argsR, m) arginfos valu = + // The generic case - we may collect information, but the construction/projection doesnRt disappear let argsTSize = AddTotalSizes arginfos let argsFSize = AddFunctionSizes arginfos let argEffects = OrEffects arginfos @@ -2099,20 +2155,17 @@ and OptimizeExprOpFallback cenv env (op, tyargs, args', m) arginfos valu = match TryOptimizeValInfo cenv env m vinfo with | Some res -> res, vinfo | None -> - Expr.Op(op, tyargs, args', m), + Expr.Op(op, tyargs, argsR, m), { TotalSize=argsTSize + cost FunctionSize=argsFSize + cost HasEffect=argEffects || effect MightMakeCriticalTailcall= mayBeCriticalTailcall // discard tailcall info for args - these are not in tailcall position Info=valu } -//------------------------------------------------------------------------- -// Optimize/analyze a constant node -//------------------------------------------------------------------------- - +/// Optimize/analyze a constant node and OptimizeConst cenv env expr (c, m, ty) = match TryEliminateDesugaredConstants cenv.g m c with - | Some(e) -> + | Some e -> OptimizeExpr cenv env e | None -> expr, { TotalSize=(match c with @@ -2123,10 +2176,7 @@ and OptimizeConst cenv env expr (c, m, ty) = MightMakeCriticalTailcall=false Info=MakeValueInfoForConst c ty} -//------------------------------------------------------------------------- -// Optimize/analyze a record lookup. -//------------------------------------------------------------------------- - +/// Optimize/analyze a record lookup. and TryOptimizeRecordFieldGet cenv _env (e1info, (RFRef (rtcref, _) as r), _tinst, m) = match destRecdValue e1info.Info with | Some finfos when cenv.settings.EliminateRecdFieldGet() && not e1info.HasEffect -> @@ -2135,7 +2185,7 @@ and TryOptimizeRecordFieldGet cenv _env (e1info, (RFRef (rtcref, _) as r), _tins | None -> let n = r.Index if n >= finfos.Length then errorR(InternalError( "TryOptimizeRecordFieldGet: term argument out of range", m)) - Some finfos.[n] (* Uses INVARIANT on record ValInfos that exprs are in defn order *) + Some finfos.[n] | _ -> None and TryOptimizeTupleFieldGet cenv _env (_tupInfo, e1info, tys, n, m) = @@ -2154,33 +2204,30 @@ and TryOptimizeUnionCaseGet cenv _env (e1info, cspec, _tys, n, m) = Some args.[n] | _ -> None -//------------------------------------------------------------------------- -// Optimize/analyze a for-loop -//------------------------------------------------------------------------- - +/// Optimize/analyze a for-loop and OptimizeFastIntegerForLoop cenv env (spStart, v, e1, dir, e2, e3, m) = - let e1', e1info = OptimizeExpr cenv env e1 - let e2', e2info = OptimizeExpr cenv env e2 + let e1R, e1info = OptimizeExpr cenv env e1 + let e2R, e2info = OptimizeExpr cenv env e2 let env = BindInternalValToUnknown cenv v env - let e3', e3info = OptimizeExpr cenv env e3 + let e3R, e3info = OptimizeExpr cenv env e3 // Try to replace F#-style loops with C# style loops that recompute their bounds but which are compiled more efficiently by the JITs, e.g. // F# "for x = 0 to arr.Length - 1 do ..." --> C# "for (int x = 0; x < arr.Length; x++) { ... }" // F# "for x = 0 to 10 do ..." --> C# "for (int x = 0; x < 11; x++) { ... }" - let e2', dir = - match dir, e2' with + let e2R, dir = + match dir, e2R with // detect upwards for loops with bounds of the form "arr.Length - 1" and convert them to a C#-style for loop | FSharpForLoopUp, Expr.Op(TOp.ILAsm([ (AI_sub | AI_sub_ovf)], _), _, [Expr.Op(TOp.ILAsm([ I_ldlen; (AI_conv DT_I4)], _), _, [arre], _); Expr.Const(Const.Int32 1, _, _)], _) when not (snd(OptimizeExpr cenv env arre)).HasEffect -> - mkLdlen cenv.g (e2'.Range) arre, CSharpForLoopUp + mkLdlen cenv.g (e2R.Range) arre, CSharpForLoopUp // detect upwards for loops with constant bounds, but not MaxValue! | FSharpForLoopUp, Expr.Const(Const.Int32 n, _, _) when n < System.Int32.MaxValue -> - mkIncr cenv.g (e2'.Range) e2', CSharpForLoopUp + mkIncr cenv.g (e2R.Range) e2R, CSharpForLoopUp | _ -> - e2', dir + e2R, dir let einfos = [e1info;e2info;e3info] let eff = OrEffects einfos @@ -2188,167 +2235,161 @@ and OptimizeFastIntegerForLoop cenv env (spStart, v, e1, dir, e2, e3, m) = if not eff then mkUnit cenv.g m , { TotalSize=0; FunctionSize=0; HasEffect=false; MightMakeCriticalTailcall=false; Info=UnknownValue } else - let expr' = mkFor cenv.g (spStart, v, e1', dir, e2', e3', m) - expr', { TotalSize=AddTotalSizes einfos + forAndWhileLoopSize + let exprR = mkFor cenv.g (spStart, v, e1R, dir, e2R, e3R, m) + exprR, { TotalSize=AddTotalSizes einfos + forAndWhileLoopSize FunctionSize=AddFunctionSizes einfos + forAndWhileLoopSize HasEffect=eff MightMakeCriticalTailcall=false Info=UnknownValue } -//------------------------------------------------------------------------- -// Optimize/analyze a set of recursive bindings -//------------------------------------------------------------------------- - +/// Optimize/analyze a set of recursive bindings and OptimizeLetRec cenv env (binds, bodyExpr, m) = let vs = binds |> List.map (fun v -> v.Var) let env = BindInternalValsToUnknown cenv vs env - let binds', env = OptimizeBindings cenv true env binds - let bodyExpr', einfo = OptimizeExpr cenv env bodyExpr + let bindsR, env = OptimizeBindings cenv true env binds + let bodyExprR, einfo = OptimizeExpr cenv env bodyExpr // REVIEW: graph analysis to determine which items are unused // Eliminate any unused bindings, as in let case - let binds'', bindinfos = - let fvs0 = freeInExpr CollectLocals bodyExpr' - let fvs = List.fold (fun acc x -> unionFreeVars acc (fst x |> freeInBindingRhs CollectLocals)) fvs0 binds' - SplitValuesByIsUsedOrHasEffect cenv (fun () -> fvs.FreeLocals) binds' + let bindsRR, bindinfos = + let fvs0 = freeInExpr CollectLocals bodyExprR + let fvs = List.fold (fun acc x -> unionFreeVars acc (fst x |> freeInBindingRhs CollectLocals)) fvs0 bindsR + SplitValuesByIsUsedOrHasEffect cenv (fun () -> fvs.FreeLocals) bindsR // Trim out any optimization info that involves escaping values - let evalue' = AbstractExprInfoByVars (vs, []) einfo.Info + let evalueR = AbstractExprInfoByVars (vs, []) einfo.Info // REVIEW: size of constructing new closures - should probably add #freevars + #recfixups here - let bodyExpr' = Expr.LetRec(binds'', bodyExpr', m, NewFreeVarsCache()) - let info = CombineValueInfos (einfo :: bindinfos) evalue' - bodyExpr', info - -//------------------------------------------------------------------------- -// Optimize/analyze a linear sequence of sequentioanl execution or 'let' bindings. -//------------------------------------------------------------------------- + let bodyExprR = Expr.LetRec(bindsRR, bodyExprR, m, NewFreeVarsCache()) + let info = CombineValueInfos (einfo :: bindinfos) evalueR + bodyExprR, info +/// Optimize/analyze a linear sequence of sequential execution or RletR bindings. and OptimizeLinearExpr cenv env expr contf = + // Eliminate subsumption coercions for functions. This must be done post-typechecking because we need + // complete inference types. let expr = DetectAndOptimizeForExpression cenv.g OptimizeAllForExpressions expr - let expr = if cenv.settings.ExpandStructrualValues() then ExpandStructuralBinding cenv expr else expr + let expr = stripExpr expr + match expr with | Expr.Sequential (e1, e2, flag, spSeq, m) -> - let e1', e1info = OptimizeExpr cenv env e1 - OptimizeLinearExpr cenv env e2 (contf << (fun (e2', e2info) -> + let e1R, e1info = OptimizeExpr cenv env e1 + OptimizeLinearExpr cenv env e2 (contf << (fun (e2R, e2info) -> if (flag = NormalSeq) && // Always eliminate '(); expr' sequences, even in debug code, to ensure that // conditional method calls don't leave a dangling breakpoint (see FSharp 1.0 bug 6034) - (cenv.settings.EliminateSequential () || (match e1' with Expr.Const(Const.Unit, _, _) -> true | _ -> false)) && + (cenv.settings.EliminateSequential () || (match e1R with Expr.Const(Const.Unit, _, _) -> true | _ -> false)) && not e1info.HasEffect then - e2', e2info + e2R, e2info else - Expr.Sequential(e1', e2', flag, spSeq, m), + Expr.Sequential(e1R, e2R, flag, spSeq, m), { TotalSize = e1info.TotalSize + e2info.TotalSize FunctionSize = e1info.FunctionSize + e2info.FunctionSize HasEffect = flag <> NormalSeq || e1info.HasEffect || e2info.HasEffect - MightMakeCriticalTailcall = (if flag = NormalSeq then e2info.MightMakeCriticalTailcall else e1info.MightMakeCriticalTailcall || e2info.MightMakeCriticalTailcall) - Info = UnknownValue (* can't propagate value: must access result of computation for its effects *) })) + MightMakeCriticalTailcall = + (if flag = NormalSeq then e2info.MightMakeCriticalTailcall + else e1info.MightMakeCriticalTailcall || e2info.MightMakeCriticalTailcall) + // can't propagate value: must access result of computation for its effects + Info = UnknownValue })) | Expr.Let (bind, body, m, _) -> - let (bind', bindingInfo), env = OptimizeBinding cenv false env bind - OptimizeLinearExpr cenv env body (contf << (fun (body', bodyInfo) -> + let (bindR, bindingInfo), env = OptimizeBinding cenv false env bind + OptimizeLinearExpr cenv env body (contf << (fun (bodyR, bodyInfo) -> // PERF: This call to ValueIsUsedOrHasEffect/freeInExpr amounts to 9% of all optimization time. // Is it quadratic or quasi-quadtratic? - if ValueIsUsedOrHasEffect cenv (fun () -> (freeInExpr CollectLocals body').FreeLocals) (bind', bindingInfo) then - (* Eliminate let bindings on the way back up *) - let expr', adjust = TryEliminateLet cenv env bind' body' m - expr', + if ValueIsUsedOrHasEffect cenv (fun () -> (freeInExpr CollectLocals bodyR).FreeLocals) (bindR, bindingInfo) then + // Eliminate let bindings on the way back up + let exprR, adjust = TryEliminateLet cenv env bindR bodyR m + exprR, { TotalSize = bindingInfo.TotalSize + bodyInfo.TotalSize + adjust FunctionSize = bindingInfo.FunctionSize + bodyInfo.FunctionSize + adjust HasEffect=bindingInfo.HasEffect || bodyInfo.HasEffect MightMakeCriticalTailcall = bodyInfo.MightMakeCriticalTailcall // discard tailcall info from binding - not in tailcall position Info = UnknownValue } else - (* On the way back up: Trim out any optimization info that involves escaping values on the way back up *) - let evalue' = AbstractExprInfoByVars ([bind'.Var], []) bodyInfo.Info - body', - { TotalSize = bindingInfo.TotalSize + bodyInfo.TotalSize - localVarSize (* eliminated a local var *) + // On the way back up: Trim out any optimization info that involves escaping values on the way back up + let evalueR = AbstractExprInfoByVars ([bindR.Var], []) bodyInfo.Info + bodyR, + { TotalSize = bindingInfo.TotalSize + bodyInfo.TotalSize - localVarSize // eliminated a local var FunctionSize = bindingInfo.FunctionSize + bodyInfo.FunctionSize - localVarSize (* eliminated a local var *) HasEffect=bindingInfo.HasEffect || bodyInfo.HasEffect MightMakeCriticalTailcall = bodyInfo.MightMakeCriticalTailcall // discard tailcall info from binding - not in tailcall position - Info = evalue' } )) + Info = evalueR } )) | LinearMatchExpr (spMatch, exprm, dtree, tg1, e2, spTarget2, m, ty) -> - let dtree, dinfo = OptimizeDecisionTree cenv env m dtree + let dtreeR, dinfo = OptimizeDecisionTree cenv env m dtree let tg1, tg1info = OptimizeDecisionTreeTarget cenv env m tg1 // tailcall OptimizeLinearExpr cenv env e2 (contf << (fun (e2, e2info) -> + // This ConsiderSplitToMethod is performed because it is present in OptimizeDecisionTreeTarget let e2, e2info = ConsiderSplitToMethod cenv.settings.abstractBigTargets cenv.settings.bigTargetSize cenv env (e2, e2info) let tinfos = [tg1info; e2info] - let tgs = [tg1; TTarget([], e2, spTarget2)] - RebuildOptimizedMatch (spMatch, exprm, m, ty, dtree, tgs, dinfo, tinfos))) + let targetsR = [tg1; TTarget([], e2, spTarget2)] + OptimizeMatchPart2 cenv (spMatch, exprm, dtreeR, targetsR, dinfo, tinfos, m, ty))) + + | LinearOpExpr (op, tyargs, argsHead, argLast, m) -> + let argsHeadR, argsHeadInfosR = OptimizeList (OptimizeExprThenConsiderSplit cenv env) argsHead + // tailcall + OptimizeLinearExpr cenv env argLast (contf << (fun (argLastR, argLastInfo) -> + OptimizeExprOpReductionsAfter cenv env (op, tyargs, argsHeadR @ [argLastR], argsHeadInfosR @ [argLastInfo], m))) | _ -> contf (OptimizeExpr cenv env expr) -//------------------------------------------------------------------------- -// Optimize/analyze a try/finally construct. -//------------------------------------------------------------------------- - +/// Optimize/analyze a try/finally construct. and OptimizeTryFinally cenv env (spTry, spFinally, e1, e2, m, ty) = - let e1', e1info = OptimizeExpr cenv env e1 - let e2', e2info = OptimizeExpr cenv env e2 + let e1R, e1info = OptimizeExpr cenv env e1 + let e2R, e2info = OptimizeExpr cenv env e2 let info = { TotalSize = e1info.TotalSize + e2info.TotalSize + tryFinallySize FunctionSize = e1info.FunctionSize + e2info.FunctionSize + tryFinallySize HasEffect = e1info.HasEffect || e2info.HasEffect MightMakeCriticalTailcall = false // no tailcalls from inside in try/finally Info = UnknownValue } - (* try-finally, so no effect means no exception can be raised, so just sequence the finally *) + // try-finally, so no effect means no exception can be raised, so just sequence the finally if cenv.settings.EliminateTryCatchAndTryFinally () && not e1info.HasEffect then let sp = match spTry with | SequencePointAtTry _ -> SequencePointsAtSeq | SequencePointInBodyOfTry -> SequencePointsAtSeq | NoSequencePointAtTry -> SuppressSequencePointOnExprOfSequential - Expr.Sequential(e1', e2', ThenDoSeq, sp, m), info + Expr.Sequential(e1R, e2R, ThenDoSeq, sp, m), info else - mkTryFinally cenv.g (e1', e2', m, ty, spTry, spFinally), + mkTryFinally cenv.g (e1R, e2R, m, ty, spTry, spFinally), info -//------------------------------------------------------------------------- -// Optimize/analyze a try/catch construct. -//------------------------------------------------------------------------- - +/// Optimize/analyze a try/catch construct. and OptimizeTryCatch cenv env (e1, vf, ef, vh, eh, m, ty, spTry, spWith) = - let e1', e1info = OptimizeExpr cenv env e1 + let e1R, e1info = OptimizeExpr cenv env e1 // try-catch, so no effect means no exception can be raised, so discard the catch if cenv.settings.EliminateTryCatchAndTryFinally () && not e1info.HasEffect then - e1', e1info + e1R, e1info else let envinner = BindInternalValToUnknown cenv vf (BindInternalValToUnknown cenv vh env) - let ef', efinfo = OptimizeExpr cenv envinner ef - let eh', ehinfo = OptimizeExpr cenv envinner eh + let efR, efinfo = OptimizeExpr cenv envinner ef + let ehR, ehinfo = OptimizeExpr cenv envinner eh let info = { TotalSize = e1info.TotalSize + efinfo.TotalSize+ ehinfo.TotalSize + tryCatchSize FunctionSize = e1info.FunctionSize + efinfo.FunctionSize+ ehinfo.FunctionSize + tryCatchSize HasEffect = e1info.HasEffect || efinfo.HasEffect || ehinfo.HasEffect MightMakeCriticalTailcall = false Info = UnknownValue } - mkTryWith cenv.g (e1', vf, ef', vh, eh', m, ty, spTry, spWith), + mkTryWith cenv.g (e1R, vf, efR, vh, ehR, m, ty, spTry, spWith), info -//------------------------------------------------------------------------- -// Optimize/analyze a while loop -//------------------------------------------------------------------------- - +/// Optimize/analyze a while loop and OptimizeWhileLoop cenv env (spWhile, marker, e1, e2, m) = - let e1', e1info = OptimizeExpr cenv env e1 - let e2', e2info = OptimizeExpr cenv env e2 - mkWhile cenv.g (spWhile, marker, e1', e2', m), + let e1R, e1info = OptimizeExpr cenv env e1 + let e2R, e2info = OptimizeExpr cenv env e2 + mkWhile cenv.g (spWhile, marker, e1R, e2R, m), { TotalSize = e1info.TotalSize + e2info.TotalSize + forAndWhileLoopSize FunctionSize = e1info.FunctionSize + e2info.FunctionSize + forAndWhileLoopSize - HasEffect = true (* may not terminate *) + HasEffect = true // may not terminate MightMakeCriticalTailcall = false Info = UnknownValue } -//------------------------------------------------------------------------- -// Optimize/analyze a call to a 'member' constraint. Try to resolve the call to -// a witness (should always be possible due to compulsory inlining of any -// code that contains calls to member constraints, except when analyzing -// not-yet-inlined generic code) -//------------------------------------------------------------------------- - - +/// Optimize/analyze a call to a 'member' constraint. Try to resolve the call to +/// a witness (should always be possible due to compulsory inlining of any +/// code that contains calls to member constraints, except when analyzing +/// not-yet-inlined generic code) and OptimizeTraitCall cenv env (traitInfo, args, m) = // Resolve the static overloading early (during the compulsory rewrite phase) so we can inline. @@ -2358,42 +2399,49 @@ and OptimizeTraitCall cenv env (traitInfo, args, m) = // Resolution fails when optimizing generic code, ignore the failure | _ -> - let args', arginfos = OptimizeExprsThenConsiderSplits cenv env args - OptimizeExprOpFallback cenv env (TOp.TraitCall(traitInfo), [], args', m) arginfos UnknownValue - -//------------------------------------------------------------------------- -// Make optimization decisions once we know the optimization information -// for a value -//------------------------------------------------------------------------- + let argsR, arginfos = OptimizeExprsThenConsiderSplits cenv env args + OptimizeExprOpFallback cenv env (TOp.TraitCall(traitInfo), [], argsR, m) arginfos UnknownValue +/// Make optimization decisions once we know the optimization information +/// for a value and TryOptimizeVal cenv env (mustInline, valInfoForVal, m) = + match valInfoForVal with // Inline all constants immediately - | ConstValue (c, ty) -> Some (Expr.Const (c, m, ty)) - | SizeValue (_, detail) -> TryOptimizeVal cenv env (mustInline, detail, m) - | ValValue (v', detail) -> + | ConstValue (c, ty) -> + Some (Expr.Const (c, m, ty)) + + | SizeValue (_, detail) -> + TryOptimizeVal cenv env (mustInline, detail, m) + + | ValValue (vR, detail) -> // Inline values bound to other values immediately + // Prefer to inline using the more specific info if possible + // If the more specific info didn't reveal an inline then use the value match TryOptimizeVal cenv env (mustInline, detail, m) with - // Prefer to inline using the more specific info if possible | Some e -> Some e - //If the more specific info didn't reveal an inline then use the value - | None -> Some(exprForValRef m v') + | None -> Some(exprForValRef m vR) + | ConstExprValue(_size, expr) -> Some (remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated expr)) + | CurriedLambdaValue (_, _, _, expr, _) when mustInline -> Some (remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated expr)) - | TupleValue _ | UnionCaseValue _ | RecdValue _ when mustInline -> failwith "tuple, union and record values cannot be marked 'inline'" - | UnknownValue when mustInline -> warning(Error(FSComp.SR.optValueMarkedInlineHasUnexpectedValue(), m)); None - | _ when mustInline -> warning(Error(FSComp.SR.optValueMarkedInlineCouldNotBeInlined(), m)); None + + | TupleValue _ | UnionCaseValue _ | RecdValue _ when mustInline -> + failwith "tuple, union and record values cannot be marked 'inline'" + + | UnknownValue when mustInline -> + warning(Error(FSComp.SR.optValueMarkedInlineHasUnexpectedValue(), m)); None + + | _ when mustInline -> + warning(Error(FSComp.SR.optValueMarkedInlineCouldNotBeInlined(), m)); None | _ -> None and TryOptimizeValInfo cenv env m vinfo = if vinfo.HasEffect then None else TryOptimizeVal cenv env (false, vinfo.Info , m) -//------------------------------------------------------------------------- -// Add 'v1 = v2' information into the information stored about a value -//------------------------------------------------------------------------- - +/// Add 'v1 = v2' information into the information stored about a value and AddValEqualityInfo g m (v:ValRef) info = // ValValue is information that v = v2, where v2 does not change // So we can't record this information for mutable values. An exception can be made @@ -2404,10 +2452,7 @@ and AddValEqualityInfo g m (v:ValRef) info = else {info with Info= MakeValueInfoForValue g m v info.Info} -//------------------------------------------------------------------------- -// Optimize/analyze a use of a value -//------------------------------------------------------------------------- - +/// Optimize/analyze a use of a value and OptimizeVal cenv env expr (v:ValRef, m) = let valInfoForVal = GetInfoForVal cenv env m v @@ -2436,10 +2481,7 @@ and OptimizeVal cenv env expr (v:ValRef, m) = FunctionSize=1 TotalSize=1}) -//------------------------------------------------------------------------- -// Attempt to replace an application of a value by an alternative value. -//------------------------------------------------------------------------- - +/// Attempt to replace an application of a value by an alternative value. and StripToNominalTyconRef cenv ty = match tryAppTy cenv.g ty with | ValueSome x -> x @@ -2524,7 +2566,6 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | Some (_, vref) -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) | _ -> None - // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparerFast | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_withc_inner_vref ty args -> let tcref, tyargs = StripToNominalTyconRef cenv ty @@ -2589,7 +2630,6 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = match vref with | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericEREqualityComparer cenv.g m :: args) m) | None -> None - // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityIntrinsic for tuple types // REVIEW (5537): GenericEqualityIntrinsic implements PER semantics, and we are replacing it to something also @@ -2649,7 +2689,6 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) | None -> None - // Calls to LanguagePrimitives.IntrinsicFunctions.UnboxGeneric can be optimized to calls to UnboxFast when we know that the // target type isn't 'NullNotLiked', i.e. that the target type is not an F# union, record etc. // Note UnboxFast is just the .NET IL 'unbox.any' instruction. @@ -2739,24 +2778,21 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) // Inlining lambda (* ---------- printf "Inlining lambda near %a = %s\n" outputRange m (showL (exprL f2)) (* JAMES: *) ----------*) - let f2' = remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated f2) + let f2R = remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated f2) // Optimizing arguments after inlining // REVIEW: this is a cheapshot way of optimizing the arg expressions as well without the restriction of recursive // inlining kicking into effect - let args' = args |> List.map (fun e -> let e', _einfo = OptimizeExpr cenv env e in e') + let argsR = args |> List.map (fun e -> let eR, _einfo = OptimizeExpr cenv env e in eR) // Beta reduce. MakeApplicationAndBetaReduce cenv.g does all the hard work. // Inlining: beta reducing - let expr' = MakeApplicationAndBetaReduce cenv.g (f2', f2ty, [tyargs], args', m) + let exprR = MakeApplicationAndBetaReduce cenv.g (f2R, f2ty, [tyargs], argsR, m) // Inlining: reoptimizing - Some(OptimizeExpr cenv {env with dontInline= Zset.add lambdaId env.dontInline} expr') + Some(OptimizeExpr cenv {env with dontInline= Zset.add lambdaId env.dontInline} exprR) | _ -> None -//------------------------------------------------------------------------- -// Optimize/analyze an application of a function to type and term arguments -//------------------------------------------------------------------------- - +/// Optimize/analyze an application of a function to type and term arguments and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) = // trying to devirtualize match TryDevirtualizeApplication cenv env (f0, tyargs, args, m) with @@ -2833,10 +2869,7 @@ and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) = MightMakeCriticalTailcall = mayBeCriticalTailcall Info=ValueOfExpr newExpr } -//------------------------------------------------------------------------- -// Optimize/analyze a lambda expression -//------------------------------------------------------------------------- - +/// Optimize/analyze a lambda expression and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = match e with | Expr.Lambda (lambdaId, _, _, _, _, m, _) @@ -2848,8 +2881,8 @@ and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = let env = BindTypeVarsToUnknown tps env let env = List.foldBack (BindInternalValsToUnknown cenv) vsl env let env = BindInternalValsToUnknown cenv (Option.toList baseValOpt) env - let body', bodyinfo = OptimizeExpr cenv env body - let expr' = mkMemberLambdas m tps ctorThisValOpt baseValOpt vsl (body', bodyty) + let bodyR, bodyinfo = OptimizeExpr cenv env body + let exprR = mkMemberLambdas m tps ctorThisValOpt baseValOpt vsl (bodyR, bodyty) let arities = vsl.Length let arities = if isNil tps then arities else 1+arities let bsize = bodyinfo.TotalSize @@ -2884,13 +2917,13 @@ and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = // can't inline any values with semi-recursive object references to self or base let valu = match baseValOpt with - | None -> CurriedLambdaValue (lambdaId, arities, bsize, expr', ety) + | None -> CurriedLambdaValue (lambdaId, arities, bsize, exprR, ety) | Some baseVal -> - let fvs = freeInExpr CollectLocals body' + let fvs = freeInExpr CollectLocals bodyR if fvs.UsesMethodLocalConstructs || fvs.FreeLocals.Contains baseVal then UnknownValue else - let expr2 = mkMemberLambdas m tps ctorThisValOpt None vsl (body', bodyty) + let expr2 = mkMemberLambdas m tps ctorThisValOpt None vsl (bodyR, bodyty) CurriedLambdaValue (lambdaId, arities, bsize, expr2, ety) @@ -2899,20 +2932,15 @@ and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = | Some v when v.IsCompiledAsTopLevel -> methodDefnTotalSize | _ -> closureTotalSize - expr', { TotalSize=bsize + estimatedSize (* estimate size of new syntactic closure - expensive, in contrast to a method *) + exprR, { TotalSize=bsize + estimatedSize (* estimate size of new syntactic closure - expensive, in contrast to a method *) FunctionSize=1 HasEffect=false MightMakeCriticalTailcall = false Info= valu } | _ -> OptimizeExpr cenv env e - - -//------------------------------------------------------------------------- -// Recursive calls that first try to make an expression "fit" the a shape -// where it is about to be consumed. -//------------------------------------------------------------------------- - +/// Recursive calls that first try to make an expression "fit" the a shape +/// where it is about to be consumed. and OptimizeExprsThenReshapeAndConsiderSplits cenv env exprs = match exprs with | [] -> NoExprs @@ -2923,7 +2951,6 @@ and OptimizeExprsThenConsiderSplits cenv env exprs = | [] -> NoExprs | _ -> OptimizeList (OptimizeExprThenConsiderSplit cenv env) exprs - and OptimizeExprThenReshapeAndConsiderSplit cenv env (shape, e) = OptimizeExprThenConsiderSplit cenv env (ReshapeExpr cenv (shape, e)) @@ -2940,14 +2967,11 @@ and ReshapeExpr cenv (shape, e) = e and OptimizeExprThenConsiderSplit cenv env e = - let e', einfo = OptimizeExpr cenv env e + let eR, einfo = OptimizeExpr cenv env e // ALWAYS consider splits for enormous sub terms here - otherwise we will create invalid .NET programs - ConsiderSplitToMethod true cenv.settings.veryBigExprSize cenv env (e', einfo) - -//------------------------------------------------------------------------- -// Decide whether to List.unzip a sub-expression into a new method -//------------------------------------------------------------------------- + ConsiderSplitToMethod true cenv.settings.veryBigExprSize cenv env (eR, einfo) +/// Decide whether to List.unzip a sub-expression into a new method and ComputeSplitToMethodCondition flag threshold cenv env (e:Expr, einfo) = flag && // REVIEW: The method splitting optimization is completely disabled if we are not taking tailcalls. @@ -2993,15 +3017,15 @@ and ConsiderSplitToMethod flag threshold cenv env (e, einfo) = else e, einfo -//------------------------------------------------------------------------- -// Optimize/analyze a pattern matching expression -//------------------------------------------------------------------------- - +/// Optimize/analyze a pattern matching expression and OptimizeMatch cenv env (spMatch, exprm, dtree, targets, m, ty) = // REVIEW: consider collecting, merging and using information flowing through each line of the decision tree to each target - let dtree', dinfo = OptimizeDecisionTree cenv env m dtree - let targets', tinfos = OptimizeDecisionTreeTargets cenv env m targets - let newExpr, newInfo = RebuildOptimizedMatch (spMatch, exprm, m, ty, dtree', targets', dinfo, tinfos) + let dtreeR, dinfo = OptimizeDecisionTree cenv env m dtree + let targetsR, tinfos = OptimizeDecisionTreeTargets cenv env m targets + OptimizeMatchPart2 cenv (spMatch, exprm, dtreeR, targetsR, dinfo, tinfos, m, ty) + +and OptimizeMatchPart2 cenv (spMatch, exprm, dtreeR, targetsR, dinfo, tinfos, m, ty) = + let newExpr, newInfo = RebuildOptimizedMatch (spMatch, exprm, m, ty, dtreeR, targetsR, dinfo, tinfos) let newExpr2 = if not (cenv.settings.localOpt()) then newExpr else CombineBoolLogic newExpr newExpr2, newInfo @@ -3018,32 +3042,25 @@ and RebuildOptimizedMatch (spMatch, exprm, m, ty, dtree, tgs, dinfo, tinfos) = let einfo = CombineMatchInfos dinfo tinfo expr, einfo -//------------------------------------------------------------------------- -// Optimize/analyze a target of a decision tree -//------------------------------------------------------------------------- - -and OptimizeDecisionTreeTarget cenv env _m (TTarget(vs, e, spTarget)) = - (* REVIEW: this is where we should be using information collected for each target *) +/// Optimize/analyze a target of a decision tree +and OptimizeDecisionTreeTarget cenv env _m (TTarget(vs, expr, spTarget)) = let env = BindInternalValsToUnknown cenv vs env - let e', einfo = OptimizeExpr cenv env e - let e', einfo = ConsiderSplitToMethod cenv.settings.abstractBigTargets cenv.settings.bigTargetSize cenv env (e', einfo) - let evalue' = AbstractExprInfoByVars (vs, []) einfo.Info - TTarget(vs, e', spTarget), + let exprR, einfo = OptimizeExpr cenv env expr + let exprR, einfo = ConsiderSplitToMethod cenv.settings.abstractBigTargets cenv.settings.bigTargetSize cenv env (exprR, einfo) + let evalueR = AbstractExprInfoByVars (vs, []) einfo.Info + TTarget(vs, exprR, spTarget), { TotalSize=einfo.TotalSize FunctionSize=einfo.FunctionSize HasEffect=einfo.HasEffect MightMakeCriticalTailcall = einfo.MightMakeCriticalTailcall - Info=evalue' } - -//------------------------------------------------------------------------- -// Optimize/analyze a decision tree -//------------------------------------------------------------------------- + Info=evalueR } +/// Optimize/analyze a decision tree and OptimizeDecisionTree cenv env m x = match x with | TDSuccess (es, n) -> - let es', einfos = OptimizeExprsThenConsiderSplits cenv env es - TDSuccess(es', n), CombineValueInfosUnknown einfos + let esR, einfos = OptimizeExprsThenConsiderSplits cenv env es + TDSuccess(esR, n), CombineValueInfosUnknown einfos | TDBind(bind, rest) -> let (bind, binfo), envinner = OptimizeBinding cenv false env bind let rest, rinfo = OptimizeDecisionTree cenv envinner m rest @@ -3085,7 +3102,7 @@ and TryOptimizeDecisionTreeTest cenv test vinfo = /// Optimize/analyze a switch construct from pattern matching and OptimizeSwitch cenv env (e, cases, dflt, m) = - let e', einfo = OptimizeExpr cenv env e + let eR, einfo = OptimizeExpr cenv env e let cases, dflt = if cenv.settings.EliminateSwitch() && not einfo.HasEffect then @@ -3098,18 +3115,24 @@ and OptimizeSwitch cenv env (e, cases, dflt, m) = dflt else cases, dflt - // OK, see what we're left with and continue + // OK, see what weRre left with and continue match cases, dflt with | [], Some case -> OptimizeDecisionTree cenv env m case - | _ -> OptimizeSwitchFallback cenv env (e', einfo, cases, dflt, m) - -and OptimizeSwitchFallback cenv env (e', einfo, cases, dflt, m) = - let cases', cinfos = List.unzip (List.map (fun (TCase(discrim, e)) -> let e', einfo = OptimizeDecisionTree cenv env m e in TCase(discrim, e'), einfo) cases) - let dflt', dinfos = match dflt with None -> None, [] | Some df -> let df', einfo = OptimizeDecisionTree cenv env m df in Some df', [einfo] + | _ -> OptimizeSwitchFallback cenv env (eR, einfo, cases, dflt, m) + +and OptimizeSwitchFallback cenv env (eR, einfo, cases, dflt, m) = + let casesR, cinfos = + cases + |> List.map (fun (TCase(discrim, e)) -> let eR, einfo = OptimizeDecisionTree cenv env m e in TCase(discrim, eR), einfo) + |> List.unzip + let dfltR, dinfos = + match dflt with + | None -> None, [] + | Some df -> let dfR, einfo = OptimizeDecisionTree cenv env m df in Some dfR, [einfo] let size = (dinfos.Length + cinfos.Length) * 2 let info = CombineValueInfosUnknown (einfo :: cinfos @ dinfos) let info = { info with TotalSize = info.TotalSize + size; FunctionSize = info.FunctionSize + size; } - TDSwitch (e', cases', dflt', m), info + TDSwitch (eR, casesR, dfltR, m), info and OptimizeBinding cenv isRec env (TBind(vref, expr, spBind)) = try @@ -3136,13 +3159,13 @@ and OptimizeBinding cenv isRec env (TBind(vref, expr, spBind)) = match ivalue with | CurriedLambdaValue (_, arities, size, body, _) -> if size > (cenv.settings.lambdaInlineThreshold + arities + 2) then - // Discarding lambda for binding v.LogicalName - UnknownValue (* trim large *) + // Discarding lambda for large binding + UnknownValue else let fvs = freeInExpr CollectLocals body if fvs.UsesMethodLocalConstructs then - // Discarding lambda for bindingbecause uses protected members - UnknownValue (* trim protected *) + // Discarding lambda for binding because uses protected members + UnknownValue else ivalue @@ -3152,7 +3175,9 @@ and OptimizeBinding cenv isRec env (TBind(vref, expr, spBind)) = | UnionCaseValue (a, b) -> UnionCaseValue (a, Array.map cut b) | UnknownValue | ConstValue _ | ConstExprValue _ -> ivalue | SizeValue(_, a) -> MakeSizedValueInfo (cut a) + let einfo = if vref.MustInline then einfo else {einfo with Info = cut einfo.Info } + let einfo = if (not vref.MustInline && not (cenv.settings.KeepOptimizationValues())) || @@ -3259,6 +3284,7 @@ and OptimizeModuleExpr cenv env x = entities= mtyp.AllEntities) mtyp.ModuleAndNamespaceDefinitions |> List.iter elimModSpec mty + and elimModSpec (mspec:ModuleOrNamespace) = let mtyp = elimModTy mspec.ModuleOrNamespaceType mspec.entity_modul_contents <- MaybeLazy.Strict mtyp @@ -3273,6 +3299,7 @@ and OptimizeModuleExpr cenv env x = | TMDefDo _ -> x | TMDefs(defs) -> TMDefs(List.map elimModDef defs) | TMAbstract _ -> x + and elimModuleBinding x = match x with | ModuleOrNamespaceBinding.Binding bind -> @@ -3302,19 +3329,19 @@ and OptimizeModuleDef cenv (env, bindInfosColl) x = let binfos = minfos |> List.choose (function Choice1Of2 (_, x) -> Some x | _ -> None) let minfos = minfos |> List.choose (function Choice2Of2 x -> Some x | _ -> None) - (* REVIEW: Eliminate let bindings on the way back up *) (TMDefRec(isRec, tycons, mbinds, m), notlazy { ValInfos = ValInfos(List.map2 (fun bind binfo -> mkValBind bind (mkValInfo binfo bind.Var)) binds binfos) ModuleOrNamespaceInfos = NameMap.ofList minfos}), (env, bindInfosColl) + | TMAbstract(mexpr) -> let mexpr, info = OptimizeModuleExpr cenv env mexpr let env = BindValsInModuleOrNamespace cenv info env (TMAbstract(mexpr), info), (env, bindInfosColl) + | TMDefLet(bind, m) -> - let ((bind', binfo) as bindInfo), env = OptimizeBinding cenv false env bind - (* REVIEW: Eliminate unused let bindings from modules *) - (TMDefLet(bind', m), + let ((bindR, binfo) as bindInfo), env = OptimizeBinding cenv false env bind + (TMDefLet(bindR, m), notlazy { ValInfos=ValInfos [mkValBind bind (mkValInfo binfo bind.Var)] ModuleOrNamespaceInfos = NameMap.empty }), (env , ([bindInfo]::bindInfosColl)) @@ -3323,6 +3350,7 @@ and OptimizeModuleDef cenv (env, bindInfosColl) x = let (e, _einfo) = OptimizeExpr cenv env e (TMDefDo(e, m), EmptyModuleInfo), (env , bindInfosColl) + | TMDefs(defs) -> let (defs, info), (env, bindInfosColl) = OptimizeModuleDefs cenv (env, bindInfosColl) defs (TMDefs(defs), info), (env, bindInfosColl) @@ -3332,8 +3360,8 @@ and OptimizeModuleBindings cenv (env, bindInfosColl) xs = List.mapFold (Optimize and OptimizeModuleBinding cenv (env, bindInfosColl) x = match x with | ModuleOrNamespaceBinding.Binding bind -> - let ((bind', binfo) as bindInfo), env = OptimizeBinding cenv true env bind - (ModuleOrNamespaceBinding.Binding bind', Choice1Of2 (bind', binfo)), (env, [ bindInfo ] :: bindInfosColl) + let ((bindR, binfo) as bindInfo), env = OptimizeBinding cenv true env bind + (ModuleOrNamespaceBinding.Binding bindR, Choice1Of2 (bindR, binfo)), (env, [ bindInfo ] :: bindInfosColl) | ModuleOrNamespaceBinding.Module(mspec, def) -> let id = mspec.Id let (def, info), (_, bindInfosColl) = OptimizeModuleDef cenv (env, bindInfosColl) def @@ -3347,7 +3375,7 @@ and OptimizeModuleDefs cenv (env, bindInfosColl) defs = (defs, UnionOptimizationInfos minfos), (env, bindInfosColl) and OptimizeImplFileInternal cenv env isIncrementalFragment hidden (TImplFile(qname, pragmas, mexpr, hasExplicitEntryPoint, isScript, anonRecdTypes)) = - let env, mexpr', minfo = + let env, mexprR, minfo = match mexpr with // FSI: FSI compiles everything as if you're typing incrementally into one module // This means the fragment is not truly a constrained module as later fragments will be typechecked @@ -3357,20 +3385,17 @@ and OptimizeImplFileInternal cenv env isIncrementalFragment hidden (TImplFile(qn let (def, minfo), (env, _bindInfosColl) = OptimizeModuleDef cenv (env, []) def env, ModuleOrNamespaceExprWithSig(mty, def, m), minfo | _ -> - let mexpr', minfo = OptimizeModuleExpr cenv env mexpr + let mexprR, minfo = OptimizeModuleExpr cenv env mexpr let env = BindValsInModuleOrNamespace cenv minfo env let env = { env with localExternalVals=env.localExternalVals.MarkAsCollapsible() } // take the chance to flatten to a dictionary - env, mexpr', minfo + env, mexprR, minfo let hidden = ComputeHidingInfoAtAssemblyBoundary mexpr.Type hidden let minfo = AbstractLazyModulInfoByHiding true hidden minfo - env, TImplFile(qname, pragmas, mexpr', hasExplicitEntryPoint, isScript, anonRecdTypes), minfo, hidden - -//------------------------------------------------------------------------- -// Entry point -//------------------------------------------------------------------------- + env, TImplFile(qname, pragmas, mexprR, hasExplicitEntryPoint, isScript, anonRecdTypes), minfo, hidden +/// Entry point let OptimizeImplFile(settings, ccu, tcGlobals, tcVal, importMap, optEnv, isIncrementalFragment, emitTailcalls, hidden, mimpls) = let cenv = { settings=settings @@ -3386,35 +3411,48 @@ let OptimizeImplFile(settings, ccu, tcGlobals, tcVal, importMap, optEnv, isIncre let optimizeDuringCodeGen expr = OptimizeExpr cenv optEnvNew expr |> fst results, optimizeDuringCodeGen -//------------------------------------------------------------------------- -// Pickle to stable format for cross-module optimization data -//------------------------------------------------------------------------- - +/// Pickle to stable format for cross-module optimization data let rec p_ExprValueInfo x st = match x with - | ConstValue (c, ty) -> p_byte 0 st; p_tup2 p_const p_ty (c, ty) st - | UnknownValue -> p_byte 1 st - | ValValue (a, b) -> p_byte 2 st; p_tup2 (p_vref "optval") p_ExprValueInfo (a, b) st - | TupleValue a -> p_byte 3 st; p_array p_ExprValueInfo a st - | UnionCaseValue (a, b) -> p_byte 4 st; p_tup2 p_ucref (p_array p_ExprValueInfo) (a, b) st - | CurriedLambdaValue (_, b, c, d, e) -> p_byte 5 st; p_tup4 p_int p_int p_expr p_ty (b, c, d, e) st - | ConstExprValue (a, b) -> p_byte 6 st; p_tup2 p_int p_expr (a, b) st - | RecdValue (tcref, a) -> p_byte 7 st; p_tup2 (p_tcref "opt data") (p_array p_ExprValueInfo) (tcref, a) st - | SizeValue (_adepth, a) -> p_ExprValueInfo a st + | ConstValue (c, ty) -> + p_byte 0 st + p_tup2 p_const p_ty (c, ty) st + | UnknownValue -> + p_byte 1 st + | ValValue (a, b) -> + p_byte 2 st + p_tup2 (p_vref "optval") p_ExprValueInfo (a, b) st + | TupleValue a -> + p_byte 3 st + p_array p_ExprValueInfo a st + | UnionCaseValue (a, b) -> + p_byte 4 st + p_tup2 p_ucref (p_array p_ExprValueInfo) (a, b) st + | CurriedLambdaValue (_, b, c, d, e) -> + p_byte 5 st + p_tup4 p_int p_int p_expr p_ty (b, c, d, e) st + | ConstExprValue (a, b) -> + p_byte 6 st + p_tup2 p_int p_expr (a, b) st + | RecdValue (tcref, a) -> + p_byte 7 st + p_tcref "opt data" tcref st + p_array p_ExprValueInfo a st + | SizeValue (_adepth, a) -> + p_ExprValueInfo a st and p_ValInfo (v:ValInfo) st = - p_tup2 p_ExprValueInfo p_bool (v.ValExprInfo, v.ValMakesNoCriticalTailcalls) st + p_ExprValueInfo v.ValExprInfo st + p_bool v.ValMakesNoCriticalTailcalls st and p_ModuleInfo x st = - p_tup2 - (p_array (p_tup2 (p_vref "opttab") p_ValInfo)) - (p_namemap p_LazyModuleInfo) - ((x.ValInfos.Entries |> Seq.toArray) , x.ModuleOrNamespaceInfos) - st + p_array (p_tup2 (p_vref "opttab") p_ValInfo) (x.ValInfos.Entries |> Seq.toArray) st + p_namemap p_LazyModuleInfo x.ModuleOrNamespaceInfos st and p_LazyModuleInfo x st = p_lazy p_ModuleInfo x st + let p_CcuOptimizationInfo x st = p_LazyModuleInfo x st let rec u_ExprInfo st = diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 2576c1c2c21d7051deebd720c2981013581f4981..1aadfd0ed486f54eb5cc222f4d6b4d45fff9996e 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -3,10 +3,10 @@ module internal FSharp.Compiler.PatternMatchCompilation open System.Collections.Generic -open FSharp.Compiler +open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Internal.Library -open FSharp.Compiler.AbstractIL.Diagnostics +open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.Range open FSharp.Compiler.Ast open FSharp.Compiler.ErrorLogger @@ -22,18 +22,18 @@ exception MatchIncomplete of bool * (string * bool) option * range exception RuleNeverMatched of range exception EnumMatchIncomplete of bool * (string * bool) option * range -type ActionOnFailure = - | ThrowIncompleteMatchException - | IgnoreWithWarning - | Throw - | Rethrow +type ActionOnFailure = + | ThrowIncompleteMatchException + | IgnoreWithWarning + | Throw + | Rethrow | FailFilter [] /// Represents type-checked patterns type Pattern = | TPat_const of Const * range - | TPat_wild of range (* note = TPat_disjs([],m), but we haven't yet removed that duplication *) + | TPat_wild of range (* note = TPat_disjs([], m), but we haven't yet removed that duplication *) | TPat_as of Pattern * PatternValBinding * range (* note: can be replaced by TPat_var, i.e. equals TPat_conjs([TPat_var; pat]) *) | TPat_disjs of Pattern list * range | TPat_conjs of Pattern list * range @@ -48,84 +48,84 @@ type Pattern = | TPat_isinst of TType * TType * PatternValBinding option * range member this.Range = match this with - | TPat_const(_,m) -> m + | TPat_const(_, m) -> m | TPat_wild m -> m - | TPat_as(_,_,m) -> m - | TPat_disjs(_,m) -> m - | TPat_conjs(_,m) -> m - | TPat_query(_,_,m) -> m - | TPat_unioncase(_,_,_,m) -> m - | TPat_exnconstr(_,_,m) -> m - | TPat_tuple(_,_,_,m) -> m - | TPat_array(_,_,m) -> m - | TPat_recd(_,_,_,m) -> m - | TPat_range(_,_,m) -> m + | TPat_as(_, _, m) -> m + | TPat_disjs(_, m) -> m + | TPat_conjs(_, m) -> m + | TPat_query(_, _, m) -> m + | TPat_unioncase(_, _, _, m) -> m + | TPat_exnconstr(_, _, m) -> m + | TPat_tuple(_, _, _, m) -> m + | TPat_array(_, _, m) -> m + | TPat_recd(_, _, _, m) -> m + | TPat_range(_, _, m) -> m | TPat_null(m) -> m - | TPat_isinst(_,_,_,m) -> m + | TPat_isinst(_, _, _, m) -> m and PatternValBinding = PBind of Val * TypeScheme -and TypedMatchClause = +and TypedMatchClause = | TClause of Pattern * Expr option * DecisionTreeTarget * range - member c.GuardExpr = let (TClause(_,whenOpt,_,_)) = c in whenOpt - member c.Pattern = let (TClause(p,_,_,_)) = c in p - member c.Range = let (TClause(_,_,_,m)) = c in m - member c.Target = let (TClause(_,_,tg,_)) = c in tg - member c.BoundVals = let (TClause(_p,_whenOpt,TTarget(vs,_,_),_m)) = c in vs + member c.GuardExpr = let (TClause(_, whenOpt, _, _)) = c in whenOpt + member c.Pattern = let (TClause(p, _, _, _)) = c in p + member c.Range = let (TClause(_, _, _, m)) = c in m + member c.Target = let (TClause(_, _, tg, _)) = c in tg + member c.BoundVals = let (TClause(_p, _whenOpt, TTarget(vs, _, _), _m)) = c in vs let debug = false //--------------------------------------------------------------------------- -// Nasty stuff to permit obscure generic bindings such as -// let x,y = [],[] +// Nasty stuff to permit obscure generic bindings such as +// let x, y = [], [] // // BindSubExprOfInput actually produces the binding -// e.g. let v2 = \Gamma ['a,'b]. ([] : 'a ,[] : 'b) -// let (x,y) = p. -// When v = x, gtvs = 'a,'b. We must bind: -// x --> \Gamma A. fst (v2[A,]) -// y --> \Gamma A. snd (v2[,A]). -// +// e.g. let v2 = \Gamma ['a, 'b]. ([] : 'a , [] : 'b) +// let (x, y) = p. +// When v = x, gtvs = 'a, 'b. We must bind: +// x --> \Gamma A. fst (v2[A, ]) +// y --> \Gamma A. snd (v2[, A]). +// // GetSubExprOfInput is just used to get a concrete value from a type // function in the middle of the "test" part of pattern matching. -// For example, e.g. let [x; y] = [ (\x.x); (\x.x) ] +// For example, e.g. let [x; y] = [ (\x.x); (\x.x) ] // Here the constructor test needs a real list, even though the // r.h.s. is actually a polymorphic type function. To do the // test, we apply the r.h.s. to a dummy type - it doesn't matter // which (unless the r.h.s. actually looks at it's type argument...) //--------------------------------------------------------------------------- -type SubExprOfInput = +type SubExprOfInput = | SubExpr of (TyparInst -> Expr -> Expr) * (Expr * Val) -let BindSubExprOfInput g amap gtps (PBind(v,tyscheme)) m (SubExpr(accessf,(ve2,v2))) = - let e' = - if isNil gtps then - accessf [] ve2 - else - let tyargs = +let BindSubExprOfInput g amap gtps (PBind(v, tyscheme)) m (SubExpr(accessf, (ve2, v2))) = + let e' = + if isNil gtps then + accessf [] ve2 + else + let tyargs = let someSolved = ref false - let freezeVar gtp = - if isBeingGeneralized gtp tyscheme then - mkTyparTy gtp - else + let freezeVar gtp = + if isBeingGeneralized gtp tyscheme then + mkTyparTy gtp + else someSolved := true TypeRelations.ChooseTyparSolution g amap gtp let solutions = List.map freezeVar gtps - if !someSolved then + if !someSolved then TypeRelations.IterativelySubstituteTyparSolutions g gtps solutions else solutions let tinst = mkTyparInst gtps tyargs - accessf tinst (mkApps g ((ve2,v2.Type),[tyargs],[],v2.Range)) + accessf tinst (mkApps g ((ve2, v2.Type), [tyargs], [], v2.Range)) - v,mkGenericBindRhs g m [] tyscheme e' + v, mkGenericBindRhs g m [] tyscheme e' -let GetSubExprOfInput g (gtps,tyargs,tinst) (SubExpr(accessf,(ve2,v2))) = +let GetSubExprOfInput g (gtps, tyargs, tinst) (SubExpr(accessf, (ve2, v2))) = if isNil gtps then accessf [] ve2 else - accessf tinst (mkApps g ((ve2,v2.Type),[tyargs],[],v2.Range)) + accessf tinst (mkApps g ((ve2, v2.Type), [tyargs], [], v2.Range)) //--------------------------------------------------------------------------- // path, frontier @@ -133,7 +133,7 @@ let GetSubExprOfInput g (gtps,tyargs,tinst) (SubExpr(accessf,(ve2,v2))) = // A path reaches into a pattern. // The ints record which choices taken, e.g. tuple/record fields. -type Path = +type Path = | PathQuery of Path * Unique | PathConj of Path * int | PathTuple of Path * TypeInst * int @@ -141,27 +141,27 @@ type Path = | PathUnionConstr of Path * UnionCaseRef * TypeInst * int | PathArray of Path * TType * int * int | PathExnConstr of Path * TyconRef * int - | PathEmpty of TType - -let rec pathEq p1 p2 = - match p1,p2 with - | PathQuery(p1,n1), PathQuery(p2,n2) -> (n1 = n2) && pathEq p1 p2 - | PathConj(p1,n1), PathConj(p2,n2) -> (n1 = n2) && pathEq p1 p2 - | PathTuple(p1,_,n1), PathTuple(p2,_,n2) -> (n1 = n2) && pathEq p1 p2 - | PathRecd(p1,_,_,n1), PathRecd(p2,_,_,n2) -> (n1 = n2) && pathEq p1 p2 - | PathUnionConstr(p1,_,_,n1), PathUnionConstr(p2,_,_,n2) -> (n1 = n2) && pathEq p1 p2 - | PathArray(p1,_,_,n1), PathArray(p2,_,_,n2) -> (n1 = n2) && pathEq p1 p2 - | PathExnConstr(p1,_,n1), PathExnConstr(p2,_,n2) -> (n1 = n2) && pathEq p1 p2 + | PathEmpty of TType + +let rec pathEq p1 p2 = + match p1, p2 with + | PathQuery(p1, n1), PathQuery(p2, n2) -> (n1 = n2) && pathEq p1 p2 + | PathConj(p1, n1), PathConj(p2, n2) -> (n1 = n2) && pathEq p1 p2 + | PathTuple(p1, _, n1), PathTuple(p2, _, n2) -> (n1 = n2) && pathEq p1 p2 + | PathRecd(p1, _, _, n1), PathRecd(p2, _, _, n2) -> (n1 = n2) && pathEq p1 p2 + | PathUnionConstr(p1, _, _, n1), PathUnionConstr(p2, _, _, n2) -> (n1 = n2) && pathEq p1 p2 + | PathArray(p1, _, _, n1), PathArray(p2, _, _, n2) -> (n1 = n2) && pathEq p1 p2 + | PathExnConstr(p1, _, n1), PathExnConstr(p2, _, n2) -> (n1 = n2) && pathEq p1 p2 | PathEmpty(_), PathEmpty(_) -> true | _ -> false //--------------------------------------------------------------------------- -// Counter example generation +// Counter example generation //--------------------------------------------------------------------------- -type RefutedSet = - /// A value RefutedInvestigation(path,discrim) indicates that the value at the given path is known +type RefutedSet = + /// A value RefutedInvestigation(path, discrim) indicates that the value at the given path is known /// to NOT be matched by the given discriminator | RefutedInvestigation of Path * DecisionTreeTest list /// A value RefutedWhenClause indicates that a 'when' clause failed @@ -173,7 +173,7 @@ let otherSubtypeText = "some-other-subtype" /// Create a TAST const value from an IL-initialized field read from .NET metadata // (Originally moved from TcFieldInit in TypeChecker.fs -- feel free to move this somewhere more appropriate) let ilFieldToTastConst lit = - match lit with + match lit with | ILFieldInit.String s -> Const.String s | ILFieldInit.Null -> Const.Zero | ILFieldInit.Bool b -> Const.Bool b @@ -187,37 +187,37 @@ let ilFieldToTastConst lit = | ILFieldInit.UInt32 x -> Const.UInt32 x | ILFieldInit.UInt64 x -> Const.UInt64 x | ILFieldInit.Single f -> Const.Single f - | ILFieldInit.Double f -> Const.Double f + | ILFieldInit.Double f -> Const.Double f exception CannotRefute -let RefuteDiscrimSet g m path discrims = +let RefuteDiscrimSet g m path discrims = let mkUnknown ty = snd(mkCompGenLocal m "_" ty) - let rec go path tm = - match path with + let rec go path tm = + match path with | PathQuery _ -> raise CannotRefute - | PathConj (p,_j) -> + | PathConj (p, _j) -> go p tm - | PathTuple (p,tys,j) -> + | PathTuple (p, tys, j) -> let k, eCoversVals = mkOneKnown tm j tys go p (fun _ -> mkRefTupled g m k tys, eCoversVals) - | PathRecd (p,tcref,tinst,j) -> + | PathRecd (p, tcref, tinst, j) -> let flds, eCoversVals = tcref |> actualTysOfInstanceRecdFields (mkTyconRefInst tcref tinst) |> mkOneKnown tm j - go p (fun _ -> Expr.Op(TOp.Recd(RecdExpr, tcref),tinst, flds,m), eCoversVals) + go p (fun _ -> Expr.Op(TOp.Recd(RecdExpr, tcref), tinst, flds, m), eCoversVals) - | PathUnionConstr (p,ucref,tinst,j) -> + | PathUnionConstr (p, ucref, tinst, j) -> let flds, eCoversVals = ucref |> actualTysOfUnionCaseFields (mkTyconRefInst ucref.TyconRef tinst)|> mkOneKnown tm j - go p (fun _ -> Expr.Op(TOp.UnionCase(ucref),tinst, flds,m), eCoversVals) + go p (fun _ -> Expr.Op(TOp.UnionCase(ucref), tinst, flds, m), eCoversVals) - | PathArray (p,ty,len,n) -> + | PathArray (p, ty, len, n) -> let flds, eCoversVals = mkOneKnown tm n (List.replicate len ty) - go p (fun _ -> Expr.Op(TOp.Array,[ty], flds ,m), eCoversVals) + go p (fun _ -> Expr.Op(TOp.Array, [ty], flds , m), eCoversVals) - | PathExnConstr (p,ecref,n) -> + | PathExnConstr (p, ecref, n) -> let flds, eCoversVals = ecref |> recdFieldTysOfExnDefRef |> mkOneKnown tm n - go p (fun _ -> Expr.Op(TOp.ExnConstr(ecref),[], flds,m), eCoversVals) + go p (fun _ -> Expr.Op(TOp.ExnConstr(ecref), [], flds, m), eCoversVals) | PathEmpty(ty) -> tm ty - + and mkOneKnown tm n tys = let flds = List.mapi (fun i ty -> if i = n then tm ty else (mkUnknown ty, false)) tys List.map fst flds, List.fold (fun acc (_, eCoversVals) -> eCoversVals || acc) false flds @@ -227,7 +227,7 @@ let RefuteDiscrimSet g m path discrims = match discrims with | [DecisionTreeTest.IsNull] -> snd(mkCompGenLocal m notNullText ty), false - | [DecisionTreeTest.IsInst (_,_)] -> + | [DecisionTreeTest.IsInst (_, _)] -> snd(mkCompGenLocal m otherSubtypeText ty), false | (DecisionTreeTest.Const c :: rest) -> let consts = Set.ofList (c :: List.choose (function DecisionTreeTest.Const(c) -> Some c | _ -> None) rest) @@ -248,12 +248,12 @@ let RefuteDiscrimSet g m path discrims = | Const.Double _ -> seq { 0 .. System.Int32.MaxValue } |> Seq.map (fun v -> Const.Double(float v)) | Const.Single _ -> seq { 0 .. System.Int32.MaxValue } |> Seq.map (fun v -> Const.Single(float32 v)) | Const.Char _ -> seq { 32us .. System.UInt16.MaxValue } |> Seq.map (fun v -> Const.Char(char v)) - | Const.String _ -> seq { 1 .. System.Int32.MaxValue } |> Seq.map (fun v -> Const.String(new System.String('a',v))) + | Const.String _ -> seq { 1 .. System.Int32.MaxValue } |> Seq.map (fun v -> Const.String(new System.String('a', v))) | Const.Decimal _ -> seq { 1 .. System.Int32.MaxValue } |> Seq.map (fun v -> Const.Decimal(decimal v)) - | _ -> + | _ -> raise CannotRefute) - - match c' with + + match c' with | None -> raise CannotRefute | Some c -> match tryDestAppTy g ty with @@ -275,16 +275,16 @@ let RefuteDiscrimSet g m path discrims = | _ -> None) let nonCoveredEnumValues = Seq.tryFind (fun (_, fldValue) -> not (consts.Contains fldValue)) enumValues - + match nonCoveredEnumValues with - | None -> Expr.Const(c,m,ty), true + | None -> Expr.Const(c, m, ty), true | Some (fldName, _) -> let v = RecdFieldRef.RFRef(tcref, fldName) Expr.Op(TOp.ValFieldGet v, [ty], [], m), false - | _ -> Expr.Const(c,m,ty), false - - | (DecisionTreeTest.UnionCase (ucref1,tinst) :: rest) -> - let ucrefs = ucref1 :: List.choose (function DecisionTreeTest.UnionCase(ucref,_) -> Some ucref | _ -> None) rest + | _ -> Expr.Const(c, m, ty), false + + | (DecisionTreeTest.UnionCase (ucref1, tinst) :: rest) -> + let ucrefs = ucref1 :: List.choose (function DecisionTreeTest.UnionCase(ucref, _) -> Some ucref | _ -> None) rest let tcref = ucref1.TyconRef (* Choose the first ucref based on ordering of names *) let others = @@ -295,37 +295,37 @@ let RefuteDiscrimSet g m path discrims = | [] -> raise CannotRefute | ucref2 :: _ -> let flds = ucref2 |> actualTysOfUnionCaseFields (mkTyconRefInst tcref tinst) |> mkUnknowns - Expr.Op(TOp.UnionCase(ucref2),tinst, flds,m), false - - | [DecisionTreeTest.ArrayLength (n,ty)] -> - Expr.Op(TOp.Array,[ty], mkUnknowns (List.replicate (n+1) ty) ,m), false - - | _ -> + Expr.Op(TOp.UnionCase(ucref2), tinst, flds, m), false + + | [DecisionTreeTest.ArrayLength (n, ty)] -> + Expr.Op(TOp.Array, [ty], mkUnknowns (List.replicate (n+1) ty) , m), false + + | _ -> raise CannotRefute go path tm let rec CombineRefutations g r1 r2 = - match r1,r2 with - | Expr.Val(vref,_,_), other | other, Expr.Val(vref,_,_) when vref.LogicalName = "_" -> other - | Expr.Val(vref,_,_), other | other, Expr.Val(vref,_,_) when vref.LogicalName = notNullText -> other - | Expr.Val(vref,_,_), other | other, Expr.Val(vref,_,_) when vref.LogicalName = otherSubtypeText -> other + match r1, r2 with + | Expr.Val(vref, _, _), other | other, Expr.Val(vref, _, _) when vref.LogicalName = "_" -> other + | Expr.Val(vref, _, _), other | other, Expr.Val(vref, _, _) when vref.LogicalName = notNullText -> other + | Expr.Val(vref, _, _), other | other, Expr.Val(vref, _, _) when vref.LogicalName = otherSubtypeText -> other - | Expr.Op((TOp.ExnConstr(ecref1) as op1), tinst1,flds1,m1), Expr.Op(TOp.ExnConstr(ecref2), _,flds2,_) when tyconRefEq g ecref1 ecref2 -> - Expr.Op(op1, tinst1,List.map2 (CombineRefutations g) flds1 flds2,m1) + | Expr.Op((TOp.ExnConstr(ecref1) as op1), tinst1, flds1, m1), Expr.Op(TOp.ExnConstr(ecref2), _, flds2, _) when tyconRefEq g ecref1 ecref2 -> + Expr.Op(op1, tinst1, List.map2 (CombineRefutations g) flds1 flds2, m1) - | Expr.Op((TOp.UnionCase(ucref1) as op1), tinst1,flds1,m1), Expr.Op(TOp.UnionCase(ucref2), _,flds2,_) -> + | Expr.Op((TOp.UnionCase(ucref1) as op1), tinst1, flds1, m1), Expr.Op(TOp.UnionCase(ucref2), _, flds2, _) -> if g.unionCaseRefEq ucref1 ucref2 then - Expr.Op(op1, tinst1,List.map2 (CombineRefutations g) flds1 flds2,m1) + Expr.Op(op1, tinst1, List.map2 (CombineRefutations g) flds1 flds2, m1) (* Choose the greater of the two ucrefs based on name ordering *) elif ucref1.CaseName < ucref2.CaseName then r2 - else + else r1 - - | Expr.Op(op1, tinst1,flds1,m1), Expr.Op(_, _,flds2,_) -> - Expr.Op(op1, tinst1,List.map2 (CombineRefutations g) flds1 flds2,m1) - - | Expr.Const(c1, m1, ty1), Expr.Const(c2,_,_) -> + + | Expr.Op(op1, tinst1, flds1, m1), Expr.Op(_, _, flds2, _) -> + Expr.Op(op1, tinst1, List.map2 (CombineRefutations g) flds1 flds2, m1) + + | Expr.Const(c1, m1, ty1), Expr.Const(c2, _, _) -> let c12 = // Make sure longer strings are greater, not the case in the default ordinal comparison @@ -336,19 +336,19 @@ let rec CombineRefutations g r1 r2 = elif c > 0 then s1 elif s1 < s2 then s2 else s1 - - match c1,c2 with + + match c1, c2 with | Const.String(s1), Const.String(s2) -> Const.String(MaxStrings s1 s2) | Const.Decimal(s1), Const.Decimal(s2) -> Const.Decimal(max s1 s2) | _ -> max c1 c2 - + Expr.Const(c12, m1, ty1) | _ -> r1 let ShowCounterExample g denv m refuted = try - let refutations = refuted |> List.collect (function RefutedWhenClause -> [] | (RefutedInvestigation(path,discrim)) -> [RefuteDiscrimSet g m path discrim]) + let refutations = refuted |> List.collect (function RefutedWhenClause -> [] | (RefutedInvestigation(path, discrim)) -> [RefuteDiscrimSet g m path discrim]) let counterExample, enumCoversKnown = match refutations with | [] -> raise CannotRefute @@ -358,19 +358,19 @@ let ShowCounterExample g denv m refuted = CombineRefutations g rAcc r, eckAcc || eck) (r, eck) t let text = Layout.showL (NicePrint.dataExprL denv counterExample) let failingWhenClause = refuted |> List.exists (function RefutedWhenClause -> true | _ -> false) - Some(text,failingWhenClause,enumCoversKnown) - + Some(text, failingWhenClause, enumCoversKnown) + with | CannotRefute -> None | e -> - warning(InternalError(sprintf "" (e.ToString()),m)) + warning(InternalError(sprintf "" (e.ToString()), m)) None - + //--------------------------------------------------------------------------- // Basic problem specification //--------------------------------------------------------------------------- - + type RuleNumber = int type Active = Active of Path * SubExprOfInput * Pattern @@ -381,49 +381,49 @@ type Frontier = Frontier of RuleNumber * Actives * ValMap type InvestigationPoint = Investigation of RuleNumber * DecisionTreeTest * Path -// Note: actives must be a SortedDictionary -// REVIEW: improve these data structures, though surprisingly these functions don't tend to show up -// on profiling runs -let rec isMemOfActives p1 actives = - match actives with - | [] -> false - | (Active(p2,_,_)) :: rest -> pathEq p1 p2 || isMemOfActives p1 rest +// Note: actives must be a SortedDictionary +// REVIEW: improve these data structures, though surprisingly these functions don't tend to show up +// on profiling runs +let rec isMemOfActives p1 actives = + match actives with + | [] -> false + | (Active(p2, _, _)) :: rest -> pathEq p1 p2 || isMemOfActives p1 rest -let rec lookupActive x l = - match l with +let rec lookupActive x l = + match l with | [] -> raise (KeyNotFoundException()) - | (Active(h,r1,r2)::t) -> if pathEq x h then (r1,r2) else lookupActive x t + | (Active(h, r1, r2)::t) -> if pathEq x h then (r1, r2) else lookupActive x t -let rec removeActive x l = - match l with +let rec removeActive x l = + match l with | [] -> [] - | ((Active(h,_,_) as p) ::t) -> if pathEq x h then t else p:: removeActive x t + | ((Active(h, _, _) as p) ::t) -> if pathEq x h then t else p:: removeActive x t //--------------------------------------------------------------------------- // Utilities //--------------------------------------------------------------------------- -// tpinst is required because the pattern is specified w.r.t. generalized type variables. -let getDiscrimOfPattern (g: TcGlobals) tpinst t = - match t with - | TPat_null _m -> +// tpinst is required because the pattern is specified w.r.t. generalized type variables. +let getDiscrimOfPattern (g: TcGlobals) tpinst t = + match t with + | TPat_null _m -> Some(DecisionTreeTest.IsNull) - | TPat_isinst (srcty,tgty,_,_m) -> - Some(DecisionTreeTest.IsInst (instType tpinst srcty,instType tpinst tgty)) - | TPat_exnconstr(tcref,_,_m) -> - Some(DecisionTreeTest.IsInst (g.exn_ty,mkAppTy tcref [])) - | TPat_const (c,_m) -> + | TPat_isinst (srcty, tgty, _, _m) -> + Some(DecisionTreeTest.IsInst (instType tpinst srcty, instType tpinst tgty)) + | TPat_exnconstr(tcref, _, _m) -> + Some(DecisionTreeTest.IsInst (g.exn_ty, mkAppTy tcref [])) + | TPat_const (c, _m) -> Some(DecisionTreeTest.Const c) - | TPat_unioncase (c,tyargs',_,_m) -> - Some(DecisionTreeTest.UnionCase (c,instTypes tpinst tyargs')) - | TPat_array (args,ty,_m) -> - Some(DecisionTreeTest.ArrayLength (args.Length,ty)) - | TPat_query ((activePatExpr,resTys,apatVrefOpt,idx,apinfo),_,_m) -> + | TPat_unioncase (c, tyargs', _, _m) -> + Some(DecisionTreeTest.UnionCase (c, instTypes tpinst tyargs')) + | TPat_array (args, ty, _m) -> + Some(DecisionTreeTest.ArrayLength (args.Length, ty)) + | TPat_query ((activePatExpr, resTys, apatVrefOpt, idx, apinfo), _, _m) -> Some(DecisionTreeTest.ActivePatternCase (activePatExpr, instTypes tpinst resTys, apatVrefOpt, idx, apinfo)) | _ -> None let constOfDiscrim discrim = - match discrim with + match discrim with | DecisionTreeTest.Const x -> x | _ -> failwith "not a const case" @@ -431,60 +431,60 @@ let constOfCase (c: DecisionTreeCase) = constOfDiscrim c.Discriminator /// Compute pattern identity let discrimsEq (g: TcGlobals) d1 d2 = - match d1,d2 with - | DecisionTreeTest.UnionCase (c1,_), DecisionTreeTest.UnionCase(c2,_) -> g.unionCaseRefEq c1 c2 - | DecisionTreeTest.ArrayLength (n1,_), DecisionTreeTest.ArrayLength(n2,_) -> (n1=n2) + match d1, d2 with + | DecisionTreeTest.UnionCase (c1, _), DecisionTreeTest.UnionCase(c2, _) -> g.unionCaseRefEq c1 c2 + | DecisionTreeTest.ArrayLength (n1, _), DecisionTreeTest.ArrayLength(n2, _) -> (n1=n2) | DecisionTreeTest.Const c1, DecisionTreeTest.Const c2 -> (c1=c2) | DecisionTreeTest.IsNull , DecisionTreeTest.IsNull -> true - | DecisionTreeTest.IsInst (srcty1,tgty1), DecisionTreeTest.IsInst (srcty2,tgty2) -> typeEquiv g srcty1 srcty2 && typeEquiv g tgty1 tgty2 - | DecisionTreeTest.ActivePatternCase (_,_,vrefOpt1,n1,_), DecisionTreeTest.ActivePatternCase (_,_,vrefOpt2,n2,_) -> - match vrefOpt1, vrefOpt2 with + | DecisionTreeTest.IsInst (srcty1, tgty1), DecisionTreeTest.IsInst (srcty2, tgty2) -> typeEquiv g srcty1 srcty2 && typeEquiv g tgty1 tgty2 + | DecisionTreeTest.ActivePatternCase (_, _, vrefOpt1, n1, _), DecisionTreeTest.ActivePatternCase (_, _, vrefOpt2, n2, _) -> + match vrefOpt1, vrefOpt2 with | Some (vref1, tinst1), Some (vref2, tinst2) -> valRefEq g vref1 vref2 && n1 = n2 && not (doesActivePatternHaveFreeTypars g vref1) && List.lengthsEqAndForall2 (typeEquiv g) tinst1 tinst2 | _ -> false (* for equality purposes these are considered unequal! This is because adhoc computed patterns have no identity. *) | _ -> false - -/// Redundancy of 'isinst' patterns + +/// Redundancy of 'isinst' patterns let isDiscrimSubsumedBy g amap m d1 d2 = - (discrimsEq g d1 d2) + (discrimsEq g d1 d2) || - (match d1,d2 with - | DecisionTreeTest.IsInst (_,tgty1), DecisionTreeTest.IsInst (_,tgty2) -> + (match d1, d2 with + | DecisionTreeTest.IsInst (_, tgty1), DecisionTreeTest.IsInst (_, tgty2) -> TypeDefinitelySubsumesTypeNoCoercion 0 g amap m tgty2 tgty1 | _ -> false) - -/// Choose a set of investigations that can be performed simultaneously + +/// Choose a set of investigations that can be performed simultaneously let rec chooseSimultaneousEdgeSet prevOpt f l = - match l with - | [] -> [],[] - | h::t -> - match f prevOpt h with - | Some x,_ -> - let l,r = chooseSimultaneousEdgeSet (Some x) f t + match l with + | [] -> [], [] + | h::t -> + match f prevOpt h with + | Some x, _ -> + let l, r = chooseSimultaneousEdgeSet (Some x) f t x :: l, r - | None,_cont -> - let l,r = chooseSimultaneousEdgeSet prevOpt f t + | None, _cont -> + let l, r = chooseSimultaneousEdgeSet prevOpt f t l, h :: r /// Can we represent a integer discrimination as a 'switch' -let canCompactConstantClass c = - match c with - | Const.SByte _ | Const.Int16 _ | Const.Int32 _ - | Const.Byte _ | Const.UInt16 _ | Const.UInt32 _ +let canCompactConstantClass c = + match c with + | Const.SByte _ | Const.Int16 _ | Const.Int32 _ + | Const.Byte _ | Const.UInt16 _ | Const.UInt32 _ | Const.Char _ -> true | _ -> false - + /// Can two discriminators in a 'column' be decided simultaneously? let discrimsHaveSameSimultaneousClass g d1 d2 = - match d1,d2 with - | DecisionTreeTest.Const _, DecisionTreeTest.Const _ - | DecisionTreeTest.IsNull , DecisionTreeTest.IsNull + match d1, d2 with + | DecisionTreeTest.Const _, DecisionTreeTest.Const _ + | DecisionTreeTest.IsNull , DecisionTreeTest.IsNull | DecisionTreeTest.ArrayLength _, DecisionTreeTest.ArrayLength _ | DecisionTreeTest.UnionCase _, DecisionTreeTest.UnionCase _ -> true | DecisionTreeTest.IsInst _, DecisionTreeTest.IsInst _ -> false - | DecisionTreeTest.ActivePatternCase (_,_,apatVrefOpt1,_,_), DecisionTreeTest.ActivePatternCase (_,_,apatVrefOpt2,_,_) -> - match apatVrefOpt1, apatVrefOpt2 with + | DecisionTreeTest.ActivePatternCase (_, _, apatVrefOpt1, _, _), DecisionTreeTest.ActivePatternCase (_, _, apatVrefOpt2, _, _) -> + match apatVrefOpt1, apatVrefOpt2 with | Some (vref1, tinst1), Some (vref2, tinst2) -> valRefEq g vref1 vref2 && not (doesActivePatternHaveFreeTypars g vref1) && List.lengthsEqAndForall2 (typeEquiv g) tinst1 tinst2 | _ -> false (* for equality purposes these are considered different classes of discriminators! This is because adhoc computed patterns have no identity! *) @@ -493,12 +493,12 @@ let discrimsHaveSameSimultaneousClass g d1 d2 = /// Decide the next pattern to investigate let ChooseInvestigationPointLeftToRight frontiers = - match frontiers with - | Frontier (_i,actives,_) ::_t -> - let rec choose l = - match l with + match frontiers with + | Frontier (_i, actives, _) ::_t -> + let rec choose l = + match l with | [] -> failwith "ChooseInvestigationPointLeftToRight: no non-immediate patterns in first rule" - | (Active(_,_,(TPat_null _ | TPat_isinst _ | TPat_exnconstr _ | TPat_unioncase _ | TPat_array _ | TPat_const _ | TPat_query _ | TPat_range _)) as active) + | (Active(_, _, (TPat_null _ | TPat_isinst _ | TPat_exnconstr _ | TPat_unioncase _ | TPat_array _ | TPat_const _ | TPat_query _ | TPat_range _)) as active) :: _ -> active | _ :: t -> choose t choose actives @@ -511,43 +511,43 @@ let ChooseInvestigationPointLeftToRight frontiers = // The problem with this technique is that it creates extra locals which inhibit the process of converting pattern matches into linear let bindings. let (|ListConsDiscrim|_|) g = function - | (DecisionTreeTest.UnionCase (ucref,tinst)) + | (DecisionTreeTest.UnionCase (ucref, tinst)) (* check we can use a simple 'isinst' instruction *) when tyconRefEq g ucref.TyconRef g.list_tcr_canon & ucref.CaseName = "op_ColonColon" -> Some tinst | _ -> None let (|ListEmptyDiscrim|_|) g = function - | (DecisionTreeTest.UnionCase (ucref,tinst)) + | (DecisionTreeTest.UnionCase (ucref, tinst)) (* check we can use a simple 'isinst' instruction *) - when tyconRefEq g ucref.TyconRef g.list_tcr_canon & ucref.CaseName = "op_Nil" -> Some tinst + when tyconRefEq g ucref.TyconRef g.list_tcr_canon & ucref.CaseName = "op_Nil" -> Some tinst | _ -> None #endif -let (|ConstNeedsDefaultCase|_|) c = - match c with - | Const.Decimal _ - | Const.String _ - | Const.Single _ - | Const.Double _ - | Const.SByte _ +let (|ConstNeedsDefaultCase|_|) c = + match c with + | Const.Decimal _ + | Const.String _ + | Const.Single _ + | Const.Double _ + | Const.SByte _ | Const.Byte _ - | Const.Int16 _ - | Const.UInt16 _ - | Const.Int32 _ - | Const.UInt32 _ - | Const.Int64 _ - | Const.UInt64 _ - | Const.IntPtr _ - | Const.UIntPtr _ + | Const.Int16 _ + | Const.UInt16 _ + | Const.Int32 _ + | Const.UInt32 _ + | Const.Int64 _ + | Const.UInt64 _ + | Const.IntPtr _ + | Const.UIntPtr _ | Const.Char _ -> Some () | _ -> None -/// Build a dtree, equivalent to: TDSwitch("expr",edges,default,m) +/// Build a dtree, equivalent to: TDSwitch("expr", edges, default, m) /// /// Once we've chosen a particular active to investigate, we compile the -/// set of edges affected by this investigation into a switch. +/// set of edges affected by this investigation into a switch. /// -/// - For DecisionTreeTest.ActivePatternCase(...,None,...) there is only one edge +/// - For DecisionTreeTest.ActivePatternCase(..., None, ...) there is only one edge /// /// - For DecisionTreeTest.IsInst there are multiple edges, which we can't deal with /// one switch, so we make an iterated if-then-else to cover the cases. We @@ -557,167 +557,167 @@ let (|ConstNeedsDefaultCase|_|) c = /// switches, string switches and floating point switches are treated in the /// same way as DecisionTreeTest.IsInst. let rec BuildSwitch inpExprOpt g expr edges dflt m = - if verbose then dprintf "--> BuildSwitch@%a, #edges = %A, dflt.IsSome = %A\n" outputRange m (List.length edges) (Option.isSome dflt) - match edges,dflt with + if verbose then dprintf "--> BuildSwitch@%a, #edges = %A, dflt.IsSome = %A\n" outputRange m (List.length edges) (Option.isSome dflt) + match edges, dflt with | [], None -> failwith "internal error: no edges and no default" | [], Some dflt -> dflt (* NOTE: first time around, edges<>[] *) - // Optimize the case where the match always succeeds - | [TCase(_,tree)], None -> tree + // Optimize the case where the match always succeeds + | [TCase(_, tree)], None -> tree + + // 'isinst' tests where we have stored the result of the 'isinst' in a variable + // In this case the 'expr' already holds the result of the 'isinst' test. - // 'isinst' tests where we have stored the result of the 'isinst' in a variable - // In this case the 'expr' already holds the result of the 'isinst' test. + | (TCase(DecisionTreeTest.IsInst _, success)):: edges, dflt when Option.isSome inpExprOpt -> + TDSwitch(expr, [TCase(DecisionTreeTest.IsNull, BuildSwitch None g expr edges dflt m)], Some success, m) - | (TCase(DecisionTreeTest.IsInst _,success)):: edges, dflt when Option.isSome inpExprOpt -> - TDSwitch(expr,[TCase(DecisionTreeTest.IsNull,BuildSwitch None g expr edges dflt m)],Some success,m) - // isnull and isinst tests - | (TCase((DecisionTreeTest.IsNull | DecisionTreeTest.IsInst _),_) as edge):: edges, dflt -> - TDSwitch(expr,[edge],Some (BuildSwitch inpExprOpt g expr edges dflt m),m) + | (TCase((DecisionTreeTest.IsNull | DecisionTreeTest.IsInst _), _) as edge):: edges, dflt -> + TDSwitch(expr, [edge], Some (BuildSwitch inpExprOpt g expr edges dflt m), m) #if OPTIMIZE_LIST_MATCHING - // 'cons/nil' tests where we have stored the result of the cons test in an 'isinst' in a variable - // In this case the 'expr' already holds the result of the 'isinst' test. - | [TCase(ListConsDiscrim g tinst, consCase)], Some emptyCase - | [TCase(ListEmptyDiscrim g tinst, emptyCase)], Some consCase + // 'cons/nil' tests where we have stored the result of the cons test in an 'isinst' in a variable + // In this case the 'expr' already holds the result of the 'isinst' test. + | [TCase(ListConsDiscrim g tinst, consCase)], Some emptyCase + | [TCase(ListEmptyDiscrim g tinst, emptyCase)], Some consCase | [TCase(ListEmptyDiscrim g _, emptyCase); TCase(ListConsDiscrim g tinst, consCase)], None | [TCase(ListConsDiscrim g tinst, consCase); TCase(ListEmptyDiscrim g _, emptyCase)], None - when Option.isSome inpExprOpt -> - TDSwitch(expr, [TCase(DecisionTreeTest.IsNull, emptyCase)], Some consCase, m) + when Option.isSome inpExprOpt -> + TDSwitch(expr, [TCase(DecisionTreeTest.IsNull, emptyCase)], Some consCase, m) #endif - - // All these should also always have default cases - | (TCase(DecisionTreeTest.Const ConstNeedsDefaultCase,_) :: _), None -> - error(InternalError("inexhaustive match - need a default cases!",m)) - - // Split string, float, uint64, int64, unativeint, nativeint matches into serial equality tests - | TCase((DecisionTreeTest.ArrayLength _ | DecisionTreeTest.Const (Const.Single _ | Const.Double _ | Const.String _ | Const.Decimal _ | Const.Int64 _ | Const.UInt64 _ | Const.IntPtr _ | Const.UIntPtr _)),_) :: _, Some dflt -> - List.foldBack - (fun (TCase(discrim,tree)) sofar -> + + // All these should also always have default cases + | (TCase(DecisionTreeTest.Const ConstNeedsDefaultCase, _) :: _), None -> + error(InternalError("inexhaustive match - need a default cases!", m)) + + // Split string, float, uint64, int64, unativeint, nativeint matches into serial equality tests + | TCase((DecisionTreeTest.ArrayLength _ | DecisionTreeTest.Const (Const.Single _ | Const.Double _ | Const.String _ | Const.Decimal _ | Const.Int64 _ | Const.UInt64 _ | Const.IntPtr _ | Const.UIntPtr _)), _) :: _, Some dflt -> + List.foldBack + (fun (TCase(discrim, tree)) sofar -> let testexpr = expr - let testexpr = - match discrim with - | DecisionTreeTest.ArrayLength(n,_) -> - let _v,vExpr,bind = mkCompGenLocalAndInvisbleBind g "testExpr" m testexpr + let testexpr = + match discrim with + | DecisionTreeTest.ArrayLength(n, _) -> + let _v, vExpr, bind = mkCompGenLocalAndInvisbleBind g "testExpr" m testexpr mkLetBind m bind (mkLazyAnd g m (mkNonNullTest g m vExpr) (mkILAsmCeq g m (mkLdlen g m vExpr) (mkInt g m n))) - | DecisionTreeTest.Const (Const.String _ as c) -> - mkCallEqualsOperator g m g.string_ty testexpr (Expr.Const(c,m,g.string_ty)) - | DecisionTreeTest.Const (Const.Decimal _ as c) -> - mkCallEqualsOperator g m g.decimal_ty testexpr (Expr.Const(c,m,g.decimal_ty)) - | DecisionTreeTest.Const ((Const.Double _ | Const.Single _ | Const.Int64 _ | Const.UInt64 _ | Const.IntPtr _ | Const.UIntPtr _) as c) -> - mkILAsmCeq g m testexpr (Expr.Const(c,m,tyOfExpr g testexpr)) - | _ -> error(InternalError("strange switch",m)) + | DecisionTreeTest.Const (Const.String _ as c) -> + mkCallEqualsOperator g m g.string_ty testexpr (Expr.Const(c, m, g.string_ty)) + | DecisionTreeTest.Const (Const.Decimal _ as c) -> + mkCallEqualsOperator g m g.decimal_ty testexpr (Expr.Const(c, m, g.decimal_ty)) + | DecisionTreeTest.Const ((Const.Double _ | Const.Single _ | Const.Int64 _ | Const.UInt64 _ | Const.IntPtr _ | Const.UIntPtr _) as c) -> + mkILAsmCeq g m testexpr (Expr.Const(c, m, tyOfExpr g testexpr)) + | _ -> error(InternalError("strange switch", m)) mkBoolSwitch m testexpr tree sofar) edges dflt - // Split integer and char matches into compact fragments which will themselves become switch statements. - | TCase(DecisionTreeTest.Const c,_) :: _, Some dflt when canCompactConstantClass c -> - let edgeCompare c1 c2 = - match constOfCase c1,constOfCase c2 with - | (Const.SByte i1),(Const.SByte i2) -> compare i1 i2 - | (Const.Int16 i1),(Const.Int16 i2) -> compare i1 i2 - | (Const.Int32 i1),(Const.Int32 i2) -> compare i1 i2 - | (Const.Byte i1),(Const.Byte i2) -> compare i1 i2 - | (Const.UInt16 i1),(Const.UInt16 i2) -> compare i1 i2 - | (Const.UInt32 i1),(Const.UInt32 i2) -> compare i1 i2 - | (Const.Char c1),(Const.Char c2) -> compare c1 c2 - | _ -> failwith "illtyped term during pattern compilation" + // Split integer and char matches into compact fragments which will themselves become switch statements. + | TCase(DecisionTreeTest.Const c, _) :: _, Some dflt when canCompactConstantClass c -> + let edgeCompare c1 c2 = + match constOfCase c1, constOfCase c2 with + | (Const.SByte i1), (Const.SByte i2) -> compare i1 i2 + | (Const.Int16 i1), (Const.Int16 i2) -> compare i1 i2 + | (Const.Int32 i1), (Const.Int32 i2) -> compare i1 i2 + | (Const.Byte i1), (Const.Byte i2) -> compare i1 i2 + | (Const.UInt16 i1), (Const.UInt16 i2) -> compare i1 i2 + | (Const.UInt32 i1), (Const.UInt32 i2) -> compare i1 i2 + | (Const.Char c1), (Const.Char c2) -> compare c1 c2 + | _ -> failwith "illtyped term during pattern compilation" let edges' = List.sortWith edgeCompare edges - let rec compactify curr edges = - match curr,edges with - | None,[] -> [] - | Some last,[] -> [List.rev last] - | None,h::t -> compactify (Some [h]) t - | Some (prev::moreprev),h::t -> - match constOfCase prev,constOfCase h with - | Const.SByte iprev,Const.SByte inext when int32(iprev) + 1 = int32 inext -> + let rec compactify curr edges = + match curr, edges with + | None, [] -> [] + | Some last, [] -> [List.rev last] + | None, h::t -> compactify (Some [h]) t + | Some (prev::moreprev), h::t -> + match constOfCase prev, constOfCase h with + | Const.SByte iprev, Const.SByte inext when int32(iprev) + 1 = int32 inext -> compactify (Some (h::prev::moreprev)) t - | Const.Int16 iprev,Const.Int16 inext when int32(iprev) + 1 = int32 inext -> + | Const.Int16 iprev, Const.Int16 inext when int32(iprev) + 1 = int32 inext -> compactify (Some (h::prev::moreprev)) t - | Const.Int32 iprev,Const.Int32 inext when iprev+1 = inext -> + | Const.Int32 iprev, Const.Int32 inext when iprev+1 = inext -> compactify (Some (h::prev::moreprev)) t - | Const.Byte iprev,Const.Byte inext when int32(iprev) + 1 = int32 inext -> + | Const.Byte iprev, Const.Byte inext when int32(iprev) + 1 = int32 inext -> compactify (Some (h::prev::moreprev)) t - | Const.UInt16 iprev,Const.UInt16 inext when int32(iprev)+1 = int32 inext -> + | Const.UInt16 iprev, Const.UInt16 inext when int32(iprev)+1 = int32 inext -> compactify (Some (h::prev::moreprev)) t - | Const.UInt32 iprev,Const.UInt32 inext when int32(iprev)+1 = int32 inext -> + | Const.UInt32 iprev, Const.UInt32 inext when int32(iprev)+1 = int32 inext -> compactify (Some (h::prev::moreprev)) t - | Const.Char cprev,Const.Char cnext when (int32 cprev + 1 = int32 cnext) -> + | Const.Char cprev, Const.Char cnext when (int32 cprev + 1 = int32 cnext) -> compactify (Some (h::prev::moreprev)) t | _ -> (List.rev (prev::moreprev)) :: compactify None edges | _ -> failwith "internal error: compactify" let edgeGroups = compactify None edges' - (edgeGroups, dflt) ||> List.foldBack (fun edgeGroup sofar -> TDSwitch(expr,edgeGroup,Some sofar,m)) + (edgeGroups, dflt) ||> List.foldBack (fun edgeGroup sofar -> TDSwitch(expr, edgeGroup, Some sofar, m)) - // For a total pattern match, run the active pattern, bind the result and - // recursively build a switch in the choice type - | (TCase(DecisionTreeTest.ActivePatternCase _,_)::_), _ -> - error(InternalError("DecisionTreeTest.ActivePatternCase should have been eliminated",m)) + // For a total pattern match, run the active pattern, bind the result and + // recursively build a switch in the choice type + | (TCase(DecisionTreeTest.ActivePatternCase _, _)::_), _ -> + error(InternalError("DecisionTreeTest.ActivePatternCase should have been eliminated", m)) - // For a complete match, optimize one test to be the default - | (TCase(_,tree)::rest), None -> TDSwitch (expr,rest,Some tree,m) + // For a complete match, optimize one test to be the default + | (TCase(_, tree)::rest), None -> TDSwitch (expr, rest, Some tree, m) - // Otherwise let codegen make the choices - | _ -> TDSwitch (expr,edges,dflt,m) + // Otherwise let codegen make the choices + | _ -> TDSwitch (expr, edges, dflt, m) #if DEBUG -let rec layoutPat pat = +let rec layoutPat pat = match pat with - | TPat_query (_,pat,_) -> Layout.(--) (Layout.wordL (Layout.TaggedTextOps.tagText "query")) (layoutPat pat) + | TPat_query (_, pat, _) -> Layout.(--) (Layout.wordL (Layout.TaggedTextOps.tagText "query")) (layoutPat pat) | TPat_wild _ -> Layout.wordL (Layout.TaggedTextOps.tagText "wild") | TPat_as _ -> Layout.wordL (Layout.TaggedTextOps.tagText "var") - | TPat_tuple (_, pats, _, _) + | TPat_tuple (_, pats, _, _) | TPat_array (pats, _, _) -> Layout.bracketL (Layout.tupleL (List.map layoutPat pats)) | _ -> Layout.wordL (Layout.TaggedTextOps.tagText "?") - + let layoutPath _p = Layout.wordL (Layout.TaggedTextOps.tagText "") - + let layoutActive (Active (path, _subexpr, pat)) = - Layout.(--) (Layout.wordL (Layout.TaggedTextOps.tagText "Active")) (Layout.tupleL [layoutPath path; layoutPat pat]) - -let layoutFrontier (Frontier (i,actives,_)) = - Layout.(--) (Layout.wordL (Layout.TaggedTextOps.tagText "Frontier ")) (Layout.tupleL [intL i; Layout.listL layoutActive actives]) + Layout.(--) (Layout.wordL (Layout.TaggedTextOps.tagText "Active")) (Layout.tupleL [layoutPath path; layoutPat pat]) + +let layoutFrontier (Frontier (i, actives, _)) = + Layout.(--) (Layout.wordL (Layout.TaggedTextOps.tagText "Frontier ")) (Layout.tupleL [intL i; Layout.listL layoutActive actives]) #endif -let mkFrontiers investigations i = - List.map (fun (actives,valMap) -> Frontier(i,actives,valMap)) investigations +let mkFrontiers investigations i = + List.map (fun (actives, valMap) -> Frontier(i, actives, valMap)) investigations -let getRuleIndex (Frontier (i,_active,_valMap)) = i +let getRuleIndex (Frontier (i, _active, _valMap)) = i /// Is a pattern a partial pattern? -let rec isPatternPartial p = - match p with - | TPat_query ((_,_,_,_,apinfo),p,_m) -> not apinfo.IsTotal || isPatternPartial p +let rec isPatternPartial p = + match p with + | TPat_query ((_, _, _, _, apinfo), p, _m) -> not apinfo.IsTotal || isPatternPartial p | TPat_const _ -> false | TPat_wild _ -> false - | TPat_as (p,_,_) -> isPatternPartial p - | TPat_disjs (ps,_) | TPat_conjs(ps,_) - | TPat_tuple (_,ps,_,_) | TPat_exnconstr(_,ps,_) - | TPat_array (ps,_,_) | TPat_unioncase (_,_,ps,_) - | TPat_recd (_,_,ps,_) -> List.exists isPatternPartial ps + | TPat_as (p, _, _) -> isPatternPartial p + | TPat_disjs (ps, _) | TPat_conjs(ps, _) + | TPat_tuple (_, ps, _, _) | TPat_exnconstr(_, ps, _) + | TPat_array (ps, _, _) | TPat_unioncase (_, _, ps, _) + | TPat_recd (_, _, ps, _) -> List.exists isPatternPartial ps | TPat_range _ -> false | TPat_null _ -> false | TPat_isinst _ -> false -let rec erasePartialPatterns inpp = - match inpp with - | TPat_query ((expr,resTys,apatVrefOpt,idx,apinfo),p,m) -> - if apinfo.IsTotal then TPat_query ((expr,resTys,apatVrefOpt,idx,apinfo),erasePartialPatterns p,m) - else TPat_disjs ([],m) (* always fail *) - | TPat_as (p,x,m) -> TPat_as (erasePartialPatterns p,x,m) - | TPat_disjs (ps,m) -> TPat_disjs(erasePartials ps, m) - | TPat_conjs(ps,m) -> TPat_conjs(erasePartials ps, m) - | TPat_tuple (tupInfo,ps,x,m) -> TPat_tuple(tupInfo,erasePartials ps, x, m) - | TPat_exnconstr(x,ps,m) -> TPat_exnconstr(x,erasePartials ps,m) - | TPat_array (ps,x,m) -> TPat_array (erasePartials ps,x,m) - | TPat_unioncase (x,y,ps,m) -> TPat_unioncase (x,y,erasePartials ps,m) - | TPat_recd (x,y,ps,m) -> TPat_recd (x,y,List.map erasePartialPatterns ps,m) - | TPat_const _ - | TPat_wild _ - | TPat_range _ - | TPat_null _ +let rec erasePartialPatterns inpp = + match inpp with + | TPat_query ((expr, resTys, apatVrefOpt, idx, apinfo), p, m) -> + if apinfo.IsTotal then TPat_query ((expr, resTys, apatVrefOpt, idx, apinfo), erasePartialPatterns p, m) + else TPat_disjs ([], m) (* always fail *) + | TPat_as (p, x, m) -> TPat_as (erasePartialPatterns p, x, m) + | TPat_disjs (ps, m) -> TPat_disjs(erasePartials ps, m) + | TPat_conjs(ps, m) -> TPat_conjs(erasePartials ps, m) + | TPat_tuple (tupInfo, ps, x, m) -> TPat_tuple(tupInfo, erasePartials ps, x, m) + | TPat_exnconstr(x, ps, m) -> TPat_exnconstr(x, erasePartials ps, m) + | TPat_array (ps, x, m) -> TPat_array (erasePartials ps, x, m) + | TPat_unioncase (x, y, ps, m) -> TPat_unioncase (x, y, erasePartials ps, m) + | TPat_recd (x, y, ps, m) -> TPat_recd (x, y, List.map erasePartialPatterns ps, m) + | TPat_const _ + | TPat_wild _ + | TPat_range _ + | TPat_null _ | TPat_isinst _ -> inpp and erasePartials inps = List.map erasePartialPatterns inps @@ -727,171 +727,171 @@ and erasePartials inps = List.map erasePartialPatterns inps //--------------------------------------------------------------------------- type EdgeDiscrim = EdgeDiscrim of int * DecisionTreeTest * range -let getDiscrim (EdgeDiscrim(_,discrim,_)) = discrim +let getDiscrim (EdgeDiscrim(_, discrim, _)) = discrim -let CompilePatternBasic - g denv amap exprm matchm - warnOnUnused - warnOnIncomplete - actionOnFailure - (origInputVal, origInputValTypars, _origInputExprOpt: Expr option) +let CompilePatternBasic + g denv amap exprm matchm + warnOnUnused + warnOnIncomplete + actionOnFailure + (origInputVal, origInputValTypars, _origInputExprOpt: Expr option) (clausesL: TypedMatchClause list) inputTy - resultTy = - // Add the targets to a match builder + resultTy = + // Add the targets to a match builder // Note the input expression has already been evaluated and saved into a variable. // Hence no need for a new sequence point. - let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,exprm) + let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding, exprm) clausesL |> List.iteri (fun _i c -> mbuilder.AddTarget c.Target |> ignore) - - // Add the incomplete or rethrow match clause on demand, printing a - // warning if necessary (only if it is ever exercised) + + // Add the incomplete or rethrow match clause on demand, printing a + // warning if necessary (only if it is ever exercised) let incompleteMatchClauseOnce = ref None - let getIncompleteMatchClause (refuted) = - // This is lazy because emit a - // warning when the lazy thunk gets evaluated - match !incompleteMatchClauseOnce with - | None -> - (* Emit the incomplete match warning *) - if warnOnIncomplete then - match actionOnFailure with + let getIncompleteMatchClause (refuted) = + // This is lazy because emit a + // warning when the lazy thunk gets evaluated + match !incompleteMatchClauseOnce with + | None -> + (* Emit the incomplete match warning *) + if warnOnIncomplete then + match actionOnFailure with | ThrowIncompleteMatchException | IgnoreWithWarning -> let ignoreWithWarning = (actionOnFailure = IgnoreWithWarning) match ShowCounterExample g denv matchm refuted with - | Some(text,failingWhenClause,true) -> - warning (EnumMatchIncomplete(ignoreWithWarning, Some(text,failingWhenClause), matchm)) - | Some(text,failingWhenClause,false) -> - warning (MatchIncomplete(ignoreWithWarning, Some(text,failingWhenClause), matchm)) + | Some(text, failingWhenClause, true) -> + warning (EnumMatchIncomplete(ignoreWithWarning, Some(text, failingWhenClause), matchm)) + | Some(text, failingWhenClause, false) -> + warning (MatchIncomplete(ignoreWithWarning, Some(text, failingWhenClause), matchm)) | None -> warning (MatchIncomplete(ignoreWithWarning, None, matchm)) - | _ -> + | _ -> () - + let throwExpr = match actionOnFailure with - | FailFilter -> + | FailFilter -> // Return 0 from the .NET exception filter mkInt g matchm 0 - | Rethrow -> + | Rethrow -> // Rethrow unmatched try-catch exn. No sequence point at the target since its not // real code. - mkReraise matchm resultTy - - | Throw -> + mkReraise matchm resultTy + + | Throw -> // We throw instead of rethrow on unmatched try-catch in a computation expression. But why? // Because this isn't a real .NET exception filter/handler but just a function we're passing // to a computation expression builder to simulate one. - mkThrow matchm resultTy (exprForVal matchm origInputVal) - - | ThrowIncompleteMatchException -> - mkThrow matchm resultTy - (mkExnExpr(mk_MFCore_tcref g.fslibCcu "MatchFailureException", - [ mkString g matchm matchm.FileName - mkInt g matchm matchm.StartLine - mkInt g matchm matchm.StartColumn],matchm)) - - | IgnoreWithWarning -> + mkThrow matchm resultTy (exprForVal matchm origInputVal) + + | ThrowIncompleteMatchException -> + mkThrow matchm resultTy + (mkExnExpr(mk_MFCore_tcref g.fslibCcu "MatchFailureException", + [ mkString g matchm matchm.FileName + mkInt g matchm matchm.StartLine + mkInt g matchm matchm.StartColumn], matchm)) + + | IgnoreWithWarning -> mkUnit g matchm - // We don't emit a sequence point at any of the above cases because they don't correspond to - // user code. + // We don't emit a sequence point at any of the above cases because they don't correspond to + // user code. // // Note we don't emit sequence points at either the succeeding or failing - // targets of filters since if the exception is filtered successfully then we + // targets of filters since if the exception is filtered successfully then we // will run the handler and hit the sequence point there. // That sequence point will have the pattern variables bound, which is exactly what we want. - let tg = TTarget(List.empty,throwExpr,SuppressSequencePointAtTarget ) + let tg = TTarget(List.empty, throwExpr, SuppressSequencePointAtTarget ) mbuilder.AddTarget tg |> ignore - let clause = TClause(TPat_wild matchm,None,tg,matchm) + let clause = TClause(TPat_wild matchm, None, tg, matchm) incompleteMatchClauseOnce := Some(clause) clause - + | Some c -> c - // Helpers to get the variables bound at a target. We conceptually add a dummy clause that will always succeed with a "throw" + // Helpers to get the variables bound at a target. We conceptually add a dummy clause that will always succeed with a "throw" let clausesA = Array.ofList clausesL let nclauses = clausesA.Length - let GetClause i refuted = - if i < nclauses then - clausesA.[i] + let GetClause i refuted = + if i < nclauses then + clausesA.[i] elif i = nclauses then getIncompleteMatchClause(refuted) else failwith "GetClause" let GetValsBoundByClause i refuted = (GetClause i refuted).BoundVals let GetWhenGuardOfClause i refuted = (GetClause i refuted).GuardExpr - - // Different uses of parameterized active patterns have different identities as far as paths + + // Different uses of parameterized active patterns have different identities as far as paths // are concerned. Here we generate unique numbers that are completely different to any stamp // by usig negative numbers. let genUniquePathId() = - (newUnique()) - // Build versions of these functions which apply a dummy instantiation to the overall type arguments - let GetSubExprOfInput,getDiscrimOfPattern = + // Build versions of these functions which apply a dummy instantiation to the overall type arguments + let GetSubExprOfInput, getDiscrimOfPattern = let tyargs = List.map (fun _ -> g.unit_ty) origInputValTypars let unit_tpinst = mkTyparInst origInputValTypars tyargs - GetSubExprOfInput g (origInputValTypars,tyargs,unit_tpinst), + GetSubExprOfInput g (origInputValTypars, tyargs, unit_tpinst), getDiscrimOfPattern g unit_tpinst - // The main recursive loop of the pattern match compiler - let rec InvestigateFrontiers refuted frontiers = + // The main recursive loop of the pattern match compiler + let rec InvestigateFrontiers refuted frontiers = match frontiers with | [] -> failwith "CompilePattern:compile - empty clauses: at least the final clause should always succeed" - | (Frontier (i,active,valMap)) :: rest -> + | (Frontier (i, active, valMap)) :: rest -> - // Check to see if we've got a succeeding clause. There may still be a 'when' condition for the clause + // Check to see if we've got a succeeding clause. There may still be a 'when' condition for the clause match active with - | [] -> CompileSuccessPointAndGuard i refuted valMap rest + | [] -> CompileSuccessPointAndGuard i refuted valMap rest - | _ -> + | _ -> (* Otherwise choose a point (i.e. a path) to investigate. *) - let (Active(path,subexpr,pat)) = ChooseInvestigationPointLeftToRight frontiers + let (Active(path, subexpr, pat)) = ChooseInvestigationPointLeftToRight frontiers match pat with - // All these constructs should have been eliminated in BindProjectionPattern + // All these constructs should have been eliminated in BindProjectionPattern | TPat_as _ | TPat_tuple _ | TPat_wild _ | TPat_disjs _ | TPat_conjs _ | TPat_recd _ -> failwith "Unexpected pattern" - // Leaving the ones where we have real work to do - | _ -> + // Leaving the ones where we have real work to do + | _ -> + + let simulSetOfEdgeDiscrims, fallthroughPathFrontiers = ChooseSimultaneousEdges frontiers path + + let inpExprOpt, bindOpt = ChoosePreBinder simulSetOfEdgeDiscrims subexpr - let simulSetOfEdgeDiscrims,fallthroughPathFrontiers = ChooseSimultaneousEdges frontiers path + // For each case, recursively compile the residue decision trees that result if that case successfully matches + let simulSetOfCases, _ = CompileSimultaneousSet frontiers path refuted subexpr simulSetOfEdgeDiscrims inpExprOpt - let inpExprOpt, bindOpt = ChoosePreBinder simulSetOfEdgeDiscrims subexpr - - // For each case, recursively compile the residue decision trees that result if that case successfully matches - let simulSetOfCases, _ = CompileSimultaneousSet frontiers path refuted subexpr simulSetOfEdgeDiscrims inpExprOpt - assert (not (isNil simulSetOfCases)) - // Work out what the default/fall-through tree looks like, is any - // Check if match is complete, if so optimize the default case away. - + // Work out what the default/fall-through tree looks like, is any + // Check if match is complete, if so optimize the default case away. + let defaultTreeOpt : DecisionTree option = CompileFallThroughTree fallthroughPathFrontiers path refuted simulSetOfCases - // OK, build the whole tree and whack on the binding if any - let finalDecisionTree = + // OK, build the whole tree and whack on the binding if any + let finalDecisionTree = let inpExprToSwitch = (match inpExprOpt with Some vExpr -> vExpr | None -> GetSubExprOfInput subexpr) let tree = BuildSwitch inpExprOpt g inpExprToSwitch simulSetOfCases defaultTreeOpt matchm - match bindOpt with + match bindOpt with | None -> tree - | Some bind -> TDBind (bind,tree) - + | Some bind -> TDBind (bind, tree) + finalDecisionTree and CompileSuccessPointAndGuard i refuted valMap rest = let vs2 = GetValsBoundByClause i refuted - let es2 = - vs2 |> List.map (fun v -> - match valMap.TryFind v with - | None -> error(Error(FSComp.SR.patcMissingVariable(v.DisplayName),v.Range)) + let es2 = + vs2 |> List.map (fun v -> + match valMap.TryFind v with + | None -> error(Error(FSComp.SR.patcMissingVariable(v.DisplayName), v.Range)) | Some res -> res) let rhs' = TDSuccess(es2, i) - match GetWhenGuardOfClause i refuted with - | Some whenExpr -> + match GetWhenGuardOfClause i refuted with + | Some whenExpr -> let m = whenExpr.Range - // SEQUENCE POINTS: REVIEW: Build a sequence point at 'when' + // SEQUENCE POINTS: REVIEW: Build a sequence point at 'when' let whenExpr = mkLetsFromBindings m (mkInvisibleBinds vs2 es2) whenExpr // We must duplicate both the bindings and the guard expression to ensure uniqueness of bound variables. @@ -899,57 +899,57 @@ let CompilePatternBasic // // let whenExpr = copyExpr g CloneAll whenExpr // - // However, we are not allowed to copy expressions until type checking is complete, because this + // However, we are not allowed to copy expressions until type checking is complete, because this // would lose recursive fixup points within the expressions (see FSharp 1.0 bug 4821). mkBoolSwitch m whenExpr rhs' (InvestigateFrontiers (RefutedWhenClause::refuted) rest) - | None -> rhs' + | None -> rhs' - /// Select the set of discriminators which we can handle in one test, or as a series of - /// iterated tests, e.g. in the case of TPat_isinst. Ensure we only take at most one class of TPat_query(_) at a time. - /// Record the rule numbers so we know which rule the TPat_query cam from, so that when we project through - /// the frontier we only project the right rule. + /// Select the set of discriminators which we can handle in one test, or as a series of + /// iterated tests, e.g. in the case of TPat_isinst. Ensure we only take at most one class of TPat_query(_) at a time. + /// Record the rule numbers so we know which rule the TPat_query cam from, so that when we project through + /// the frontier we only project the right rule. and ChooseSimultaneousEdges frontiers path = - frontiers |> chooseSimultaneousEdgeSet None (fun prevOpt (Frontier (i',active',_)) -> - if isMemOfActives path active' then + frontiers |> chooseSimultaneousEdgeSet None (fun prevOpt (Frontier (i', active', _)) -> + if isMemOfActives path active' then let p = lookupActive path active' |> snd match getDiscrimOfPattern p with - | Some discrim -> - if (match prevOpt with None -> true | Some (EdgeDiscrim(_,discrimPrev,_)) -> discrimsHaveSameSimultaneousClass g discrim discrimPrev) then - Some (EdgeDiscrim(i',discrim,p.Range)),true - else - None,false - - | None -> - None,true - else - None,true) - - and IsCopyableInputExpr origInputExpr = - match origInputExpr with - | Expr.Op (TOp.LValueOp (LByrefGet, v), [], [], _) when not v.IsMutable -> true + | Some discrim -> + if (match prevOpt with None -> true | Some (EdgeDiscrim(_, discrimPrev, _)) -> discrimsHaveSameSimultaneousClass g discrim discrimPrev) then + Some (EdgeDiscrim(i', discrim, p.Range)), true + else + None, false + + | None -> + None, true + else + None, true) + + and IsCopyableInputExpr origInputExpr = + match origInputExpr with + | Expr.Op (TOp.LValueOp (LByrefGet, v), [], [], _) when not v.IsMutable -> true | _ -> false and ChoosePreBinder simulSetOfEdgeDiscrims subexpr = - match simulSetOfEdgeDiscrims with - // Very simple 'isinst' tests: put the result of 'isinst' in a local variable + match simulSetOfEdgeDiscrims with + // Very simple 'isinst' tests: put the result of 'isinst' in a local variable // - // That is, transform - // 'if istype e then ...unbox e .... ' + // That is, transform + // 'if istype e then ...unbox e .... ' // into - // 'let v = isinst e in .... if nonnull v then ...v .... ' + // 'let v = isinst e in .... if nonnull v then ...v .... ' // // This is really an optimization that could be done more effectively in opt.fs - // if we flowed a bit of information through + // if we flowed a bit of information through + - - | EdgeDiscrim(_i',(DecisionTreeTest.IsInst (_srcty,tgty)),m) :: _rest + | EdgeDiscrim(_i', (DecisionTreeTest.IsInst (_srcty, tgty)), m) :: _rest (* check we can use a simple 'isinst' instruction *) when canUseTypeTestFast g tgty && isNil origInputValTypars -> - let v,vExpr = mkCompGenLocal m "typeTestResult" tgty - if origInputVal.IsMemberOrModuleBinding then + let v, vExpr = mkCompGenLocal m "typeTestResult" tgty + if origInputVal.IsMemberOrModuleBinding then AdjustValToTopVal v origInputVal.DeclaringEntity ValReprInfo.emptyValData let argExpr = GetSubExprOfInput subexpr let appExpr = mkIsInst tgty argExpr matchm @@ -957,26 +957,26 @@ let CompilePatternBasic // Any match on a struct union must take the address of its input. // We can shortcut the addrof when the original input is a deref of a byref value. - | EdgeDiscrim(_i',(DecisionTreeTest.UnionCase (ucref, _)),_) :: _rest + | EdgeDiscrim(_i', (DecisionTreeTest.UnionCase (ucref, _)), _) :: _rest when isNil origInputValTypars && ucref.Tycon.IsStructRecordOrUnionTycon -> let argExpr = GetSubExprOfInput subexpr - let argExpr = - match argExpr, _origInputExprOpt with + let argExpr = + match argExpr, _origInputExprOpt with | Expr.Val(v1, _, _), Some origInputExpr when valEq origInputVal v1.Deref && IsCopyableInputExpr origInputExpr -> origInputExpr | _ -> argExpr let vOpt, addrExp, _readonly, _writeonly = mkExprAddrOfExprAux g true false NeverMutates argExpr None matchm - match vOpt with + match vOpt with | None -> Some addrExp, None - | Some (v,e) -> - if origInputVal.IsMemberOrModuleBinding then + | Some (v, e) -> + if origInputVal.IsMemberOrModuleBinding then AdjustValToTopVal v origInputVal.DeclaringEntity ValReprInfo.emptyValData - Some addrExp, Some (mkInvisibleBind v e) - + Some addrExp, Some (mkInvisibleBind v e) + #if OPTIMIZE_LIST_MATCHING - | [EdgeDiscrim(_, ListConsDiscrim g tinst,m); EdgeDiscrim(_, ListEmptyDiscrim g _, _)] + | [EdgeDiscrim(_, ListConsDiscrim g tinst, m); EdgeDiscrim(_, ListEmptyDiscrim g _, _)] | [EdgeDiscrim(_, ListEmptyDiscrim g _, _); EdgeDiscrim(_, ListConsDiscrim g tinst, m)] | [EdgeDiscrim(_, ListConsDiscrim g tinst, m)] | [EdgeDiscrim(_, ListEmptyDiscrim g tinst, m)] @@ -984,132 +984,132 @@ let CompilePatternBasic when isNil origInputValTypars -> let ucaseTy = (mkProvenUnionCaseTy g.cons_ucref tinst) - let v,vExpr = mkCompGenLocal m "unionTestResult" ucaseTy - if origInputVal.IsMemberOrModuleBinding then + let v, vExpr = mkCompGenLocal m "unionTestResult" ucaseTy + if origInputVal.IsMemberOrModuleBinding then AdjustValToTopVal v origInputVal.DeclaringEntity ValReprInfo.emptyValData let argExpr = GetSubExprOfInput subexpr let appExpr = mkIsInst ucaseTy argExpr matchm - Some vExpr,Some (mkInvisibleBind v appExpr) + Some vExpr, Some (mkInvisibleBind v appExpr) #endif - // Active pattern matches: create a variable to hold the results of executing the active pattern. - | (EdgeDiscrim(_,(DecisionTreeTest.ActivePatternCase(activePatExpr,resTys,_,_,apinfo)),m) :: _) -> - - if not (isNil origInputValTypars) then error(InternalError("Unexpected generalized type variables when compiling an active pattern",m)) + // Active pattern matches: create a variable to hold the results of executing the active pattern. + | (EdgeDiscrim(_, (DecisionTreeTest.ActivePatternCase(activePatExpr, resTys, _, _, apinfo)), m) :: _) -> + + if not (isNil origInputValTypars) then error(InternalError("Unexpected generalized type variables when compiling an active pattern", m)) let resTy = apinfo.ResultType g m resTys - let v,vExpr = mkCompGenLocal m ("activePatternResult" + string (newUnique())) resTy - if origInputVal.IsMemberOrModuleBinding then + let v, vExpr = mkCompGenLocal m ("activePatternResult" + string (newUnique())) resTy + if origInputVal.IsMemberOrModuleBinding then AdjustValToTopVal v origInputVal.DeclaringEntity ValReprInfo.emptyValData let argExpr = GetSubExprOfInput subexpr - let appExpr = mkApps g ((activePatExpr, tyOfExpr g activePatExpr), [], [argExpr],m) - - Some(vExpr),Some(mkInvisibleBind v appExpr) - | _ -> None,None - + let appExpr = mkApps g ((activePatExpr, tyOfExpr g activePatExpr), [], [argExpr], m) + + Some(vExpr), Some(mkInvisibleBind v appExpr) + | _ -> None, None + and CompileSimultaneousSet frontiers path refuted subexpr simulSetOfEdgeDiscrims (inpExprOpt: Expr option) = - ([],simulSetOfEdgeDiscrims) ||> List.collectFold (fun taken (EdgeDiscrim(i',discrim,m)) -> - // Check to see if we've already collected the edge for this case, in which case skip it. - if List.exists (isDiscrimSubsumedBy g amap m discrim) taken then - // Skip this edge: it is refuted - ([],taken) - else + ([], simulSetOfEdgeDiscrims) ||> List.collectFold (fun taken (EdgeDiscrim(i', discrim, m)) -> + // Check to see if we've already collected the edge for this case, in which case skip it. + if List.exists (isDiscrimSubsumedBy g amap m discrim) taken then + // Skip this edge: it is refuted + ([], taken) + else // Make a resVar to hold the results of the successful "proof" that a union value is - // a successful union case. That is, transform - // 'match v with - // | A _ -> ... - // | B _ -> ...' + // a successful union case. That is, transform + // 'match v with + // | A _ -> ... + // | B _ -> ...' // into - // 'match v with - // | A _ -> let vA = (v ~~> A) in .... - // | B _ -> let vB = (v ~~> B) in .... ' + // 'match v with + // | A _ -> let vA = (v ~~> A) in .... + // | B _ -> let vB = (v ~~> B) in .... ' // // Only do this for union cases that actually have some fields and with more than one case - let resPostBindOpt,ucaseBindOpt = - match discrim with - | DecisionTreeTest.UnionCase (ucref, tinst) when + let resPostBindOpt, ucaseBindOpt = + match discrim with + | DecisionTreeTest.UnionCase (ucref, tinst) when #if OPTIMIZE_LIST_MATCHING isNone inpExprOpt && #endif - (isNil origInputValTypars && - not origInputVal.IsMemberOrModuleBinding && + (isNil origInputValTypars && + not origInputVal.IsMemberOrModuleBinding && not ucref.Tycon.IsStructRecordOrUnionTycon && - ucref.UnionCase.RecdFields.Length >= 1 && + ucref.UnionCase.RecdFields.Length >= 1 && ucref.Tycon.UnionCasesArray.Length > 1) -> - let v,vExpr = mkCompGenLocal m "unionCase" (mkProvenUnionCaseTy ucref tinst) + let v, vExpr = mkCompGenLocal m "unionCase" (mkProvenUnionCaseTy ucref tinst) let argExpr = GetSubExprOfInput subexpr - let appExpr = mkUnionCaseProof (argExpr, ucref,tinst,m) - Some vExpr,Some(mkInvisibleBind v appExpr) - | _ -> - None,None - - // Convert active pattern edges to tests on results data - let discrim' = - match discrim with - | DecisionTreeTest.ActivePatternCase(_pexp,resTys,_apatVrefOpt,idx,apinfo) -> + let appExpr = mkUnionCaseProof (argExpr, ucref, tinst, m) + Some vExpr, Some(mkInvisibleBind v appExpr) + | _ -> + None, None + + // Convert active pattern edges to tests on results data + let discrim' = + match discrim with + | DecisionTreeTest.ActivePatternCase(_pexp, resTys, _apatVrefOpt, idx, apinfo) -> let aparity = apinfo.Names.Length let total = apinfo.IsTotal - if not total && aparity > 1 then - error(Error(FSComp.SR.patcPartialActivePatternsGenerateOneResult(),m)) - - if not total then DecisionTreeTest.UnionCase(mkSomeCase g,resTys) - elif aparity <= 1 then DecisionTreeTest.Const(Const.Unit) - else DecisionTreeTest.UnionCase(mkChoiceCaseRef g m aparity idx,resTys) + if not total && aparity > 1 then + error(Error(FSComp.SR.patcPartialActivePatternsGenerateOneResult(), m)) + + if not total then DecisionTreeTest.UnionCase(mkSomeCase g, resTys) + elif aparity <= 1 then DecisionTreeTest.Const(Const.Unit) + else DecisionTreeTest.UnionCase(mkChoiceCaseRef g m aparity idx, resTys) | _ -> discrim - - // Project a successful edge through the frontiers. - let investigation = Investigation(i',discrim,path) - let frontiers = frontiers |> List.collect (GenerateNewFrontiersAfterSucccessfulInvestigation inpExprOpt resPostBindOpt investigation) + // Project a successful edge through the frontiers. + let investigation = Investigation(i', discrim, path) + + let frontiers = frontiers |> List.collect (GenerateNewFrontiersAfterSucccessfulInvestigation inpExprOpt resPostBindOpt investigation) let tree = InvestigateFrontiers refuted frontiers // Bind the resVar for the union case, if we have one - let tree = - match ucaseBindOpt with + let tree = + match ucaseBindOpt with | None -> tree - | Some bind -> TDBind (bind,tree) - // Return the edge - let edge = TCase(discrim',tree) + | Some bind -> TDBind (bind, tree) + // Return the edge + let edge = TCase(discrim', tree) [edge], (discrim :: taken) ) and CompileFallThroughTree fallthroughPathFrontiers path refuted (simulSetOfCases: DecisionTreeCase list) = let simulSetOfDiscrims = simulSetOfCases |> List.map (fun c -> c.Discriminator) - let isRefuted (Frontier (_i',active',_)) = + let isRefuted (Frontier (_i', active', _)) = isMemOfActives path active' && let p = lookupActive path active' |> snd - match getDiscrimOfPattern p with - | Some(discrim) -> List.exists (isDiscrimSubsumedBy g amap exprm discrim) simulSetOfDiscrims + match getDiscrimOfPattern p with + | Some(discrim) -> List.exists (isDiscrimSubsumedBy g amap exprm discrim) simulSetOfDiscrims | None -> false - match simulSetOfDiscrims with + match simulSetOfDiscrims with | DecisionTreeTest.Const (Const.Bool _b) :: _ when simulSetOfCases.Length = 2 -> None | DecisionTreeTest.Const (Const.Unit) :: _ -> None - | DecisionTreeTest.UnionCase (ucref,_) :: _ when simulSetOfCases.Length = ucref.TyconRef.UnionCasesArray.Length -> None - | DecisionTreeTest.ActivePatternCase _ :: _ -> error(InternalError("DecisionTreeTest.ActivePatternCase should have been eliminated",matchm)) - | _ -> + | DecisionTreeTest.UnionCase (ucref, _) :: _ when simulSetOfCases.Length = ucref.TyconRef.UnionCasesArray.Length -> None + | DecisionTreeTest.ActivePatternCase _ :: _ -> error(InternalError("DecisionTreeTest.ActivePatternCase should have been eliminated", matchm)) + | _ -> let fallthroughPathFrontiers = List.filter (isRefuted >> not) fallthroughPathFrontiers - + (* Add to the refuted set *) - let refuted = (RefutedInvestigation(path,simulSetOfDiscrims)) :: refuted - + let refuted = (RefutedInvestigation(path, simulSetOfDiscrims)) :: refuted + match fallthroughPathFrontiers with - | [] -> + | [] -> None - | _ -> + | _ -> Some(InvestigateFrontiers refuted fallthroughPathFrontiers) - - // Build a new frontier that represents the result of a successful investigation - // at rule point (i',discrim,path) - and GenerateNewFrontiersAfterSucccessfulInvestigation inpExprOpt resPostBindOpt (Investigation(i',discrim,path)) (Frontier (i, active,valMap) as frontier) = + + // Build a new frontier that represents the result of a successful investigation + // at rule point (i', discrim, path) + and GenerateNewFrontiersAfterSucccessfulInvestigation inpExprOpt resPostBindOpt (Investigation(i', discrim, path)) (Frontier (i, active, valMap) as frontier) = if (isMemOfActives path active) then - let (SubExpr(accessf,ve)),pat = lookupActive path active + let (SubExpr(accessf, ve)), pat = lookupActive path active - let mkSubFrontiers path accessf' active' argpats pathBuilder = - let mkSubActive j p = + let mkSubFrontiers path accessf' active' argpats pathBuilder = + let mkSubActive j p = let newSubExpr = SubExpr(accessf' j, ve) let newPath = pathBuilder path j Active(newPath, newSubExpr, p) @@ -1118,248 +1118,248 @@ let CompilePatternBasic mkFrontiers investigations i let active' = removeActive path active - match pat with + match pat with | TPat_wild _ | TPat_as _ | TPat_tuple _ | TPat_disjs _ | TPat_conjs _ | TPat_recd _ -> failwith "Unexpected projection pattern" - | TPat_query ((_,resTys,apatVrefOpt,idx,apinfo),p,m) -> - + | TPat_query ((_, resTys, apatVrefOpt, idx, apinfo), p, m) -> + if apinfo.IsTotal then - let hasParam = (match apatVrefOpt with None -> true | Some (vref,_) -> doesActivePatternHaveFreeTypars g vref) + let hasParam = (match apatVrefOpt with None -> true | Some (vref, _) -> doesActivePatternHaveFreeTypars g vref) if (hasParam && i = i') || (discrimsEq g discrim (Option.get (getDiscrimOfPattern pat))) then let aparity = apinfo.Names.Length - let accessf' j tpinst _e' = + let accessf' j tpinst _e' = assert inpExprOpt.IsSome - if aparity <= 1 then - Option.get inpExprOpt + if aparity <= 1 then + Option.get inpExprOpt else let ucref = mkChoiceCaseRef g m aparity idx // TODO: In the future we will want active patterns to be able to return struct-unions // In that eventuality, we need to check we are taking the address correctly - mkUnionCaseFieldGetUnprovenViaExprAddr (Option.get inpExprOpt,ucref,instTypes tpinst resTys,j,exprm) - mkSubFrontiers path accessf' active' [p] (fun path j -> PathQuery(path,int64 j)) + mkUnionCaseFieldGetUnprovenViaExprAddr (Option.get inpExprOpt, ucref, instTypes tpinst resTys, j, exprm) + mkSubFrontiers path accessf' active' [p] (fun path j -> PathQuery(path, int64 j)) elif hasParam then // Successful active patterns don't refute other patterns - [frontier] + [frontier] else [] - else + else if i = i' then - let accessf' _j tpinst _ = + let accessf' _j tpinst _ = // TODO: In the future we will want active patterns to be able to return struct-unions // In that eventuality, we need to check we are taking the address correctly mkUnionCaseFieldGetUnprovenViaExprAddr (Option.get inpExprOpt, mkSomeCase g, instTypes tpinst resTys, 0, exprm) - mkSubFrontiers path accessf' active' [p] (fun path j -> PathQuery(path,int64 j)) - else + mkSubFrontiers path accessf' active' [p] (fun path j -> PathQuery(path, int64 j)) + else // Successful active patterns don't refute other patterns - [frontier] + [frontier] - | TPat_unioncase (ucref1, tyargs, argpats,_) -> - match discrim with + | TPat_unioncase (ucref1, tyargs, argpats, _) -> + match discrim with | DecisionTreeTest.UnionCase (ucref2, tinst) when g.unionCaseRefEq ucref1 ucref2 -> - let accessf' j tpinst exprIn = - match resPostBindOpt with - | Some e -> mkUnionCaseFieldGetProvenViaExprAddr (e,ucref1,tinst,j,exprm) - | None -> - let exprIn = - match inpExprOpt with + let accessf' j tpinst exprIn = + match resPostBindOpt with + | Some e -> mkUnionCaseFieldGetProvenViaExprAddr (e, ucref1, tinst, j, exprm) + | None -> + let exprIn = + match inpExprOpt with | Some addrExp -> addrExp | None -> accessf tpinst exprIn - mkUnionCaseFieldGetUnprovenViaExprAddr (exprIn,ucref1,instTypes tpinst tyargs,j,exprm) - - mkSubFrontiers path accessf' active' argpats (fun path j -> PathUnionConstr(path,ucref1,tyargs,j)) + mkUnionCaseFieldGetUnprovenViaExprAddr (exprIn, ucref1, instTypes tpinst tyargs, j, exprm) + + mkSubFrontiers path accessf' active' argpats (fun path j -> PathUnionConstr(path, ucref1, tyargs, j)) | DecisionTreeTest.UnionCase _ -> // Successful union case tests DO refute all other union case tests (no overlapping union cases) [] - | _ -> + | _ -> // Successful union case tests don't refute any other patterns [frontier] - | TPat_array (argpats,ty,_) -> + | TPat_array (argpats, ty, _) -> match discrim with - | DecisionTreeTest.ArrayLength (n,_) when List.length argpats = n -> + | DecisionTreeTest.ArrayLength (n, _) when List.length argpats = n -> let accessf' j tpinst exprIn = mkCallArrayGet g exprm ty (accessf tpinst exprIn) (mkInt g exprm j) - mkSubFrontiers path accessf' active' argpats (fun path j -> PathArray(path,ty,List.length argpats,j)) + mkSubFrontiers path accessf' active' argpats (fun path j -> PathArray(path, ty, List.length argpats, j)) // Successful length tests refute all other lengths - | DecisionTreeTest.ArrayLength _ -> + | DecisionTreeTest.ArrayLength _ -> [] - | _ -> + | _ -> [frontier] - | TPat_exnconstr (ecref, argpats,_) -> - match discrim with - | DecisionTreeTest.IsInst (_srcTy,tgtTy) when typeEquiv g (mkAppTy ecref []) tgtTy -> - let accessf' j tpinst exprIn = mkExnCaseFieldGet(accessf tpinst exprIn,ecref,j,exprm) - mkSubFrontiers path accessf' active' argpats (fun path j -> PathExnConstr(path,ecref,j)) - | _ -> + | TPat_exnconstr (ecref, argpats, _) -> + match discrim with + | DecisionTreeTest.IsInst (_srcTy, tgtTy) when typeEquiv g (mkAppTy ecref []) tgtTy -> + let accessf' j tpinst exprIn = mkExnCaseFieldGet(accessf tpinst exprIn, ecref, j, exprm) + mkSubFrontiers path accessf' active' argpats (fun path j -> PathExnConstr(path, ecref, j)) + | _ -> // Successful type tests against one sealed type refute all other sealed types // REVIEW: Successful type tests against one sealed type should refute all other sealed types [frontier] - | TPat_isinst (_srcty,tgtTy1,pbindOpt,_) -> - match discrim with - | DecisionTreeTest.IsInst (_srcTy,tgtTy2) when typeEquiv g tgtTy1 tgtTy2 -> - match pbindOpt with - | Some pbind -> - let accessf' tpinst exprIn = + | TPat_isinst (_srcty, tgtTy1, pbindOpt, _) -> + match discrim with + | DecisionTreeTest.IsInst (_srcTy, tgtTy2) when typeEquiv g tgtTy1 tgtTy2 -> + match pbindOpt with + | Some pbind -> + let accessf' tpinst exprIn = // Fetch the result from the place where we saved it, if possible - match inpExprOpt with - | Some e -> e - | _ -> + match inpExprOpt with + | Some e -> e + | _ -> // Otherwise call the helper mkCallUnboxFast g exprm (instType tpinst tgtTy1) (accessf tpinst exprIn) - let (v,exprIn) = BindSubExprOfInput g amap origInputValTypars pbind exprm (SubExpr(accessf',ve)) + let (v, exprIn) = BindSubExprOfInput g amap origInputValTypars pbind exprm (SubExpr(accessf', ve)) [Frontier (i, active', valMap.Add v exprIn )] - | None -> + | None -> [Frontier (i, active', valMap)] - + | _ -> // Successful type tests against other types don't refute anything // REVIEW: Successful type tests against one sealed type should refute all other sealed types [frontier] - | TPat_null _ -> - match discrim with - | DecisionTreeTest.IsNull -> - [Frontier (i, active',valMap)] + | TPat_null _ -> + match discrim with + | DecisionTreeTest.IsNull -> + [Frontier (i, active', valMap)] | _ -> - // Successful null tests don't refute any other patterns + // Successful null tests don't refute any other patterns [frontier] - | TPat_const (c1,_) -> - match discrim with - | DecisionTreeTest.Const c2 when (c1=c2) -> - [Frontier (i, active',valMap)] - | DecisionTreeTest.Const _ -> + | TPat_const (c1, _) -> + match discrim with + | DecisionTreeTest.Const c2 when (c1=c2) -> + [Frontier (i, active', valMap)] + | DecisionTreeTest.Const _ -> // All constants refute all other constants (no overlapping between constants!) [] | _ -> [frontier] | _ -> failwith "pattern compilation: GenerateNewFrontiersAfterSucccessfulInvestigation" - else [frontier] - - and BindProjectionPattern (Active(path,subExpr,p) as inp) ((accActive,accValMap) as s) = - let (SubExpr(accessf,ve)) = subExpr - let mkSubActive pathBuilder accessf' j p' = - Active(pathBuilder path j,SubExpr(accessf' j,ve),p') - - match p with - | TPat_wild _ -> - BindProjectionPatterns [] s - | TPat_as(p',pbind,m) -> - let (v,subExpr') = BindSubExprOfInput g amap origInputValTypars pbind m subExpr - BindProjectionPattern (Active(path,subExpr,p')) (accActive,accValMap.Add v subExpr' ) - | TPat_tuple(tupInfo,ps,tyargs,_m) -> - let accessf' j tpinst subExpr' = mkTupleFieldGet g (tupInfo,accessf tpinst subExpr',instTypes tpinst tyargs,j,exprm) - let pathBuilder path j = PathTuple(path,tyargs,j) + else [frontier] + + and BindProjectionPattern (Active(path, subExpr, p) as inp) ((accActive, accValMap) as s) = + let (SubExpr(accessf, ve)) = subExpr + let mkSubActive pathBuilder accessf' j p' = + Active(pathBuilder path j, SubExpr(accessf' j, ve), p') + + match p with + | TPat_wild _ -> + BindProjectionPatterns [] s + | TPat_as(p', pbind, m) -> + let (v, subExpr') = BindSubExprOfInput g amap origInputValTypars pbind m subExpr + BindProjectionPattern (Active(path, subExpr, p')) (accActive, accValMap.Add v subExpr' ) + | TPat_tuple(tupInfo, ps, tyargs, _m) -> + let accessf' j tpinst subExpr' = mkTupleFieldGet g (tupInfo, accessf tpinst subExpr', instTypes tpinst tyargs, j, exprm) + let pathBuilder path j = PathTuple(path, tyargs, j) let newActives = List.mapi (mkSubActive pathBuilder accessf') ps - BindProjectionPatterns newActives s - | TPat_recd(tcref,tinst,ps,_m) -> - let newActives = - (ps,tcref.TrueInstanceFieldsAsRefList) ||> List.mapi2 (fun j p fref -> - let accessf' fref _j tpinst exprIn = mkRecdFieldGet g (accessf tpinst exprIn,fref,instTypes tpinst tinst,exprm) - let pathBuilder path j = PathRecd(path,tcref,tinst,j) - mkSubActive pathBuilder (accessf' fref) j p) - BindProjectionPatterns newActives s - | TPat_disjs(ps,_m) -> - List.collect (fun p -> BindProjectionPattern (Active(path,subExpr,p)) s) ps - | TPat_conjs(ps,_m) -> - let newActives = List.mapi (mkSubActive (fun path j -> PathConj(path,j)) (fun _j -> accessf)) ps - BindProjectionPatterns newActives s - - | TPat_range (c1,c2,m) -> + BindProjectionPatterns newActives s + | TPat_recd(tcref, tinst, ps, _m) -> + let newActives = + (ps, tcref.TrueInstanceFieldsAsRefList) ||> List.mapi2 (fun j p fref -> + let accessf' fref _j tpinst exprIn = mkRecdFieldGet g (accessf tpinst exprIn, fref, instTypes tpinst tinst, exprm) + let pathBuilder path j = PathRecd(path, tcref, tinst, j) + mkSubActive pathBuilder (accessf' fref) j p) + BindProjectionPatterns newActives s + | TPat_disjs(ps, _m) -> + List.collect (fun p -> BindProjectionPattern (Active(path, subExpr, p)) s) ps + | TPat_conjs(ps, _m) -> + let newActives = List.mapi (mkSubActive (fun path j -> PathConj(path, j)) (fun _j -> accessf)) ps + BindProjectionPatterns newActives s + + | TPat_range (c1, c2, m) -> let res = ref [] for i = int c1 to int c2 do - res := BindProjectionPattern (Active(path,subExpr,TPat_const(Const.Char(char i),m))) s @ !res + res := BindProjectionPattern (Active(path, subExpr, TPat_const(Const.Char(char i), m))) s @ !res !res - // Assign an identifier to each TPat_query based on our knowledge of the 'identity' of the active pattern, if any - | TPat_query ((_,_,apatVrefOpt,_,_),_,_) -> - let uniqId = - match apatVrefOpt with - | Some (vref,_) when not (doesActivePatternHaveFreeTypars g vref) -> vref.Stamp - | _ -> genUniquePathId() - let inp = Active(PathQuery(path,uniqId),subExpr,p) - [(inp::accActive, accValMap)] - | _ -> - [(inp::accActive, accValMap)] + // Assign an identifier to each TPat_query based on our knowledge of the 'identity' of the active pattern, if any + | TPat_query ((_, _, apatVrefOpt, _, _), _, _) -> + let uniqId = + match apatVrefOpt with + | Some (vref, _) when not (doesActivePatternHaveFreeTypars g vref) -> vref.Stamp + | _ -> genUniquePathId() + let inp = Active(PathQuery(path, uniqId), subExpr, p) + [(inp::accActive, accValMap)] + | _ -> + [(inp::accActive, accValMap)] and BindProjectionPatterns ps s = - List.foldBack (fun p sofar -> List.collect (BindProjectionPattern p) sofar) ps [s] + List.foldBack (fun p sofar -> List.collect (BindProjectionPattern p) sofar) ps [s] (* The setup routine of the match compiler *) - let frontiers = - ((clausesL - |> List.mapi (fun i c -> - let initialSubExpr = SubExpr((fun _tpinst x -> x),(exprForVal origInputVal.Range origInputVal,origInputVal)) - let investigations = BindProjectionPattern (Active(PathEmpty(inputTy),initialSubExpr,c.Pattern)) ([],ValMap<_>.Empty) - mkFrontiers investigations i) + let frontiers = + ((clausesL + |> List.mapi (fun i c -> + let initialSubExpr = SubExpr((fun _tpinst x -> x), (exprForVal origInputVal.Range origInputVal, origInputVal)) + let investigations = BindProjectionPattern (Active(PathEmpty(inputTy), initialSubExpr, c.Pattern)) ([], ValMap<_>.Empty) + mkFrontiers investigations i) |> List.concat) - @ - mkFrontiers [([],ValMap<_>.Empty)] nclauses) - let dtree = + @ + mkFrontiers [([], ValMap<_>.Empty)] nclauses) + let dtree = InvestigateFrontiers [] frontiers let targets = mbuilder.CloseTargets() - - // Report unused targets - if warnOnUnused then - let used = HashSet<_>(accTargetsOfDecisionTree dtree [],HashIdentity.Structural) - clausesL |> List.iteri (fun i c -> - if not (used.Contains i) then warning (RuleNeverMatched c.Range)) + // Report unused targets + if warnOnUnused then + let used = HashSet<_>(accTargetsOfDecisionTree dtree [], HashIdentity.Structural) + + clausesL |> List.iteri (fun i c -> + if not (used.Contains i) then warning (RuleNeverMatched c.Range)) + + dtree, targets - dtree,targets - let isPartialOrWhenClause (c:TypedMatchClause) = isPatternPartial c.Pattern || c.GuardExpr.IsSome -let rec CompilePattern g denv amap exprm matchm warnOnUnused actionOnFailure (origInputVal,origInputValTypars,origInputExprOpt) (clausesL: TypedMatchClause list) inputTy resultTy = - match clausesL with +let rec CompilePattern g denv amap exprm matchm warnOnUnused actionOnFailure (origInputVal, origInputValTypars, origInputExprOpt) (clausesL: TypedMatchClause list) inputTy resultTy = + match clausesL with | _ when List.exists isPartialOrWhenClause clausesL -> - // Partial clauses cause major code explosion if treated naively - // Hence treat any pattern matches with any partial clauses clause-by-clause - - // First make sure we generate at least some of the obvious incomplete match warnings. + // Partial clauses cause major code explosion if treated naively + // Hence treat any pattern matches with any partial clauses clause-by-clause + + // First make sure we generate at least some of the obvious incomplete match warnings. let warnOnUnused = false in (* we can't turn this on since we're pretending all partial's fail in order to control the complexity of this. *) let warnOnIncomplete = true - let clausesPretendAllPartialFail = List.collect (fun (TClause(p,whenOpt,tg,m)) -> [TClause(erasePartialPatterns p,whenOpt,tg,m)]) clausesL - let _ = CompilePatternBasic g denv amap exprm matchm warnOnUnused warnOnIncomplete actionOnFailure (origInputVal,origInputValTypars,origInputExprOpt) clausesPretendAllPartialFail inputTy resultTy + let clausesPretendAllPartialFail = List.collect (fun (TClause(p, whenOpt, tg, m)) -> [TClause(erasePartialPatterns p, whenOpt, tg, m)]) clausesL + let _ = CompilePatternBasic g denv amap exprm matchm warnOnUnused warnOnIncomplete actionOnFailure (origInputVal, origInputValTypars, origInputExprOpt) clausesPretendAllPartialFail inputTy resultTy let warnOnIncomplete = false - - let rec atMostOnePartialAtATime clauses = - match List.takeUntil isPartialOrWhenClause clauses with - | l,[] -> - CompilePatternBasic g denv amap exprm matchm warnOnUnused warnOnIncomplete actionOnFailure (origInputVal,origInputValTypars,origInputExprOpt) l inputTy resultTy - | l,(h :: t) -> - // Add the partial clause + + let rec atMostOnePartialAtATime clauses = + match List.takeUntil isPartialOrWhenClause clauses with + | l, [] -> + CompilePatternBasic g denv amap exprm matchm warnOnUnused warnOnIncomplete actionOnFailure (origInputVal, origInputValTypars, origInputExprOpt) l inputTy resultTy + | l, (h :: t) -> + // Add the partial clause doGroupWithAtMostOnePartial (l @ [h]) t - and doGroupWithAtMostOnePartial group rest = + and doGroupWithAtMostOnePartial group rest = // Compile the remaining clauses - let dtree,targets = atMostOnePartialAtATime rest + let dtree, targets = atMostOnePartialAtATime rest // Make the expression that represents the remaining cases of the pattern match let expr = mkAndSimplifyMatch NoSequencePointAtInvisibleBinding exprm matchm resultTy dtree targets - + // If the remainder of the match boiled away to nothing interesting. // We measure this simply by seeing if the range of the resulting expression is identical to matchm. - let spTarget = - if Range.equals expr.Range matchm then SuppressSequencePointAtTarget + let spTarget = + if Range.equals expr.Range matchm then SuppressSequencePointAtTarget else SequencePointAtTarget // Make the clause that represents the remaining cases of the pattern match - let clauseForRestOfMatch = TClause(TPat_wild matchm,None,TTarget(List.empty,expr,spTarget),matchm) - - CompilePatternBasic g denv amap exprm matchm warnOnUnused warnOnIncomplete actionOnFailure (origInputVal,origInputValTypars,origInputExprOpt) (group @ [clauseForRestOfMatch]) inputTy resultTy - + let clauseForRestOfMatch = TClause(TPat_wild matchm, None, TTarget(List.empty, expr, spTarget), matchm) + + CompilePatternBasic g denv amap exprm matchm warnOnUnused warnOnIncomplete actionOnFailure (origInputVal, origInputValTypars, origInputExprOpt) (group @ [clauseForRestOfMatch]) inputTy resultTy + atMostOnePartialAtATime clausesL - - | _ -> - CompilePatternBasic g denv amap exprm matchm warnOnUnused true actionOnFailure (origInputVal,origInputValTypars,origInputExprOpt) clausesL inputTy resultTy + + | _ -> + CompilePatternBasic g denv amap exprm matchm warnOnUnused true actionOnFailure (origInputVal, origInputValTypars, origInputExprOpt) clausesL inputTy resultTy diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index f2c8f370da2ac924ccb503848a2062aafee22805..f691f4f0b9ed6e1cccb17bc38b539d82bb6ff5d9 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -25,22 +25,6 @@ open FSharp.Compiler.PrettyNaming open FSharp.Compiler.InfoReader open FSharp.Compiler.TypeRelations -//-------------------------------------------------------------------------- -// TestHooks - for dumping range to support source transforms -//-------------------------------------------------------------------------- - -let testFlagMemberBody = ref false -let testHookMemberBody (membInfo: ValMemberInfo) (expr:Expr) = - if !testFlagMemberBody then - let m = expr.Range - printf "TestMemberBody,%A,%s,%d,%d,%d,%d\n" - membInfo.MemberFlags.MemberKind - m.FileName - m.StartLine - m.StartColumn - m.EndLine - m.EndColumn - //-------------------------------------------------------------------------- // NOTES: reraise safety checks //-------------------------------------------------------------------------- @@ -121,15 +105,15 @@ let BindTypars g env (tps:Typar list) = if isNil tps then env else // Here we mutate to provide better names for generalized type parameters let nms = PrettyTypes.PrettyTyparNames (fun _ -> true) env.boundTyparNames tps - (tps,nms) ||> List.iter2 (fun tp nm -> + (tps, nms) ||> List.iter2 (fun tp nm -> if PrettyTypes.NeedsPrettyTyparName tp then - tp.typar_id <- ident (nm,tp.Range)) + tp.typar_id <- ident (nm, tp.Range)) List.fold BindTypar env tps /// Set the set of vals which are arguments in the active lambda. We are allowed to return /// byref arguments as byref returns. let BindArgVals env (vs: Val list) = - { env with argVals = ValMap.OfList (List.map (fun v -> (v,())) vs) } + { env with argVals = ValMap.OfList (List.map (fun v -> (v, ())) vs) } /// Limit flags represent a type(s) returned from checking an expression(s) that is interesting to impose rules on. [] @@ -167,7 +151,7 @@ let CombineTwoLimits limit1 limit2 = let isLimited1 = isByRef1 || isStackSpan1 let isLimited2 = isByRef2 || isStackSpan2 - // A limit that has a stack referring span-like but not a by-ref, + // A limit that has a stack referring span-like but not a by-ref, // we force the scope to 1. This is to handle call sites // that return a by-ref and have stack referring span-likes as arguments. // This is to ensure we can only prevent out of scope at the method level rather than visibility. @@ -305,19 +289,19 @@ let BindVals cenv env vs = List.iter (BindVal cenv env) vs // approx walk of type //-------------------------------------------------------------------------- -let rec CheckTypeDeep (cenv: cenv) ((visitTy,visitTyconRefOpt,visitAppTyOpt,visitTraitSolutionOpt, visitTyparOpt) as f) g env isInner ty = +let rec CheckTypeDeep (cenv: cenv) ((visitTy, visitTyconRefOpt, visitAppTyOpt, visitTraitSolutionOpt, visitTyparOpt) as f) g env isInner ty = // We iterate the _solved_ constraints as well, to pick up any record of trait constraint solutions // This means we walk _all_ the constraints _everywhere_ in a type, including // those attached to _solved_ type variables. This is used by PostTypeCheckSemanticChecks to detect uses of // values as solutions to trait constraints and determine if inference has caused the value to escape its scope. // The only record of these solutions is in the _solved_ constraints of types. - // In an ideal world we would, instead, record the solutions to these constraints as "witness variables" in expressions, + // In an ideal world we would, instead, record the solutions to these constraints as "witness variables" in expressions, // rather than solely in types. match ty with | TType_var tp when tp.Solution.IsSome -> tp.Constraints |> List.iter (fun cx -> match cx with - | TyparConstraint.MayResolveMember((TTrait(_,_,_,_,_,soln)),_) -> + | TyparConstraint.MayResolveMember((TTrait(_, _, _, _, _, soln)), _) -> match visitTraitSolutionOpt, !soln with | Some visitTraitSolution, Some sln -> visitTraitSolution sln | _ -> () @@ -328,13 +312,13 @@ let rec CheckTypeDeep (cenv: cenv) ((visitTy,visitTyconRefOpt,visitAppTyOpt,visi visitTy ty match ty with - | TType_forall (tps,body) -> + | TType_forall (tps, body) -> let env = BindTypars g env tps CheckTypeDeep cenv f g env isInner body tps |> List.iter (fun tp -> tp.Constraints |> List.iter (CheckTypeConstraintDeep cenv f g env)) | TType_measure _ -> () - | TType_app (tcref,tinst) -> + | TType_app (tcref, tinst) -> match visitTyconRefOpt with | Some visitTyconRef -> visitTyconRef isInner tcref | None -> () @@ -349,20 +333,20 @@ let rec CheckTypeDeep (cenv: cenv) ((visitTy,visitTyconRefOpt,visitAppTyOpt,visi match visitAppTyOpt with | Some visitAppTy -> visitAppTy (tcref, tinst) | None -> () - | TType_anon (anonInfo,tys) -> + | TType_anon (anonInfo, tys) -> if not (cenv.anonRecdTypes.ContainsKey anonInfo.Stamp) then cenv.anonRecdTypes <- cenv.anonRecdTypes.Add(anonInfo.Stamp, anonInfo) CheckTypesDeep cenv f g env tys - | TType_ucase (_,tinst) -> CheckTypesDeep cenv f g env tinst - | TType_tuple (_,tys) -> CheckTypesDeep cenv f g env tys - | TType_fun (s,t) -> CheckTypeDeep cenv f g env true s; CheckTypeDeep cenv f g env true t + | TType_ucase (_, tinst) -> CheckTypesDeep cenv f g env tinst + | TType_tuple (_, tys) -> CheckTypesDeep cenv f g env tys + | TType_fun (s, t) -> CheckTypeDeep cenv f g env true s; CheckTypeDeep cenv f g env true t | TType_var tp -> if not tp.IsSolved then match visitTyparOpt with | None -> () | Some visitTyar -> - visitTyar (env,tp) + visitTyar (env, tp) and CheckTypesDeep cenv f g env tys = tys |> List.iter (CheckTypeDeep cenv f g env true) @@ -372,12 +356,12 @@ and CheckTypesDeepNoInner cenv f g env tys = and CheckTypeConstraintDeep cenv f g env x = match x with - | TyparConstraint.CoercesTo(ty,_) -> CheckTypeDeep cenv f g env true ty - | TyparConstraint.MayResolveMember(traitInfo,_) -> CheckTraitInfoDeep cenv f g env traitInfo - | TyparConstraint.DefaultsTo(_,ty,_) -> CheckTypeDeep cenv f g env true ty - | TyparConstraint.SimpleChoice(tys,_) -> CheckTypesDeep cenv f g env tys - | TyparConstraint.IsEnum(uty,_) -> CheckTypeDeep cenv f g env true uty - | TyparConstraint.IsDelegate(aty,bty,_) -> CheckTypeDeep cenv f g env true aty; CheckTypeDeep cenv f g env true bty + | TyparConstraint.CoercesTo(ty, _) -> CheckTypeDeep cenv f g env true ty + | TyparConstraint.MayResolveMember(traitInfo, _) -> CheckTraitInfoDeep cenv f g env traitInfo + | TyparConstraint.DefaultsTo(_, ty, _) -> CheckTypeDeep cenv f g env true ty + | TyparConstraint.SimpleChoice(tys, _) -> CheckTypesDeep cenv f g env tys + | TyparConstraint.IsEnum(uty, _) -> CheckTypeDeep cenv f g env true uty + | TyparConstraint.IsDelegate(aty, bty, _) -> CheckTypeDeep cenv f g env true aty; CheckTypeDeep cenv f g env true bty | TyparConstraint.SupportsComparison _ | TyparConstraint.SupportsEquality _ | TyparConstraint.SupportsNull _ @@ -386,7 +370,7 @@ and CheckTypeConstraintDeep cenv f g env x = | TyparConstraint.IsReferenceType _ | TyparConstraint.RequiresDefaultConstructor _ -> () -and CheckTraitInfoDeep cenv ((_,_,_,visitTraitSolutionOpt,_) as f) g env (TTrait(tys,_,_,argtys,rty,soln)) = +and CheckTraitInfoDeep cenv ((_, _, _, visitTraitSolutionOpt, _) as f) g env (TTrait(tys, _, _, argtys, rty, soln)) = CheckTypesDeep cenv f g env tys CheckTypesDeep cenv f g env argtys Option.iter (CheckTypeDeep cenv f g env true ) rty @@ -404,9 +388,9 @@ let CheckForByrefType cenv env ty check = /// check captures under lambdas /// -/// This is the definition of what can/can't be free in a lambda expression. This is checked at lambdas OR TBind(v,e) nodes OR TObjExprMethod nodes. -/// For TBind(v,e) nodes we may know an 'arity' which gives as a larger set of legitimate syntactic arguments for a lambda. -/// For TObjExprMethod(v,e) nodes we always know the legitimate syntactic arguments. +/// This is the definition of what can/can't be free in a lambda expression. This is checked at lambdas OR TBind(v, e) nodes OR TObjExprMethod nodes. +/// For TBind(v, e) nodes we may know an 'arity' which gives as a larger set of legitimate syntactic arguments for a lambda. +/// For TObjExprMethod(v, e) nodes we always know the legitimate syntactic arguments. let CheckEscapes cenv allowProtected m syntacticArgs body = (* m is a range suited to error reporting *) if cenv.reportErrors then let cantBeFree (v: Val) = @@ -451,8 +435,8 @@ let AccessInternalsVisibleToAsInternal thisCompPath internalsVisibleToPaths acce // Each internalsVisibleToPath is a compPath for the internals of some assembly. // Replace those by the compPath for the internals of this assembly. // This makes those internals visible here, but still internal. Bug://3737 - (access,internalsVisibleToPaths) ||> List.fold (fun access internalsVisibleToPath -> - accessSubstPaths (thisCompPath,internalsVisibleToPath) access) + (access, internalsVisibleToPaths) ||> List.fold (fun access internalsVisibleToPath -> + accessSubstPaths (thisCompPath, internalsVisibleToPath) access) let CheckTypeForAccess (cenv:cenv) env objName valAcc m ty = @@ -565,22 +549,22 @@ let mkArgsForAppliedVal isBaseCall (vref:ValRef) argsl = let rec mkArgsForAppliedExpr isBaseCall argsl x = match stripExpr x with // recognise val - | Expr.Val (vref,_,_) -> mkArgsForAppliedVal isBaseCall vref argsl + | Expr.Val (vref, _, _) -> mkArgsForAppliedVal isBaseCall vref argsl // step through instantiations - | Expr.App(f,_fty,_tyargs,[],_) -> mkArgsForAppliedExpr isBaseCall argsl f + | Expr.App(f, _fty, _tyargs, [], _) -> mkArgsForAppliedExpr isBaseCall argsl f // step through subsumption coercions - | Expr.Op(TOp.Coerce,_,[f],_) -> mkArgsForAppliedExpr isBaseCall argsl f + | Expr.Op(TOp.Coerce, _, [f], _) -> mkArgsForAppliedExpr isBaseCall argsl f | _ -> [] /// Check types occurring in the TAST. let CheckTypeAux permitByRefLike (cenv:cenv) env m ty onInnerByrefError = if cenv.reportErrors then - let visitTyar (env,tp) = + let visitTyar (env, tp) = if not (env.boundTypars.ContainsKey tp) then if tp.IsCompilerGenerated then - errorR (Error(FSComp.SR.checkNotSufficientlyGenericBecauseOfScopeAnon(),m)) + errorR (Error(FSComp.SR.checkNotSufficientlyGenericBecauseOfScopeAnon(), m)) else - errorR (Error(FSComp.SR.checkNotSufficientlyGenericBecauseOfScope(tp.DisplayName),m)) + errorR (Error(FSComp.SR.checkNotSufficientlyGenericBecauseOfScope(tp.DisplayName), m)) let visitTyconRef isInner tcref = @@ -599,7 +583,7 @@ let CheckTypeAux permitByRefLike (cenv:cenv) env m ty onInnerByrefError = errorR(Error(FSComp.SR.chkSystemVoidOnlyInTypeof(), m)) // check if T contains byref types in case of byref - let visitAppTy (tcref,tinst) = + let visitAppTy (tcref, tinst) = if isByrefLikeTyconRef cenv.g m tcref then let visitType ty0 = match tryDestAppTy cenv.g ty0 with @@ -611,11 +595,11 @@ let CheckTypeAux permitByRefLike (cenv:cenv) env m ty onInnerByrefError = let visitTraitSolution info = match info with - | FSMethSln(_,vref,_) -> + | FSMethSln(_, vref, _) -> //printfn "considering %s..." vref.DisplayName if valRefInThisAssembly cenv.g.compilingFslib vref && not (cenv.boundVals.ContainsKey(vref.Stamp)) then //printfn "recording %s..." vref.DisplayName - cenv.potentialUnboundUsesOfVals <- cenv.potentialUnboundUsesOfVals.Add(vref.Stamp,m) + cenv.potentialUnboundUsesOfVals <- cenv.potentialUnboundUsesOfVals.Add(vref.Stamp, m) | _ -> () CheckTypeDeep cenv (ignore, Some visitTyconRef, Some visitAppTy, Some visitTraitSolution, Some visitTyar) cenv.g env false ty @@ -672,12 +656,12 @@ let CheckMultipleInterfaceInstantiations cenv interfaces m = tyconRefEq cenv.g (tcrefOfAppTy cenv.g typ1) (tcrefOfAppTy cenv.g typ2) && // different instantiations not (typeEquivAux EraseNone cenv.g typ1 typ2) - then Some (typ1,typ2) + then Some (typ1, typ2) else None)) match firstInterfaceWithMultipleGenericInstantiations with | None -> () - | Some (typ1,typ2) -> - errorR(Error(FSComp.SR.chkMultipleGenericInterfaceInstantiations((NicePrint.minimalStringOfType cenv.denv typ1), (NicePrint.minimalStringOfType cenv.denv typ2)),m)) + | Some (typ1, typ2) -> + errorR(Error(FSComp.SR.chkMultipleGenericInterfaceInstantiations((NicePrint.minimalStringOfType cenv.denv typ1), (NicePrint.minimalStringOfType cenv.denv typ2)), m)) /// Check an expression, where the expression is in a position where byrefs can be generated let rec CheckExprNoByrefs cenv env expr = @@ -719,7 +703,7 @@ and CheckValUse (cenv: cenv) (env: env) (vref: ValRef, vFlags, m) (context: Perm (match vref.DeclaringEntity with Parent tcref -> isAbstractTycon tcref.Deref | _ -> false) if isCallOfConstructorOfAbstractType then - errorR(Error(FSComp.SR.tcAbstractTypeCannotBeInstantiated(),m)) + errorR(Error(FSComp.SR.tcAbstractTypeCannotBeInstantiated(), m)) // This is used to handle this case: // let x = 1 @@ -758,7 +742,7 @@ and CheckForOverAppliedExceptionRaisingPrimitive (cenv:cenv) expr = // Some things are more easily checked prior to NormalizeAndAdjustPossibleSubsumptionExprs match expr with - | Expr.App(f,_fty,_tyargs,argsl,_m) -> + | Expr.App(f, _fty, _tyargs, argsl, _m) -> if cenv.reportErrors then @@ -879,29 +863,14 @@ and CheckCallWithReceiver cenv env m returnTy args contexts context = limitArgs CheckCallLimitArgs cenv env m returnTy limitArgs context -/// Check an expression, given information about the position of the expression -and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : Limit = - let g = cenv.g - - let origExpr = stripExpr origExpr - - // CheckForOverAppliedExceptionRaisingPrimitive is more easily checked prior to NormalizeAndAdjustPossibleSubsumptionExprs - CheckForOverAppliedExceptionRaisingPrimitive cenv origExpr - let expr = NormalizeAndAdjustPossibleSubsumptionExprs g origExpr - let expr = stripExpr expr - +and CheckExprLinear (cenv:cenv) (env:env) expr (context:PermitByRefExpr) (contf : Limit -> Limit) = match expr with - | Expr.Sequential (e1,e2,dir,_,_) -> + | Expr.Sequential (e1, e2, NormalSeq, _, _) -> CheckExprNoByrefs cenv env e1 + // tailcall + CheckExprLinear cenv env e2 context contf - match dir with - | NormalSeq -> - CheckExpr cenv env e2 context // carry context into _;RHS (normal sequencing only) - | ThenDoSeq -> - CheckExprNoByrefs cenv {env with ctorLimitedZone=false} e2 - NoLimit - - | Expr.Let ((TBind(v,_bindRhs,_) as bind),body,_,_) -> + | Expr.Let ((TBind(v, _bindRhs, _) as bind), body, _, _) -> let isByRef = isByrefTy cenv.g v.Type let bindingContext = @@ -913,25 +882,66 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : Limit = let limit = CheckBinding cenv { env with returnScope = env.returnScope + 1 } false bindingContext bind BindVal cenv env v LimitVal cenv v { limit with scope = if isByRef then limit.scope else env.returnScope } - CheckExpr cenv env body context + // tailcall + CheckExprLinear cenv env body context contf - | Expr.Const (_,m,ty) -> + | LinearOpExpr (_op, tyargs, argsHead, argLast, m) -> + CheckTypeInstNoByrefs cenv env m tyargs + argsHead |> List.iter (CheckExprNoByrefs cenv env) + // tailcall + CheckExprLinear cenv env argLast PermitByRefExpr.No (fun _ -> contf NoLimit) + + | LinearMatchExpr (_spMatch, _exprm, dtree, tg1, e2, _spTarget2, m, ty) -> + CheckTypeNoInnerByrefs cenv env m ty + CheckDecisionTree cenv env dtree + let lim1 = CheckDecisionTreeTarget cenv env context tg1 + // tailcall + CheckExprLinear cenv env e2 context (fun lim2 -> contf (CombineLimits [ lim1; lim2 ])) + + | _ -> + // not a linear expression + contf (CheckExpr cenv env expr context) + +/// Check an expression, given information about the position of the expression +and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : Limit = + let g = cenv.g + + let origExpr = stripExpr origExpr + + // CheckForOverAppliedExceptionRaisingPrimitive is more easily checked prior to NormalizeAndAdjustPossibleSubsumptionExprs + CheckForOverAppliedExceptionRaisingPrimitive cenv origExpr + let expr = NormalizeAndAdjustPossibleSubsumptionExprs g origExpr + let expr = stripExpr expr + + match expr with + | LinearOpExpr _ + | LinearMatchExpr _ + | Expr.Let _ + | Expr.Sequential (_, _, NormalSeq, _, _) -> + CheckExprLinear cenv env expr context id + + | Expr.Sequential (e1,e2,ThenDoSeq,_,_) -> + CheckExprNoByrefs cenv env e1 + CheckExprNoByrefs cenv {env with ctorLimitedZone=false} e2 + NoLimit + + | Expr.Const (_, m, ty) -> CheckTypeNoInnerByrefs cenv env m ty NoLimit - | Expr.Val (vref,vFlags,m) -> + | Expr.Val (vref, vFlags, m) -> CheckValUse cenv env (vref, vFlags, m) context - | Expr.Quote(ast,savedConv,_isFromQueryExpression,m,ty) -> + | Expr.Quote(ast, savedConv, _isFromQueryExpression, m, ty) -> CheckExprNoByrefs cenv {env with quote=true} ast if cenv.reportErrors then cenv.usesQuotations <- true // Translate to quotation data try - let qscope = QuotationTranslator.QuotationGenerationScope.Create (g,cenv.amap,cenv.viewCcu, QuotationTranslator.IsReflectedDefinition.No) + let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, QuotationTranslator.IsReflectedDefinition.No) let qdata = QuotationTranslator.ConvExprPublic qscope QuotationTranslator.QuotationTranslationEnv.Empty ast - let typeDefs,spliceTypes,spliceExprs = qscope.Close() + let typeDefs, spliceTypes, spliceExprs = qscope.Close() match savedConv.Value with | None -> savedConv:= Some (typeDefs, List.map fst spliceTypes, List.map fst spliceExprs, qdata) | Some _ -> () @@ -941,7 +951,7 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : Limit = CheckTypeNoByrefs cenv env m ty NoLimit - | Expr.Obj (_,ty,basev,superInitCall,overrides,iimpls,m) -> + | Expr.Obj (_, ty, basev, superInitCall, overrides, iimpls, m) -> CheckExprNoByrefs cenv env superInitCall CheckMethods cenv env basev overrides CheckInterfaceImpls cenv env basev iimpls @@ -950,7 +960,7 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : Limit = let interfaces = [ if isInterfaceTy g ty then yield! AllSuperTypesOfType g cenv.amap m AllowMultiIntfInstantiations.Yes ty - for (ty,_) in iimpls do + for (ty, _) in iimpls do yield! AllSuperTypesOfType g cenv.amap m AllowMultiIntfInstantiations.Yes ty ] |> List.filter (isInterfaceTy g) @@ -958,13 +968,13 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : Limit = NoLimit // Allow base calls to F# methods - | Expr.App((InnerExprPat(ExprValWithPossibleTypeInst(v,vFlags,_,_) as f)),_fty,tyargs,(Expr.Val(baseVal,_,_) :: rest),m) + | Expr.App((InnerExprPat(ExprValWithPossibleTypeInst(v, vFlags, _, _) as f)), _fty, tyargs, (Expr.Val(baseVal, _, _) :: rest), m) when ((match vFlags with VSlotDirectCall -> true | _ -> false) && baseVal.BaseOrThisInfo = BaseVal) -> let memberInfo = Option.get v.MemberInfo if memberInfo.MemberFlags.IsDispatchSlot then - errorR(Error(FSComp.SR.tcCannotCallAbstractBaseMember(v.DisplayName),m)) + errorR(Error(FSComp.SR.tcCannotCallAbstractBaseMember(v.DisplayName), m)) NoLimit else let env = { env with isInAppExpr = true } @@ -977,7 +987,7 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : Limit = CheckExprs cenv env rest (mkArgsForAppliedExpr true rest f) // Allow base calls to IL methods - | Expr.Op (TOp.ILCall (virt,_,_,_,_,_,_,mref,enclTypeArgs,methTypeArgs,tys),tyargs,(Expr.Val(baseVal,_,_)::rest),m) + | Expr.Op (TOp.ILCall (virt, _, _, _, _, _, _, mref, enclTypeArgs, methTypeArgs, tys), tyargs, (Expr.Val(baseVal, _, _)::rest), m) when not virt && baseVal.BaseOrThisInfo = BaseVal -> // Disallow calls to abstract base methods on IL types. @@ -990,7 +1000,7 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : Limit = // equality. It would be better to make this check in tc.fs when we have the Abstract IL metadata for the method to hand. let mdef = resolveILMethodRef tcref.ILTyconRawMetadata mref if mdef.IsAbstract then - errorR(Error(FSComp.SR.tcCannotCallAbstractBaseMember(mdef.Name),m)) + errorR(Error(FSComp.SR.tcCannotCallAbstractBaseMember(mdef.Name), m)) with _ -> () // defensive coding | _ -> () @@ -1001,8 +1011,8 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : Limit = CheckValRef cenv env baseVal m PermitByRefExpr.No CheckExprsPermitByRefLike cenv env rest - | Expr.Op (c,tyargs,args,m) -> - CheckExprOp cenv env (c,tyargs,args,m) context expr + | Expr.Op (c, tyargs, args, m) -> + CheckExprOp cenv env (c, tyargs, args, m) context expr // Allow 'typeof' calls as a special case, the only accepted use of System.Void! | TypeOfExpr g ty when isVoidTy g ty -> @@ -1013,13 +1023,13 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : Limit = NoLimit // Allow '%expr' in quotations - | Expr.App(Expr.Val(vref,_,_),_,tinst,[arg],m) when isSpliceOperator g vref && env.quote -> + | Expr.App(Expr.Val(vref, _, _), _, tinst, [arg], m) when isSpliceOperator g vref && env.quote -> CheckTypeInstNoInnerByrefs cenv env m tinst // it's the splice operator, a byref instantiation is allowed CheckExprNoByrefs cenv env arg NoLimit // Check an application - | Expr.App(f,_fty,tyargs,argsl,m) -> + | Expr.App(f, _fty, tyargs, argsl, m) -> let returnTy = tyOfExpr g expr // This is to handle recursive cases. Don't check 'returnTy' again if we are still inside a app expression. @@ -1042,37 +1052,37 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : Limit = else CheckCall cenv env m returnTy argsl contexts context - | Expr.Lambda(_,_ctorThisValOpt,_baseValOpt,argvs,_,m,rty) -> - let topValInfo = ValReprInfo ([],[argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)],ValReprInfo.unnamedRetVal) + | Expr.Lambda(_, _ctorThisValOpt, _baseValOpt, argvs, _, m, rty) -> + let topValInfo = ValReprInfo ([], [argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)], ValReprInfo.unnamedRetVal) let ty = mkMultiLambdaTy m argvs rty in CheckLambdas false None cenv env false topValInfo false expr m ty PermitByRefExpr.Yes - | Expr.TyLambda(_,tps,_,m,rty) -> - let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps,[],ValReprInfo.unnamedRetVal) + | Expr.TyLambda(_, tps, _, m, rty) -> + let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps, [], ValReprInfo.unnamedRetVal) let ty = mkForallTyIfNeeded tps rty in CheckLambdas false None cenv env false topValInfo false expr m ty PermitByRefExpr.Yes - | Expr.TyChoose(tps,e1,_) -> + | Expr.TyChoose(tps, e1, _) -> let env = BindTypars g env tps CheckExprNoByrefs cenv env e1 NoLimit - | Expr.Match(_,_,dtree,targets,m,ty) -> + | Expr.Match(_, _, dtree, targets, m, ty) -> CheckTypeNoInnerByrefs cenv env m ty // computed byrefs allowed at each branch CheckDecisionTree cenv env dtree CheckDecisionTreeTargets cenv env targets context - | Expr.LetRec (binds,e,_,_) -> + | Expr.LetRec (binds, e, _, _) -> BindVals cenv env (valsOfBinds binds) CheckBindings cenv env binds CheckExprNoByrefs cenv env e NoLimit - | Expr.StaticOptimization (constraints,e2,e3,m) -> + | Expr.StaticOptimization (constraints, e2, e3, m) -> CheckExprNoByrefs cenv env e2 CheckExprNoByrefs cenv env e3 constraints |> List.iter (function - | TTyconEqualsTycon(ty1,ty2) -> + | TTyconEqualsTycon(ty1, ty2) -> CheckTypeNoByrefs cenv env m ty1 CheckTypeNoByrefs cenv env m ty2 | TTyconIsStruct(ty1) -> @@ -1085,7 +1095,7 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : Limit = and CheckMethods cenv env baseValOpt methods = methods |> List.iter (CheckMethod cenv env baseValOpt) -and CheckMethod cenv env baseValOpt (TObjExprMethod(_,attribs,tps,vs,body,m)) = +and CheckMethod cenv env baseValOpt (TObjExprMethod(_, attribs, tps, vs, body, m)) = let env = BindTypars cenv.g env tps let vs = List.concat vs let env = BindArgVals env vs @@ -1097,33 +1107,33 @@ and CheckMethod cenv env baseValOpt (TObjExprMethod(_,attribs,tps,vs,body,m)) = and CheckInterfaceImpls cenv env baseValOpt l = l |> List.iter (CheckInterfaceImpl cenv env baseValOpt) -and CheckInterfaceImpl cenv env baseValOpt (_ty,overrides) = +and CheckInterfaceImpl cenv env baseValOpt (_ty, overrides) = CheckMethods cenv env baseValOpt overrides -and CheckExprOp cenv env (op,tyargs,args,m) context expr = +and CheckExprOp cenv env (op, tyargs, args, m) context expr = let g = cenv.g let ctorLimitedZoneCheck() = if env.ctorLimitedZone then errorR(Error(FSComp.SR.chkObjCtorsCantUseExceptionHandling(), m)) (* Special cases *) - match op,tyargs,args with + match op, tyargs, args with // Handle these as special cases since mutables are allowed inside their bodies - | TOp.While _,_,[Expr.Lambda(_,_,_,[_],e1,_,_);Expr.Lambda(_,_,_,[_],e2,_,_)] -> + | TOp.While _, _, [Expr.Lambda(_, _, _, [_], e1, _, _);Expr.Lambda(_, _, _, [_], e2, _, _)] -> CheckTypeInstNoByrefs cenv env m tyargs CheckExprsNoByRefLike cenv env [e1;e2] - | TOp.TryFinally _,[_],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[_],e2,_,_)] -> + | TOp.TryFinally _, [_], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)] -> CheckTypeInstNoInnerByrefs cenv env m tyargs // result of a try/finally can be a byref ctorLimitedZoneCheck() let limit = CheckExpr cenv env e1 context // result of a try/finally can be a byref if in a position where the overall expression is can be a byref CheckExprNoByrefs cenv env e2 limit - | TOp.For(_),_,[Expr.Lambda(_,_,_,[_],e1,_,_);Expr.Lambda(_,_,_,[_],e2,_,_);Expr.Lambda(_,_,_,[_],e3,_,_)] -> + | TOp.For(_), _, [Expr.Lambda(_, _, _, [_], e1, _, _);Expr.Lambda(_, _, _, [_], e2, _, _);Expr.Lambda(_, _, _, [_], e3, _, _)] -> CheckTypeInstNoByrefs cenv env m tyargs CheckExprsNoByRefLike cenv env [e1;e2;e3] - | TOp.TryCatch _,[_],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[_],_e2,_,_); Expr.Lambda(_,_,_,[_],e3,_,_)] -> + | TOp.TryCatch _, [_], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], _e2, _, _); Expr.Lambda(_, _, _, [_], e3, _, _)] -> CheckTypeInstNoInnerByrefs cenv env m tyargs // result of a try/catch can be a byref ctorLimitedZoneCheck() let limit1 = CheckExpr cenv env e1 context // result of a try/catch can be a byref if in a position where the overall expression is can be a byref @@ -1131,7 +1141,7 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = let limit2 = CheckExpr cenv env e3 context // result of a try/catch can be a byref if in a position where the overall expression is can be a byref CombineTwoLimits limit1 limit2 - | TOp.ILCall (_,_,_,_,_,_,_,methRef,enclTypeArgs,methTypeArgs,tys),_,_ -> + | TOp.ILCall (_, _, _, _, _, _, _, methRef, enclTypeArgs, methTypeArgs, tys), _, _ -> CheckTypeInstNoByrefs cenv env m tyargs CheckTypeInstNoByrefs cenv env m enclTypeArgs CheckTypeInstNoByrefs cenv env m methTypeArgs @@ -1157,12 +1167,12 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = else CheckCall cenv env m returnTy args argContexts PermitByRefExpr.Yes - | TOp.Tuple tupInfo,_,_ when not (evalTupInfoIsStruct tupInfo) -> + | TOp.Tuple tupInfo, _, _ when not (evalTupInfoIsStruct tupInfo) -> match context with | PermitByRefExpr.YesTupleOfArgs nArity -> if cenv.reportErrors then if args.Length <> nArity then - errorR(InternalError("Tuple arity does not correspond to planned function argument arity",m)) + errorR(InternalError("Tuple arity does not correspond to planned function argument arity", m)) // This tuple should not be generated. The known function arity // means it just bundles arguments. CheckExprsPermitByRefLike cenv env args @@ -1170,7 +1180,7 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = CheckTypeInstNoByrefs cenv env m tyargs CheckExprsNoByRefLike cenv env args - | TOp.LValueOp(LAddrOf _,vref),_,_ -> + | TOp.LValueOp(LAddrOf _, vref), _, _ -> let limit1 = GetLimitValByRef cenv env m vref.Deref let limit2 = CheckExprsNoByRefLike cenv env args let limit = CombineTwoLimits limit1 limit2 @@ -1193,7 +1203,7 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = limit - | TOp.LValueOp(LByrefSet,vref),_,[arg] -> + | TOp.LValueOp(LByrefSet, vref), _, [arg] -> let limit = GetLimitVal cenv env m vref.Deref let isVrefLimited = not (HasLimitFlag LimitFlags.ByRefOfStackReferringSpanLike limit) let isArgLimited = HasLimitFlag LimitFlags.StackReferringSpanLike (CheckExprPermitByRefLike cenv env arg) @@ -1201,7 +1211,7 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = errorR(Error(FSComp.SR.chkNoWriteToLimitedSpan(vref.DisplayName), m)) NoLimit - | TOp.LValueOp(LByrefGet,vref),_,[] -> + | TOp.LValueOp(LByrefGet, vref), _, [] -> let limit = GetLimitVal cenv env m vref.Deref if HasLimitFlag LimitFlags.ByRefOfStackReferringSpanLike limit then @@ -1217,25 +1227,25 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = else { scope = 1; flags = LimitFlags.None } - | TOp.LValueOp(LSet _, vref),_,[arg] -> + | TOp.LValueOp(LSet _, vref), _, [arg] -> let isVrefLimited = not (HasLimitFlag LimitFlags.StackReferringSpanLike (GetLimitVal cenv env m vref.Deref)) let isArgLimited = HasLimitFlag LimitFlags.StackReferringSpanLike (CheckExprPermitByRefLike cenv env arg) if isVrefLimited && isArgLimited then errorR(Error(FSComp.SR.chkNoWriteToLimitedSpan(vref.DisplayName), m)) NoLimit - | TOp.AnonRecdGet _,_,[arg1] - | TOp.TupleFieldGet _,_,[arg1] -> + | TOp.AnonRecdGet _, _, [arg1] + | TOp.TupleFieldGet _, _, [arg1] -> CheckTypeInstNoByrefs cenv env m tyargs CheckExprsPermitByRefLike cenv env [arg1] (* Compiled pattern matches on immutable value structs come through here. *) - | TOp.ValFieldGet _rf,_,[arg1] -> + | TOp.ValFieldGet _rf, _, [arg1] -> CheckTypeInstNoByrefs cenv env m tyargs //See mkRecdFieldGetViaExprAddr -- byref arg1 when #args =1 // Property getters on mutable structs come through here. CheckExprsPermitByRefLike cenv env [arg1] - | TOp.ValFieldSet rf,_,[arg1;arg2] -> + | TOp.ValFieldSet rf, _, [arg1;arg2] -> CheckTypeInstNoByrefs cenv env m tyargs // See mkRecdFieldSetViaExprAddr -- byref arg1 when #args=2 // Field setters on mutable structs come through here @@ -1248,7 +1258,7 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = errorR(Error(FSComp.SR.chkNoWriteToLimitedSpan(rf.FieldName), m)) NoLimit - | TOp.Coerce,[tgty;srcty],[x] -> + | TOp.Coerce, [tgty;srcty], [x] -> if TypeRelations.TypeDefinitelySubsumesTypeNoCoercion 0 g cenv.amap m tgty srcty then CheckExpr cenv env x context else @@ -1256,12 +1266,12 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = CheckExprNoByrefs cenv env x NoLimit - | TOp.Reraise,[_ty1],[] -> + | TOp.Reraise, [_ty1], [] -> CheckTypeInstNoByrefs cenv env m tyargs NoLimit // Check get of static field - | TOp.ValFieldGetAddr (rfref, _readonly),tyargs,[] -> + | TOp.ValFieldGetAddr (rfref, _readonly), tyargs, [] -> if context.Disallow && cenv.reportErrors && isByrefLikeTy g m (tyOfExpr g expr) then errorR(Error(FSComp.SR.chkNoAddressStaticFieldAtThisPoint(rfref.FieldName), m)) @@ -1270,7 +1280,7 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = NoLimit // Check get of instance field - | TOp.ValFieldGetAddr (rfref, _readonly),tyargs,[obj] -> + | TOp.ValFieldGetAddr (rfref, _readonly), tyargs, [obj] -> if context.Disallow && cenv.reportErrors && isByrefLikeTy g m (tyOfExpr g expr) then errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(rfref.FieldName), m)) @@ -1290,15 +1300,15 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = // Recursively check in same context, e.g. if at PermitOnlyReturnable the obj arg must also be returnable CheckExpr cenv env obj context - | TOp.UnionCaseFieldGet _,_,[arg1] -> + | TOp.UnionCaseFieldGet _, _, [arg1] -> CheckTypeInstNoByrefs cenv env m tyargs CheckExprPermitByRefLike cenv env arg1 - | TOp.UnionCaseTagGet _,_,[arg1] -> + | TOp.UnionCaseTagGet _, _, [arg1] -> CheckTypeInstNoByrefs cenv env m tyargs CheckExprPermitByRefLike cenv env arg1 // allow byref - it may be address-of-struct - | TOp.UnionCaseFieldGetAddr (uref, _idx, _readonly),tyargs,[obj] -> + | TOp.UnionCaseFieldGetAddr (uref, _idx, _readonly), tyargs, [obj] -> if context.Disallow && cenv.reportErrors && isByrefLikeTy g m (tyOfExpr g expr) then errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(uref.CaseName), m)) @@ -1311,23 +1321,23 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = // Recursively check in same context, e.g. if at PermitOnlyReturnable the obj arg must also be returnable CheckExpr cenv env obj context - | TOp.ILAsm (instrs,tys),_,_ -> + | TOp.ILAsm (instrs, tys), _, _ -> CheckTypeInstNoInnerByrefs cenv env m tys CheckTypeInstNoByrefs cenv env m tyargs - match instrs,args with + match instrs, args with // Write a .NET instance field - | [ I_stfld (_alignment,_vol,_fspec) ],_ -> + | [ I_stfld (_alignment, _vol, _fspec) ], _ -> // permit byref for lhs lvalue // permit byref for rhs lvalue (field would have to have ByRefLike type, i.e. be a field in another ByRefLike type) CheckExprsPermitByRefLike cenv env args // Read a .NET instance field - | [ I_ldfld (_alignment,_vol,_fspec) ],_ -> + | [ I_ldfld (_alignment, _vol, _fspec) ], _ -> // permit byref for lhs lvalue CheckExprsPermitByRefLike cenv env args // Read a .NET instance field - | [ I_ldfld (_alignment,_vol,_fspec); AI_nop ],_ -> + | [ I_ldfld (_alignment, _vol, _fspec); AI_nop ], _ -> // permit byref for lhs lvalue of readonly value CheckExprsPermitByRefLike cenv env args @@ -1344,7 +1354,7 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = // Recursively check in same context, e.g. if at PermitOnlyReturnable the obj arg must also be returnable CheckExpr cenv env obj context - | [ I_ldelema (_,isNativePtr,_,_) ],lhsArray::indices -> + | [ I_ldelema (_, isNativePtr, _, _) ], lhsArray::indices -> if context.Disallow && cenv.reportErrors && not isNativePtr && isByrefLikeTy g m (tyOfExpr g expr) then errorR(Error(FSComp.SR.chkNoAddressOfArrayElementAtThisPoint(), m)) // permit byref for lhs lvalue @@ -1352,14 +1362,14 @@ and CheckExprOp cenv env (op,tyargs,args,m) context expr = CheckExprsNoByRefLike cenv env indices |> ignore limit - | [ AI_conv _ ],_ -> + | [ AI_conv _ ], _ -> // permit byref for args to conv CheckExprsPermitByRefLike cenv env args | _ -> CheckExprsNoByRefLike cenv env args - | TOp.TraitCall _,_,_ -> + | TOp.TraitCall _, _, _ -> CheckTypeInstNoByrefs cenv env m tyargs // allow args to be byref here CheckExprsPermitByRefLike cenv env args @@ -1377,13 +1387,13 @@ and CheckLambdas isTop (memInfo: ValMemberInfo option) cenv env inlined topValIn // The topValInfo here says we are _guaranteeing_ to compile a function value // as a .NET method with precisely the corresponding argument counts. match e with - | Expr.TyChoose(tps,e1,m) -> + | Expr.TyChoose(tps, e1, m) -> let env = BindTypars g env tps CheckLambdas isTop memInfo cenv env inlined topValInfo alwaysCheckNoReraise e1 m ety context - | Expr.Lambda (_,_,_,_,_,m,_) - | Expr.TyLambda(_,_,_,m,_) -> - let tps,ctorThisValOpt,baseValOpt,vsl,body,bodyty = destTopLambda g cenv.amap topValInfo (e, ety) in + | Expr.Lambda (_, _, _, _, _, m, _) + | Expr.TyLambda(_, _, _, m, _) -> + let tps, ctorThisValOpt, baseValOpt, vsl, body, bodyty = destTopLambda g cenv.amap topValInfo (e, ety) in let env = BindTypars g env tps let thisAndBase = Option.toList ctorThisValOpt @ Option.toList baseValOpt let restArgs = List.concat vsl @@ -1426,11 +1436,6 @@ and CheckLambdas isTop (memInfo: ValMemberInfo option) cenv env inlined topValIn syntacticArgs |> List.iter (BindVal cenv env) - // Trigger a test hook - match memInfo with - | None -> () - | Some membInfo -> testHookMemberBody membInfo body - // Check escapes in the body. Allow access to protected things within members. let freesOpt = CheckEscapes cenv memInfo.IsSome m syntacticArgs body @@ -1456,7 +1461,7 @@ and CheckLambdas isTop (memInfo: ValMemberInfo option) cenv env inlined topValIn errorR(Error(FSComp.SR.chkReturnTypeNoByref(), m))) for tp in tps do - if tp.Constraints |> List.sumBy (function TyparConstraint.CoercesTo(ty,_) when isClassTy g ty -> 1 | _ -> 0) > 1 then + if tp.Constraints |> List.sumBy (function TyparConstraint.CoercesTo(ty, _) when isClassTy g ty -> 1 | _ -> 0) > 1 then errorR(Error(FSComp.SR.chkTyparMultipleClassConstraints(), m)) NoLimit @@ -1511,40 +1516,40 @@ and CheckDecisionTreeTargets cenv env targets context = |> Array.map (CheckDecisionTreeTarget cenv env context) |> (CombineLimits << List.ofArray) -and CheckDecisionTreeTarget cenv env context (TTarget(vs,e,_)) = +and CheckDecisionTreeTarget cenv env context (TTarget(vs, e, _)) = BindVals cenv env vs vs |> List.iter (CheckValSpec PermitByRefType.All cenv env) CheckExpr cenv env e context and CheckDecisionTree cenv env x = match x with - | TDSuccess (es,_) -> + | TDSuccess (es, _) -> CheckExprsNoByRefLike cenv env es |> ignore - | TDBind(bind,rest) -> + | TDBind(bind, rest) -> CheckBinding cenv env false PermitByRefExpr.Yes bind |> ignore CheckDecisionTree cenv env rest - | TDSwitch (e,cases,dflt,m) -> - CheckDecisionTreeSwitch cenv env (e,cases,dflt,m) + | TDSwitch (e, cases, dflt, m) -> + CheckDecisionTreeSwitch cenv env (e, cases, dflt, m) -and CheckDecisionTreeSwitch cenv env (e,cases,dflt,m) = +and CheckDecisionTreeSwitch cenv env (e, cases, dflt, m) = CheckExprPermitByRefLike cenv env e |> ignore// can be byref for struct union switch - cases |> List.iter (fun (TCase(discrim,e)) -> CheckDecisionTreeTest cenv env m discrim; CheckDecisionTree cenv env e) + cases |> List.iter (fun (TCase(discrim, e)) -> CheckDecisionTreeTest cenv env m discrim; CheckDecisionTree cenv env e) dflt |> Option.iter (CheckDecisionTree cenv env) and CheckDecisionTreeTest cenv env m discrim = match discrim with - | DecisionTreeTest.UnionCase (_,tinst) -> CheckTypeInstNoInnerByrefs cenv env m tinst - | DecisionTreeTest.ArrayLength (_,ty) -> CheckTypeNoInnerByrefs cenv env m ty + | DecisionTreeTest.UnionCase (_, tinst) -> CheckTypeInstNoInnerByrefs cenv env m tinst + | DecisionTreeTest.ArrayLength (_, ty) -> CheckTypeNoInnerByrefs cenv env m ty | DecisionTreeTest.Const _ -> () | DecisionTreeTest.IsNull -> () - | DecisionTreeTest.IsInst (srcTy,tgtTy) -> CheckTypeNoInnerByrefs cenv env m srcTy; CheckTypeNoInnerByrefs cenv env m tgtTy - | DecisionTreeTest.ActivePatternCase (exp,_,_,_,_) -> CheckExprNoByrefs cenv env exp + | DecisionTreeTest.IsInst (srcTy, tgtTy) -> CheckTypeNoInnerByrefs cenv env m srcTy; CheckTypeNoInnerByrefs cenv env m tgtTy + | DecisionTreeTest.ActivePatternCase (exp, _, _, _, _) -> CheckExprNoByrefs cenv env exp -and CheckAttrib cenv env (Attrib(_,_,args,props,_,_,_)) = - props |> List.iter (fun (AttribNamedArg(_,_,_,expr)) -> CheckAttribExpr cenv env expr) +and CheckAttrib cenv env (Attrib(_, _, args, props, _, _, _)) = + props |> List.iter (fun (AttribNamedArg(_, _, _, expr)) -> CheckAttribExpr cenv env expr) args |> List.iter (CheckAttribExpr cenv env) -and CheckAttribExpr cenv env (AttribExpr(expr,vexpr)) = +and CheckAttribExpr cenv env (AttribExpr(expr, vexpr)) = CheckExprNoByrefs cenv env expr CheckExprNoByrefs cenv env vexpr CheckNoReraise cenv None expr @@ -1555,7 +1560,7 @@ and CheckAttribArgExpr cenv env expr = match expr with // Detect standard constants - | Expr.Const(c,m,_) -> + | Expr.Const(c, m, _) -> match c with | Const.Bool _ | Const.Int32 _ @@ -1576,17 +1581,17 @@ and CheckAttribArgExpr cenv env expr = if cenv.reportErrors then errorR (Error (FSComp.SR.tastNotAConstantExpression(), m)) - | Expr.Op(TOp.Array,[_elemTy],args,_m) -> + | Expr.Op(TOp.Array, [_elemTy], args, _m) -> List.iter (CheckAttribArgExpr cenv env) args | TypeOfExpr g _ -> () | TypeDefOfExpr g _ -> () - | Expr.Op(TOp.Coerce,_,[arg],_) -> + | Expr.Op(TOp.Coerce, _, [arg], _) -> CheckAttribArgExpr cenv env arg | EnumExpr g arg1 -> CheckAttribArgExpr cenv env arg1 - | AttribBitwiseOrExpr g (arg1,arg2) -> + | AttribBitwiseOrExpr g (arg1, arg2) -> CheckAttribArgExpr cenv env arg1 CheckAttribArgExpr cenv env arg2 | _ -> @@ -1595,26 +1600,26 @@ and CheckAttribArgExpr cenv env expr = and CheckAttribs cenv env (attribs: Attribs) = if isNil attribs then () else - let tcrefs = [ for (Attrib(tcref,_,_,_,_,_,m)) in attribs -> (tcref,m) ] + let tcrefs = [ for (Attrib(tcref, _, _, _, _, _, m)) in attribs -> (tcref, m) ] // Check for violations of allowMultiple = false let duplicates = tcrefs - |> Seq.groupBy (fun (tcref,_) -> tcref.Stamp) - |> Seq.map (fun (_,elems) -> List.last (List.ofSeq elems), Seq.length elems) - |> Seq.filter (fun (_,count) -> count > 1) + |> Seq.groupBy (fun (tcref, _) -> tcref.Stamp) + |> Seq.map (fun (_, elems) -> List.last (List.ofSeq elems), Seq.length elems) + |> Seq.filter (fun (_, count) -> count > 1) |> Seq.map fst |> Seq.toList // Filter for allowMultiple = false - |> List.filter (fun (tcref,m) -> TryFindAttributeUsageAttribute cenv.g m tcref <> Some(true)) + |> List.filter (fun (tcref, m) -> TryFindAttributeUsageAttribute cenv.g m tcref <> Some(true)) if cenv.reportErrors then - for (tcref,m) in duplicates do + for (tcref, m) in duplicates do errorR(Error(FSComp.SR.chkAttrHasAllowMultiFalse(tcref.DisplayName), m)) attribs |> List.iter (CheckAttrib cenv env) -and CheckValInfo cenv env (ValReprInfo(_,args,ret)) = +and CheckValInfo cenv env (ValReprInfo(_, args, ret)) = args |> List.iterSquared (CheckArgInfo cenv env) ret |> CheckArgInfo cenv env @@ -1634,11 +1639,11 @@ and AdjustAccess isHidden (cpath: unit -> CompilationPath) access = let (TAccess(l)) = access // FSharp 1.0 bug 1908: Values hidden by signatures are implicitly at least 'internal' let scoref = cpath().ILScopeRef - TAccess(CompPath(scoref,[])::l) + TAccess(CompPath(scoref, [])::l) else access -and CheckBinding cenv env alwaysCheckNoReraise context (TBind(v,bindRhs,_) as bind) : Limit = +and CheckBinding cenv env alwaysCheckNoReraise context (TBind(v, bindRhs, _) as bind) : Limit = let g = cenv.g let isTop = Option.isSome bind.Var.ValReprInfo //printfn "visiting %s..." v.DisplayName @@ -1649,7 +1654,7 @@ and CheckBinding cenv env alwaysCheckNoReraise context (TBind(v,bindRhs,_) as bi match TryGetActivePatternInfo (mkLocalValRef v) with | Some _apinfo when _apinfo.ActiveTags.Length > 1 -> if doesActivePatternHaveFreeTypars g (mkLocalValRef v) then - errorR(Error(FSComp.SR.activePatternChoiceHasFreeTypars(v.LogicalName),v.Range)) + errorR(Error(FSComp.SR.activePatternChoiceHasFreeTypars(v.LogicalName), v.Range)) | _ -> () match cenv.potentialUnboundUsesOfVals.TryFind v.Stamp with @@ -1674,7 +1679,7 @@ and CheckBinding cenv env alwaysCheckNoReraise context (TBind(v,bindRhs,_) as bi // Check top-level let-bound values match bind.Var.ValReprInfo with | Some info when info.HasNoArgs -> - CheckForByrefLikeType cenv env v.Range v.Type (fun () -> errorR(Error(FSComp.SR.chkNoByrefAsTopValue(),v.Range))) + CheckForByrefLikeType cenv env v.Range v.Type (fun () -> errorR(Error(FSComp.SR.chkNoByrefAsTopValue(), v.Range))) | _ -> () match v.PublicPath with @@ -1695,7 +1700,7 @@ and CheckBinding cenv env alwaysCheckNoReraise context (TBind(v,bindRhs,_) as bi HasFSharpAttribute g g.attrib_ReflectedDefinitionAttribute v.TopValDeclaringEntity.Attribs) then if v.IsInstanceMember && v.MemberApparentEntity.IsStructOrEnumTycon then - errorR(Error(FSComp.SR.chkNoReflectedDefinitionOnStructMember(),v.Range)) + errorR(Error(FSComp.SR.chkNoReflectedDefinitionOnStructMember(), v.Range)) cenv.usesQuotations <- true // If we've already recorded a definition then skip this @@ -1708,14 +1713,14 @@ and CheckBinding cenv env alwaysCheckNoReraise context (TBind(v,bindRhs,_) as bi // one blob for pickling to the binary format try let ety = tyOfExpr g bindRhs - let tps,taue,_ = + let tps, taue, _ = match bindRhs with - | Expr.TyLambda (_,tps,b,_,_) -> tps,b,applyForallTy g ety (List.map mkTyparTy tps) - | _ -> [],bindRhs,ety + | Expr.TyLambda (_, tps, b, _, _) -> tps, b, applyForallTy g ety (List.map mkTyparTy tps) + | _ -> [], bindRhs, ety let env = QuotationTranslator.QuotationTranslationEnv.Empty.BindTypars tps - let qscope = QuotationTranslator.QuotationGenerationScope.Create (g,cenv.amap,cenv.viewCcu, QuotationTranslator.IsReflectedDefinition.Yes) + let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, QuotationTranslator.IsReflectedDefinition.Yes) QuotationTranslator.ConvExprPublic qscope env taue |> ignore - let _,_,argExprs = qscope.Close() + let _, _, argExprs = qscope.Close() if not (isNil argExprs) then errorR(Error(FSComp.SR.chkReflectedDefCantSplice(), v.Range)) QuotationTranslator.ConvMethodBase qscope env (v.CompiledName, v) |> ignore @@ -1743,7 +1748,7 @@ and CheckBindings cenv env xs = xs |> List.iter (CheckBinding cenv env false PermitByRefExpr.Yes >> ignore) // Top binds introduce expression, check they are reraise free. -let CheckModuleBinding cenv env (TBind(v,e,_) as bind) = +let CheckModuleBinding cenv env (TBind(v, e, _) as bind) = let g = cenv.g let isExplicitEntryPoint = HasFSharpAttribute g g.attrib_EntryPointAttribute v.Attribs if isExplicitEntryPoint then @@ -1763,7 +1768,7 @@ let CheckModuleBinding cenv env (TBind(v,e,_) as bind) = IsSimpleSyntacticConstantExpr g e && // Check the thing is actually compiled as a property IsCompiledAsStaticProperty g v || - (g.compilingFslib && v.Attribs |> List.exists(fun (Attrib(tc,_,_,_,_,_,_)) -> tc.CompiledName = "ValueAsStaticPropertyAttribute")) + (g.compilingFslib && v.Attribs |> List.exists(fun (Attrib(tc, _, _, _, _, _, _)) -> tc.CompiledName = "ValueAsStaticPropertyAttribute")) then v.SetIsCompiledAsStaticPropertyWithoutField() @@ -1783,7 +1788,7 @@ let CheckModuleBinding cenv env (TBind(v,e,_) as bind) = let hasDefaultAugmentation = tcref.IsUnionTycon && match TryFindFSharpAttribute g g.attrib_DefaultAugmentationAttribute tcref.Attribs with - | Some(Attrib(_,_,[ AttribBoolArg(b) ],_,_,_,_)) -> b + | Some(Attrib(_, _, [ AttribBoolArg(b) ], _, _, _, _)) -> b | _ -> true (* not hiddenRepr *) let kind = (if v.IsMember then "member" else "value") @@ -1793,20 +1798,20 @@ let CheckModuleBinding cenv env (TBind(v,e,_) as bind) = tcref.ModuleOrNamespaceType.AllValsByLogicalName.ContainsKey(nm) && not (valEq tcref.ModuleOrNamespaceType.AllValsByLogicalName.[nm] v) then - error(Duplicate(kind,v.DisplayName,v.Range)) + error(Duplicate(kind, v.DisplayName, v.Range)) #if CASES_IN_NESTED_CLASS if tcref.IsUnionTycon && nm = "Cases" then - errorR(NameClash(nm,kind,v.DisplayName,v.Range, "generated type","Cases",tcref.Range)) + errorR(NameClash(nm, kind, v.DisplayName, v.Range, "generated type", "Cases", tcref.Range)) #endif if tcref.IsUnionTycon then match nm with - | "Tag" -> errorR(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.typeInfoGeneratedProperty(),"Tag",tcref.Range)) - | "Tags" -> errorR(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.typeInfoGeneratedType(),"Tags",tcref.Range)) + | "Tag" -> errorR(NameClash(nm, kind, v.DisplayName, v.Range, FSComp.SR.typeInfoGeneratedProperty(), "Tag", tcref.Range)) + | "Tags" -> errorR(NameClash(nm, kind, v.DisplayName, v.Range, FSComp.SR.typeInfoGeneratedType(), "Tags", tcref.Range)) | _ -> if hasDefaultAugmentation then match tcref.GetUnionCaseByName(nm) with - | Some(uc) -> error(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.typeInfoUnionCase(),uc.DisplayName,uc.Range)) + | Some(uc) -> error(NameClash(nm, kind, v.DisplayName, v.Range, FSComp.SR.typeInfoUnionCase(), uc.DisplayName, uc.Range)) | None -> () let hasNoArgs = @@ -1818,24 +1823,24 @@ let CheckModuleBinding cenv env (TBind(v,e,_) as bind) = if tcref.UnionCasesArray.Length = 1 && hasNoArgs then let ucase1 = tcref.UnionCasesArray.[0] for f in ucase1.RecdFieldsArray do - if f.Name = nm then error(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.typeInfoGeneratedProperty(),f.Name,ucase1.Range)) + if f.Name = nm then error(NameClash(nm, kind, v.DisplayName, v.Range, FSComp.SR.typeInfoGeneratedProperty(), f.Name, ucase1.Range)) // Default augmentation contains the nasty 'Case' etc. let prefix = "New" if nm.StartsWithOrdinal(prefix) then match tcref.GetUnionCaseByName(nm.[prefix.Length ..]) with - | Some(uc) -> error(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.chkUnionCaseCompiledForm(),uc.DisplayName,uc.Range)) + | Some(uc) -> error(NameClash(nm, kind, v.DisplayName, v.Range, FSComp.SR.chkUnionCaseCompiledForm(), uc.DisplayName, uc.Range)) | None -> () // Default augmentation contains the nasty 'Is' etc. let prefix = "Is" if nm.StartsWithOrdinal(prefix) && hasDefaultAugmentation then match tcref.GetUnionCaseByName(nm.[prefix.Length ..]) with - | Some(uc) -> error(NameClash(nm,kind,v.DisplayName,v.Range, FSComp.SR.chkUnionCaseDefaultAugmentation(),uc.DisplayName,uc.Range)) + | Some(uc) -> error(NameClash(nm, kind, v.DisplayName, v.Range, FSComp.SR.chkUnionCaseDefaultAugmentation(), uc.DisplayName, uc.Range)) | None -> () match tcref.GetFieldByName(nm) with - | Some(rf) -> error(NameClash(nm,kind,v.DisplayName,v.Range,"field",rf.Name,rf.Range)) + | Some(rf) -> error(NameClash(nm, kind, v.DisplayName, v.Range, "field", rf.Name, rf.Range)) | None -> () check false v.CoreDisplayName @@ -1850,7 +1855,7 @@ let CheckModuleBinding cenv env (TBind(v,e,_) as bind) = let minfo2 = FSMeth(g, generalizedTyconRef tcref, mkLocalValRef v2, Some 0UL) if tyconRefEq g v.MemberApparentEntity v2.MemberApparentEntity && MethInfosEquivByNameAndSig EraseAll true g cenv.amap v.Range minfo1 minfo2 then - errorR(Duplicate(kind,v.DisplayName,v.Range))) + errorR(Duplicate(kind, v.DisplayName, v.Range))) // Properties get 'get_X', only if there are no args // Properties get 'get_X' @@ -1925,7 +1930,7 @@ let CheckEntityDefn cenv env (tycon:Entity) = let allVirtualMethsInParent = match GetSuperTypeOfType g cenv.amap m ty with | Some super -> - GetIntrinsicMethInfosOfType cenv.infoReader (None,AccessibleFromSomewhere,AllowMultiIntfInstantiations.Yes) IgnoreOverrides m super + GetIntrinsicMethInfosOfType cenv.infoReader (None, AccessibleFromSomewhere, AllowMultiIntfInstantiations.Yes) IgnoreOverrides m super |> List.filter (fun minfo -> minfo.IsVirtual) | None -> [] @@ -1937,12 +1942,12 @@ let CheckEntityDefn cenv env (tycon:Entity) = else MethInfosEquivByNameAndPartialSig eraseFlag true g cenv.amap m minfo minfo2 (* partial ignores return type *) let immediateMeths = - [ for v in tycon.AllGeneratedValues do yield FSMeth (g,ty,v,None) - yield! GetImmediateIntrinsicMethInfosOfType (None,AccessibleFromSomewhere) g cenv.amap m ty ] + [ for v in tycon.AllGeneratedValues do yield FSMeth (g, ty, v, None) + yield! GetImmediateIntrinsicMethInfosOfType (None, AccessibleFromSomewhere) g cenv.amap m ty ] - let immediateProps = GetImmediateIntrinsicPropInfosOfType (None,AccessibleFromSomewhere) g cenv.amap m ty + let immediateProps = GetImmediateIntrinsicPropInfosOfType (None, AccessibleFromSomewhere) g cenv.amap m ty - let getHash (hash:Dictionary) nm = + let getHash (hash:Dictionary) nm = match hash.TryGetValue(nm) with | true, h -> h | _ -> [] @@ -1967,7 +1972,7 @@ let CheckEntityDefn cenv env (tycon:Entity) = yield m ] - let hashOfImmediateProps = new Dictionary() + let hashOfImmediateProps = new Dictionary() for minfo in immediateMeths do let nm = minfo.LogicalName let m = (match minfo.ArbitraryValRef with None -> m | Some vref -> vref.DefinitionRange) @@ -1984,14 +1989,14 @@ let CheckEntityDefn cenv env (tycon:Entity) = if others |> List.exists (checkForDup EraseAll) then if others |> List.exists (checkForDup EraseNone) then - errorR(Error(FSComp.SR.chkDuplicateMethod(nm, NicePrint.minimalStringOfType cenv.denv ty),m)) + errorR(Error(FSComp.SR.chkDuplicateMethod(nm, NicePrint.minimalStringOfType cenv.denv ty), m)) else - errorR(Error(FSComp.SR.chkDuplicateMethodWithSuffix(nm, NicePrint.minimalStringOfType cenv.denv ty),m)) + errorR(Error(FSComp.SR.chkDuplicateMethodWithSuffix(nm, NicePrint.minimalStringOfType cenv.denv ty), m)) let numCurriedArgSets = minfo.NumArgs.Length if numCurriedArgSets > 1 && others |> List.exists (fun minfo2 -> not (IsAbstractDefaultPair2 minfo minfo2)) then - errorR(Error(FSComp.SR.chkDuplicateMethodCurried(nm, NicePrint.minimalStringOfType cenv.denv ty),m)) + errorR(Error(FSComp.SR.chkDuplicateMethodCurried(nm, NicePrint.minimalStringOfType cenv.denv ty), m)) if numCurriedArgSets > 1 && (minfo.GetParamDatas(cenv.amap, m, minfo.FormalMethodInst) @@ -2005,25 +2010,25 @@ let CheckEntityDefn cenv env (tycon:Entity) = ignore isInArg match (optArgInfo, callerInfo) with | _, NoCallerInfo -> () - | NotOptional, _ -> errorR(Error(FSComp.SR.tcCallerInfoNotOptional(callerInfo.ToString()),m)) + | NotOptional, _ -> errorR(Error(FSComp.SR.tcCallerInfoNotOptional(callerInfo.ToString()), m)) | CallerSide(_), CallerLineNumber -> if not (typeEquiv g g.int32_ty ty) then - errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "int", NicePrint.minimalStringOfType cenv.denv ty),m)) + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "int", NicePrint.minimalStringOfType cenv.denv ty), m)) | CalleeSide, CallerLineNumber -> if not ((isOptionTy g ty) && (typeEquiv g g.int32_ty (destOptionTy g ty))) then - errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "int", NicePrint.minimalStringOfType cenv.denv (destOptionTy g ty)),m)) + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "int", NicePrint.minimalStringOfType cenv.denv (destOptionTy g ty)), m)) | CallerSide(_), CallerFilePath -> if not (typeEquiv g g.string_ty ty) then - errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv ty),m)) + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv ty), m)) | CalleeSide, CallerFilePath -> if not ((isOptionTy g ty) && (typeEquiv g g.string_ty (destOptionTy g ty))) then - errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv (destOptionTy g ty)),m)) + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv (destOptionTy g ty)), m)) | CallerSide(_), CallerMemberName -> if not (typeEquiv g g.string_ty ty) then - errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv ty),m)) + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv ty), m)) | CalleeSide, CallerMemberName -> if not ((isOptionTy g ty) && (typeEquiv g g.string_ty (destOptionTy g ty))) then - errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv (destOptionTy g ty)),m))) + errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo.ToString(), "string", NicePrint.minimalStringOfType cenv.denv (destOptionTy g ty)), m))) for pinfo in immediateProps do let nm = pinfo.PropertyName @@ -2033,12 +2038,12 @@ let CheckEntityDefn cenv env (tycon:Entity) = | Some vref -> vref.DefinitionRange if hashOfImmediateMeths.ContainsKey nm then - errorR(Error(FSComp.SR.chkPropertySameNameMethod(nm, NicePrint.minimalStringOfType cenv.denv ty),m)) + errorR(Error(FSComp.SR.chkPropertySameNameMethod(nm, NicePrint.minimalStringOfType cenv.denv ty), m)) let others = getHash hashOfImmediateProps nm if pinfo.HasGetter && pinfo.HasSetter && pinfo.GetterMethod.IsVirtual <> pinfo.SetterMethod.IsVirtual then - errorR(Error(FSComp.SR.chkGetterSetterDoNotMatchAbstract(nm, NicePrint.minimalStringOfType cenv.denv ty),m)) + errorR(Error(FSComp.SR.chkGetterSetterDoNotMatchAbstract(nm, NicePrint.minimalStringOfType cenv.denv ty), m)) let checkForDup erasureFlag pinfo2 = // abstract/default pairs of duplicate properties are OK @@ -2050,34 +2055,34 @@ let CheckEntityDefn cenv env (tycon:Entity) = if others |> List.exists (checkForDup EraseAll) then if others |> List.exists (checkForDup EraseNone) then - errorR(Error(FSComp.SR.chkDuplicateProperty(nm, NicePrint.minimalStringOfType cenv.denv ty) ,m)) + errorR(Error(FSComp.SR.chkDuplicateProperty(nm, NicePrint.minimalStringOfType cenv.denv ty) , m)) else - errorR(Error(FSComp.SR.chkDuplicatePropertyWithSuffix(nm, NicePrint.minimalStringOfType cenv.denv ty) ,m)) + errorR(Error(FSComp.SR.chkDuplicatePropertyWithSuffix(nm, NicePrint.minimalStringOfType cenv.denv ty) , m)) // Check to see if one is an indexer and one is not if ( (pinfo.HasGetter && pinfo.HasSetter && - let setterArgs = pinfo.DropGetter.GetParamTypes(cenv.amap,m) - let getterArgs = pinfo.DropSetter.GetParamTypes(cenv.amap,m) + let setterArgs = pinfo.DropGetter.GetParamTypes(cenv.amap, m) + let getterArgs = pinfo.DropSetter.GetParamTypes(cenv.amap, m) setterArgs.Length <> getterArgs.Length) || - (let nargs = pinfo.GetParamTypes(cenv.amap,m).Length - others |> List.exists (fun pinfo2 -> (isNil(pinfo2.GetParamTypes(cenv.amap,m))) <> (nargs = 0)))) then + (let nargs = pinfo.GetParamTypes(cenv.amap, m).Length + others |> List.exists (fun pinfo2 -> (isNil(pinfo2.GetParamTypes(cenv.amap, m))) <> (nargs = 0)))) then - errorR(Error(FSComp.SR.chkPropertySameNameIndexer(nm, NicePrint.minimalStringOfType cenv.denv ty),m)) + errorR(Error(FSComp.SR.chkPropertySameNameIndexer(nm, NicePrint.minimalStringOfType cenv.denv ty), m)) // Check to see if the signatures of the both getter and the setter imply the same property type if pinfo.HasGetter && pinfo.HasSetter && not pinfo.IsIndexer then - let ty1 = pinfo.DropSetter.GetPropertyType(cenv.amap,m) - let ty2 = pinfo.DropGetter.GetPropertyType(cenv.amap,m) + let ty1 = pinfo.DropSetter.GetPropertyType(cenv.amap, m) + let ty2 = pinfo.DropGetter.GetPropertyType(cenv.amap, m) if not (typeEquivAux EraseNone cenv.amap.g ty1 ty2) then - errorR(Error(FSComp.SR.chkGetterAndSetterHaveSamePropertyType(pinfo.PropertyName, NicePrint.minimalStringOfType cenv.denv ty1, NicePrint.minimalStringOfType cenv.denv ty2),m)) + errorR(Error(FSComp.SR.chkGetterAndSetterHaveSamePropertyType(pinfo.PropertyName, NicePrint.minimalStringOfType cenv.denv ty1, NicePrint.minimalStringOfType cenv.denv ty2), m)) hashOfImmediateProps.[nm] <- pinfo::others if not (isInterfaceTy g ty) then - let hashOfAllVirtualMethsInParent = new Dictionary() + let hashOfAllVirtualMethsInParent = new Dictionary() for minfo in allVirtualMethsInParent do let nm = minfo.LogicalName let others = getHash hashOfAllVirtualMethsInParent nm @@ -2093,9 +2098,9 @@ let CheckEntityDefn cenv env (tycon:Entity) = | Some minfo -> let mtext = NicePrint.stringOfMethInfo cenv.amap m cenv.denv minfo if parentMethsOfSameName |> List.exists (checkForDup EraseNone) then - warning(Error(FSComp.SR.tcNewMemberHidesAbstractMember(mtext),m)) + warning(Error(FSComp.SR.tcNewMemberHidesAbstractMember(mtext), m)) else - warning(Error(FSComp.SR.tcNewMemberHidesAbstractMemberWithSuffix(mtext),m)) + warning(Error(FSComp.SR.tcNewMemberHidesAbstractMemberWithSuffix(mtext), m)) if minfo.IsDispatchSlot then @@ -2106,9 +2111,9 @@ let CheckEntityDefn cenv env (tycon:Entity) = if parentMethsOfSameName |> List.exists (checkForDup EraseAll) then if parentMethsOfSameName |> List.exists (checkForDup EraseNone) then - errorR(Error(FSComp.SR.chkDuplicateMethodInheritedType(nm),m)) + errorR(Error(FSComp.SR.chkDuplicateMethodInheritedType(nm), m)) else - errorR(Error(FSComp.SR.chkDuplicateMethodInheritedTypeWithSuffix(nm),m)) + errorR(Error(FSComp.SR.chkDuplicateMethodInheritedTypeWithSuffix(nm), m)) if TyconRefHasAttribute g m g.attrib_IsByRefLikeAttribute tcref && not tycon.IsStructOrEnumTycon then errorR(Error(FSComp.SR.tcByRefLikeNotStruct(), tycon.Range)) @@ -2117,7 +2122,7 @@ let CheckEntityDefn cenv env (tycon:Entity) = errorR(Error(FSComp.SR.tcIsReadOnlyNotStruct(), tycon.Range)) // Considers TFSharpObjectRepr, TRecdRepr and TUnionRepr. - // [Review] are all cases covered: TILObjectRepr,TAsmRepr. [Yes - these are FSharp.Core.dll only] + // [Review] are all cases covered: TILObjectRepr, TAsmRepr. [Yes - these are FSharp.Core.dll only] tycon.AllFieldsArray |> Array.iter (CheckRecdField false cenv env tycon) // Abstract slots can have byref arguments and returns @@ -2161,7 +2166,7 @@ let CheckEntityDefn cenv env (tycon:Entity) = //ss.ClassTypars //ss.MethodTypars ss.FormalReturnType |> Option.iter visitType - ss.FormalParams |> List.iterSquared (fun (TSlotParam(_,ty,_,_,_,_)) -> visitType ty) + ss.FormalParams |> List.iterSquared (fun (TSlotParam(_, ty, _, _, _, _)) -> visitType ty) | _ -> () | _ -> () @@ -2174,7 +2179,7 @@ let CheckEntityDefn cenv env (tycon:Entity) = List.iter visitType interfaces // Check inherited interface is as accessible if not (isRecdOrStructTyconRefAssumedImmutable g tcref) && isRecdOrStructTyconRefReadOnly g m tcref then - errorR(Error(FSComp.SR.readOnlyAttributeOnStructWithMutableField(),m)) + errorR(Error(FSComp.SR.readOnlyAttributeOnStructWithMutableField(), m)) if cenv.reportErrors then if not tycon.IsTypeAbbrev then @@ -2212,8 +2217,8 @@ let CheckEntityDefns cenv env tycons = let rec CheckModuleExpr cenv env x = match x with | ModuleOrNamespaceExprWithSig(mty, def, _) -> - let (rpi,mhi) = ComputeRemappingFromImplementationToSignature cenv.g def mty - let env = { env with sigToImplRemapInfo = (mkRepackageRemapping rpi,mhi) :: env.sigToImplRemapInfo } + let (rpi, mhi) = ComputeRemappingFromImplementationToSignature cenv.g def mty + let env = { env with sigToImplRemapInfo = (mkRepackageRemapping rpi, mhi) :: env.sigToImplRemapInfo } CheckDefnInModule cenv env def and CheckDefnsInModule cenv env x = @@ -2225,16 +2230,16 @@ and CheckNothingAfterEntryPoint cenv m = and CheckDefnInModule cenv env x = match x with - | TMDefRec(isRec,tycons,mspecs,m) -> + | TMDefRec(isRec, tycons, mspecs, m) -> CheckNothingAfterEntryPoint cenv m if isRec then BindVals cenv env (allValsOfModDef x |> Seq.toList) CheckEntityDefns cenv env tycons List.iter (CheckModuleSpec cenv env) mspecs - | TMDefLet(bind,m) -> + | TMDefLet(bind, m) -> CheckNothingAfterEntryPoint cenv m CheckModuleBinding cenv env bind BindVal cenv env bind.Var - | TMDefDo(e,m) -> + | TMDefDo(e, m) -> CheckNothingAfterEntryPoint cenv m CheckNoReraise cenv None e CheckExprNoByrefs cenv env e @@ -2251,12 +2256,12 @@ and CheckModuleSpec cenv env x = let env = { env with reflect = env.reflect || HasFSharpAttribute cenv.g cenv.g.attrib_ReflectedDefinitionAttribute mspec.Attribs } CheckDefnInModule cenv env rhs -let CheckTopImpl (g,amap,reportErrors,infoReader,internalsVisibleToPaths,viewCcu,denv ,mexpr,extraAttribs,(isLastCompiland:bool*bool),isInternalTestSpanStackReferring) = +let CheckTopImpl (g, amap, reportErrors, infoReader, internalsVisibleToPaths, viewCcu, denv , mexpr, extraAttribs, (isLastCompiland:bool*bool), isInternalTestSpanStackReferring) = let cenv = { g =g reportErrors=reportErrors - boundVals= new Dictionary<_,_>(100, HashIdentity.Structural) - limitVals= new Dictionary<_,_>(100, HashIdentity.Structural) + boundVals= new Dictionary<_, _>(100, HashIdentity.Structural) + limitVals= new Dictionary<_, _>(100, HashIdentity.Structural) potentialUnboundUsesOfVals=Map.empty anonRecdTypes = StampMap.Empty usesQuotations=false diff --git a/src/fsharp/PostInferenceChecks.fsi b/src/fsharp/PostInferenceChecks.fsi index 54f4ba7db11210a38e5f00565a229482f2543cd3..25c6bf3ac352e46d9c2ccf268f73d591dfce3fcb 100644 --- a/src/fsharp/PostInferenceChecks.fsi +++ b/src/fsharp/PostInferenceChecks.fsi @@ -10,7 +10,5 @@ open FSharp.Compiler.Tast open FSharp.Compiler.Tastops open FSharp.Compiler.TcGlobals -val testFlagMemberBody : bool ref - /// Perform the checks on the TAST for a file after type inference is complete. val CheckTopImpl : TcGlobals * ImportMap * bool * InfoReader * CompilationPath list * CcuThunk * DisplayEnv * ModuleOrNamespaceExprWithSig * Attribs * (bool * bool) * isInternalTestSpanStackReferring: bool -> bool * StampMap diff --git a/src/fsharp/PrettyNaming.fs b/src/fsharp/PrettyNaming.fs index 6f5222b7d47f9f9538f6e6fdde9a8fd85e9e2bed..3935542a046ac4ede122e50761c1306c840e0b7b 100755 --- a/src/fsharp/PrettyNaming.fs +++ b/src/fsharp/PrettyNaming.fs @@ -19,10 +19,6 @@ module public FSharp.Compiler.PrettyNaming open Internal.Utilities.StructuredFormat open Internal.Utilities.StructuredFormat.LayoutOps -#if FX_RESHAPED_REFLECTION - open Microsoft.FSharp.Core.ReflectionAdapters -#endif - //------------------------------------------------------------------------ // Operator name compilation //----------------------------------------------------------------------- diff --git a/src/fsharp/QuotationPickler.fs b/src/fsharp/QuotationPickler.fs index 7cd8cb99182bcb0a56afbb8be5daf09f587a6b44..c0e0360f6e8da46898d2928386826923cf67e8b5 100644 --- a/src/fsharp/QuotationPickler.fs +++ b/src/fsharp/QuotationPickler.fs @@ -2,14 +2,13 @@ module internal FSharp.Compiler.QuotationPickler - open System.Text open Internal.Utilities.Collections open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler open FSharp.Compiler.Lib -let mkRLinear mk (vs,body) = List.foldBack (fun v acc -> mk (v,acc)) vs body +let mkRLinear mk (vs, body) = List.foldBack (fun v acc -> mk (v, acc)) vs body type TypeVarData = { tvName: string; } @@ -27,24 +26,24 @@ type TypeData = | AppType of TypeCombOp * TypeData list let mkVarTy v = VarType v -let mkFunTy (x1,x2) = AppType(FunTyOp, [x1; x2]) -let mkArrayTy (n,x) = AppType(ArrayTyOp n, [x]) -let mkILNamedTy (r,l) = AppType(NamedTyOp r,l) +let mkFunTy (x1, x2) = AppType(FunTyOp, [x1; x2]) +let mkArrayTy (n, x) = AppType(ArrayTyOp n, [x]) +let mkILNamedTy (r, l) = AppType(NamedTyOp r, l) type CtorData = - { ctorParent: NamedTypeData; + { ctorParent: NamedTypeData ctorArgTypes: TypeData list; } type MethodData = - { methParent: NamedTypeData; - methName: string; - methArgTypes: TypeData list; - methRetType: TypeData; + { methParent: NamedTypeData + methName: string + methArgTypes: TypeData list + methRetType: TypeData numGenericArgs: int } type VarData = - { vText: string; - vType: TypeData; + { vText: string + vType: TypeData vMutable: bool } type FieldData = NamedTypeData * string @@ -114,69 +113,119 @@ type ExprData = | QuoteRawExpr of ExprData let mkVar v = VarExpr v -let mkHole (v,idx) = HoleExpr (v ,idx) -let mkApp (a,b) = CombExpr(AppOp, [], [a; b]) -let mkLambda (a,b) = LambdaExpr (a,b) + +let mkHole (v, idx) = HoleExpr (v , idx) + +let mkApp (a, b) = CombExpr(AppOp, [], [a; b]) + +let mkLambda (a, b) = LambdaExpr (a, b) + let mkQuote (a) = QuoteExpr (a) + let mkQuoteRaw40 (a) = QuoteRawExpr (a) -let mkCond (x1,x2,x3) = CombExpr(CondOp,[], [x1;x2;x3]) -let mkModuleValueApp (tcref,nm,isProp,tyargs,args: ExprData list list) = CombExpr(ModuleValueOp(tcref,nm,isProp),tyargs,List.concat args) -let mkTuple (ty,x) = CombExpr(TupleMkOp,[ty],x) -let mkLet ((v,e),b) = CombExpr(LetOp,[],[e;mkLambda (v,b)]) (* nb. order preserves source order *) +let mkCond (x1, x2, x3) = CombExpr(CondOp, [], [x1;x2;x3]) + +let mkModuleValueApp (tcref, nm, isProp, tyargs, args: ExprData list list) = CombExpr(ModuleValueOp(tcref, nm, isProp), tyargs, List.concat args) + +let mkTuple (ty, x) = CombExpr(TupleMkOp, [ty], x) + +let mkLet ((v, e), b) = CombExpr(LetOp, [], [e;mkLambda (v, b)]) (* nb. order preserves source order *) + let mkUnit () = CombExpr(UnitOp, [], []) + let mkNull ty = CombExpr(NullOp, [ty], []) -let mkLetRecRaw e1 = CombExpr(LetRecOp,[],[e1]) -let mkLetRecCombRaw args = CombExpr(LetRecCombOp,[], args) -let mkLetRec (ves,body) = - let vs,es = List.unzip ves +let mkLetRecRaw e1 = CombExpr(LetRecOp, [], [e1]) + +let mkLetRecCombRaw args = CombExpr(LetRecCombOp, [], args) + +let mkLetRec (ves, body) = + let vs, es = List.unzip ves mkLetRecRaw(mkRLinear mkLambda (vs, mkLetRecCombRaw (body::es))) -let mkRecdMk (n,tys,args) = CombExpr(RecdMkOp n,tys,args) -let mkRecdGet ((d1,d2),tyargs,args) = CombExpr(RecdGetOp(d1,d2),tyargs,args) -let mkRecdSet ((d1,d2),tyargs,args) = CombExpr(RecdSetOp(d1,d2),tyargs,args) -let mkUnion ((d1,d2),tyargs,args) = CombExpr(SumMkOp(d1,d2),tyargs,args) -let mkUnionFieldGet ((d1,d2,d3),tyargs,arg) = CombExpr(SumFieldGetOp(d1,d2,d3),tyargs,[arg]) -let mkUnionCaseTagTest ((d1,d2),tyargs,arg) = CombExpr(SumTagTestOp(d1,d2),tyargs,[arg]) -let mkTupleGet (ty,n,e) = CombExpr(TupleGetOp n,[ty],[e]) - -let mkCoerce (ty,arg) = CombExpr(CoerceOp,[ty],[arg]) -let mkTypeTest (ty,arg) = CombExpr(TypeTestOp,[ty],[arg]) -let mkAddressOf (arg) = CombExpr(AddressOfOp,[],[arg]) -let mkAddressSet (arg1,arg2) = CombExpr(AddressSetOp,[],[arg1;arg2]) -let mkVarSet (arg1,arg2) = CombExpr(ExprSetOp,[],[arg1;arg2]) -let mkDefaultValue (ty) = CombExpr(DefaultValueOp,[ty],[]) +let mkRecdMk (n, tys, args) = CombExpr(RecdMkOp n, tys, args) + +let mkRecdGet ((d1, d2), tyargs, args) = CombExpr(RecdGetOp(d1, d2), tyargs, args) + +let mkRecdSet ((d1, d2), tyargs, args) = CombExpr(RecdSetOp(d1, d2), tyargs, args) + +let mkUnion ((d1, d2), tyargs, args) = CombExpr(SumMkOp(d1, d2), tyargs, args) + +let mkUnionFieldGet ((d1, d2, d3), tyargs, arg) = CombExpr(SumFieldGetOp(d1, d2, d3), tyargs, [arg]) + +let mkUnionCaseTagTest ((d1, d2), tyargs, arg) = CombExpr(SumTagTestOp(d1, d2), tyargs, [arg]) + +let mkTupleGet (ty, n, e) = CombExpr(TupleGetOp n, [ty], [e]) + +let mkCoerce (ty, arg) = CombExpr(CoerceOp, [ty], [arg]) + +let mkTypeTest (ty, arg) = CombExpr(TypeTestOp, [ty], [arg]) + +let mkAddressOf (arg) = CombExpr(AddressOfOp, [], [arg]) + +let mkAddressSet (arg1, arg2) = CombExpr(AddressSetOp, [], [arg1;arg2]) + +let mkVarSet (arg1, arg2) = CombExpr(ExprSetOp, [], [arg1;arg2]) + +let mkDefaultValue (ty) = CombExpr(DefaultValueOp, [ty], []) + let mkThisVar (ty) = ThisVarExpr(ty) -let mkNewArray (ty,args) = CombExpr(NewArrayOp,[ty],args) - -let mkBool (v, ty) = CombExpr(BoolOp v,[ty],[]) -let mkString (v, ty) = CombExpr(StringOp v,[ty],[]) -let mkSingle (v, ty) = CombExpr(SingleOp v,[ty],[]) -let mkDouble (v, ty) = CombExpr(DoubleOp v,[ty],[]) -let mkChar (v, ty) = CombExpr(CharOp v,[ty],[]) -let mkSByte (v, ty) = CombExpr(SByteOp v,[ty],[]) -let mkByte (v, ty) = CombExpr(ByteOp v,[ty],[]) -let mkInt16 (v, ty) = CombExpr(Int16Op v,[ty],[]) -let mkUInt16 (v, ty) = CombExpr(UInt16Op v,[ty],[]) -let mkInt32 (v, ty) = CombExpr(Int32Op v,[ty],[]) -let mkUInt32 (v, ty) = CombExpr(UInt32Op v,[ty],[]) -let mkInt64 (v, ty) = CombExpr(Int64Op v,[ty],[]) -let mkUInt64 (v, ty) = CombExpr(UInt64Op v,[ty],[]) - -let mkSequential (e1,e2) = CombExpr(SeqOp,[],[e1;e2]) -let mkForLoop (x1,x2,x3) = CombExpr(ForLoopOp,[], [x1;x2;x3]) -let mkWhileLoop (e1,e2) = CombExpr(WhileLoopOp,[],[e1;e2]) -let mkTryFinally(e1,e2) = CombExpr(TryFinallyOp,[],[e1;e2]) -let mkTryWith(e1,vf,ef,vh,eh) = CombExpr(TryWithOp,[],[e1;mkLambda(vf,ef);mkLambda(vh,eh)]) -let mkDelegate (ty,e) = CombExpr(DelegateOp,[ty],[e]) -let mkPropGet (d,tyargs,args) = CombExpr(PropGetOp(d),tyargs,args) -let mkPropSet (d,tyargs,args) = CombExpr(PropSetOp(d),tyargs,args) -let mkFieldGet ((d1,d2),tyargs,args) = CombExpr(FieldGetOp(d1,d2),tyargs,args) -let mkFieldSet ((d1,d2),tyargs,args) = CombExpr(FieldSetOp(d1,d2),tyargs,args) -let mkCtorCall (d,tyargs,args) = CombExpr(CtorCallOp(d),tyargs,args) -let mkMethodCall (d,tyargs,args) = CombExpr(MethodCallOp(d),tyargs,args) -let mkAttributedExpression(e,attr) = AttrExpr(e,[attr]) + +let mkNewArray (ty, args) = CombExpr(NewArrayOp, [ty], args) + +let mkBool (v, ty) = CombExpr(BoolOp v, [ty], []) + +let mkString (v, ty) = CombExpr(StringOp v, [ty], []) + +let mkSingle (v, ty) = CombExpr(SingleOp v, [ty], []) + +let mkDouble (v, ty) = CombExpr(DoubleOp v, [ty], []) + +let mkChar (v, ty) = CombExpr(CharOp v, [ty], []) + +let mkSByte (v, ty) = CombExpr(SByteOp v, [ty], []) + +let mkByte (v, ty) = CombExpr(ByteOp v, [ty], []) + +let mkInt16 (v, ty) = CombExpr(Int16Op v, [ty], []) + +let mkUInt16 (v, ty) = CombExpr(UInt16Op v, [ty], []) + +let mkInt32 (v, ty) = CombExpr(Int32Op v, [ty], []) + +let mkUInt32 (v, ty) = CombExpr(UInt32Op v, [ty], []) + +let mkInt64 (v, ty) = CombExpr(Int64Op v, [ty], []) + +let mkUInt64 (v, ty) = CombExpr(UInt64Op v, [ty], []) + +let mkSequential (e1, e2) = CombExpr(SeqOp, [], [e1;e2]) + +let mkForLoop (x1, x2, x3) = CombExpr(ForLoopOp, [], [x1;x2;x3]) + +let mkWhileLoop (e1, e2) = CombExpr(WhileLoopOp, [], [e1;e2]) + +let mkTryFinally(e1, e2) = CombExpr(TryFinallyOp, [], [e1;e2]) + +let mkTryWith(e1, vf, ef, vh, eh) = CombExpr(TryWithOp, [], [e1;mkLambda(vf, ef);mkLambda(vh, eh)]) + +let mkDelegate (ty, e) = CombExpr(DelegateOp, [ty], [e]) + +let mkPropGet (d, tyargs, args) = CombExpr(PropGetOp(d), tyargs, args) + +let mkPropSet (d, tyargs, args) = CombExpr(PropSetOp(d), tyargs, args) + +let mkFieldGet ((d1, d2), tyargs, args) = CombExpr(FieldGetOp(d1, d2), tyargs, args) + +let mkFieldSet ((d1, d2), tyargs, args) = CombExpr(FieldSetOp(d1, d2), tyargs, args) + +let mkCtorCall (d, tyargs, args) = CombExpr(CtorCallOp(d), tyargs, args) + +let mkMethodCall (d, tyargs, args) = CombExpr(MethodCallOp(d), tyargs, args) + +let mkAttributedExpression(e, attr) = AttrExpr(e, [attr]) + let isAttributedExpression e = match e with AttrExpr(_, _) -> true | _ -> false //--------------------------------------------------------------------------- @@ -191,23 +240,24 @@ let freshVar (n, ty, mut) = { vText=n; vType=ty; vMutable=mut } module SimplePickle = type Table<'T> = - { tbl: HashMultiMap<'T,int>; // This should be "Dictionary" - mutable rows: 'T list; + { tbl: HashMultiMap<'T, int> // This should be "Dictionary" + mutable rows: 'T list mutable count: int } static member Create () = { tbl = HashMultiMap(20, HashIdentity.Structural) - rows=[]; + rows=[] count=0; } member tbl.AsList = List.rev tbl.rows + member tbl.Count = tbl.rows.Length member tbl.Add x = let n = tbl.count - tbl.count <- tbl.count + 1; - tbl.tbl.Add(x,n) - tbl.rows <- x :: tbl.rows; + tbl.count <- tbl.count + 1 + tbl.tbl.Add(x, n) + tbl.rows <- x :: tbl.rows n member tbl.FindOrAdd x = @@ -219,17 +269,21 @@ module SimplePickle = member tbl.ContainsKey x = tbl.tbl.ContainsKey x type QuotationPickleOutState = - { os: ByteBuffer; + { os: ByteBuffer ostrings: Table } let p_byte b st = st.os.EmitIntAsByte b + let p_bool b st = p_byte (if b then 1 else 0) st + let p_void (_os: QuotationPickleOutState) = () + let p_unit () (_os: QuotationPickleOutState) = () + let prim_pint32 i st = - p_byte (Bits.b0 i) st; - p_byte (Bits.b1 i) st; - p_byte (Bits.b2 i) st; + p_byte (Bits.b0 i) st + p_byte (Bits.b1 i) st + p_byte (Bits.b2 i) st p_byte (Bits.b3 i) st // compress integers according to the same scheme used by CLR metadata @@ -238,78 +292,92 @@ module SimplePickle = if n >= 0 && n <= 0x7F then p_byte (Bits.b0 n) st else if n >= 0x80 && n <= 0x3FFF then - p_byte (0x80 ||| (n >>> 8)) st; + p_byte (0x80 ||| (n >>> 8)) st p_byte (n &&& 0xFF) st else - p_byte 0xFF st; + p_byte 0xFF st prim_pint32 n st let p_bytes (s:byte[]) st = let len = s.Length - p_int32 (len) st; + p_int32 (len) st st.os.EmitBytes s let prim_pstring (s:string) st = let bytes = Encoding.UTF8.GetBytes s let len = bytes.Length - p_int32 (len) st; + p_int32 (len) st st.os.EmitBytes bytes let p_int (c:int) st = p_int32 c st + let p_int8 (i:int8) st = p_int32 (int32 i) st + let p_uint8 (i:uint8) st = p_byte (int i) st + let p_int16 (i:int16) st = p_int32 (int32 i) st + let p_uint16 (x:uint16) st = p_int32 (int32 x) st + let puint32 (x:uint32) st = p_int32 (int32 x) st + let p_int64 i st = - p_int32 (int32 (i &&& 0xFFFFFFFFL)) st; + p_int32 (int32 (i &&& 0xFFFFFFFFL)) st p_int32 (int32 (i >>> 32)) st - let bits_of_float32 (x:float32) = System.BitConverter.ToInt32(System.BitConverter.GetBytes(x),0) - let bits_of_float (x:float) = System.BitConverter.ToInt64(System.BitConverter.GetBytes(x),0) + let bits_of_float32 (x:float32) = System.BitConverter.ToInt32(System.BitConverter.GetBytes(x), 0) + + let bits_of_float (x:float) = System.BitConverter.ToInt64(System.BitConverter.GetBytes(x), 0) let p_uint64 x st = p_int64 (int64 x) st + let p_double i st = p_int64 (bits_of_float i) st + let p_single i st = p_int32 (bits_of_float32 i) st + let p_char i st = p_uint16 (uint16 (int32 i)) st - let inline p_tup2 p1 p2 (a,b) (st:QuotationPickleOutState) = (p1 a st : unit); (p2 b st : unit) - let inline p_tup3 p1 p2 p3 (a,b,c) st = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit) - let inline p_tup4 p1 p2 p3 p4 (a,b,c,d) st = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit); (p4 d st : unit) - let inline p_tup5 p1 p2 p3 p4 p5 (a,b,c,d,e) st = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit); (p4 d st : unit); (p5 e st : unit) + + let inline p_tup2 p1 p2 (a, b) (st:QuotationPickleOutState) = (p1 a st : unit); (p2 b st : unit) + + let inline p_tup3 p1 p2 p3 (a, b, c) st = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit) + + let inline p_tup4 p1 p2 p3 p4 (a, b, c, d) st = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit); (p4 d st : unit) + + let inline p_tup5 p1 p2 p3 p4 p5 (a, b, c, d, e) st = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit); (p4 d st : unit); (p5 e st : unit) + let puniq (tbl: Table<_>) key st = p_int (tbl.FindOrAdd key) st + let p_string s st = puniq st.ostrings s st + let rec p_list f x st = match x with | [] -> p_byte 0 st | h :: t -> p_byte 1 st; f h st; p_list f t st - let pickle_obj p x = - let stringTab,phase1bytes = + let stringTab, phase1bytes = let st1 = - { os = ByteBuffer.Create 100000; - ostrings=Table<_>.Create(); } - p x st1; + { os = ByteBuffer.Create 100000 + ostrings=Table<_>.Create() } + p x st1 st1.ostrings.AsList, st1.os.Close() - let phase2data = (stringTab,phase1bytes) + let phase2data = (stringTab, phase1bytes) let phase2bytes = let st2 = - { os = ByteBuffer.Create 100000; - ostrings=Table<_>.Create();} - p_tup2 (p_list prim_pstring) p_bytes phase2data st2; + { os = ByteBuffer.Create 100000 + ostrings=Table<_>.Create() } + p_tup2 (p_list prim_pstring) p_bytes phase2data st2 st2.os.Close() phase2bytes - open SimplePickle - let p_assemblyref x st = p_string x st let p_NamedType x st = match x with | Idx n -> p_tup2 p_string p_assemblyref (string n, "") st - | Named (nm,a) -> p_tup2 p_string p_assemblyref (nm, a) st + | Named (nm, a) -> p_tup2 p_string p_assemblyref (nm, a) st let p_tycon x st = match x with @@ -320,7 +388,7 @@ let p_tycon x st = let rec p_type x st = match x with | VarType v -> p_byte 0 st; p_int v st - | AppType(c,ts) -> p_byte 1 st; p_tup2 p_tycon p_types (c,ts) st + | AppType(c, ts) -> p_byte 1 st; p_tup2 p_tycon p_types (c, ts) st and p_types x st = p_list p_type x st @@ -331,10 +399,10 @@ let p_recdFieldSpec v st = p_tup2 p_NamedType p_string v st let p_ucaseSpec v st = p_tup2 p_NamedType p_string v st let p_MethodData a st = - p_tup5 p_NamedType p_types p_type p_string p_int (a.methParent,a.methArgTypes,a.methRetType, a.methName, a.numGenericArgs) st + p_tup5 p_NamedType p_types p_type p_string p_int (a.methParent, a.methArgTypes, a.methRetType, a.methName, a.numGenericArgs) st let p_CtorData a st = - p_tup2 p_NamedType p_types (a.ctorParent,a.ctorArgTypes) st + p_tup2 p_NamedType p_types (a.ctorParent, a.ctorArgTypes) st let p_PropInfoData a st = p_tup4 p_NamedType p_string p_type p_types a st @@ -342,13 +410,13 @@ let p_PropInfoData a st = let p_CombOp x st = match x with | CondOp -> p_byte 0 st - | ModuleValueOp (x,y,z) -> p_byte 1 st; p_tup3 p_NamedType p_string p_bool (x,y,z) st + | ModuleValueOp (x, y, z) -> p_byte 1 st; p_tup3 p_NamedType p_string p_bool (x, y, z) st | LetRecOp -> p_byte 2 st | RecdMkOp a -> p_byte 3 st; p_NamedType a st - | RecdGetOp (x,y) -> p_byte 4 st; p_recdFieldSpec (x,y) st - | SumMkOp (x,y) -> p_byte 5 st; p_ucaseSpec (x,y) st - | SumFieldGetOp (a,b,c) -> p_byte 6 st; p_tup2 p_ucaseSpec p_int ((a,b),c) st - | SumTagTestOp (x,y) -> p_byte 7 st; p_ucaseSpec (x,y) st + | RecdGetOp (x, y) -> p_byte 4 st; p_recdFieldSpec (x, y) st + | SumMkOp (x, y) -> p_byte 5 st; p_ucaseSpec (x, y) st + | SumFieldGetOp (a, b, c) -> p_byte 6 st; p_tup2 p_ucaseSpec p_int ((a, b), c) st + | SumTagTestOp (x, y) -> p_byte 7 st; p_ucaseSpec (x, y) st | TupleMkOp -> p_byte 8 st | TupleGetOp a -> p_byte 9 st; p_int a st | BoolOp a -> p_byte 11 st; p_bool a st @@ -375,14 +443,14 @@ let p_CombOp x st = | DelegateOp -> p_byte 33 st | WhileLoopOp -> p_byte 34 st | LetOp -> p_byte 35 st - | RecdSetOp (x,y) -> p_byte 36 st; p_recdFieldSpec (x,y) st - | FieldGetOp (a,b) -> p_byte 37 st; p_tup2 p_NamedType p_string (a, b) st + | RecdSetOp (x, y) -> p_byte 36 st; p_recdFieldSpec (x, y) st + | FieldGetOp (a, b) -> p_byte 37 st; p_tup2 p_NamedType p_string (a, b) st | LetRecCombOp -> p_byte 38 st | AppOp -> p_byte 39 st | NullOp -> p_byte 40 st | DefaultValueOp -> p_byte 41 st | PropSetOp d -> p_byte 42 st; p_PropInfoData d st - | FieldSetOp (a,b) -> p_byte 43 st; p_tup2 p_NamedType p_string (a, b) st + | FieldSetOp (a, b) -> p_byte 43 st; p_tup2 p_NamedType p_string (a, b) st | AddressOfOp -> p_byte 44 st | AddressSetOp -> p_byte 45 st | TypeTestOp -> p_byte 46 st @@ -392,18 +460,18 @@ let p_CombOp x st = let rec p_expr x st = match x with - | CombExpr(c,ts,args) -> p_byte 0 st; p_tup3 p_CombOp p_types (p_list p_expr) (c,ts,args) st + | CombExpr(c, ts, args) -> p_byte 0 st; p_tup3 p_CombOp p_types (p_list p_expr) (c, ts, args) st | VarExpr v -> p_byte 1 st; p_int v st - | LambdaExpr(v,e) -> p_byte 2 st; p_tup2 p_varDecl p_expr (v,e) st - | HoleExpr(ty,idx) -> p_byte 3 st; p_type ty st; p_int idx st + | LambdaExpr(v, e) -> p_byte 2 st; p_tup2 p_varDecl p_expr (v, e) st + | HoleExpr(ty, idx) -> p_byte 3 st; p_type ty st; p_int idx st | QuoteExpr(tm) -> p_byte 4 st; p_expr tm st - | AttrExpr(e,attrs) -> p_byte 5 st; p_tup2 p_expr (p_list p_expr) (e,attrs) st + | AttrExpr(e, attrs) -> p_byte 5 st; p_tup2 p_expr (p_list p_expr) (e, attrs) st | ThisVarExpr(ty) -> p_byte 6 st; p_type ty st | QuoteRawExpr(tm) -> p_byte 7 st; p_expr tm st type ModuleDefnData = - { Module: NamedTypeData; - Name: string; + { Module: NamedTypeData + Name: string IsProperty: bool } type MethodBaseData = @@ -416,15 +484,15 @@ let pickle = pickle_obj p_expr let p_MethodBase x st = match x with | ModuleDefn md -> - p_byte 0 st; - p_NamedType md.Module st; - p_string md.Name st; + p_byte 0 st + p_NamedType md.Module st + p_string md.Name st p_bool md.IsProperty st | Method md -> - p_byte 1 st; + p_byte 1 st p_MethodData md st | Ctor md -> - p_byte 2 st; + p_byte 2 st p_CtorData md st let PickleDefns = pickle_obj (p_list (p_tup2 p_MethodBase p_expr)) diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index ab7d63348d07e9d439cf36437c731103b4636b1e..6deca36555eab899c36cea792bb1ea159c6e4e41 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -3,8 +3,8 @@ module internal FSharp.Compiler.QuotationTranslator open Internal.Utilities -open FSharp.Compiler -open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler +open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.Tast @@ -32,106 +32,113 @@ type QuotationSerializationFormat = | FSharp_40_Plus | FSharp_20_Plus -type QuotationGenerationScope = - { g: TcGlobals +type QuotationGenerationScope = + { g: TcGlobals amap: Import.ImportMap - scope: CcuThunk + scope: CcuThunk // Accumulate the references to type definitions referencedTypeDefs: ResizeArray referencedTypeDefsTable: Dictionary // Accumulate the type splices (i.e. captured type parameters) into here typeSplices: ResizeArray // Accumulate the expression splices into here - exprSplices: ResizeArray + exprSplices: ResizeArray isReflectedDefinition : IsReflectedDefinition quotationFormat : QuotationSerializationFormat mutable emitDebugInfoInQuotations : bool } - static member Create (g: TcGlobals, amap, scope, isReflectedDefinition) = + static member Create (g: TcGlobals, amap, scope, isReflectedDefinition) = { g = g scope = scope amap = amap - referencedTypeDefs = new ResizeArray<_>() - referencedTypeDefsTable = new Dictionary<_,_>() - typeSplices = new ResizeArray<_>() - exprSplices = new ResizeArray<_>() - isReflectedDefinition = isReflectedDefinition + referencedTypeDefs = new ResizeArray<_>() + referencedTypeDefsTable = new Dictionary<_, _>() + typeSplices = new ResizeArray<_>() + exprSplices = new ResizeArray<_>() + isReflectedDefinition = isReflectedDefinition quotationFormat = QuotationGenerationScope.ComputeQuotationFormat g - emitDebugInfoInQuotations = g.emitDebugInfoInQuotations } + emitDebugInfoInQuotations = g.emitDebugInfoInQuotations } - member cenv.Close() = - cenv.referencedTypeDefs |> ResizeArray.toList, - cenv.typeSplices |> ResizeArray.map (fun (ty,m) -> mkTyparTy ty, m) |> ResizeArray.toList, + member cenv.Close() = + cenv.referencedTypeDefs |> ResizeArray.toList, + cenv.typeSplices |> ResizeArray.map (fun (ty, m) -> mkTyparTy ty, m) |> ResizeArray.toList, cenv.exprSplices |> ResizeArray.toList - static member ComputeQuotationFormat g = - let deserializeExValRef = ValRefForIntrinsic g.deserialize_quoted_FSharp_40_plus_info - if ValueOptionInternal.isSome deserializeExValRef.TryDeref then + static member ComputeQuotationFormat g = + let deserializeExValRef = ValRefForIntrinsic g.deserialize_quoted_FSharp_40_plus_info + if ValueOptionInternal.isSome deserializeExValRef.TryDeref then QuotationSerializationFormat.FSharp_40_Plus - else + else QuotationSerializationFormat.FSharp_20_Plus -type QuotationTranslationEnv = - { /// Map from Val to binding index - vs: ValMap +type QuotationTranslationEnv = + { + /// Map from Val to binding index + vs: ValMap + nvs: int + /// Map from typar stamps to binding index tyvs: StampMap - // Map for values bound by the - // 'let v = isinst e in .... if nonnull v then ...v .... ' + + // Map for values bound by the + // 'let v = isinst e in .... if nonnull v then ...v .... ' // construct arising out the compilation of pattern matching. We decode these back to the form - // 'if istype v then ...unbox v .... ' - isinstVals: ValMap - substVals: ValMap } + // 'if istype v then ...unbox v .... ' + isinstVals: ValMap + + substVals: ValMap + } - static member Empty = - { vs = ValMap<_>.Empty + static member Empty = + { vs = ValMap<_>.Empty nvs = 0 - tyvs = Map.empty - isinstVals = ValMap<_>.Empty + tyvs = Map.empty + isinstVals = ValMap<_>.Empty substVals = ValMap<_>.Empty } - member env.BindTypar (v:Typar) = + member env.BindTypar (v:Typar) = let idx = env.tyvs.Count - { env with tyvs = env.tyvs.Add(v.Stamp,idx ) } + { env with tyvs = env.tyvs.Add(v.Stamp, idx ) } - member env.BindTypars vs = - (env, vs) ||> List.fold (fun env v -> env.BindTypar v) // fold left-to-right because indexes are left-to-right + member env.BindTypars vs = + (env, vs) ||> List.fold (fun env v -> env.BindTypar v) // fold left-to-right because indexes are left-to-right -let BindFormalTypars (env:QuotationTranslationEnv) vs = - { env with tyvs = Map.empty }.BindTypars vs +let BindFormalTypars (env:QuotationTranslationEnv) vs = + { env with tyvs = Map.empty }.BindTypars vs let BindVal env v = - { env with + { env with vs = env.vs.Add v env.nvs nvs = env.nvs + 1 } -let BindIsInstVal env v (ty,e) = - { env with isinstVals = env.isinstVals.Add v (ty,e) } +let BindIsInstVal env v (ty, e) = + { env with isinstVals = env.isinstVals.Add v (ty, e) } -let BindSubstVal env v e = +let BindSubstVal env v e = { env with substVals = env.substVals.Add v e } +let BindVals env vs = List.fold BindVal env vs // fold left-to-right because indexes are left-to-right -let BindVals env vs = List.fold BindVal env vs // fold left-to-right because indexes are left-to-right -let BindFlatVals env vs = List.fold BindVal env vs // fold left-to-right because indexes are left-to-right +let BindFlatVals env vs = List.fold BindVal env vs // fold left-to-right because indexes are left-to-right exception InvalidQuotedTerm of exn + exception IgnoringPartOfQuotedTermWarning of string * Range.range let wfail e = raise (InvalidQuotedTerm e) -let (|ModuleValueOrMemberUse|_|) g expr = - let rec loop expr args = - match stripExpr expr with - | Expr.App((InnerExprPat(Expr.Val(vref,vFlags,_) as f)),fty,tyargs,actualArgs,_m) when vref.IsMemberOrModuleBinding -> - Some(vref,vFlags,f,fty,tyargs,actualArgs @ args) - | Expr.App(f,_fty,[],actualArgs,_) -> +let (|ModuleValueOrMemberUse|_|) g expr = + let rec loop expr args = + match stripExpr expr with + | Expr.App((InnerExprPat(Expr.Val(vref, vFlags, _) as f)), fty, tyargs, actualArgs, _m) when vref.IsMemberOrModuleBinding -> + Some(vref, vFlags, f, fty, tyargs, actualArgs @ args) + | Expr.App(f, _fty, [], actualArgs, _) -> loop f (actualArgs @ args) - | (Expr.Val(vref,vFlags,_m) as f) when (match vref.DeclaringEntity with ParentNone -> false | _ -> true) -> + | (Expr.Val(vref, vFlags, _m) as f) when (match vref.DeclaringEntity with ParentNone -> false | _ -> true) -> let fty = tyOfExpr g f - Some(vref,vFlags,f,fty,[],args) - | _ -> + Some(vref, vFlags, f, fty, [], args) + | _ -> None loop expr [] @@ -140,26 +147,26 @@ let (|SimpleArrayLoopUpperBound|_|) expr = | Expr.Op(TOp.ILAsm([AI_sub], _), _, [Expr.Op(TOp.ILAsm([I_ldlen; AI_conv ILBasicType.DT_I4], _), _, _, _); Expr.Const(Const.Int32 1, _, _) ], _) -> Some () | _ -> None -let (|SimpleArrayLoopBody|_|) g expr = +let (|SimpleArrayLoopBody|_|) g expr = match expr with - | Expr.Lambda(_, a, b, ([_] as args), Expr.Let(TBind(forVarLoop, Expr.Op(TOp.ILAsm([I_ldelem_any(ILArrayShape [(Some 0, None)], _)], _), [elemTy], [arr; idx], m1), seqPoint), body, m2, freeVars), m, ty) -> + | Expr.Lambda(_, a, b, ([_] as args), Expr.Let(TBind(forVarLoop, Expr.Op(TOp.ILAsm([I_ldelem_any(ILArrayShape [(Some 0, None)], _)], _), [elemTy], [arr; idx], m1), seqPoint), body, m2, freeVars), m, ty) -> let body = Expr.Let(TBind(forVarLoop, mkCallArrayGet g m1 elemTy arr idx, seqPoint), body, m2, freeVars) let expr = Expr.Lambda(newUnique(), a, b, args, body, m, ty) Some (arr, elemTy, expr) | _ -> None -let (|ObjectInitializationCheck|_|) g expr = +let (|ObjectInitializationCheck|_|) g expr = // recognize "if this.init@ < 1 then failinit" match expr with | Expr.Match ( - _, _, - TDSwitch + _, _, + TDSwitch ( - Expr.Op(TOp.ILAsm([AI_clt], _), _, [Expr.Op(TOp.ValFieldGet((RFRef(_, name))), _, [Expr.Val(selfRef, NormalValUse, _)], _); Expr.Const(Const.Int32 1, _, _)], _), _, _, _ - ), + Expr.Op(TOp.ILAsm([AI_clt], _), _, [Expr.Op(TOp.ValFieldGet((RFRef(_, name))), _, [Expr.Val(selfRef, NormalValUse, _)], _); Expr.Const(Const.Int32 1, _, _)], _), _, _, _ + ), [| TTarget([], Expr.App(Expr.Val(failInitRef, _, _), _, _, _, _), _); _ |], _, resultTy - ) when + ) when IsCompilerGeneratedName name && name.StartsWithOrdinal("init") && selfRef.BaseOrThisInfo = MemberThisVal && @@ -176,15 +183,15 @@ let rec EmitDebugInfoIfNecessary cenv env m astExpr : QP.ExprData = try let mk_tuple g m es = mkRefTupled g m es (List.map (tyOfExpr g) es) - let rangeExpr = - mk_tuple cenv.g m - [ mkString cenv.g m m.FileName - mkInt cenv.g m m.StartLine - mkInt cenv.g m m.StartColumn - mkInt cenv.g m m.EndLine - mkInt cenv.g m m.EndColumn ] - let attrExpr = - mk_tuple cenv.g m + let rangeExpr = + mk_tuple cenv.g m + [ mkString cenv.g m m.FileName + mkInt cenv.g m m.StartLine + mkInt cenv.g m m.StartColumn + mkInt cenv.g m m.EndLine + mkInt cenv.g m m.EndColumn ] + let attrExpr = + mk_tuple cenv.g m [ mkString cenv.g m "DebugRange" rangeExpr ] @@ -193,13 +200,13 @@ let rec EmitDebugInfoIfNecessary cenv env m astExpr : QP.ExprData = QP.mkAttributedExpression(astExpr, attrExprR) finally cenv.emitDebugInfoInQuotations <- true - else + else astExpr and ConvExpr cenv env (expr : Expr) = EmitDebugInfoIfNecessary cenv env expr.Range (ConvExprCore cenv env expr) -and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.ExprData = +and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.ExprData = let expr = DetectAndOptimizeForExpression cenv.g OptimizeIntRangesOnly expr @@ -208,369 +215,369 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let expr = NormalizeAndAdjustPossibleSubsumptionExprs cenv.g expr // Remove TExpr_ref nodes - let expr = stripExpr expr + let expr = stripExpr expr - // Recognize F# object model calls - // Recognize applications of module functions. - match expr with + // Recognize F# object model calls + // Recognize applications of module functions. + match expr with // Detect expression tree exprSplices - | Expr.App(InnerExprPat(Expr.Val(vf,_,_)),_,_,x0::rest,m) - when isSplice cenv.g vf -> + | Expr.App(InnerExprPat(Expr.Val(vf, _, _)), _, _, x0::rest, m) + when isSplice cenv.g vf -> let idx = cenv.exprSplices.Count let ty = tyOfExpr cenv.g expr - - match (freeInExpr CollectTyparsAndLocalsNoCaching x0).FreeLocals |> Seq.tryPick (fun v -> if env.vs.ContainsVal v then Some v else None) with + + match (freeInExpr CollectTyparsAndLocalsNoCaching x0).FreeLocals |> Seq.tryPick (fun v -> if env.vs.ContainsVal v then Some v else None) with | Some v -> errorR(Error(FSComp.SR.crefBoundVarUsedInSplice(v.DisplayName), v.Range)) | None -> () cenv.exprSplices.Add((x0, m)) - let hole = QP.mkHole(ConvType cenv env m ty,idx) - (hole, rest) ||> List.fold (fun fR arg -> QP.mkApp (fR,ConvExpr cenv env arg)) + let hole = QP.mkHole(ConvType cenv env m ty, idx) + (hole, rest) ||> List.fold (fun fR arg -> QP.mkApp (fR, ConvExpr cenv env arg)) - | ModuleValueOrMemberUse cenv.g (vref,vFlags,_f,_fty,tyargs,curriedArgs) + | ModuleValueOrMemberUse cenv.g (vref, vFlags, _f, _fty, tyargs, curriedArgs) when not (isSplice cenv.g vref) -> - let m = expr.Range + let m = expr.Range - let (numEnclTypeArgs,_,isNewObj,valUseFlags,isSelfInit,takesInstanceArg,isPropGet,isPropSet) = - GetMemberCallInfo cenv.g (vref,vFlags) + let (numEnclTypeArgs, _, isNewObj, valUseFlags, isSelfInit, takesInstanceArg, isPropGet, isPropSet) = + GetMemberCallInfo cenv.g (vref, vFlags) - let isMember,tps,curriedArgInfos,retTy = - match vref.MemberInfo with - | Some _ when not vref.IsExtensionMember -> + let isMember, tps, curriedArgInfos, retTy = + match vref.MemberInfo with + | Some _ when not vref.IsExtensionMember -> // This is an application of a member method // We only count one argument block for these. - let tps,curriedArgInfos,retTy,_ = GetTypeOfIntrinsicMemberInCompiledForm cenv.g vref - true,tps,curriedArgInfos,retTy - | _ -> + let tps, curriedArgInfos, retTy, _ = GetTypeOfIntrinsicMemberInCompiledForm cenv.g vref + true, tps, curriedArgInfos, retTy + | _ -> // This is an application of a module value or extension member - let arities = arityOfVal vref.Deref - let tps,curriedArgInfos,retTy,_ = GetTopValTypeInCompiledForm cenv.g arities vref.Type m - false,tps,curriedArgInfos,retTy + let arities = arityOfVal vref.Deref + let tps, curriedArgInfos, retTy, _ = GetTopValTypeInCompiledForm cenv.g arities vref.Type m + false, tps, curriedArgInfos, retTy // Compute the object arguments as they appear in a compiled call // Strip off the object argument, if any. The curriedArgInfos are already adjusted to compiled member form - let objArgs,curriedArgs = - match takesInstanceArg,curriedArgs with - | false,curriedArgs -> [],curriedArgs - | true,(objArg::curriedArgs) -> [objArg],curriedArgs - | true,[] -> wfail(InternalError("warning: unexpected missing object argument when generating quotation for call to F# object member " + vref.LogicalName,m)) + let objArgs, curriedArgs = + match takesInstanceArg, curriedArgs with + | false, curriedArgs -> [], curriedArgs + | true, (objArg::curriedArgs) -> [objArg], curriedArgs + | true, [] -> wfail(InternalError("warning: unexpected missing object argument when generating quotation for call to F# object member " + vref.LogicalName, m)) - if verboseCReflect then - dprintfn "vref.DisplayName = %A, #objArgs = %A, #curriedArgs = %A" vref.DisplayName objArgs.Length curriedArgs.Length + if verboseCReflect then + dprintfn "vref.DisplayName = %A, #objArgs = %A, #curriedArgs = %A" vref.DisplayName objArgs.Length curriedArgs.Length // Check to see if there aren't enough arguments or if there is a tuple-arity mismatch // If so, adjust and try again let nCurriedArgInfos = curriedArgInfos.Length if curriedArgs.Length < nCurriedArgInfos || - ((List.truncate nCurriedArgInfos curriedArgs,curriedArgInfos) ||> List.exists2 (fun arg argInfo -> + ((List.truncate nCurriedArgInfos curriedArgs, curriedArgInfos) ||> List.exists2 (fun arg argInfo -> (argInfo.Length > (tryDestRefTupleExpr arg).Length))) then - if verboseCReflect then - dprintfn "vref.DisplayName = %A was under applied" vref.DisplayName - // Too few arguments or incorrect tupling? Convert to a lambda and beta-reduce the - // partially applied arguments to 'let' bindings - let topValInfo = - match vref.ValReprInfo with - | None -> error(InternalError("no arity information found for F# value " + vref.LogicalName,vref.Range)) - | Some a -> a - - let expr,exprty = AdjustValForExpectedArity cenv.g m vref vFlags topValInfo - ConvExpr cenv env (MakeApplicationAndBetaReduce cenv.g (expr,exprty,[tyargs],curriedArgs,m)) + if verboseCReflect then + dprintfn "vref.DisplayName = %A was under applied" vref.DisplayName + // Too few arguments or incorrect tupling? Convert to a lambda and beta-reduce the + // partially applied arguments to 'let' bindings + let topValInfo = + match vref.ValReprInfo with + | None -> error(InternalError("no arity information found for F# value " + vref.LogicalName, vref.Range)) + | Some a -> a + + let expr, exprty = AdjustValForExpectedArity cenv.g m vref vFlags topValInfo + ConvExpr cenv env (MakeApplicationAndBetaReduce cenv.g (expr, exprty, [tyargs], curriedArgs, m)) else - // Too many arguments? Chop - let (curriedArgs:Expr list ),laterArgs = List.splitAt nCurriedArgInfos curriedArgs + // Too many arguments? Chop + let (curriedArgs:Expr list ), laterArgs = List.splitAt nCurriedArgInfos curriedArgs - let callR = + let callR = // We now have the right number of arguments, w.r.t. currying and tupling. - // Next work out what kind of object model call and build an object model call node. - + // Next work out what kind of object model call and build an object model call node. + // detuple the args - let untupledCurriedArgs = - (curriedArgs,curriedArgInfos) ||> List.map2 (fun arg curriedArgInfo -> - let numUntupledArgs = curriedArgInfo.Length - (if numUntupledArgs = 0 then [] - elif numUntupledArgs = 1 then [arg] + let untupledCurriedArgs = + (curriedArgs, curriedArgInfos) ||> List.map2 (fun arg curriedArgInfo -> + let numUntupledArgs = curriedArgInfo.Length + (if numUntupledArgs = 0 then [] + elif numUntupledArgs = 1 then [arg] else tryDestRefTupleExpr arg)) - if verboseCReflect then + if verboseCReflect then dprintfn "vref.DisplayName = %A , after unit adjust, #untupledCurriedArgs = %A, #curriedArgInfos = %d" vref.DisplayName (List.map List.length untupledCurriedArgs) curriedArgInfos.Length let subCall = - if isMember then + if isMember then // This is an application of a member method // We only count one argument block for these. let callArgs = (objArgs::untupledCurriedArgs) |> List.concat - let parentTyconR = ConvTyconRef cenv vref.TopValDeclaringEntity m + let parentTyconR = ConvTyconRef cenv vref.TopValDeclaringEntity m let isNewObj = isNewObj || valUseFlags || isSelfInit - // The signature types are w.r.t. to the formal context - let envinner = BindFormalTypars env tps + // The signature types are w.r.t. to the formal context + let envinner = BindFormalTypars env tps let argTys = curriedArgInfos |> List.concat |> List.map fst - let methArgTypesR = ConvTypes cenv envinner m argTys + let methArgTypesR = ConvTypes cenv envinner m argTys let methRetTypeR = ConvReturnType cenv envinner m retTy - let methName = vref.CompiledName - let numGenericArgs = tyargs.Length - numEnclTypeArgs - ConvObjectModelCall cenv env m (isPropGet,isPropSet,isNewObj,parentTyconR,methArgTypesR,methRetTypeR,methName,tyargs,numGenericArgs,callArgs) + let methName = vref.CompiledName + let numGenericArgs = tyargs.Length - numEnclTypeArgs + ConvObjectModelCall cenv env m (isPropGet, isPropSet, isNewObj, parentTyconR, methArgTypesR, methRetTypeR, methName, tyargs, numGenericArgs, callArgs) else - // This is an application of the module value. + // This is an application of the module value. ConvModuleValueApp cenv env m vref tyargs untupledCurriedArgs - match curriedArgs,curriedArgInfos with + match curriedArgs, curriedArgInfos with // static member and module value unit argument elimination - | [arg:Expr],[[]] -> + | [arg:Expr], [[]] -> // we got here if quotation is represents a call with unit argument // let f () = () // <@ f @> // => (\arg -> f arg) => arg is Expr.Val - no-effects, first case // <@ f() @> // Expr.Const(Unit) - no-effects - first case // <@ f (someFunctionThatReturnsUnit) @> - potential effects - second case match arg with - | Expr.Val _ - | Expr.Const(Const.Unit,_,_) -> subCall + | Expr.Val _ + | Expr.Const(Const.Unit, _, _) -> subCall | _ -> - let argQ = ConvExpr cenv env arg + let argQ = ConvExpr cenv env arg QP.mkSequential(argQ, subCall) | _ -> subCall - List.fold (fun fR arg -> QP.mkApp (fR,ConvExpr cenv env arg)) callR laterArgs + List.fold (fun fR arg -> QP.mkApp (fR, ConvExpr cenv env arg)) callR laterArgs - // Blast type application nodes and expression application nodes apart so values are left with just their type arguments - | Expr.App(f,fty,(_ :: _ as tyargs),(_ :: _ as args),m) -> + // Blast type application nodes and expression application nodes apart so values are left with just their type arguments + | Expr.App(f, fty, (_ :: _ as tyargs), (_ :: _ as args), m) -> let rfty = applyForallTy cenv.g fty tyargs - ConvExpr cenv env (primMkApp (primMkApp (f,fty) tyargs [] m, rfty) [] args m) + ConvExpr cenv env (primMkApp (primMkApp (f, fty) tyargs [] m, rfty) [] args m) - // Uses of possibly-polymorphic values - | Expr.App(InnerExprPat(Expr.Val(vref,_vFlags,m)),_fty,tyargs,[],_) -> + // Uses of possibly-polymorphic values + | Expr.App(InnerExprPat(Expr.Val(vref, _vFlags, m)), _fty, tyargs, [], _) -> ConvValRef true cenv env m vref tyargs - // Simple applications - | Expr.App(f,_fty,tyargs,args,m) -> + // Simple applications + | Expr.App(f, _fty, tyargs, args, m) -> if not (List.isEmpty tyargs) then wfail(Error(FSComp.SR.crefQuotationsCantContainGenericExprs(), m)) - List.fold (fun fR arg -> QP.mkApp (fR,ConvExpr cenv env arg)) (ConvExpr cenv env f) args - - // REVIEW: what is the quotation view of literals accessing enumerations? Currently they show up as integers. - | Expr.Const(c,m,ty) -> + List.fold (fun fR arg -> QP.mkApp (fR, ConvExpr cenv env arg)) (ConvExpr cenv env f) args + + // REVIEW: what is the quotation view of literals accessing enumerations? Currently they show up as integers. + | Expr.Const(c, m, ty) -> ConvConst cenv env m c ty - | Expr.Val(vref,_vFlags,m) -> + | Expr.Val(vref, _vFlags, m) -> ConvValRef true cenv env m vref [] - | Expr.Let(bind,body,_,_) -> + | Expr.Let(bind, body, _, _) -> // The binding may be a compiler-generated binding that gets removed in the quotation presentation - match ConvLetBind cenv env bind with + match ConvLetBind cenv env bind with | None, env -> ConvExpr cenv env body - | Some(bindR),env -> QP.mkLet(bindR,ConvExpr cenv env body) - - | Expr.LetRec(binds,body,_,_) -> + | Some(bindR), env -> QP.mkLet(bindR, ConvExpr cenv env body) + + | Expr.LetRec(binds, body, _, _) -> let vs = valsOfBinds binds - let vsR = vs |> List.map (ConvVal cenv env) + let vsR = vs |> List.map (ConvVal cenv env) let env = BindFlatVals env vs - let bodyR = ConvExpr cenv env body + let bodyR = ConvExpr cenv env body let bindsR = List.zip vsR (binds |> List.map (fun b -> ConvExpr cenv env b.Expr)) - QP.mkLetRec(bindsR,bodyR) + QP.mkLetRec(bindsR, bodyR) - | Expr.Lambda(_,_,_,vs,b,_,_) -> - let v,b = MultiLambdaToTupledLambda cenv.g vs b - let vR = ConvVal cenv env v - let bR = ConvExpr cenv (BindVal env v) b + | Expr.Lambda(_, _, _, vs, b, _, _) -> + let v, b = MultiLambdaToTupledLambda cenv.g vs b + let vR = ConvVal cenv env v + let bR = ConvExpr cenv (BindVal env v) b QP.mkLambda(vR, bR) - | Expr.Quote(ast,_,_,_,ety) -> + | Expr.Quote(ast, _, _, _, ety) -> // F# 2.0-3.1 had a bug with nested 'raw' quotations. F# 4.0 + FSharp.Core 4.4.0.0+ allows us to do the right thing. - if cenv.quotationFormat = QuotationSerializationFormat.FSharp_40_Plus && + if cenv.quotationFormat = QuotationSerializationFormat.FSharp_40_Plus && // Look for a 'raw' quotation - tyconRefEq cenv.g (tcrefOfAppTy cenv.g ety) cenv.g.raw_expr_tcr + tyconRefEq cenv.g (tcrefOfAppTy cenv.g ety) cenv.g.raw_expr_tcr then QP.mkQuoteRaw40(ConvExpr cenv env ast) else QP.mkQuote(ConvExpr cenv env ast) - | Expr.TyLambda (_,_,_,m,_) -> + | Expr.TyLambda (_, _, _, m, _) -> wfail(Error(FSComp.SR.crefQuotationsCantContainGenericFunctions(), m)) - | Expr.Match (_spBind,m,dtree,tgs,_,retTy) -> - let typR = ConvType cenv env m retTy - ConvDecisionTree cenv env tgs typR dtree - + | Expr.Match (_spBind, m, dtree, tgs, _, retTy) -> + let typR = ConvType cenv env m retTy + ConvDecisionTree cenv env tgs typR dtree + // initialization check | Expr.Sequential(ObjectInitializationCheck cenv.g, x1, NormalSeq, _, _) -> ConvExpr cenv env x1 - | Expr.Sequential (x0,x1,NormalSeq,_,_) -> QP.mkSequential(ConvExpr cenv env x0, ConvExpr cenv env x1) - | Expr.Obj (_,ty,_,_,[TObjExprMethod(TSlotSig(_,ctyp, _,_,_,_),_,tps,[tmvs],e,_) as tmethod],_,m) when isDelegateTy cenv.g ty -> - let f = mkLambdas m tps tmvs (e,GetFSharpViewOfReturnType cenv.g (returnTyOfMethod cenv.g tmethod)) - let fR = ConvExpr cenv env f - let tyargR = ConvType cenv env m ctyp + | Expr.Sequential (x0, x1, NormalSeq, _, _) -> QP.mkSequential(ConvExpr cenv env x0, ConvExpr cenv env x1) + | Expr.Obj (_, ty, _, _, [TObjExprMethod(TSlotSig(_, ctyp, _, _, _, _), _, tps, [tmvs], e, _) as tmethod], _, m) when isDelegateTy cenv.g ty -> + let f = mkLambdas m tps tmvs (e, GetFSharpViewOfReturnType cenv.g (returnTyOfMethod cenv.g tmethod)) + let fR = ConvExpr cenv env f + let tyargR = ConvType cenv env m ctyp QP.mkDelegate(tyargR, fR) - | Expr.StaticOptimization (_,_,x,_) -> ConvExpr cenv env x + | Expr.StaticOptimization (_, _, x, _) -> ConvExpr cenv env x | Expr.TyChoose _ -> ConvExpr cenv env (TypeRelations.ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr) - | Expr.Sequential (x0,x1,ThenDoSeq,_,_) -> QP.mkSequential(ConvExpr cenv env x0, ConvExpr cenv env x1) - | Expr.Obj (_lambdaId,_typ,_basev,_basecall,_overrides,_iimpls,m) -> wfail(Error(FSComp.SR.crefQuotationsCantContainObjExprs(),m)) + | Expr.Sequential (x0, x1, ThenDoSeq, _, _) -> QP.mkSequential(ConvExpr cenv env x0, ConvExpr cenv env x1) + | Expr.Obj (_lambdaId, _typ, _basev, _basecall, _overrides, _iimpls, m) -> wfail(Error(FSComp.SR.crefQuotationsCantContainObjExprs(), m)) - | Expr.Op(op,tyargs,args,m) -> - match op,tyargs,args with - | TOp.UnionCase ucref,_,_ -> + | Expr.Op(op, tyargs, args, m) -> + match op, tyargs, args with + | TOp.UnionCase ucref, _, _ -> let mkR = ConvUnionCaseRef cenv ucref m let tyargsR = ConvTypes cenv env m tyargs let argsR = ConvExprs cenv env args - QP.mkUnion(mkR,tyargsR,argsR) + QP.mkUnion(mkR, tyargsR, argsR) - | TOp.Tuple tupInfo,tyargs,_ -> + | TOp.Tuple tupInfo, tyargs, _ -> let tyR = ConvType cenv env m (mkAnyTupledTy cenv.g tupInfo tyargs) let argsR = ConvExprs cenv env args - QP.mkTuple(tyR,argsR) // TODO: propagate to quotations + QP.mkTuple(tyR, argsR) // TODO: propagate to quotations - | TOp.Recd (_,tcref),_,_ -> + | TOp.Recd (_, tcref), _, _ -> let rgtypR = ConvTyconRef cenv tcref m let tyargsR = ConvTypes cenv env m tyargs let argsR = ConvExprs cenv env args - QP.mkRecdMk(rgtypR,tyargsR,argsR) + QP.mkRecdMk(rgtypR, tyargsR, argsR) - | TOp.AnonRecd anonInfo, _, _ -> + | TOp.AnonRecd anonInfo, _, _ -> let tref = anonInfo.ILTypeRef let rgtypR = ConvILTypeRef cenv tref let tyargsR = ConvTypes cenv env m tyargs let argsR = ConvExprs cenv env args - QP.mkRecdMk(rgtypR,tyargsR,argsR) + QP.mkRecdMk(rgtypR, tyargsR, argsR) - | TOp.AnonRecdGet (anonInfo, n), _, _ -> + | TOp.AnonRecdGet (anonInfo, n), _, _ -> let tref = anonInfo.ILTypeRef let rgtypR = ConvILTypeRef cenv tref let tyargsR = ConvTypes cenv env m tyargs let argsR = ConvExprs cenv env args - QP.mkRecdGet((rgtypR,anonInfo.SortedNames.[n]),tyargsR,argsR) + QP.mkRecdGet((rgtypR, anonInfo.SortedNames.[n]), tyargsR, argsR) - | TOp.UnionCaseFieldGet (ucref,n),tyargs,[e] -> + | TOp.UnionCaseFieldGet (ucref, n), tyargs, [e] -> ConvUnionFieldGet cenv env m ucref n tyargs e - | TOp.ValFieldGetAddr(_rfref, _readonly),_tyargs,_ -> - wfail(Error(FSComp.SR.crefQuotationsCantContainAddressOf(), m)) + | TOp.ValFieldGetAddr(_rfref, _readonly), _tyargs, _ -> + wfail(Error(FSComp.SR.crefQuotationsCantContainAddressOf(), m)) - | TOp.UnionCaseFieldGetAddr _,_tyargs,_ -> - wfail(Error(FSComp.SR.crefQuotationsCantContainAddressOf(), m)) + | TOp.UnionCaseFieldGetAddr _, _tyargs, _ -> + wfail(Error(FSComp.SR.crefQuotationsCantContainAddressOf(), m)) - | TOp.ValFieldGet(_rfref),_tyargs,[] -> - wfail(Error(FSComp.SR.crefQuotationsCantContainStaticFieldRef(),m)) + | TOp.ValFieldGet(_rfref), _tyargs, [] -> + wfail(Error(FSComp.SR.crefQuotationsCantContainStaticFieldRef(), m)) - | TOp.ValFieldGet(rfref),tyargs,args -> - ConvClassOrRecdFieldGet cenv env m rfref tyargs args + | TOp.ValFieldGet(rfref), tyargs, args -> + ConvClassOrRecdFieldGet cenv env m rfref tyargs args - | TOp.TupleFieldGet(tupInfo,n),tyargs,[e] -> + | TOp.TupleFieldGet(tupInfo, n), tyargs, [e] -> let eR = ConvLValueExpr cenv env e let tyR = ConvType cenv env m (mkAnyTupledTy cenv.g tupInfo tyargs) QP.mkTupleGet(tyR, n, eR) - | TOp.ILAsm(([ I_ldfld(_,_,fspec) ] - | [ I_ldfld(_,_,fspec); AI_nop ] - | [ I_ldsfld (_,fspec) ] - | [ I_ldsfld (_,fspec); AI_nop ]),_),enclTypeArgs,args -> + | TOp.ILAsm(([ I_ldfld(_, _, fspec) ] + | [ I_ldfld(_, _, fspec); AI_nop ] + | [ I_ldsfld (_, fspec) ] + | [ I_ldsfld (_, fspec); AI_nop ]), _), enclTypeArgs, args -> ConvLdfld cenv env m fspec enclTypeArgs args - | TOp.ILAsm([ I_stfld(_,_,fspec) | I_stsfld (_,fspec) ],_),enclTypeArgs,args -> + | TOp.ILAsm([ I_stfld(_, _, fspec) | I_stsfld (_, fspec) ], _), enclTypeArgs, args -> let tyargsR = ConvTypes cenv env m enclTypeArgs let parentTyconR = ConvILTypeRefUnadjusted cenv m fspec.DeclaringTypeRef let argsR = ConvLValueArgs cenv env args - QP.mkFieldSet( (parentTyconR, fspec.Name),tyargsR, argsR) + QP.mkFieldSet( (parentTyconR, fspec.Name), tyargsR, argsR) - | TOp.ILAsm([ AI_ceq ],_),_,[arg1;arg2] -> + | TOp.ILAsm([ AI_ceq ], _), _, [arg1;arg2] -> let ty = tyOfExpr cenv.g arg1 let eq = mkCallEqualsOperator cenv.g m ty arg1 arg2 ConvExpr cenv env eq - | TOp.ILAsm([ I_throw ],_),_,[arg1] -> - let raiseExpr = mkCallRaise cenv.g m (tyOfExpr cenv.g expr) arg1 - ConvExpr cenv env raiseExpr + | TOp.ILAsm([ I_throw ], _), _, [arg1] -> + let raiseExpr = mkCallRaise cenv.g m (tyOfExpr cenv.g expr) arg1 + ConvExpr cenv env raiseExpr - | TOp.ILAsm(_il,_),_,_ -> + | TOp.ILAsm(_il, _), _, _ -> wfail(Error(FSComp.SR.crefQuotationsCantContainInlineIL(), m)) - | TOp.ExnConstr tcref,_,args -> + | TOp.ExnConstr tcref, _, args -> let _rgtypR = ConvTyconRef cenv tcref m let _typ = mkAppTy tcref [] - let parentTyconR = ConvTyconRef cenv tcref m - let argtys = tcref |> recdFieldsOfExnDefRef |> List.map (fun rfld -> rfld.FormalType) + let parentTyconR = ConvTyconRef cenv tcref m + let argtys = tcref |> recdFieldsOfExnDefRef |> List.map (fun rfld -> rfld.FormalType) let methArgTypesR = ConvTypes cenv env m argtys let argsR = ConvExprs cenv env args - let objR = - QP.mkCtorCall( { ctorParent = parentTyconR + let objR = + QP.mkCtorCall( { ctorParent = parentTyconR ctorArgTypes = methArgTypesR }, [], argsR) let exnTypeR = ConvType cenv env m cenv.g.exn_ty QP.mkCoerce(exnTypeR, objR) - | TOp.ValFieldSet rfref, _tinst,args -> - let argsR = ConvLValueArgs cenv env args + | TOp.ValFieldSet rfref, _tinst, args -> + let argsR = ConvLValueArgs cenv env args let tyargsR = ConvTypes cenv env m tyargs - let ((_parentTyconR,fldOrPropName) as projR) = ConvRecdFieldRef cenv rfref m + let ((_parentTyconR, fldOrPropName) as projR) = ConvRecdFieldRef cenv rfref m if rfref.TyconRef.IsRecordTycon then - QP.mkRecdSet(projR,tyargsR,argsR) + QP.mkRecdSet(projR, tyargsR, argsR) else - let fspec = rfref.RecdField + let fspec = rfref.RecdField let tcref = rfref.TyconRef let parentTyconR = ConvTyconRef cenv tcref m if useGenuineField tcref.Deref fspec then - QP.mkFieldSet( projR,tyargsR, argsR) + QP.mkFieldSet( projR, tyargsR, argsR) else let envinner = BindFormalTypars env (tcref.TyparsNoRange) let propRetTypeR = ConvType cenv envinner m fspec.FormalType - QP.mkPropSet( (parentTyconR, fldOrPropName,propRetTypeR,[]),tyargsR, argsR) + QP.mkPropSet( (parentTyconR, fldOrPropName, propRetTypeR, []), tyargsR, argsR) - | TOp.ExnFieldGet(tcref,i),[],[obj] -> + | TOp.ExnFieldGet(tcref, i), [], [obj] -> let exnc = stripExnEqns tcref let fspec = exnc.TrueInstanceFieldsAsList.[i] - let parentTyconR = ConvTyconRef cenv tcref m + let parentTyconR = ConvTyconRef cenv tcref m let propRetTypeR = ConvType cenv env m fspec.FormalType let callArgR = ConvExpr cenv env obj let exnTypeR = ConvType cenv env m (generalizedTyconRef tcref) - QP.mkPropGet( (parentTyconR, fspec.Name,propRetTypeR,[]),[], [QP.mkCoerce (exnTypeR, callArgR)]) + QP.mkPropGet( (parentTyconR, fspec.Name, propRetTypeR, []), [], [QP.mkCoerce (exnTypeR, callArgR)]) - | TOp.Coerce,[tgtTy;srcTy],[x] -> + | TOp.Coerce, [tgtTy;srcTy], [x] -> let xR = ConvExpr cenv env x - if typeEquiv cenv.g tgtTy srcTy then + if typeEquiv cenv.g tgtTy srcTy then xR else - QP.mkCoerce(ConvType cenv env m tgtTy,xR) + QP.mkCoerce(ConvType cenv env m tgtTy, xR) - | TOp.Reraise,[toTy],[] -> - // rebuild reraise() and Convert - mkReraiseLibCall cenv.g toTy m |> ConvExpr cenv env + | TOp.Reraise, [toTy], [] -> + // rebuild reraise() and Convert + mkReraiseLibCall cenv.g toTy m |> ConvExpr cenv env - | TOp.LValueOp(LAddrOf _,vref),[],[] -> + | TOp.LValueOp(LAddrOf _, vref), [], [] -> QP.mkAddressOf(ConvValRef false cenv env m vref []) - | TOp.LValueOp(LByrefSet,vref),[],[e] -> + | TOp.LValueOp(LByrefSet, vref), [], [e] -> QP.mkAddressSet(ConvValRef false cenv env m vref [], ConvExpr cenv env e) - | TOp.LValueOp(LSet,vref),[],[e] -> + | TOp.LValueOp(LSet, vref), [], [e] -> // Sets of module values become property sets - match vref.DeclaringEntity with - | Parent tcref when IsCompiledAsStaticProperty cenv.g vref.Deref -> - let parentTyconR = ConvTyconRef cenv tcref m + match vref.DeclaringEntity with + | Parent tcref when IsCompiledAsStaticProperty cenv.g vref.Deref -> + let parentTyconR = ConvTyconRef cenv tcref m let propName = vref.CompiledName - let propTy = ConvType cenv env m vref.Type - QP.mkPropSet( (parentTyconR, propName,propTy,[]),[], [ConvExpr cenv env e]) - | _ -> + let propTy = ConvType cenv env m vref.Type + QP.mkPropSet( (parentTyconR, propName, propTy, []), [], [ConvExpr cenv env e]) + | _ -> QP.mkVarSet( ConvValRef false cenv env m vref [], ConvExpr cenv env e) - | TOp.LValueOp(LByrefGet,vref),[],[] -> + | TOp.LValueOp(LByrefGet, vref), [], [] -> ConvValRef false cenv env m vref [] - | TOp.Array,[ty],xa -> - QP.mkNewArray(ConvType cenv env m ty,ConvExprs cenv env xa) + | TOp.Array, [ty], xa -> + QP.mkNewArray(ConvType cenv env m ty, ConvExprs cenv env xa) - | TOp.While _,[],[Expr.Lambda(_,_,_,[_],test,_,_);Expr.Lambda(_,_,_,[_],body,_,_)] -> + | TOp.While _, [], [Expr.Lambda(_, _, _, [_], test, _, _);Expr.Lambda(_, _, _, [_], body, _, _)] -> QP.mkWhileLoop(ConvExpr cenv env test, ConvExpr cenv env body) - - | TOp.For(_, FSharpForLoopUp), [], [Expr.Lambda(_,_,_,[_], lim0,_,_); Expr.Lambda(_,_,_,[_], SimpleArrayLoopUpperBound, lm,_); SimpleArrayLoopBody cenv.g (arr, elemTy, body)] -> - let lim1 = + + | TOp.For(_, FSharpForLoopUp), [], [Expr.Lambda(_, _, _, [_], lim0, _, _); Expr.Lambda(_, _, _, [_], SimpleArrayLoopUpperBound, lm, _); SimpleArrayLoopBody cenv.g (arr, elemTy, body)] -> + let lim1 = let len = mkCallArrayLength cenv.g lm elemTy arr // Array.length arr mkCallSubtractionOperator cenv.g lm cenv.g.int32_ty len (Expr.Const(Const.Int32 1, m, cenv.g.int32_ty)) // len - 1 QP.mkForLoop(ConvExpr cenv env lim0, ConvExpr cenv env lim1, ConvExpr cenv env body) - | TOp.For(_,dir),[],[Expr.Lambda(_,_,_,[_],lim0,_,_);Expr.Lambda(_,_,_,[_],lim1,_,_);body] -> - match dir with - | FSharpForLoopUp -> QP.mkForLoop(ConvExpr cenv env lim0,ConvExpr cenv env lim1, ConvExpr cenv env body) + | TOp.For(_, dir), [], [Expr.Lambda(_, _, _, [_], lim0, _, _);Expr.Lambda(_, _, _, [_], lim1, _, _);body] -> + match dir with + | FSharpForLoopUp -> QP.mkForLoop(ConvExpr cenv env lim0, ConvExpr cenv env lim1, ConvExpr cenv env body) | _ -> wfail(Error(FSComp.SR.crefQuotationsCantContainDescendingForLoops(), m)) - | TOp.ILCall(_,_,_,isNewObj,valUseFlags,isProp,_,ilMethRef,enclTypeArgs,methTypeArgs,_tys),[],callArgs -> + | TOp.ILCall(_, _, _, isNewObj, valUseFlags, isProp, _, ilMethRef, enclTypeArgs, methTypeArgs, _tys), [], callArgs -> let parentTyconR = ConvILTypeRefUnadjusted cenv m ilMethRef.DeclaringTypeRef let isNewObj = isNewObj || (match valUseFlags with CtorValUsedAsSuperInit | CtorValUsedAsSelfInit -> true | _ -> false) let methArgTypesR = List.map (ConvILType cenv env m) ilMethRef.ArgTypes @@ -579,114 +586,114 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let isPropGet = isProp && methName.StartsWithOrdinal("get_") let isPropSet = isProp && methName.StartsWithOrdinal("set_") let tyargs = (enclTypeArgs@methTypeArgs) - ConvObjectModelCall cenv env m (isPropGet,isPropSet,isNewObj,parentTyconR,methArgTypesR,methRetTypeR,methName,tyargs,methTypeArgs.Length,callArgs) + ConvObjectModelCall cenv env m (isPropGet, isPropSet, isNewObj, parentTyconR, methArgTypesR, methRetTypeR, methName, tyargs, methTypeArgs.Length, callArgs) - | TOp.TryFinally _,[_resty],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[_],e2,_,_)] -> - QP.mkTryFinally(ConvExpr cenv env e1,ConvExpr cenv env e2) + | TOp.TryFinally _, [_resty], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)] -> + QP.mkTryFinally(ConvExpr cenv env e1, ConvExpr cenv env e2) - | TOp.TryCatch _,[_resty],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[vf],ef,_,_); Expr.Lambda(_,_,_,[vh],eh,_,_)] -> + | TOp.TryCatch _, [_resty], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [vf], ef, _, _); Expr.Lambda(_, _, _, [vh], eh, _, _)] -> let vfR = ConvVal cenv env vf let envf = BindVal env vf let vhR = ConvVal cenv env vh let envh = BindVal env vh - QP.mkTryWith(ConvExpr cenv env e1,vfR,ConvExpr cenv envf ef,vhR,ConvExpr cenv envh eh) + QP.mkTryWith(ConvExpr cenv env e1, vfR, ConvExpr cenv envf ef, vhR, ConvExpr cenv envh eh) - | TOp.Bytes bytes,[],[] -> + | TOp.Bytes bytes, [], [] -> ConvExpr cenv env (Expr.Op(TOp.Array, [cenv.g.byte_ty], List.ofArray (Array.map (mkByte cenv.g m) bytes), m)) - | TOp.UInt16s arr,[],[] -> + | TOp.UInt16s arr, [], [] -> ConvExpr cenv env (Expr.Op(TOp.Array, [cenv.g.uint16_ty], List.ofArray (Array.map (mkUInt16 cenv.g m) arr), m)) - - | TOp.UnionCaseProof _,_,[e] -> ConvExpr cenv env e // Note: we erase the union case proof conversions when converting to quotations - | TOp.UnionCaseTagGet _tycr,_tinst,[_cx] -> wfail(Error(FSComp.SR.crefQuotationsCantFetchUnionIndexes(), m)) - | TOp.UnionCaseFieldSet (_c,_i),_tinst,[_cx;_x] -> wfail(Error(FSComp.SR.crefQuotationsCantSetUnionFields(), m)) - | TOp.ExnFieldSet(_tcref,_i),[],[_ex;_x] -> wfail(Error(FSComp.SR.crefQuotationsCantSetExceptionFields(), m)) - | TOp.RefAddrGet _,_,_ -> wfail(Error(FSComp.SR.crefQuotationsCantRequireByref(), m)) - | TOp.TraitCall (_ss),_,_ -> wfail(Error(FSComp.SR.crefQuotationsCantCallTraitMembers(), m)) - | _ -> - wfail(InternalError( "Unexpected expression shape",m)) - - | _ -> - wfail(InternalError(sprintf "unhandled construct in AST: %A" expr,expr.Range)) + + | TOp.UnionCaseProof _, _, [e] -> ConvExpr cenv env e // Note: we erase the union case proof conversions when converting to quotations + | TOp.UnionCaseTagGet _tycr, _tinst, [_cx] -> wfail(Error(FSComp.SR.crefQuotationsCantFetchUnionIndexes(), m)) + | TOp.UnionCaseFieldSet (_c, _i), _tinst, [_cx;_x] -> wfail(Error(FSComp.SR.crefQuotationsCantSetUnionFields(), m)) + | TOp.ExnFieldSet(_tcref, _i), [], [_ex;_x] -> wfail(Error(FSComp.SR.crefQuotationsCantSetExceptionFields(), m)) + | TOp.RefAddrGet _, _, _ -> wfail(Error(FSComp.SR.crefQuotationsCantRequireByref(), m)) + | TOp.TraitCall (_ss), _, _ -> wfail(Error(FSComp.SR.crefQuotationsCantCallTraitMembers(), m)) + | _ -> + wfail(InternalError( "Unexpected expression shape", m)) + + | _ -> + wfail(InternalError(sprintf "unhandled construct in AST: %A" expr, expr.Range)) and ConvLdfld cenv env m (fspec: ILFieldSpec) enclTypeArgs args = let tyargsR = ConvTypes cenv env m enclTypeArgs let parentTyconR = ConvILTypeRefUnadjusted cenv m fspec.DeclaringTypeRef let argsR = ConvLValueArgs cenv env args - QP.mkFieldGet( (parentTyconR, fspec.Name),tyargsR, argsR) + QP.mkFieldGet( (parentTyconR, fspec.Name), tyargsR, argsR) and ConvUnionFieldGet cenv env m ucref n tyargs e = let tyargsR = ConvTypes cenv env m tyargs - let tcR,s = ConvUnionCaseRef cenv ucref m - let projR = (tcR,s,n) + let tcR, s = ConvUnionCaseRef cenv ucref m + let projR = (tcR, s, n) let eR = ConvLValueExpr cenv env e QP.mkUnionFieldGet(projR, tyargsR, eR) and ConvClassOrRecdFieldGet cenv env m rfref tyargs args = EmitDebugInfoIfNecessary cenv env m (ConvClassOrRecdFieldGetCore cenv env m rfref tyargs args) -and private ConvClassOrRecdFieldGetCore cenv env m rfref tyargs args = +and private ConvClassOrRecdFieldGetCore cenv env m rfref tyargs args = let tyargsR = ConvTypes cenv env m tyargs - let argsR = ConvLValueArgs cenv env args - let ((parentTyconR,fldOrPropName) as projR) = ConvRecdFieldRef cenv rfref m + let argsR = ConvLValueArgs cenv env args + let ((parentTyconR, fldOrPropName) as projR) = ConvRecdFieldRef cenv rfref m if rfref.TyconRef.IsRecordTycon then - QP.mkRecdGet(projR,tyargsR,argsR) + QP.mkRecdGet(projR, tyargsR, argsR) else - let fspec = rfref.RecdField + let fspec = rfref.RecdField let tcref = rfref.TyconRef if useGenuineField tcref.Deref fspec then - QP.mkFieldGet(projR,tyargsR, argsR) + QP.mkFieldGet(projR, tyargsR, argsR) else let envinner = BindFormalTypars env tcref.TyparsNoRange let propRetTypeR = ConvType cenv envinner m fspec.FormalType - QP.mkPropGet( (parentTyconR, fldOrPropName,propRetTypeR,[]),tyargsR, argsR) + QP.mkPropGet( (parentTyconR, fldOrPropName, propRetTypeR, []), tyargsR, argsR) -and ConvLetBind cenv env (bind : Binding) = - match bind.Expr with - // Map for values bound by the - // 'let v = isinst e in .... if nonnull v then ...v .... ' +and ConvLetBind cenv env (bind : Binding) = + match bind.Expr with + // Map for values bound by the + // 'let v = isinst e in .... if nonnull v then ...v .... ' // construct arising out the compilation of pattern matching. We decode these back to the form - // 'if istype e then ...unbox e .... ' - // It's bit annoying that pattern matching does this transformation. Like all premature optimization we pay a + // 'if istype e then ...unbox e .... ' + // It's bit annoying that pattern matching does this transformation. Like all premature optimization we pay a // cost here to undo it. - | Expr.Op(TOp.ILAsm([ I_isinst _ ],_),[ty],[e],_) -> - None, BindIsInstVal env bind.Var (ty,e) - + | Expr.Op(TOp.ILAsm([ I_isinst _ ], _), [ty], [e], _) -> + None, BindIsInstVal env bind.Var (ty, e) + // Remove let = from quotation tree - | Expr.Val _ when bind.Var.IsCompilerGenerated -> + | Expr.Val _ when bind.Var.IsCompilerGenerated -> None, BindSubstVal env bind.Var bind.Expr // Remove let unionCase = ... from quotation tree - | Expr.Op(TOp.UnionCaseProof _,_,[e],_) -> + | Expr.Op(TOp.UnionCaseProof _, _, [e], _) -> None, BindSubstVal env bind.Var e | _ -> let v = bind.Var - let vR = ConvVal cenv env v + let vR = ConvVal cenv env v let rhsR = ConvExpr cenv env bind.Expr let envinner = BindVal env v - Some(vR,rhsR),envinner + Some(vR, rhsR), envinner -and ConvLValueArgs cenv env args = - match args with +and ConvLValueArgs cenv env args = + match args with | obj::rest -> ConvLValueExpr cenv env obj :: ConvExprs cenv env rest | [] -> [] -and ConvLValueExpr cenv env expr = +and ConvLValueExpr cenv env expr = EmitDebugInfoIfNecessary cenv env expr.Range (ConvLValueExprCore cenv env expr) -// This function has to undo the work of mkExprAddrOfExpr -and ConvLValueExprCore cenv env expr = - match expr with - | Expr.Op(op,tyargs,args,m) -> +// This function has to undo the work of mkExprAddrOfExpr +and ConvLValueExprCore cenv env expr = + match expr with + | Expr.Op(op, tyargs, args, m) -> match op, args, tyargs with - | TOp.LValueOp(LAddrOf _,vref),_,_ -> ConvValRef false cenv env m vref [] - | TOp.ValFieldGetAddr(rfref, _),_,_ -> ConvClassOrRecdFieldGet cenv env m rfref tyargs args - | TOp.UnionCaseFieldGetAddr(ucref,n, _),[e],_ -> ConvUnionFieldGet cenv env m ucref n tyargs e - | TOp.ILAsm([ I_ldflda(fspec) ],_rtys),_,_ -> ConvLdfld cenv env m fspec tyargs args - | TOp.ILAsm([ I_ldsflda(fspec) ],_rtys),_,_ -> ConvLdfld cenv env m fspec tyargs args - | TOp.ILAsm(([ I_ldelema(_ro,_isNativePtr,shape,_tyarg) ] ),_), (arr::idxs), [elemty] -> - match shape.Rank, idxs with + | TOp.LValueOp(LAddrOf _, vref), _, _ -> ConvValRef false cenv env m vref [] + | TOp.ValFieldGetAddr(rfref, _), _, _ -> ConvClassOrRecdFieldGet cenv env m rfref tyargs args + | TOp.UnionCaseFieldGetAddr(ucref, n, _), [e], _ -> ConvUnionFieldGet cenv env m ucref n tyargs e + | TOp.ILAsm([ I_ldflda(fspec) ], _rtys), _, _ -> ConvLdfld cenv env m fspec tyargs args + | TOp.ILAsm([ I_ldsflda(fspec) ], _rtys), _, _ -> ConvLdfld cenv env m fspec tyargs args + | TOp.ILAsm(([ I_ldelema(_ro, _isNativePtr, shape, _tyarg) ] ), _), (arr::idxs), [elemty] -> + match shape.Rank, idxs with | 1, [idx1] -> ConvExpr cenv env (mkCallArrayGet cenv.g m elemty arr idx1) | 2, [idx1; idx2] -> ConvExpr cenv env (mkCallArray2DGet cenv.g m elemty arr idx1 idx2) | 3, [idx1; idx2; idx3] -> ConvExpr cenv env (mkCallArray3DGet cenv.g m elemty arr idx1 idx2 idx3) @@ -694,31 +701,31 @@ and ConvLValueExprCore cenv env expr = | _ -> ConvExpr cenv env expr | _ -> ConvExpr cenv env expr | _ -> ConvExpr cenv env expr - + and ConvObjectModelCall cenv env m callInfo = EmitDebugInfoIfNecessary cenv env m (ConvObjectModelCallCore cenv env m callInfo) -and ConvObjectModelCallCore cenv env m (isPropGet,isPropSet,isNewObj,parentTyconR,methArgTypesR,methRetTypeR,methName,tyargs,numGenericArgs,callArgs) = +and ConvObjectModelCallCore cenv env m (isPropGet, isPropSet, isNewObj, parentTyconR, methArgTypesR, methRetTypeR, methName, tyargs, numGenericArgs, callArgs) = let tyargsR = ConvTypes cenv env m tyargs let callArgsR = ConvLValueArgs cenv env callArgs - if isPropGet || isPropSet then + if isPropGet || isPropSet then let propName = ChopPropertyName methName - if isPropGet then - QP.mkPropGet( (parentTyconR, propName,methRetTypeR,methArgTypesR),tyargsR, callArgsR) - else - let args,propTy = List.frontAndBack methArgTypesR - QP.mkPropSet( (parentTyconR, propName,propTy,args),tyargsR, callArgsR) - - elif isNewObj then - let ctorR : QuotationPickler.CtorData = - { ctorParent = parentTyconR - ctorArgTypes = methArgTypesR } + if isPropGet then + QP.mkPropGet( (parentTyconR, propName, methRetTypeR, methArgTypesR), tyargsR, callArgsR) + else + let args, propTy = List.frontAndBack methArgTypesR + QP.mkPropSet( (parentTyconR, propName, propTy, args), tyargsR, callArgsR) + + elif isNewObj then + let ctorR : QuotationPickler.CtorData = + { ctorParent = parentTyconR + ctorArgTypes = methArgTypesR } QP.mkCtorCall(ctorR, tyargsR, callArgsR) - else - let methR : QuotationPickler.MethodData = - { methParent = parentTyconR + else + let methR : QuotationPickler.MethodData = + { methParent = parentTyconR methArgTypes = methArgTypesR methRetType = methRetTypeR methName = methName @@ -729,115 +736,115 @@ and ConvModuleValueApp cenv env m (vref:ValRef) tyargs (args: Expr list list) = EmitDebugInfoIfNecessary cenv env m (ConvModuleValueAppCore cenv env m vref tyargs args) and ConvModuleValueAppCore cenv env m (vref:ValRef) tyargs (args: Expr list list) = - match vref.DeclaringEntity with + match vref.DeclaringEntity with | ParentNone -> failwith "ConvModuleValueApp" - | Parent(tcref) -> + | Parent(tcref) -> let isProperty = IsCompiledAsStaticProperty cenv.g vref.Deref - let tcrefR = ConvTyconRef cenv tcref m - let tyargsR = ConvTypes cenv env m tyargs + let tcrefR = ConvTyconRef cenv tcref m + let tyargsR = ConvTypes cenv env m tyargs let nm = vref.CompiledName let argsR = List.map (ConvExprs cenv env) args - QP.mkModuleValueApp(tcrefR,nm,isProperty,tyargsR,argsR) + QP.mkModuleValueApp(tcrefR, nm, isProperty, tyargsR, argsR) and ConvExprs cenv env args = - List.map (ConvExpr cenv env) args + List.map (ConvExpr cenv env) args and ConvValRef holeOk cenv env m (vref:ValRef) tyargs = EmitDebugInfoIfNecessary cenv env m (ConvValRefCore holeOk cenv env m vref tyargs) and private ConvValRefCore holeOk cenv env m (vref:ValRef) tyargs = let v = vref.Deref - if env.isinstVals.ContainsVal v then - let (ty,e) = env.isinstVals.[v] + if env.isinstVals.ContainsVal v then + let (ty, e) = env.isinstVals.[v] ConvExpr cenv env (mkCallUnbox cenv.g m ty e) - elif env.substVals.ContainsVal v then + elif env.substVals.ContainsVal v then let e = env.substVals.[v] ConvExpr cenv env e - elif env.vs.ContainsVal v then - if not (List.isEmpty tyargs) then wfail(InternalError("ignoring generic application of local quoted variable",m)) + elif env.vs.ContainsVal v then + if not (List.isEmpty tyargs) then wfail(InternalError("ignoring generic application of local quoted variable", m)) QP.mkVar(env.vs.[v]) - elif v.BaseOrThisInfo = CtorThisVal && cenv.isReflectedDefinition = IsReflectedDefinition.Yes then + elif v.BaseOrThisInfo = CtorThisVal && cenv.isReflectedDefinition = IsReflectedDefinition.Yes then QP.mkThisVar(ConvType cenv env m v.Type) - else + else let vty = v.Type - match v.DeclaringEntity with - | ParentNone -> + match v.DeclaringEntity with + | ParentNone -> // References to local values are embedded by value - if not holeOk then wfail(Error(FSComp.SR.crefNoSetOfHole(),m)) - let idx = cenv.exprSplices.Count + if not holeOk then wfail(Error(FSComp.SR.crefNoSetOfHole(), m)) + let idx = cenv.exprSplices.Count cenv.exprSplices.Add((mkCallLiftValueWithName cenv.g m vty v.LogicalName (exprForValRef m vref), m)) - QP.mkHole(ConvType cenv env m vty,idx) - | Parent _ -> + QP.mkHole(ConvType cenv env m vty, idx) + | Parent _ -> ConvModuleValueApp cenv env m vref tyargs [] and ConvUnionCaseRef cenv (ucref:UnionCaseRef) m = let ucgtypR = ConvTyconRef cenv ucref.TyconRef m - let nm = + let nm = if cenv.g.unionCaseRefEq ucref cenv.g.cons_ucref then "Cons" elif cenv.g.unionCaseRefEq ucref cenv.g.nil_ucref then "Empty" - else ucref.CaseName - (ucgtypR,nm) + else ucref.CaseName + (ucgtypR, nm) and ConvRecdFieldRef cenv (rfref:RecdFieldRef) m = let typR = ConvTyconRef cenv rfref.TyconRef m - let nm = + let nm = if useGenuineField rfref.TyconRef.Deref rfref.RecdField then ComputeFieldName rfref.TyconRef.Deref rfref.RecdField - else + else rfref.FieldName - (typR,nm) + (typR, nm) -and ConvVal cenv env (v:Val) = +and ConvVal cenv env (v:Val) = let tyR = ConvType cenv env v.Range v.Type QP.freshVar (v.CompiledName, tyR, v.IsMutable) -and ConvTyparRef cenv env m (tp:Typar) = +and ConvTyparRef cenv env m (tp:Typar) = match env.tyvs.TryFind tp.Stamp with | Some x -> x - | None -> - match ResizeArray.tryFindIndex (fun (tp2,_m) -> typarEq tp tp2) cenv.typeSplices with + | None -> + match ResizeArray.tryFindIndex (fun (tp2, _m) -> typarEq tp tp2) cenv.typeSplices with | Some idx -> idx | None -> - let idx = cenv.typeSplices.Count + let idx = cenv.typeSplices.Count cenv.typeSplices.Add((tp, m)) idx -and FilterMeasureTyargs tys = - tys |> List.filter (fun ty -> match ty with TType_measure _ -> false | _ -> true) +and FilterMeasureTyargs tys = + tys |> List.filter (fun ty -> match ty with TType_measure _ -> false | _ -> true) and ConvType cenv env m ty = - match stripTyEqnsAndMeasureEqns cenv.g ty with - | TType_app(tcref,[tyarg]) when isArrayTyconRef cenv.g tcref -> - QP.mkArrayTy(rankOfArrayTyconRef cenv.g tcref,ConvType cenv env m tyarg) + match stripTyEqnsAndMeasureEqns cenv.g ty with + | TType_app(tcref, [tyarg]) when isArrayTyconRef cenv.g tcref -> + QP.mkArrayTy(rankOfArrayTyconRef cenv.g tcref, ConvType cenv env m tyarg) - | TType_ucase(UCRef(tcref,_),tyargs) // Note: we erase union case 'types' when converting to quotations - | TType_app(tcref,tyargs) -> + | TType_ucase(UCRef(tcref, _), tyargs) // Note: we erase union case 'types' when converting to quotations + | TType_app(tcref, tyargs) -> #if !NO_EXTENSIONTYPING - match TryElimErasableTyconRef cenv m tcref with + match TryElimErasableTyconRef cenv m tcref with | Some baseTy -> ConvType cenv env m baseTy - | _ -> + | _ -> #endif QP.mkILNamedTy(ConvTyconRef cenv tcref m, ConvTypes cenv env m tyargs) - | TType_fun(a,b) -> QP.mkFunTy(ConvType cenv env m a,ConvType cenv env m b) - | TType_tuple(tupInfo,l) -> ConvType cenv env m (mkCompiledTupleTy cenv.g (evalTupInfoIsStruct tupInfo) l) - | TType_anon(anonInfo,tinst) -> + | TType_fun(a, b) -> QP.mkFunTy(ConvType cenv env m a, ConvType cenv env m b) + | TType_tuple(tupInfo, l) -> ConvType cenv env m (mkCompiledTupleTy cenv.g (evalTupInfoIsStruct tupInfo) l) + | TType_anon(anonInfo, tinst) -> let tref = anonInfo.ILTypeRef let tinstR = ConvTypes cenv env m tinst QP.mkILNamedTy(ConvILTypeRefUnadjusted cenv m tref, tinstR) | TType_var(tp) -> QP.mkVarTy(ConvTyparRef cenv env m tp) - | TType_forall(_spec,_ty) -> wfail(Error(FSComp.SR.crefNoInnerGenericsInQuotations(),m)) - | _ -> wfail(Error (FSComp.SR.crefQuotationsCantContainThisType(),m)) + | TType_forall(_spec, _ty) -> wfail(Error(FSComp.SR.crefNoInnerGenericsInQuotations(), m)) + | _ -> wfail(Error (FSComp.SR.crefQuotationsCantContainThisType(), m)) and ConvTypes cenv env m tys = List.map (ConvType cenv env m) (FilterMeasureTyargs tys) and ConvConst cenv env m c ty = - match TryEliminateDesugaredConstants cenv.g m c with + match TryEliminateDesugaredConstants cenv.g m c with | Some e -> ConvExpr cenv env e | None -> let tyR = ConvType cenv env m ty - match c with + match c with | Const.Bool i -> QP.mkBool (i, tyR) | Const.SByte i -> QP.mkSByte (i, tyR) | Const.Byte i -> QP.mkByte (i, tyR) @@ -852,191 +859,191 @@ and ConvConst cenv env m c ty = | Const.String s -> QP.mkString (s, tyR) | Const.Char c -> QP.mkChar (c, tyR) | Const.Unit -> QP.mkUnit() - | Const.Zero -> - if isRefTy cenv.g ty then + | Const.Zero -> + if isRefTy cenv.g ty then QP.mkNull tyR else QP.mkDefaultValue tyR - | _ -> + | _ -> wfail(Error (FSComp.SR.crefQuotationsCantContainThisConstant(), m)) -and ConvDecisionTree cenv env tgs typR x = - match x with - | TDSwitch(e1,csl,dfltOpt,m) -> - let acc = - match dfltOpt with - | Some d -> ConvDecisionTree cenv env tgs typR d +and ConvDecisionTree cenv env tgs typR x = + match x with + | TDSwitch(e1, csl, dfltOpt, m) -> + let acc = + match dfltOpt with + | Some d -> ConvDecisionTree cenv env tgs typR d | None -> wfail(Error(FSComp.SR.crefQuotationsCantContainThisPatternMatch(), m)) - let converted = - (csl,acc) ||> List.foldBack (fun (TCase(discrim,dtree)) acc -> + let converted = + (csl, acc) ||> List.foldBack (fun (TCase(discrim, dtree)) acc -> - match discrim with - | DecisionTreeTest.UnionCase (ucref, tyargs) -> + match discrim with + | DecisionTreeTest.UnionCase (ucref, tyargs) -> let e1R = ConvLValueExpr cenv env e1 let ucR = ConvUnionCaseRef cenv ucref m let tyargsR = ConvTypes cenv env m tyargs QP.mkCond (QP.mkUnionCaseTagTest (ucR, tyargsR, e1R), ConvDecisionTree cenv env tgs typR dtree, acc) - | DecisionTreeTest.Const (Const.Bool true) -> + | DecisionTreeTest.Const (Const.Bool true) -> let e1R = ConvExpr cenv env e1 QP.mkCond (e1R, ConvDecisionTree cenv env tgs typR dtree, acc) - | DecisionTreeTest.Const (Const.Bool false) -> + | DecisionTreeTest.Const (Const.Bool false) -> let e1R = ConvExpr cenv env e1 // Note, reverse the branches QP.mkCond (e1R, acc, ConvDecisionTree cenv env tgs typR dtree) - | DecisionTreeTest.Const c -> + | DecisionTreeTest.Const c -> let ty = tyOfExpr cenv.g e1 let eq = mkCallEqualsOperator cenv.g m ty e1 (Expr.Const (c, m, ty)) - let eqR = ConvExpr cenv env eq + let eqR = ConvExpr cenv env eq QP.mkCond (eqR, ConvDecisionTree cenv env tgs typR dtree, acc) - | DecisionTreeTest.IsNull -> + | DecisionTreeTest.IsNull -> // Decompile cached isinst tests - match e1 with - | Expr.Val(vref,_,_) when env.isinstVals.ContainsVal vref.Deref -> - let (ty,e) = env.isinstVals.[vref.Deref] + match e1 with + | Expr.Val(vref, _, _) when env.isinstVals.ContainsVal vref.Deref -> + let (ty, e) = env.isinstVals.[vref.Deref] let tyR = ConvType cenv env m ty let eR = ConvExpr cenv env e // note: reverse the branches - a null test is a failure of an isinst test - QP.mkCond (QP.mkTypeTest (tyR,eR), acc, ConvDecisionTree cenv env tgs typR dtree) - | _ -> + QP.mkCond (QP.mkTypeTest (tyR, eR), acc, ConvDecisionTree cenv env tgs typR dtree) + | _ -> let ty = tyOfExpr cenv.g e1 let eq = mkCallEqualsOperator cenv.g m ty e1 (Expr.Const (Const.Zero, m, ty)) - let eqR = ConvExpr cenv env eq + let eqR = ConvExpr cenv env eq QP.mkCond (eqR, ConvDecisionTree cenv env tgs typR dtree, acc) - | DecisionTreeTest.IsInst (_srcty, tgty) -> + | DecisionTreeTest.IsInst (_srcty, tgty) -> let e1R = ConvExpr cenv env e1 QP.mkCond (QP.mkTypeTest (ConvType cenv env m tgty, e1R), ConvDecisionTree cenv env tgs typR dtree, acc) - | DecisionTreeTest.ActivePatternCase _ -> wfail(InternalError( "DecisionTreeTest.ActivePatternCase test in quoted expression",m)) + | DecisionTreeTest.ActivePatternCase _ -> wfail(InternalError( "DecisionTreeTest.ActivePatternCase test in quoted expression", m)) | DecisionTreeTest.ArrayLength _ -> wfail(Error(FSComp.SR.crefQuotationsCantContainArrayPatternMatching(), m)) ) EmitDebugInfoIfNecessary cenv env m converted - | TDSuccess (args,n) -> - let (TTarget(vars,rhs,_)) = tgs.[n] + | TDSuccess (args, n) -> + let (TTarget(vars, rhs, _)) = tgs.[n] // TAST stores pattern bindings in reverse order for some reason // Reverse them here to give a good presentation to the user let args = List.rev args let vars = List.rev vars - - let varsR = vars |> List.map (ConvVal cenv env) + + let varsR = vars |> List.map (ConvVal cenv env) let targetR = ConvExpr cenv (BindVals env vars) rhs - (varsR,args,targetR) |||> List.foldBack2 (fun vR arg acc -> QP.mkLet((vR,ConvExpr cenv env arg), acc) ) - - | TDBind(bind,rest) -> + (varsR, args, targetR) |||> List.foldBack2 (fun vR arg acc -> QP.mkLet((vR, ConvExpr cenv env arg), acc) ) + + | TDBind(bind, rest) -> // The binding may be a compiler-generated binding that gets removed in the quotation presentation - match ConvLetBind cenv env bind with - | None, env -> ConvDecisionTree cenv env tgs typR rest - | Some(bindR),env -> QP.mkLet(bindR,ConvDecisionTree cenv env tgs typR rest) + match ConvLetBind cenv env bind with + | None, env -> ConvDecisionTree cenv env tgs typR rest + | Some(bindR), env -> QP.mkLet(bindR, ConvDecisionTree cenv env tgs typR rest) // Check if this is an provider-generated assembly that will be statically linked and IsILTypeRefStaticLinkLocal cenv m (tr:ILTypeRef) = ignore cenv; ignore m - match tr.Scope with + match tr.Scope with #if !NO_EXTENSIONTYPING - | ILScopeRef.Assembly aref + | ILScopeRef.Assembly aref when not cenv.g.isInteractive && aref.Name <> cenv.g.ilg.primaryAssemblyName && // optimization to avoid this check in the common case // Explanation: This represents an unchecked invariant in the hosted compiler: that any operations // which import types (and resolve assemblies from the tcImports tables) happen on the compilation thread. - let ctok = AssumeCompilationThreadWithoutEvidence() + let ctok = AssumeCompilationThreadWithoutEvidence() - (match cenv.amap.assemblyLoader.FindCcuFromAssemblyRef (ctok, m,aref) with + (match cenv.amap.assemblyLoader.FindCcuFromAssemblyRef (ctok, m, aref) with | ResolvedCcu ccu -> ccu.IsProviderGenerated - | UnresolvedCcu _ -> false) + | UnresolvedCcu _ -> false) -> true #endif | _ -> false // Adjust for static linking information, then convert -and ConvILTypeRefUnadjusted cenv m (tr:ILTypeRef) = - let trefAdjusted = - if IsILTypeRefStaticLinkLocal cenv m tr then - ILTypeRef.Create(ILScopeRef.Local, tr.Enclosing, tr.Name) +and ConvILTypeRefUnadjusted cenv m (tr:ILTypeRef) = + let trefAdjusted = + if IsILTypeRefStaticLinkLocal cenv m tr then + ILTypeRef.Create(ILScopeRef.Local, tr.Enclosing, tr.Name) else tr ConvILTypeRef cenv trefAdjusted - -and ConvILTypeRef cenv (tr:ILTypeRef) = + +and ConvILTypeRef cenv (tr:ILTypeRef) = match cenv.quotationFormat with | QuotationSerializationFormat.FSharp_40_Plus -> - let idx = + let idx = match cenv.referencedTypeDefsTable.TryGetValue tr with | true, idx -> idx - | _ -> + | _ -> let idx = cenv.referencedTypeDefs.Count cenv.referencedTypeDefs.Add tr cenv.referencedTypeDefsTable.[tr] <- idx idx QP.Idx idx - + | QuotationSerializationFormat.FSharp_20_Plus -> - let assemblyRef = - match tr.Scope with + let assemblyRef = + match tr.Scope with | ILScopeRef.Local -> "." - | _ -> tr.Scope.QualifiedName + | _ -> tr.Scope.QualifiedName QP.Named(tr.BasicQualifiedName, assemblyRef) - + and ConvVoidType cenv m = QP.mkILNamedTy(ConvTyconRef cenv cenv.g.system_Void_tcref m, []) -and ConvILType cenv env m ty = - match ty with +and ConvILType cenv env m ty = + match ty with | ILType.Boxed tspec | ILType.Value tspec -> QP.mkILNamedTy(ConvILTypeRefUnadjusted cenv m tspec.TypeRef, List.map (ConvILType cenv env m) tspec.GenericArgs) - | ILType.Array (shape,ty) -> QP.mkArrayTy(shape.Rank,ConvILType cenv env m ty) + | ILType.Array (shape, ty) -> QP.mkArrayTy(shape.Rank, ConvILType cenv env m ty) | ILType.TypeVar idx -> QP.mkVarTy(int idx) | ILType.Void -> ConvVoidType cenv m - | ILType.Ptr _ - | ILType.Byref _ - | ILType.Modified _ + | ILType.Ptr _ + | ILType.Byref _ + | ILType.Modified _ | ILType.FunctionPointer _ -> wfail(Error(FSComp.SR.crefQuotationsCantContainThisType(), m)) - + #if !NO_EXTENSIONTYPING -and TryElimErasableTyconRef cenv m (tcref:TyconRef) = - match tcref.TypeReprInfo with +and TryElimErasableTyconRef cenv m (tcref:TyconRef) = + match tcref.TypeReprInfo with // Get the base type | TProvidedTypeExtensionPoint info when info.IsErased -> Some (info.BaseTypeForErased (m, cenv.g.obj_ty)) | _ -> None #endif -and ConvTyconRef cenv (tcref:TyconRef) m = +and ConvTyconRef cenv (tcref:TyconRef) m = #if !NO_EXTENSIONTYPING - match TryElimErasableTyconRef cenv m tcref with + match TryElimErasableTyconRef cenv m tcref with | Some baseTy -> ConvTyconRef cenv (tcrefOfAppTy cenv.g baseTy) m - | None -> - match tcref.TypeReprInfo with - | TProvidedTypeExtensionPoint info when not cenv.g.isInteractive && not info.IsErased -> + | None -> + match tcref.TypeReprInfo with + | TProvidedTypeExtensionPoint info when not cenv.g.isInteractive && not info.IsErased -> // Note, generated types are (currently) non-generic let tref = ExtensionTyping.GetILTypeRefOfProvidedType (info.ProvidedType, m) ConvILTypeRefUnadjusted cenv m tref - | _ -> + | _ -> #endif let repr = tcref.CompiledRepresentation - match repr with - | CompiledTypeRepr.ILAsmOpen asm -> - match asm with - | ILType.Boxed tspec | ILType.Value tspec -> + match repr with + | CompiledTypeRepr.ILAsmOpen asm -> + match asm with + | ILType.Boxed tspec | ILType.Value tspec -> ConvILTypeRef cenv tspec.TypeRef - | _ -> - wfail(Error(FSComp.SR.crefQuotationsCantContainThisType(),m)) - | CompiledTypeRepr.ILAsmNamed (tref,_boxity,_) -> + | _ -> + wfail(Error(FSComp.SR.crefQuotationsCantContainThisType(), m)) + | CompiledTypeRepr.ILAsmNamed (tref, _boxity, _) -> ConvILTypeRefUnadjusted cenv m tref and ConvReturnType cenv envinner m retTy = - match retTy with + match retTy with | None -> ConvVoidType cenv m | Some ty -> ConvType cenv envinner m ty -let ConvExprPublic cenv env e = - let astExpr = +let ConvExprPublic cenv env e = + let astExpr = let astExpr = ConvExpr cenv env e // always emit debug info for the top level expression cenv.emitDebugInfoInQuotations <- true @@ -1045,49 +1052,49 @@ let ConvExprPublic cenv env e = astExpr -let ConvMethodBase cenv env (methName, v:Val) = - let m = v.Range - let parentTyconR = ConvTyconRef cenv v.TopValDeclaringEntity m +let ConvMethodBase cenv env (methName, v:Val) = + let m = v.Range + let parentTyconR = ConvTyconRef cenv v.TopValDeclaringEntity m - match v.MemberInfo with - | Some vspr when not v.IsExtensionMember -> + match v.MemberInfo with + | Some vspr when not v.IsExtensionMember -> let vref = mkLocalValRef v - let tps,argInfos,retTy,_ = GetTypeOfMemberInMemberForm cenv.g vref + let tps, argInfos, retTy, _ = GetTypeOfMemberInMemberForm cenv.g vref let numEnclTypeArgs = vref.MemberApparentEntity.TyparsNoRange.Length - let argTys = argInfos |> List.concat |> List.map fst + let argTys = argInfos |> List.concat |> List.map fst let isNewObj = (vspr.MemberFlags.MemberKind = MemberKind.Constructor) - // The signature types are w.r.t. to the formal context - let envinner = BindFormalTypars env tps - let methArgTypesR = ConvTypes cenv envinner m argTys + // The signature types are w.r.t. to the formal context + let envinner = BindFormalTypars env tps + let methArgTypesR = ConvTypes cenv envinner m argTys let methRetTypeR = ConvReturnType cenv envinner m retTy - let numGenericArgs = tps.Length-numEnclTypeArgs + let numGenericArgs = tps.Length-numEnclTypeArgs - if isNewObj then - QP.MethodBaseData.Ctor - { ctorParent = parentTyconR + if isNewObj then + QP.MethodBaseData.Ctor + { ctorParent = parentTyconR ctorArgTypes = methArgTypesR } - else - QP.MethodBaseData.Method - { methParent = parentTyconR + else + QP.MethodBaseData.Method + { methParent = parentTyconR methArgTypes = methArgTypesR methRetType = methRetTypeR methName = methName numGenericArgs=numGenericArgs } - | _ when v.IsExtensionMember -> + | _ when v.IsExtensionMember -> - let tps,argInfos,retTy,_ = GetTopValTypeInCompiledForm cenv.g v.ValReprInfo.Value v.Type v.Range - let argTys = argInfos |> List.concat |> List.map fst - let envinner = BindFormalTypars env tps - let methArgTypesR = ConvTypes cenv envinner m argTys + let tps, argInfos, retTy, _ = GetTopValTypeInCompiledForm cenv.g v.ValReprInfo.Value v.Type v.Range + let argTys = argInfos |> List.concat |> List.map fst + let envinner = BindFormalTypars env tps + let methArgTypesR = ConvTypes cenv envinner m argTys let methRetTypeR = ConvReturnType cenv envinner m retTy let numGenericArgs = tps.Length - QP.MethodBaseData.Method + QP.MethodBaseData.Method { methParent = parentTyconR methArgTypes = methArgTypesR methRetType = methRetTypeR diff --git a/src/fsharp/SignatureConformance.fs b/src/fsharp/SignatureConformance.fs index a9db8a883a34dc5db7f2d5539703eea4c19882eb..a162a951595b89824f3de2524d2247760f96e9b8 100644 --- a/src/fsharp/SignatureConformance.fs +++ b/src/fsharp/SignatureConformance.fs @@ -37,8 +37,8 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = // Used when checking attributes. let sigToImplRemap = let remap = Remap.Empty - let remap = (remapInfo.RepackagedEntities,remap) ||> List.foldBack (fun (implTcref ,signTcref) acc -> addTyconRefRemap signTcref implTcref acc) - let remap = (remapInfo.RepackagedVals ,remap) ||> List.foldBack (fun (implValRef,signValRef) acc -> addValRemap signValRef.Deref implValRef.Deref acc) + let remap = (remapInfo.RepackagedEntities, remap) ||> List.foldBack (fun (implTcref , signTcref) acc -> addTyconRefRemap signTcref implTcref acc) + let remap = (remapInfo.RepackagedVals , remap) ||> List.foldBack (fun (implValRef, signValRef) acc -> addValRemap signValRef.Deref implValRef.Deref acc) remap // For all attributable elements (types, modules, exceptions, record fields, unions, parameters, generic type parameters) @@ -57,25 +57,25 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = let sigAttribs = sigAttribs |> List.map (remapAttrib g sigToImplRemap) // Helper to check for equality of evaluated attribute expressions - let attribExprEq (AttribExpr(_,e1)) (AttribExpr(_,e2)) = EvaledAttribExprEquality g e1 e2 + let attribExprEq (AttribExpr(_, e1)) (AttribExpr(_, e2)) = EvaledAttribExprEquality g e1 e2 // Helper to check for equality of evaluated named attribute arguments - let attribNamedArgEq (AttribNamedArg(nm1,ty1,isProp1,e1)) (AttribNamedArg(nm2,ty2,isProp2,e2)) = + let attribNamedArgEq (AttribNamedArg(nm1, ty1, isProp1, e1)) (AttribNamedArg(nm2, ty2, isProp2, e2)) = (nm1 = nm2) && typeEquiv g ty1 ty2 && (isProp1 = isProp2) && attribExprEq e1 e2 let attribsEq attrib1 attrib2 = - let (Attrib(implTcref,_,implArgs,implNamedArgs,_,_,_implRange)) = attrib1 - let (Attrib(signTcref,_,signArgs,signNamedArgs,_,_,_signRange)) = attrib2 + let (Attrib(implTcref, _, implArgs, implNamedArgs, _, _, _implRange)) = attrib1 + let (Attrib(signTcref, _, signArgs, signNamedArgs, _, _, _signRange)) = attrib2 tyconRefEq g signTcref implTcref && - (implArgs,signArgs) ||> List.lengthsEqAndForall2 attribExprEq && + (implArgs, signArgs) ||> List.lengthsEqAndForall2 attribExprEq && (implNamedArgs, signNamedArgs) ||> List.lengthsEqAndForall2 attribNamedArgEq let attribsHaveSameTycon attrib1 attrib2 = - let (Attrib(implTcref,_,_,_,_,_,_)) = attrib1 - let (Attrib(signTcref,_,_,_,_,_,_)) = attrib2 + let (Attrib(implTcref, _, _, _, _, _, _)) = attrib1 + let (Attrib(signTcref, _, _, _, _, _, _)) = attrib2 tyconRefEq g signTcref implTcref // For each implementation attribute, only keep if it is not mentioned in the signature. @@ -96,7 +96,7 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = let existsSimilarAttrib = sigAttribs |> List.exists (attribsHaveSameTycon implAttrib) if existsSimilarAttrib then - let (Attrib(implTcref,_,_,_,_,_,implRange)) = implAttrib + let (Attrib(implTcref, _, _, _, _, _, implRange)) = implAttrib warning(Error(FSComp.SR.tcAttribArgsDiffer(implTcref.DisplayName), implRange)) check keptImplAttribsRev remainingImplAttribs sigAttribs else @@ -109,11 +109,11 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = let rec checkTypars m (aenv: TypeEquivEnv) (implTypars:Typars) (sigTypars:Typars) = if implTypars.Length <> sigTypars.Length then - errorR (Error(FSComp.SR.typrelSigImplNotCompatibleParamCountsDiffer(),m)) + errorR (Error(FSComp.SR.typrelSigImplNotCompatibleParamCountsDiffer(), m)) false else let aenv = aenv.BindEquivTypars implTypars sigTypars - (implTypars,sigTypars) ||> List.forall2 (fun implTypar sigTypar -> + (implTypars, sigTypars) ||> List.forall2 (fun implTypar sigTypar -> let m = sigTypar.Range if implTypar.StaticReq <> sigTypar.StaticReq then errorR (Error(FSComp.SR.typrelSigImplNotCompatibleCompileTimeRequirementsDiffer(), m)) @@ -128,23 +128,23 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = implTypar.Constraints |> List.forall (fun implTyparCx -> match implTyparCx with // defaults can be dropped in the signature - | TyparConstraint.DefaultsTo(_,_acty,_) -> true + | TyparConstraint.DefaultsTo(_, _acty, _) -> true | _ -> if not (List.exists (typarConstraintsAEquiv g aenv implTyparCx) sigTypar.Constraints) - then (errorR(Error(FSComp.SR.typrelSigImplNotCompatibleConstraintsDiffer(sigTypar.Name, Layout.showL(NicePrint.layoutTyparConstraint denv (implTypar,implTyparCx))),m)); false) + then (errorR(Error(FSComp.SR.typrelSigImplNotCompatibleConstraintsDiffer(sigTypar.Name, Layout.showL(NicePrint.layoutTyparConstraint denv (implTypar, implTyparCx))), m)); false) else true) && // Check the constraints in the signature are present in the implementation sigTypar.Constraints |> List.forall (fun sigTyparCx -> match sigTyparCx with // defaults can be present in the signature and not in the implementation because they are erased - | TyparConstraint.DefaultsTo(_,_acty,_) -> true + | TyparConstraint.DefaultsTo(_, _acty, _) -> true // 'comparison' and 'equality' constraints can be present in the signature and not in the implementation because they are erased | TyparConstraint.SupportsComparison _ -> true | TyparConstraint.SupportsEquality _ -> true | _ -> if not (List.exists (fun implTyparCx -> typarConstraintsAEquiv g aenv implTyparCx sigTyparCx) implTypar.Constraints) then - (errorR(Error(FSComp.SR.typrelSigImplNotCompatibleConstraintsDifferRemove(sigTypar.Name, Layout.showL(NicePrint.layoutTyparConstraint denv (sigTypar,sigTyparCx))),m)); false) + (errorR(Error(FSComp.SR.typrelSigImplNotCompatibleConstraintsDifferRemove(sigTypar.Name, Layout.showL(NicePrint.layoutTyparConstraint denv (sigTypar, sigTyparCx))), m)); false) else true) && (not checkingSig || checkAttribs aenv implTypar.Attribs sigTypar.Attribs (fun attribs -> implTypar.SetAttribs attribs))) @@ -157,32 +157,32 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = implTycon.SetOtherRange (sigTycon.Range, false) if implTycon.LogicalName <> sigTycon.LogicalName then - errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleNamesDiffer(implTycon.TypeOrMeasureKind.ToString(),sigTycon.LogicalName,implTycon.LogicalName),m)) + errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleNamesDiffer(implTycon.TypeOrMeasureKind.ToString(), sigTycon.LogicalName, implTycon.LogicalName), m)) false else if implTycon.CompiledName <> sigTycon.CompiledName then - errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleNamesDiffer(implTycon.TypeOrMeasureKind.ToString(),sigTycon.CompiledName,implTycon.CompiledName),m)) + errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleNamesDiffer(implTycon.TypeOrMeasureKind.ToString(), sigTycon.CompiledName, implTycon.CompiledName), m)) false else - checkExnInfo (fun f -> ExnconstrNotContained(denv,implTycon,sigTycon,f)) aenv implTycon.ExceptionInfo sigTycon.ExceptionInfo && + checkExnInfo (fun f -> ExnconstrNotContained(denv, implTycon, sigTycon, f)) aenv implTycon.ExceptionInfo sigTycon.ExceptionInfo && let implTypars = implTycon.Typars m let sigTypars = sigTycon.Typars m if implTypars.Length <> sigTypars.Length then - errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleParameterCountsDiffer(implTycon.TypeOrMeasureKind.ToString(),implTycon.DisplayName),m)) + errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleParameterCountsDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)) false elif isLessAccessible implTycon.Accessibility sigTycon.Accessibility then - errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleAccessibilityDiffer(implTycon.TypeOrMeasureKind.ToString(),implTycon.DisplayName),m)) + errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleAccessibilityDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)) false else let aenv = aenv.BindEquivTypars implTypars sigTypars let aintfs = implTycon.ImmediateInterfaceTypesOfFSharpTycon let fintfs = sigTycon.ImmediateInterfaceTypesOfFSharpTycon - let aintfsUser = implTycon.TypeContents.tcaug_interfaces |> List.filter (fun (_,compgen,_) -> not compgen) |> List.map p13 + let aintfsUser = implTycon.TypeContents.tcaug_interfaces |> List.filter (fun (_, compgen, _) -> not compgen) |> List.map p13 let flatten tys = tys |> List.collect (AllSuperTypesOfType g amap m AllowMultiIntfInstantiations.Yes) @@ -194,55 +194,55 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = let unimpl = ListSet.subtract (fun fity aity -> typeAEquiv g aenv aity fity) fintfs aintfs (unimpl |> List.forall (fun ity -> - let errorMessage = FSComp.SR.DefinitionsInSigAndImplNotCompatibleMissingInterface(implTycon.TypeOrMeasureKind.ToString(),implTycon.DisplayName, NicePrint.minimalStringOfType denv ity) - errorR (Error(errorMessage,m)); false)) && + let errorMessage = FSComp.SR.DefinitionsInSigAndImplNotCompatibleMissingInterface(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, NicePrint.minimalStringOfType denv ity) + errorR (Error(errorMessage, m)); false)) && let aintfsUser = flatten aintfsUser let hidden = ListSet.subtract (typeAEquiv g aenv) aintfsUser fintfs - let continueChecks,warningOrError = if implTycon.IsFSharpInterfaceTycon then false,errorR else true,warning - (hidden |> List.forall (fun ity -> warningOrError (InterfaceNotRevealed(denv,ity,implTycon.Range)); continueChecks)) && + let continueChecks, warningOrError = if implTycon.IsFSharpInterfaceTycon then false, errorR else true, warning + (hidden |> List.forall (fun ity -> warningOrError (InterfaceNotRevealed(denv, ity, implTycon.Range)); continueChecks)) && let aNull = IsUnionTypeWithNullAsTrueValue g implTycon let fNull = IsUnionTypeWithNullAsTrueValue g sigTycon if aNull && not fNull then - errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationSaysNull(implTycon.TypeOrMeasureKind.ToString(),implTycon.DisplayName),m)) + errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationSaysNull(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)) false elif fNull && not aNull then - errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureSaysNull(implTycon.TypeOrMeasureKind.ToString(),implTycon.DisplayName),m)) + errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureSaysNull(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)) false else let aNull2 = TypeNullIsExtraValue g m (generalizedTyconRef (mkLocalTyconRef implTycon)) let fNull2 = TypeNullIsExtraValue g m (generalizedTyconRef (mkLocalTyconRef implTycon)) if aNull2 && not fNull2 then - errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationSaysNull2(implTycon.TypeOrMeasureKind.ToString(),implTycon.DisplayName),m)) + errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationSaysNull2(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)) false elif fNull2 && not aNull2 then - errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureSaysNull2(implTycon.TypeOrMeasureKind.ToString(),implTycon.DisplayName),m)) + errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureSaysNull2(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)) false else let aSealed = isSealedTy g (generalizedTyconRef (mkLocalTyconRef implTycon)) let fSealed = isSealedTy g (generalizedTyconRef (mkLocalTyconRef sigTycon)) if aSealed && not fSealed then - errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationSealed(implTycon.TypeOrMeasureKind.ToString(),implTycon.DisplayName),m)) + errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationSealed(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)) false elif not aSealed && fSealed then - errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationIsNotSealed(implTycon.TypeOrMeasureKind.ToString(),implTycon.DisplayName),m)) + errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationIsNotSealed(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)) false else let aPartial = isAbstractTycon implTycon let fPartial = isAbstractTycon sigTycon if aPartial && not fPartial then - errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationIsAbstract(implTycon.TypeOrMeasureKind.ToString(),implTycon.DisplayName),m)) + errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationIsAbstract(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)) false elif not aPartial && fPartial then - errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureIsAbstract(implTycon.TypeOrMeasureKind.ToString(),implTycon.DisplayName),m)) + errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureIsAbstract(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)) false elif not (typeAEquiv g aenv (superOfTycon g implTycon) (superOfTycon g sigTycon)) then - errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleTypesHaveDifferentBaseTypes(implTycon.TypeOrMeasureKind.ToString(),implTycon.DisplayName),m)) + errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleTypesHaveDifferentBaseTypes(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)) false else @@ -255,9 +255,9 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = and checkValInfo aenv err (implVal : Val) (sigVal : Val) = let id = implVal.Id match implVal.ValReprInfo, sigVal.ValReprInfo with - | _,None -> true + | _, None -> true | None, Some _ -> err(FSComp.SR.ValueNotContainedMutabilityArityNotInferred) - | Some (ValReprInfo (implTyparNames,implArgInfos,implRetInfo) as implValInfo), Some (ValReprInfo (sigTyparNames,sigArgInfos,sigRetInfo) as sigValInfo) -> + | Some (ValReprInfo (implTyparNames, implArgInfos, implRetInfo) as implValInfo), Some (ValReprInfo (sigTyparNames, sigArgInfos, sigRetInfo) as sigValInfo) -> let ntps = implTyparNames.Length let mtps = sigTyparNames.Length let nSigArgInfos = sigArgInfos.Length @@ -277,11 +277,11 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = // This ensures that the compiled form of the value matches the signature rather than // the implementation. This also propagates argument names from signature to implementation let res = - (implArgInfos,sigArgInfos) ||> List.forall2 (List.forall2 (fun implArgInfo sigArgInfo -> + (implArgInfos, sigArgInfos) ||> List.forall2 (List.forall2 (fun implArgInfo sigArgInfo -> checkAttribs aenv implArgInfo.Attribs sigArgInfo.Attribs (fun attribs -> match implArgInfo.Name, sigArgInfo.Name with | Some iname, Some sname when sname.idText <> iname.idText -> - warning(Error (FSComp.SR.ArgumentsInSigAndImplMismatch(sname.idText, iname.idText),iname.idRange)) + warning(Error (FSComp.SR.ArgumentsInSigAndImplMismatch(sname.idText, iname.idText), iname.idRange)) | _ -> () implArgInfo.Name <- sigArgInfo.Name @@ -291,7 +291,7 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = implRetInfo.Name <- sigRetInfo.Name implRetInfo.Attribs <- attribs) - implVal.SetValReprInfo (Some (ValReprInfo (sigTyparNames,implArgInfos,implRetInfo))) + implVal.SetValReprInfo (Some (ValReprInfo (sigTyparNames, implArgInfos, implRetInfo))) res and checkVal implModRef (aenv:TypeEquivEnv) (implVal:Val) (sigVal:Val) = @@ -300,7 +300,7 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = sigVal.SetOtherRange (implVal.Range, true) implVal.SetOtherRange (sigVal.Range, false) - let mk_err denv f = ValueNotContained(denv,implModRef,implVal,sigVal,f) + let mk_err denv f = ValueNotContained(denv, implModRef, implVal, sigVal, f) let err denv f = errorR(mk_err denv f); false let m = implVal.Range if implVal.IsMutable <> sigVal.IsMutable then (err denv FSComp.SR.ValueNotContainedMutabilityAttributesDiffer) @@ -312,20 +312,20 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = elif implVal.LiteralValue <> sigVal.LiteralValue then (err denv FSComp.SR.ValueNotContainedMutabilityLiteralConstantValuesDiffer) elif implVal.IsTypeFunction <> sigVal.IsTypeFunction then (err denv FSComp.SR.ValueNotContainedMutabilityOneIsTypeFunction) else - let implTypars,atau = implVal.TypeScheme - let sigTypars,ftau = sigVal.TypeScheme + let implTypars, atau = implVal.TypeScheme + let sigTypars, ftau = sigVal.TypeScheme if implTypars.Length <> sigTypars.Length then (err {denv with showTyparBinding=true} FSComp.SR.ValueNotContainedMutabilityParameterCountsDiffer) else let aenv = aenv.BindEquivTypars implTypars sigTypars checkTypars m aenv implTypars sigTypars && if not (typeAEquiv g aenv atau ftau) then err denv (FSComp.SR.ValueNotContainedMutabilityTypesDiffer) elif not (checkValInfo aenv (err denv) implVal sigVal) then false elif not (implVal.IsExtensionMember = sigVal.IsExtensionMember) then err denv (FSComp.SR.ValueNotContainedMutabilityExtensionsDiffer) - elif not (checkMemberDatasConform (err denv) (implVal.Attribs, implVal,implVal.MemberInfo) (sigVal.Attribs,sigVal,sigVal.MemberInfo)) then false + elif not (checkMemberDatasConform (err denv) (implVal.Attribs, implVal, implVal.MemberInfo) (sigVal.Attribs, sigVal, sigVal.MemberInfo)) then false else checkAttribs aenv implVal.Attribs sigVal.Attribs (fun attribs -> implVal.SetAttribs attribs) and checkExnInfo err aenv implTypeRepr sigTypeRepr = - match implTypeRepr,sigTypeRepr with + match implTypeRepr, sigTypeRepr with | TExnAsmRepr _, TExnFresh _ -> (errorR (err FSComp.SR.ExceptionDefsNotCompatibleHiddenBySignature); false) | TExnAsmRepr tcr1, TExnAsmRepr tcr2 -> @@ -337,12 +337,12 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = (errorR (err FSComp.SR.ExceptionDefsNotCompatibleSignaturesDiffer); false) else true | TExnFresh r1, TExnFresh r2-> checkRecordFieldsForExn g denv err aenv r1 r2 - | TExnNone,TExnNone -> true + | TExnNone, TExnNone -> true | _ -> (errorR (err FSComp.SR.ExceptionDefsNotCompatibleExceptionDeclarationsDiffer); false) and checkUnionCase aenv implUnionCase sigUnionCase = - let err f = errorR(ConstrNotContained(denv,implUnionCase,sigUnionCase,f));false + let err f = errorR(ConstrNotContained(denv, implUnionCase, sigUnionCase, f));false sigUnionCase.OtherRangeOpt <- Some (implUnionCase.Range, true) implUnionCase.OtherRangeOpt <- Some (sigUnionCase.Range, false) if implUnionCase.Id.idText <> sigUnionCase.Id.idText then err FSComp.SR.ModuleContainsConstructorButNamesDiffer @@ -352,7 +352,7 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = else checkAttribs aenv implUnionCase.Attribs sigUnionCase.Attribs (fun attribs -> implUnionCase.Attribs <- attribs) and checkField aenv implField sigField = - let err f = errorR(FieldNotContained(denv,implField,sigField,f)); false + let err f = errorR(FieldNotContained(denv, implField, sigField, f)); false sigField.rfield_other_range <- Some (implField.Range, true) implField.rfield_other_range <- Some (sigField.Range, false) if implField.rfield_id.idText <> sigField.rfield_id.idText then err FSComp.SR.FieldNotContainedNamesDiffer @@ -365,9 +365,9 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = checkAttribs aenv implField.FieldAttribs sigField.FieldAttribs (fun attribs -> implField.rfield_fattribs <- attribs) && checkAttribs aenv implField.PropertyAttribs sigField.PropertyAttribs (fun attribs -> implField.rfield_pattribs <- attribs) - and checkMemberDatasConform err (_implAttrs,implVal,implMemberInfo) (_sigAttrs, sigVal,sigMemberInfo) = - match implMemberInfo,sigMemberInfo with - | None,None -> true + and checkMemberDatasConform err (_implAttrs, implVal, implMemberInfo) (_sigAttrs, sigVal, sigMemberInfo) = + match implMemberInfo, sigMemberInfo with + | None, None -> true | Some implMembInfo, Some sigMembInfo -> if not (implVal.CompiledName = sigVal.CompiledName) then err(FSComp.SR.ValueNotContainedMutabilityDotNetNamesDiffer) @@ -414,17 +414,17 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = let m1 = implFields |> NameMap.ofKeyedList (fun rfld -> rfld.Name) let m2 = sigFields |> NameMap.ofKeyedList (fun rfld -> rfld.Name) NameMap.suball2 - (fun fieldName _ -> errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldRequiredButNotSpecified(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, fieldName),m)); false) + (fun fieldName _ -> errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldRequiredButNotSpecified(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, fieldName), m)); false) (checkField aenv) m1 m2 && NameMap.suball2 - (fun fieldName _ -> errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldWasPresent(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, fieldName),m)); false) + (fun fieldName _ -> errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldWasPresent(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, fieldName), m)); false) (fun x y -> checkField aenv y x) m2 m1 && // This check is required because constructors etc. are externally visible // and thus compiled representations do pick up dependencies on the field order (if List.forall2 (checkField aenv) implFields sigFields then true - else (errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldOrderDiffer(implTycon.TypeOrMeasureKind.ToString(),implTycon.DisplayName),m)); false)) + else (errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldOrderDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false)) and checkRecordFieldsForExn _g _denv err aenv (implFields:TyconRecdFields) (sigFields:TyconRecdFields) = let implFields = implFields.TrueFieldsAsList @@ -442,15 +442,15 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = and checkVirtualSlots denv m (implTycon:Tycon) implAbstractSlots sigAbstractSlots = let m1 = NameMap.ofKeyedList (fun (v:ValRef) -> v.DisplayName) implAbstractSlots let m2 = NameMap.ofKeyedList (fun (v:ValRef) -> v.DisplayName) sigAbstractSlots - (m1,m2) ||> NameMap.suball2 (fun _s vref -> + (m1, m2) ||> NameMap.suball2 (fun _s vref -> let kindText = implTycon.TypeOrMeasureKind.ToString() let valText = NicePrint.stringValOrMember denv vref.Deref - errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleAbstractMemberMissingInImpl(kindText, implTycon.DisplayName, valText),m)); false) (fun _x _y -> true) && + errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleAbstractMemberMissingInImpl(kindText, implTycon.DisplayName, valText), m)); false) (fun _x _y -> true) && - (m2,m1) ||> NameMap.suball2 (fun _s vref -> + (m2, m1) ||> NameMap.suball2 (fun _s vref -> let kindText = implTycon.TypeOrMeasureKind.ToString() let valText = NicePrint.stringValOrMember denv vref.Deref - errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleAbstractMemberMissingInSig(kindText, implTycon.DisplayName, valText),m)); false) (fun _x _y -> true) + errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleAbstractMemberMissingInSig(kindText, implTycon.DisplayName, valText), m)); false) (fun _x _y -> true) and checkClassFields isStruct m aenv (implTycon:Tycon) (implFields:TyconRecdFields) (sigFields:TyconRecdFields) = let implFields = implFields.TrueFieldsAsList @@ -458,11 +458,11 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = let m1 = implFields |> NameMap.ofKeyedList (fun rfld -> rfld.Name) let m2 = sigFields |> NameMap.ofKeyedList (fun rfld -> rfld.Name) NameMap.suball2 - (fun fieldName _ -> errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldRequiredButNotSpecified(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, fieldName),m)); false) + (fun fieldName _ -> errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldRequiredButNotSpecified(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, fieldName), m)); false) (checkField aenv) m1 m2 && (if isStruct then NameMap.suball2 - (fun fieldName _ -> warning(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldIsInImplButNotSig(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, fieldName),m)); true) + (fun fieldName _ -> warning(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldIsInImplButNotSig(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, fieldName), m)); true) (fun x y -> checkField aenv y x) m2 m1 else true) @@ -475,11 +475,11 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = match Zset.elements (Zset.diff aset fset) with | [] -> match Zset.elements (Zset.diff fset aset) with - | [] -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleNumbersDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, k),m)); false) - | l -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureDefinesButImplDoesNot(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, k, String.concat ";" l),m)); false) - | l -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplDefinesButSignatureDoesNot(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, k, String.concat ";" l),m)); false) + | [] -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleNumbersDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, k), m)); false) + | l -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureDefinesButImplDoesNot(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, k, String.concat ";" l), m)); false) + | l -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplDefinesButSignatureDoesNot(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, k, String.concat ";" l), m)); false) - match implTycon.TypeReprInfo,sigTypeRepr with + match implTycon.TypeReprInfo, sigTypeRepr with | (TRecdRepr _ | TUnionRepr _ | TILObjectRepr _ @@ -491,13 +491,13 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = | (TFSharpObjectRepr r), TNoRepr -> match r.fsobjmodel_kind with | TTyconStruct | TTyconEnum -> - (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplDefinesStruct(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName),m)); false) + (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplDefinesStruct(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false) | _ -> true | (TAsmRepr _), TNoRepr -> - (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleDotNetTypeRepresentationIsHidden(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName),m)); false) + (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleDotNetTypeRepresentationIsHidden(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false) | (TMeasureableRepr _), TNoRepr -> - (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleTypeIsHidden(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName),m)); false) + (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleTypeIsHidden(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false) | (TUnionRepr r1), (TUnionRepr r2) -> let ucases1 = r1.UnionCasesAsList let ucases2 = r2.UnionCasesAsList @@ -508,13 +508,13 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = | (TRecdRepr implFields), (TRecdRepr sigFields) -> checkRecordFields m aenv implTycon implFields sigFields | (TFSharpObjectRepr r1), (TFSharpObjectRepr r2) -> - if not (match r1.fsobjmodel_kind,r2.fsobjmodel_kind with - | TTyconClass,TTyconClass -> true - | TTyconInterface,TTyconInterface -> true - | TTyconStruct,TTyconStruct -> true + if not (match r1.fsobjmodel_kind, r2.fsobjmodel_kind with + | TTyconClass, TTyconClass -> true + | TTyconInterface, TTyconInterface -> true + | TTyconStruct, TTyconStruct -> true | TTyconEnum, TTyconEnum -> true - | TTyconDelegate (TSlotSig(_,typ1,ctps1,mtps1,ps1, rty1)), - TTyconDelegate (TSlotSig(_,typ2,ctps2,mtps2,ps2, rty2)) -> + | TTyconDelegate (TSlotSig(_, typ1, ctps1, mtps1, ps1, rty1)), + TTyconDelegate (TSlotSig(_, typ2, ctps2, mtps2, ps2, rty2)) -> (typeAEquiv g aenv typ1 typ2) && (ctps1.Length = ctps2.Length) && (let aenv = aenv.BindEquivTypars ctps1 ctps2 @@ -522,69 +522,69 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = (mtps1.Length = mtps2.Length) && (let aenv = aenv.BindEquivTypars mtps1 mtps2 (typarsAEquiv g aenv mtps1 mtps2) && - ((ps1,ps2) ||> List.lengthsEqAndForall2 (List.lengthsEqAndForall2 (fun p1 p2 -> typeAEquiv g aenv p1.Type p2.Type))) && + ((ps1, ps2) ||> List.lengthsEqAndForall2 (List.lengthsEqAndForall2 (fun p1 p2 -> typeAEquiv g aenv p1.Type p2.Type))) && (returnTypesAEquiv g aenv rty1 rty2))) - | _,_ -> false) then - (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleTypeIsDifferentKind(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName),m)); false) + | _, _ -> false) then + (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleTypeIsDifferentKind(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false) else let isStruct = (match r1.fsobjmodel_kind with TTyconStruct -> true | _ -> false) checkClassFields isStruct m aenv implTycon r1.fsobjmodel_rfields r2.fsobjmodel_rfields && checkVirtualSlots denv m implTycon r1.fsobjmodel_vslots r2.fsobjmodel_vslots | (TAsmRepr tcr1), (TAsmRepr tcr2) -> - if tcr1 <> tcr2 then (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleILDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName),m)); false) else true + if tcr1 <> tcr2 then (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleILDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false) else true | (TMeasureableRepr ty1), (TMeasureableRepr ty2) -> - if typeAEquiv g aenv ty1 ty2 then true else (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleRepresentationsDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName),m)); false) + if typeAEquiv g aenv ty1 ty2 then true else (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleRepresentationsDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false) | TNoRepr, TNoRepr -> true #if !NO_EXTENSIONTYPING | TProvidedTypeExtensionPoint info1 , TProvidedTypeExtensionPoint info2 -> - Tainted.EqTainted info1.ProvidedType.TypeProvider info2.ProvidedType.TypeProvider && ProvidedType.TaintedEquals(info1.ProvidedType,info2.ProvidedType) + Tainted.EqTainted info1.ProvidedType.TypeProvider info2.ProvidedType.TypeProvider && ProvidedType.TaintedEquals(info1.ProvidedType, info2.ProvidedType) | TProvidedNamespaceExtensionPoint _, TProvidedNamespaceExtensionPoint _ -> System.Diagnostics.Debug.Assert(false, "unreachable: TProvidedNamespaceExtensionPoint only on namespaces, not types" ) true #endif - | TNoRepr, _ -> (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleRepresentationsDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName),m)); false) - | _, _ -> (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleRepresentationsDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName),m)); false) + | TNoRepr, _ -> (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleRepresentationsDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false) + | _, _ -> (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleRepresentationsDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false) and checkTypeAbbrev m aenv (implTycon:Tycon) (sigTycon:Tycon) = let kind1 = implTycon.TypeOrMeasureKind let kind2 = sigTycon.TypeOrMeasureKind - if kind1 <> kind2 then (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureDeclaresDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, kind2.ToString(), kind1.ToString()),m)); false) + if kind1 <> kind2 then (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureDeclaresDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, kind2.ToString(), kind1.ToString()), m)); false) else - match implTycon.TypeAbbrev,sigTycon.TypeAbbrev with + match implTycon.TypeAbbrev, sigTycon.TypeAbbrev with | Some ty1, Some ty2 -> if not (typeAEquiv g aenv ty1 ty2) then let s1, s2, _ = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 - errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleAbbreviationsDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, s1, s2),m)) + errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleAbbreviationsDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, s1, s2), m)) false else true - | None,None -> true - | Some _, None -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleAbbreviationHiddenBySig(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName),m)); false) - | None, Some _ -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleSigHasAbbreviation(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName),m)); false) + | None, None -> true + | Some _, None -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleAbbreviationHiddenBySig(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false) + | None, Some _ -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleSigHasAbbreviation(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false) and checkModuleOrNamespaceContents m aenv (implModRef:ModuleOrNamespaceRef) (signModType:ModuleOrNamespaceType) = let implModType = implModRef.ModuleOrNamespaceType - (if implModType.ModuleOrNamespaceKind <> signModType.ModuleOrNamespaceKind then errorR(Error(FSComp.SR.typrelModuleNamespaceAttributesDifferInSigAndImpl(),m))) + (if implModType.ModuleOrNamespaceKind <> signModType.ModuleOrNamespaceKind then errorR(Error(FSComp.SR.typrelModuleNamespaceAttributesDifferInSigAndImpl(), m))) (implModType.TypesByMangledName , signModType.TypesByMangledName) ||> NameMap.suball2 - (fun s _fx -> errorR(RequiredButNotSpecified(denv,implModRef,"type",(fun os -> Printf.bprintf os "%s" s),m)); false) + (fun s _fx -> errorR(RequiredButNotSpecified(denv, implModRef, "type", (fun os -> Printf.bprintf os "%s" s), m)); false) (checkTypeDef aenv) && (implModType.ModulesAndNamespacesByDemangledName, signModType.ModulesAndNamespacesByDemangledName ) ||> NameMap.suball2 - (fun s fx -> errorR(RequiredButNotSpecified(denv,implModRef,(if fx.IsModule then "module" else "namespace"),(fun os -> Printf.bprintf os "%s" s),m)); false) + (fun s fx -> errorR(RequiredButNotSpecified(denv, implModRef, (if fx.IsModule then "module" else "namespace"), (fun os -> Printf.bprintf os "%s" s), m)); false) (fun x1 x2 -> checkModuleOrNamespace aenv (mkLocalModRef x1) x2) && let sigValHadNoMatchingImplementation (fx:Val) (_closeActualVal: Val option) = - errorR(RequiredButNotSpecified(denv,implModRef,"value",(fun os -> + errorR(RequiredButNotSpecified(denv, implModRef, "value", (fun os -> (* In the case of missing members show the full required enclosing type and signature *) if fx.IsMember then NicePrint.outputQualifiedValOrMember denv os fx else - Printf.bprintf os "%s" fx.DisplayName),m)) + Printf.bprintf os "%s" fx.DisplayName), m)) let valuesPartiallyMatch (av:Val) (fv:Val) = let akey = av.GetLinkagePartialKey() @@ -597,9 +597,9 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = ||> NameMap.suball2 (fun _s (fxs:Val list) -> sigValHadNoMatchingImplementation fxs.Head None; false) (fun avs fvs -> - match avs,fvs with - | [],_ | _,[] -> failwith "unreachable" - | [av],[fv] -> + match avs, fvs with + | [], _ | _, [] -> failwith "unreachable" + | [av], [fv] -> if valuesPartiallyMatch av fv then checkVal implModRef aenv av fv else @@ -611,19 +611,19 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = fvs |> List.choose (fun fv -> match avs |> List.tryFind (fun av -> valLinkageAEquiv g aenv av fv) with | None -> None - | Some av -> Some(fv,av)) + | Some av -> Some(fv, av)) // Check the ones with matching linkage - let allPairsOk = matchingPairs |> List.map (fun (fv,av) -> checkVal implModRef aenv av fv) |> List.forall id + let allPairsOk = matchingPairs |> List.map (fun (fv, av) -> checkVal implModRef aenv av fv) |> List.forall id let someNotOk = matchingPairs.Length < fvs.Length // Report an error for those that don't. Try pairing up by enclosing-type/name if someNotOk then - let noMatches,partialMatchingPairs = + let noMatches, partialMatchingPairs = fvs |> List.splitChoose (fun fv -> match avs |> List.tryFind (fun av -> valuesPartiallyMatch av fv) with | None -> Choice1Of2 fv - | Some av -> Choice2Of2(fv,av)) - for (fv,av) in partialMatchingPairs do + | Some av -> Choice2Of2(fv, av)) + for (fv, av) in partialMatchingPairs do checkVal implModRef aenv av fv |> ignore for fv in noMatches do sigValHadNoMatchingImplementation fv None @@ -649,26 +649,26 @@ let rec CheckNamesOfModuleOrNamespaceContents denv (implModRef:ModuleOrNamespace let m = implModRef.Range let implModType = implModRef.ModuleOrNamespaceType NameMap.suball2 - (fun s _fx -> errorR(RequiredButNotSpecified(denv,implModRef,"type",(fun os -> Printf.bprintf os "%s" s),m)); false) + (fun s _fx -> errorR(RequiredButNotSpecified(denv, implModRef, "type", (fun os -> Printf.bprintf os "%s" s), m)); false) (fun _ _ -> true) implModType.TypesByMangledName signModType.TypesByMangledName && (implModType.ModulesAndNamespacesByDemangledName, signModType.ModulesAndNamespacesByDemangledName ) ||> NameMap.suball2 - (fun s fx -> errorR(RequiredButNotSpecified(denv,implModRef,(if fx.IsModule then "module" else "namespace"),(fun os -> Printf.bprintf os "%s" s),m)); false) + (fun s fx -> errorR(RequiredButNotSpecified(denv, implModRef, (if fx.IsModule then "module" else "namespace"), (fun os -> Printf.bprintf os "%s" s), m)); false) (fun x1 (x2:ModuleOrNamespace) -> CheckNamesOfModuleOrNamespace denv (mkLocalModRef x1) x2.ModuleOrNamespaceType) && (implModType.AllValsAndMembersByLogicalNameUncached , signModType.AllValsAndMembersByLogicalNameUncached) ||> NameMap.suball2 (fun _s (fxs:Val list) -> let fx = fxs.Head - errorR(RequiredButNotSpecified(denv,implModRef,"value",(fun os -> + errorR(RequiredButNotSpecified(denv, implModRef, "value", (fun os -> // In the case of missing members show the full required enclosing type and signature if Option.isSome fx.MemberInfo then NicePrint.outputQualifiedValOrMember denv os fx else - Printf.bprintf os "%s" fx.DisplayName),m)); false) + Printf.bprintf os "%s" fx.DisplayName), m)); false) (fun _ _ -> true) diff --git a/src/fsharp/SimulatedMSBuildReferenceResolver.fs b/src/fsharp/SimulatedMSBuildReferenceResolver.fs index 387611b6c3e5e2d92f257e5db2e99a026255666a..cf0aeecf80e5d800f4e1ca691c4471355877f76d 100644 --- a/src/fsharp/SimulatedMSBuildReferenceResolver.fs +++ b/src/fsharp/SimulatedMSBuildReferenceResolver.fs @@ -16,14 +16,14 @@ open FSharp.Compiler.AbstractIL.Internal.Library let internal SimulatedMSBuildResolver = let supportedFrameworks = [| - "v4.7.2"; - "v4.7.1"; - "v4.7"; - "v4.6.2"; - "v4.6.1"; - "v4.6"; - "v4.5.1"; - "v4.5"; + "v4.7.2" + "v4.7.1" + "v4.7" + "v4.6.2" + "v4.6.1" + "v4.6" + "v4.5.1" + "v4.5" "v4.0" |] { new Resolver with @@ -52,7 +52,7 @@ let internal SimulatedMSBuildResolver = #if !FX_NO_WIN_REGISTRY let registrySearchPaths() = - [ let registryKey = @"Software\Microsoft\.NetFramework"; + [ let registryKey = @"Software\Microsoft\.NetFramework" use key = Registry.LocalMachine.OpenSubKey(registryKey) match key with | null -> () diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 8c8973add230555205690ff77eaff8746b3ba7c0..8d659f54aed5b5eb88cb6d511197cfcbffb1ccb4 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -99,7 +99,7 @@ type Remap = removeTraitSolutions: bool } let emptyRemap = - { tpinst = emptyTyparInst; + { tpinst = emptyTyparInst tyconRefRemap = emptyTyconRefRemap valRemap = ValMap.Empty removeTraitSolutions = false } @@ -142,10 +142,10 @@ let instMeasureTyparRef tpinst unt (tp:Typar) = loop tpinst | _ -> failwith "instMeasureTyparRef: kind=Type" -let remapTyconRef (tcmap: TyconRefMap<_>) tcr = - match tcmap.TryFind tcr with - | Some tcr -> tcr - | None -> tcr +let remapTyconRef (tcmap: TyconRefMap<_>) tcref = + match tcmap.TryFind tcref with + | Some tcref -> tcref + | None -> tcref let remapUnionCaseRef tcmap (UCRef(tcref, nm)) = UCRef(remapTyconRef tcmap tcref, nm) let remapRecdFieldRef tcmap (RFRef(tcref, nm)) = RFRef(remapTyconRef tcmap tcref, nm) @@ -153,7 +153,7 @@ let remapRecdFieldRef tcmap (RFRef(tcref, nm)) = RFRef(remapTyconRef tcmap tcref let mkTyparInst (typars: Typars) tyargs = #if CHECKED if List.length typars <> List.length tyargs then - failwith ("mkTyparInst: invalid type" + (sprintf " %d <> %d" (List.length typars) (List.length tyargs))); + failwith ("mkTyparInst: invalid type" + (sprintf " %d <> %d" (List.length typars) (List.length tyargs))) #endif (List.zip typars tyargs : TyparInst) @@ -164,9 +164,9 @@ let rec remapTypeAux (tyenv : Remap) (ty:TType) = let ty = stripTyparEqns ty match ty with | TType_var tp as ty -> instTyparRef tyenv.tpinst ty tp - | TType_app (tcr, tinst) as ty -> - match tyenv.tyconRefRemap.TryFind tcr with - | Some tcr' -> TType_app (tcr', remapTypesAux tyenv tinst) + | TType_app (tcref, tinst) as ty -> + match tyenv.tyconRefRemap.TryFind tcref with + | Some tcref' -> TType_app (tcref', remapTypesAux tyenv tinst) | None -> match tinst with | [] -> ty // optimization to avoid re-allocation of TType_app node in the common case @@ -174,12 +174,12 @@ let rec remapTypeAux (tyenv : Remap) (ty:TType) = // avoid reallocation on idempotent let tinst' = remapTypesAux tyenv tinst if tinst === tinst' then ty else - TType_app (tcr, tinst') + TType_app (tcref, tinst') - | TType_ucase (UCRef(tcr, n), tinst) -> - match tyenv.tyconRefRemap.TryFind tcr with - | Some tcr' -> TType_ucase (UCRef(tcr', n), remapTypesAux tyenv tinst) - | None -> TType_ucase (UCRef(tcr, n), remapTypesAux tyenv tinst) + | TType_ucase (UCRef(tcref, n), tinst) -> + match tyenv.tyconRefRemap.TryFind tcref with + | Some tcref' -> TType_ucase (UCRef(tcref', n), remapTypesAux tyenv tinst) + | None -> TType_ucase (UCRef(tcref, n), remapTypesAux tyenv tinst) | TType_anon (anonInfo, l) as ty -> let tupInfo' = remapTupInfoAux tyenv anonInfo.TupInfo @@ -210,9 +210,9 @@ let rec remapTypeAux (tyenv : Remap) (ty:TType) = and remapMeasureAux tyenv unt = match unt with | Measure.One -> unt - | Measure.Con tcr -> - match tyenv.tyconRefRemap.TryFind tcr with - | Some tcr -> Measure.Con tcr + | Measure.Con tcref -> + match tyenv.tyconRefRemap.TryFind tcref with + | Some tcref -> Measure.Con tcref | None -> unt | Measure.Prod(u1, u2) -> Measure.Prod(remapMeasureAux tyenv u1, remapMeasureAux tyenv u2) | Measure.RationalPower(u, q) -> Measure.RationalPower(remapMeasureAux tyenv u, q) @@ -688,7 +688,7 @@ let applyTyconAbbrev abbrevTy tycon tyargs = let reduceTyconAbbrev (tycon:Tycon) tyargs = let abbrev = tycon.TypeAbbrev match abbrev with - | None -> invalidArg "tycon" "this type definition is not an abbreviation"; + | None -> invalidArg "tycon" "this type definition is not an abbreviation" | Some abbrevTy -> applyTyconAbbrev abbrevTy tycon tyargs @@ -780,7 +780,6 @@ let rec stripExnEqns (eref:TyconRef) = | TExnAbbrevRepr eref -> stripExnEqns eref | _ -> exnc - let primDestForallTy g ty = ty |> stripTyEqns g |> (function TType_forall (tyvs, tau) -> (tyvs, tau) | _ -> failwith "primDestForallTy: not a forall type") let destFunTy g ty = ty |> stripTyEqns g |> (function TType_fun (tyv, tau) -> (tyv, tau) | _ -> failwith "destFunTy: not a function type") let destAnyTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo, l) -> tupInfo, l | _ -> failwith "destAnyTupleTy: not a tuple type") @@ -796,12 +795,12 @@ let isRefTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupIn let isStructTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo, _) -> evalTupInfoIsStruct tupInfo | _ -> false) let isAnonRecdTy g ty = ty |> stripTyEqns g |> (function TType_anon _ -> true | _ -> false) let isStructAnonRecdTy g ty = ty |> stripTyEqns g |> (function TType_anon (anonInfo, _) -> evalAnonInfoIsStruct anonInfo | _ -> false) -let isUnionTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr, _) -> tcr.IsUnionTycon | _ -> false) -let isReprHiddenTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr, _) -> tcr.IsHiddenReprTycon | _ -> false) -let isFSharpObjModelTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr, _) -> tcr.IsFSharpObjectModelTycon | _ -> false) -let isRecdTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr, _) -> tcr.IsRecordTycon | _ -> false) -let isFSharpStructOrEnumTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr, _) -> tcr.IsFSharpStructOrEnumTycon | _ -> false) -let isFSharpEnumTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr, _) -> tcr.IsFSharpEnumTycon | _ -> false) +let isUnionTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsUnionTycon | _ -> false) +let isReprHiddenTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsHiddenReprTycon | _ -> false) +let isFSharpObjModelTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsFSharpObjectModelTycon | _ -> false) +let isRecdTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsRecordTycon | _ -> false) +let isFSharpStructOrEnumTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsFSharpStructOrEnumTycon | _ -> false) +let isFSharpEnumTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsFSharpEnumTycon | _ -> false) let isTyparTy g ty = ty |> stripTyEqns g |> (function TType_var _ -> true | _ -> false) let isAnyParTy g ty = ty |> stripTyEqns g |> (function TType_var _ -> true | TType_measure unt -> isUnitParMeasure g unt | _ -> false) let isMeasureTy g ty = ty |> stripTyEqns g |> (function TType_measure _ -> true | _ -> false) @@ -843,12 +842,12 @@ let tryNiceEntityRefOfTyOption ty = let (|NullableTy|_|) g ty = match tryAppTy g ty with - | ValueSome (tcr, [tyarg]) when tyconRefEq g tcr g.system_Nullable_tcref -> Some tyarg + | ValueSome (tcref, [tyarg]) when tyconRefEq g tcref g.system_Nullable_tcref -> Some tyarg | _ -> None let (|StripNullableTy|) g ty = match tryAppTy g ty with - | ValueSome (tcr, [tyarg]) when tyconRefEq g tcr g.system_Nullable_tcref -> tyarg + | ValueSome (tcref, [tyarg]) when tyconRefEq g tcref g.system_Nullable_tcref -> tyarg | _ -> ty let mkInstForAppTy g ty = @@ -1076,10 +1075,15 @@ let unionCaseRefOrder = //--------------------------------------------------------------------------- let mkFunTy d r = TType_fun (d, r) + let (-->) d r = mkFunTy d r + let mkForallTy d r = TType_forall (d, r) + let mkForallTyIfNeeded d r = if isNil d then r else mkForallTy d r + let (+->) d r = mkForallTyIfNeeded d r + let mkIteratedFunTy dl r = List.foldBack (-->) dl r let mkLambdaArgTy m tys = @@ -1105,7 +1109,7 @@ let ensureCcuHasModuleOrNamespaceAtPath (ccu:CcuThunk) path (CompPath(_, cpath)) let modName = hpath.idText if not (Map.containsKey modName mtype.AllEntitiesByCompiledAndLogicalMangledNames) then let smodul = NewModuleOrNamespace (Some(CompPath(scoref, prior_cpath))) taccessPublic hpath xml [] (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType mkind)) - mtype.AddModuleOrNamespaceByMutation(smodul); + mtype.AddModuleOrNamespaceByMutation(smodul) let modul = Map.find modName mtype.AllEntitiesByCompiledAndLogicalMangledNames loop (prior_cpath@[(modName, Namespace)]) tpath tcpath modul @@ -1494,7 +1498,6 @@ let destForallTy g ty = let tryDestForallTy g ty = if isForallTy g ty then destForallTy g ty else [], ty - let rec stripFunTy g ty = if isFunTy g ty then let (d, r) = destFunTy g ty @@ -1524,7 +1527,7 @@ let formalApplyTys g functy (tyargs, args) = args let rec stripFunTyN g n ty = - assert (n >= 0); + assert (n >= 0) if n > 0 && isFunTy g ty then let (d, r) = destFunTy g ty let more, rty = stripFunTyN g (n-1) r in d::more, rty @@ -1557,7 +1560,7 @@ let GetTopTauTypeInFSharpForm g (curriedArgInfos: ArgReprInfo list list) tau m = let destTopForallTy g (ValReprInfo (ntps, _, _)) ty = let tps, tau = (if isNil ntps then [], ty else tryDestForallTy g ty) #if CHECKED - if tps.Length <> kinds.Length then failwith (sprintf "destTopForallTy: internal error, #tps = %d, #ntps = %d" (List.length tps) ntps); + if tps.Length <> kinds.Length then failwith (sprintf "destTopForallTy: internal error, #tps = %d, #ntps = %d" (List.length tps) ntps) #endif // tps may be have been equated to other tps in equi-recursive type inference. Normalize them here let tps = NormalizeDeclaredTyparsForEquiRecursiveInference g tps @@ -1565,9 +1568,8 @@ let destTopForallTy g (ValReprInfo (ntps, _, _)) ty = let GetTopValTypeInFSharpForm g (ValReprInfo(_, argInfos, retInfo) as topValInfo) ty m = let tps, tau = destTopForallTy g topValInfo ty - let argtysl, rty = GetTopTauTypeInFSharpForm g argInfos tau m - tps, argtysl, rty, retInfo - + let curriedArgTys, returnTy = GetTopTauTypeInFSharpForm g argInfos tau m + tps, curriedArgTys, returnTy, retInfo let IsCompiledAsStaticProperty g (v:Val) = match v.ValReprInfo with @@ -1584,12 +1586,12 @@ let IsCompiledAsStaticPropertyWithField g (v:Val) = // Multi-dimensional array types... //------------------------------------------------------------------------- -let isArrayTyconRef (g:TcGlobals) tcr = +let isArrayTyconRef (g:TcGlobals) tcref = g.il_arr_tcr_map - |> Array.exists (tyconRefEq g tcr) + |> Array.exists (tyconRefEq g tcref) -let rankOfArrayTyconRef (g:TcGlobals) tcr = - match g.il_arr_tcr_map |> Array.tryFindIndex (tyconRefEq g tcr) with +let rankOfArrayTyconRef (g:TcGlobals) tcref = + match g.il_arr_tcr_map |> Array.tryFindIndex (tyconRefEq g tcref) with | Some idx -> idx + 1 | None -> @@ -1698,8 +1700,8 @@ let rankOfArrayTy g ty = rankOfArrayTyconRef g (tcrefOfAppTy g ty) let isFSharpObjModelRefTy g ty = isFSharpObjModelTy g ty && - let tcr = tcrefOfAppTy g ty - match tcr.FSharpObjectModelTypeInfo.fsobjmodel_kind with + let tcref = tcrefOfAppTy g ty + match tcref.FSharpObjectModelTypeInfo.fsobjmodel_kind with | TTyconClass | TTyconInterface | TTyconDelegate _ -> true | TTyconStruct | TTyconEnum -> false @@ -1935,7 +1937,7 @@ let CollectAllNoCaching = includeLocalTyconReprs = true includeRecdFields = true includeUnionCases = true - includeTypars = true; + includeTypars = true includeLocals = true } let CollectTyparsNoCaching = @@ -1975,7 +1977,7 @@ let CollectAll = includeLocalTyconReprs = true includeRecdFields = true includeUnionCases = true - includeTypars = true; + includeTypars = true includeLocals = true } let CollectTyparsAndLocals = // CollectAll @@ -1999,9 +2001,9 @@ let accFreeLocalTycon opts x acc = if Zset.contains x acc.FreeTycons then acc else { acc with FreeTycons = Zset.add x acc.FreeTycons } -let accFreeTycon opts (tcr:TyconRef) acc = +let accFreeTycon opts (tcref:TyconRef) acc = if not opts.includeLocalTycons then acc - elif tcr.IsLocalRef then accFreeLocalTycon opts tcr.PrivateTarget acc + elif tcref.IsLocalRef then accFreeLocalTycon opts tcref.PrivateTarget acc else acc let rec boundTypars opts tps acc = @@ -2129,12 +2131,18 @@ and accFreeInTyparConstraintsLeftToRight g cxFlag thruFlag acc cxs = and accFreeInTyparConstraintLeftToRight g cxFlag thruFlag acc tpc = match tpc with - | TyparConstraint.CoercesTo(ty, _) -> accFreeInTypeLeftToRight g cxFlag thruFlag acc ty - | TyparConstraint.MayResolveMember (traitInfo, _) -> accFreeInTraitLeftToRight g cxFlag thruFlag acc traitInfo - | TyparConstraint.DefaultsTo(_, rty, _) -> accFreeInTypeLeftToRight g cxFlag thruFlag acc rty - | TyparConstraint.SimpleChoice(tys, _) -> accFreeInTypesLeftToRight g cxFlag thruFlag acc tys - | TyparConstraint.IsEnum(uty, _) -> accFreeInTypeLeftToRight g cxFlag thruFlag acc uty - | TyparConstraint.IsDelegate(aty, bty, _) -> accFreeInTypeLeftToRight g cxFlag thruFlag (accFreeInTypeLeftToRight g cxFlag thruFlag acc aty) bty + | TyparConstraint.CoercesTo(ty, _) -> + accFreeInTypeLeftToRight g cxFlag thruFlag acc ty + | TyparConstraint.MayResolveMember (traitInfo, _) -> + accFreeInTraitLeftToRight g cxFlag thruFlag acc traitInfo + | TyparConstraint.DefaultsTo(_, rty, _) -> + accFreeInTypeLeftToRight g cxFlag thruFlag acc rty + | TyparConstraint.SimpleChoice(tys, _) -> + accFreeInTypesLeftToRight g cxFlag thruFlag acc tys + | TyparConstraint.IsEnum(uty, _) -> + accFreeInTypeLeftToRight g cxFlag thruFlag acc uty + | TyparConstraint.IsDelegate(aty, bty, _) -> + accFreeInTypeLeftToRight g cxFlag thruFlag (accFreeInTypeLeftToRight g cxFlag thruFlag acc aty) bty | TyparConstraint.SupportsComparison _ | TyparConstraint.SupportsEquality _ | TyparConstraint.SupportsNull _ @@ -2160,20 +2168,28 @@ and accFreeTyparRefLeftToRight g cxFlag thruFlag acc (tp:Typar) = acc and accFreeInTypeLeftToRight g cxFlag thruFlag acc ty = - if verbose then dprintf "--> accFreeInTypeLeftToRight \n" match (if thruFlag then stripTyEqns g ty else stripTyparEqns ty) with - | TType_anon (anonInfo, l) -> + | TType_anon (anonInfo, anonTys) -> let acc = accFreeInTupInfoLeftToRight g cxFlag thruFlag acc anonInfo.TupInfo - accFreeInTypesLeftToRight g cxFlag thruFlag acc l - | TType_tuple (tupInfo, l) -> + accFreeInTypesLeftToRight g cxFlag thruFlag acc anonTys + | TType_tuple (tupInfo, tupTys) -> let acc = accFreeInTupInfoLeftToRight g cxFlag thruFlag acc tupInfo - accFreeInTypesLeftToRight g cxFlag thruFlag acc l - | TType_app (_, tinst) -> accFreeInTypesLeftToRight g cxFlag thruFlag acc tinst - | TType_ucase (_, tinst) -> accFreeInTypesLeftToRight g cxFlag thruFlag acc tinst - | TType_fun (d, r) -> accFreeInTypeLeftToRight g cxFlag thruFlag (accFreeInTypeLeftToRight g cxFlag thruFlag acc d ) r - | TType_var r -> accFreeTyparRefLeftToRight g cxFlag thruFlag acc r - | TType_forall (tps, r) -> unionFreeTyparsLeftToRight (boundTyparsLeftToRight g cxFlag thruFlag tps (accFreeInTypeLeftToRight g cxFlag thruFlag emptyFreeTyparsLeftToRight r)) acc - | TType_measure unt -> List.foldBack (fun (tp, _) acc -> accFreeTyparRefLeftToRight g cxFlag thruFlag acc tp) (ListMeasureVarOccsWithNonZeroExponents unt) acc + accFreeInTypesLeftToRight g cxFlag thruFlag acc tupTys + | TType_app (_, tinst) -> + accFreeInTypesLeftToRight g cxFlag thruFlag acc tinst + | TType_ucase (_, tinst) -> + accFreeInTypesLeftToRight g cxFlag thruFlag acc tinst + | TType_fun (d, r) -> + let dacc = accFreeInTypeLeftToRight g cxFlag thruFlag acc d + accFreeInTypeLeftToRight g cxFlag thruFlag dacc r + | TType_var r -> + accFreeTyparRefLeftToRight g cxFlag thruFlag acc r + | TType_forall (tps, r) -> + let racc = accFreeInTypeLeftToRight g cxFlag thruFlag emptyFreeTyparsLeftToRight r + unionFreeTyparsLeftToRight (boundTyparsLeftToRight g cxFlag thruFlag tps racc) acc + | TType_measure unt -> + let mvars = ListMeasureVarOccsWithNonZeroExponents unt + List.foldBack (fun (tp, _) acc -> accFreeTyparRefLeftToRight g cxFlag thruFlag acc tp) mvars acc and accFreeInTupInfoLeftToRight _g _cxFlag _thruFlag acc unt = match unt with @@ -2184,11 +2200,17 @@ and accFreeInTypesLeftToRight g cxFlag thruFlag acc tys = | [] -> acc | h :: t -> accFreeInTypesLeftToRight g cxFlag thruFlag (accFreeInTypeLeftToRight g cxFlag thruFlag acc h) t -let freeInTypeLeftToRight g thruFlag ty = accFreeInTypeLeftToRight g true thruFlag emptyFreeTyparsLeftToRight ty |> List.rev -let freeInTypesLeftToRight g thruFlag ty = accFreeInTypesLeftToRight g true thruFlag emptyFreeTyparsLeftToRight ty |> List.rev -let freeInTypesLeftToRightSkippingConstraints g ty = accFreeInTypesLeftToRight g false true emptyFreeTyparsLeftToRight ty |> List.rev +let freeInTypeLeftToRight g thruFlag ty = + accFreeInTypeLeftToRight g true thruFlag emptyFreeTyparsLeftToRight ty |> List.rev + +let freeInTypesLeftToRight g thruFlag ty = + accFreeInTypesLeftToRight g true thruFlag emptyFreeTyparsLeftToRight ty |> List.rev + +let freeInTypesLeftToRightSkippingConstraints g ty = + accFreeInTypesLeftToRight g false true emptyFreeTyparsLeftToRight ty |> List.rev let valOfBind (b:Binding) = b.Var + let valsOfBinds (binds:Bindings) = binds |> List.map (fun b -> b.Var) //-------------------------------------------------------------------------- @@ -2327,7 +2349,7 @@ let ReturnTypeOfPropertyVal g (v:Val) = if not arginfos.IsEmpty && not arginfos.Head.IsEmpty then arginfos.Head |> List.last |> fst else - error(Error(FSComp.SR.tastValueDoesNotHaveSetterType(), v.Range)); + error(Error(FSComp.SR.tastValueDoesNotHaveSetterType(), v.Range)) | MemberKind.PropertyGet -> let _, _, rty, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo v.Type v.Range GetFSharpViewOfReturnType g rty @@ -2346,7 +2368,7 @@ let ArgInfosOfPropertyVal g (v:Val) = if not arginfos.IsEmpty && not arginfos.Head.IsEmpty then arginfos.Head |> List.frontAndBack |> fst else - error(Error(FSComp.SR.tastValueDoesNotHaveSetterType(), v.Range)); + error(Error(FSComp.SR.tastValueDoesNotHaveSetterType(), v.Range)) | _ -> error(InternalError("ArgInfosOfPropertyVal", v.Range)) @@ -2391,7 +2413,7 @@ module PrettyTypes = let niceTypars = List.map2 newPrettyTypar tps names let tl, _tt = mkTyparToTyparRenaming tps niceTypars in let renaming = renaming @ tl - (tps, niceTypars) ||> List.iter2 (fun tp tpnice -> tpnice.SetConstraints (instTyparConstraints renaming tp.Constraints)) ; + (tps, niceTypars) ||> List.iter2 (fun tp tpnice -> tpnice.SetConstraints (instTyparConstraints renaming tp.Constraints)) niceTypars, renaming // We choose names for type parameters from 'a'..'t' @@ -2447,7 +2469,6 @@ module PrettyTypes = tryAgain (typeIndex, measureIndex))) else useThisName (tp.Name, typeIndex, measureIndex) - choose tps (0, 0) [] @@ -2458,14 +2479,14 @@ module PrettyTypes = match tps with | [] -> List.rev keep, List.rev change | tp :: rest -> - if not (NeedsPrettyTyparName tp) && (not (keep |> List.exists (fun tp2 -> tp.Name = tp2.Name))) then + if not (NeedsPrettyTyparName tp) && (not (keep |> List.exists (fun tp2 -> tp.Name = tp2.Name))) then computeKeep (tp :: keep) change rest else computeKeep keep (tp :: change) rest let keep, change = computeKeep [] [] ftps - // change |> List.iter (fun tp -> dprintf "change typar: %s %s %d\n" tp.Name (tp.DisplayName) (stamp_of_typar tp)); - // keep |> List.iter (fun tp -> dprintf "keep typar: %s %s %d\n" tp.Name (tp.DisplayName) (stamp_of_typar tp)); + // change |> List.iter (fun tp -> dprintf "change typar: %s %s %d\n" tp.Name (tp.DisplayName) (stamp_of_typar tp)) + // keep |> List.iter (fun tp -> dprintf "keep typar: %s %s %d\n" tp.Name (tp.DisplayName) (stamp_of_typar tp)) let alreadyInUse = keep |> List.map (fun x -> x.Name) let names = PrettyTyparNames (fun x -> List.memq x change) alreadyInUse ftps @@ -2480,14 +2501,14 @@ module PrettyTypes = let prettyThings = mapTys (instType renaming) tauThings // niceTypars |> List.iter (fun tp -> dprintf "nice typar: %d\n" (stamp_of_typar tp)); * - let tpconstraints = niceTypars |> List.collect (fun tpnice -> List.map (fun tpc -> tpnice, tpc) tpnice.Constraints) + let tpconstraints = niceTypars |> List.collect (fun tpnice -> List.map (fun tpc -> tpnice, tpc) tpnice.Constraints) prettyThings, tpconstraints let PrettifyType g x = PrettifyThings g id id x let PrettifyTypePair g x = PrettifyThings g (fun f -> foldPair (f, f)) (fun f -> mapPair (f, f)) x - let PrettifyTypes g x = PrettifyThings g List.fold List.map x - let PrettifyCurriedTypes g x = PrettifyThings g (fun f -> List.fold (List.fold f)) List.mapSquared x + let PrettifyTypes g x = PrettifyThings g List.fold List.map x + let PrettifyCurriedTypes g x = PrettifyThings g (fun f -> List.fold (List.fold f)) List.mapSquared x let PrettifyCurriedSigTypes g x = PrettifyThings g (fun f -> foldPair (List.fold (List.fold f), f)) (fun f -> mapPair (List.mapSquared f, f)) x // Badly formed code may instantiate rigid declared typars to types. @@ -2501,10 +2522,10 @@ module PrettyTypes = let foldTypar f z (x: Typar) = foldOn mkTyparTy f z x let mapTypar g f (x: Typar) : Typar = (mkTyparTy >> f >> safeDestAnyParTy x g) x - let foldTypars f z (x: Typars) = List.fold (foldTypar f) z x + let foldTypars f z (x: Typars) = List.fold (foldTypar f) z x let mapTypars g f (x: Typars) : Typars = List.map (mapTypar g f) x - let foldTyparInst f z (x: TyparInst) = List.fold (foldPair (foldTypar f, f)) z x + let foldTyparInst f z (x: TyparInst) = List.fold (foldPair (foldTypar f, f)) z x let mapTyparInst g f (x: TyparInst) : TyparInst = List.map (mapPair (mapTypar g f, f)) x let PrettifyInstAndTyparsAndType g x = @@ -2513,10 +2534,10 @@ module PrettyTypes = (fun f-> mapTriple (mapTyparInst g f, mapTypars g f, f)) x - let PrettifyInstAndUncurriedSig g (x: TyparInst * UncurriedArgInfos * TType) = + let PrettifyInstAndUncurriedSig g (x: TyparInst * UncurriedArgInfos * TType) = PrettifyThings g (fun f -> foldTriple (foldTyparInst f, foldUnurriedArgInfos f, f)) - (fun f -> mapTriple (mapTyparInst g f, List.map (map1Of2 f), f)) + (fun f -> mapTriple (mapTyparInst g f, List.map (map1Of2 f), f)) x let PrettifyInstAndCurriedSig g (x: TyparInst * TTypes * CurriedArgInfos * TType) = @@ -2561,9 +2582,9 @@ module SimplifyTypes = | TType_ucase (_, tys) | TType_anon (_, tys) | TType_tuple (_, tys) -> List.fold (foldTypeButNotConstraints f) z tys - | TType_fun (s, t) -> foldTypeButNotConstraints f (foldTypeButNotConstraints f z s) t - | TType_var _ -> z - | TType_measure _ -> z + | TType_fun (s, t) -> foldTypeButNotConstraints f (foldTypeButNotConstraints f z s) t + | TType_var _ -> z + | TType_measure _ -> z let incM x m = if Zmap.mem x m then Zmap.add x (1 + Zmap.find x m) m @@ -2579,12 +2600,12 @@ module SimplifyTypes = let accTyparCountsMulti acc l = List.fold accTyparCounts acc l type TypeSimplificationInfo = - { singletons : Typar Zset - inplaceConstraints : Zmap - postfixConstraints : (Typar * TyparConstraint) list } + { singletons: Typar Zset + inplaceConstraints: Zmap + postfixConstraints: (Typar * TyparConstraint) list } let typeSimplificationInfo0 = - { singletons = Zset.empty typarOrder + { singletons = Zset.empty typarOrder inplaceConstraints = Zmap.empty typarOrder postfixConstraints = [] } @@ -2606,7 +2627,7 @@ module SimplifyTypes = tp.Constraints.Length = 1) let inplace = inplace |> List.map (function (tp, TyparConstraint.CoercesTo(ty, _)) -> tp, ty | _ -> failwith "not isTTyparCoercesToType") - { singletons = singletons + { singletons = singletons inplaceConstraints = Zmap.ofList typarOrder inplace postfixConstraints = postfix } let CollectInfo simplify tys cxs = @@ -2680,12 +2701,12 @@ type DisplayEnv = member denv.AddOpenModuleOrNamespace (modref: ModuleOrNamespaceRef) = denv.AddOpenPath (fullCompPathOfModuleOrNamespace modref.Deref).DemangledPath - member denv.AddAccessibility access = + member denv.AddAccessibility access = { denv with contextAccessibility = combineAccess denv.contextAccessibility access } let (+.+) s1 s2 = if s1 = "" then s2 else s1+"."+s2 -let layoutOfPath p = +let layoutOfPath p = sepListL SepL.dot (List.map (tagNamespace >> wordL) p) let fullNameOfParentOfPubPath pp = @@ -2703,11 +2724,11 @@ let fullNameOfPubPathAsLayout (PubPath(p)) = layoutOfPath (Array.toList p) let fullNameOfParentOfNonLocalEntityRef (nlr: NonLocalEntityRef) = if nlr.Path.Length < 2 then ValueNone - else ValueSome (textOfPath nlr.EnclosingMangledPath) // <--- BAD BAD BAD: this is a mangled path. This is wrong for nested modules + else ValueSome (textOfPath nlr.EnclosingMangledPath) let fullNameOfParentOfNonLocalEntityRefAsLayout (nlr: NonLocalEntityRef) = if nlr.Path.Length < 2 then ValueNone - else ValueSome (layoutOfPath (List.ofArray nlr.EnclosingMangledPath)) // <--- BAD BAD BAD: this is a mangled path. This is wrong for nested modules + else ValueSome (layoutOfPath (List.ofArray nlr.EnclosingMangledPath)) let fullNameOfParentOfEntityRef eref = match eref with @@ -2742,14 +2763,15 @@ let tagEntityRefName (xref: EntityRef) name = elif xref.IsRecordTycon then tagRecord name else tagClass name -let fullDisplayTextOfTyconRef r = fullNameOfEntityRef (fun (tc:TyconRef) -> tc.DisplayNameWithStaticParametersAndUnderscoreTypars) r +let fullDisplayTextOfTyconRef (tc: TyconRef) = + fullNameOfEntityRef (fun tc -> tc.DisplayNameWithStaticParametersAndUnderscoreTypars) tc let fullNameOfEntityRefAsLayout nmF (xref: EntityRef) = let navigableText = tagEntityRefName xref (nmF xref) |> mkNav xref.DefinitionRange |> wordL - match fullNameOfParentOfEntityRefAsLayout xref with + match fullNameOfParentOfEntityRefAsLayout xref with | ValueNone -> navigableText | ValueSome pathText -> pathText ^^ SepL.dot ^^ navigableText @@ -2774,16 +2796,16 @@ let fullNameOfParentOfValRefAsLayout vref = let fullDisplayTextOfParentOfModRef r = fullNameOfParentOfEntityRef r -let fullDisplayTextOfModRef r = fullNameOfEntityRef (fun (x:EntityRef) -> x.DemangledModuleOrNamespaceName) r -let fullDisplayTextOfTyconRefAsLayout r = fullNameOfEntityRefAsLayout (fun (tc:TyconRef) -> tc.DisplayNameWithStaticParametersAndUnderscoreTypars) r -let fullDisplayTextOfExnRef r = fullNameOfEntityRef (fun (tc:TyconRef) -> tc.DisplayNameWithStaticParametersAndUnderscoreTypars) r -let fullDisplayTextOfExnRefAsLayout r = fullNameOfEntityRefAsLayout (fun (tc:TyconRef) -> tc.DisplayNameWithStaticParametersAndUnderscoreTypars) r +let fullDisplayTextOfModRef r = fullNameOfEntityRef (fun (x:EntityRef) -> x.DemangledModuleOrNamespaceName) r +let fullDisplayTextOfTyconRefAsLayout r = fullNameOfEntityRefAsLayout (fun (tc:TyconRef) -> tc.DisplayNameWithStaticParametersAndUnderscoreTypars) r +let fullDisplayTextOfExnRef r = fullNameOfEntityRef (fun (tc:TyconRef) -> tc.DisplayNameWithStaticParametersAndUnderscoreTypars) r +let fullDisplayTextOfExnRefAsLayout r = fullNameOfEntityRefAsLayout (fun (tc:TyconRef) -> tc.DisplayNameWithStaticParametersAndUnderscoreTypars) r let fullDisplayTextOfUnionCaseRef (ucref:UnionCaseRef) = fullDisplayTextOfTyconRef ucref.TyconRef +.+ ucref.CaseName let fullDisplayTextOfRecdFieldRef (rfref:RecdFieldRef) = fullDisplayTextOfTyconRef rfref.TyconRef +.+ rfref.FieldName let fullDisplayTextOfValRef (vref:ValRef) = - match fullNameOfParentOfValRef vref with + match fullNameOfParentOfValRef vref with | ValueNone -> vref.DisplayName | ValueSome pathText -> pathText +.+ vref.DisplayName @@ -2801,7 +2823,7 @@ let fullDisplayTextOfValRefAsLayout (vref:ValRef) = | MemberKind.ClassConstructor | MemberKind.Constructor -> tagMethod vref.DisplayName | MemberKind.Member -> tagMember vref.DisplayName - match fullNameOfParentOfValRefAsLayout vref with + match fullNameOfParentOfValRefAsLayout vref with | ValueNone -> wordL n | ValueSome pathText -> pathText ^^ SepL.dot ^^ wordL n @@ -2837,7 +2859,7 @@ let trimPathByDisplayEnv denv path = match List.tryPick findOpenedNamespace (denv.openTopPathsSorted.Force()) with | Some s -> s - | None -> if isNil path then "" else textOfPath path + "." + | None -> if isNil path then "" else textOfPath path + "." let superOfTycon (g:TcGlobals) (tycon:Tycon) = @@ -2866,10 +2888,10 @@ let HasILAttribute tref (attrs: ILAttributes) = attrs.AsArray |> Array.exists (isILAttrib tref) let TryDecodeILAttribute (g:TcGlobals) tref (attrs: ILAttributes) = - attrs.AsArray |> Array.tryPick (fun x -> if isILAttrib tref x then Some(decodeILAttribData g.ilg x) else None) + attrs.AsArray |> Array.tryPick (fun x -> if isILAttrib tref x then Some(decodeILAttribData g.ilg x) else None) // F# view of attributes (these get converted to AbsIL attributes in ilxgen) -let IsMatchingFSharpAttribute g (AttribInfo(_, tcref)) (Attrib(tcref2, _, _, _, _, _, _)) = tyconRefEq g tcref tcref2 +let IsMatchingFSharpAttribute g (AttribInfo(_, tcref)) (Attrib(tcref2, _, _, _, _, _, _)) = tyconRefEq g tcref tcref2 let HasFSharpAttribute g tref attrs = List.exists (IsMatchingFSharpAttribute g tref) attrs let findAttrib g tref attrs = List.find (IsMatchingFSharpAttribute g tref) attrs let TryFindFSharpAttribute g tref attrs = List.tryFind (IsMatchingFSharpAttribute g tref) attrs @@ -2936,39 +2958,39 @@ let TryBindTyconRefAttribute g (m:range) (AttribInfo (atref, _) as args) (tcref: | Some attr -> f2 attr | _ -> None -let TryFindTyconRefBoolAttribute g m attribSpec tcref = +let TryFindTyconRefBoolAttribute g m attribSpec tcref = TryBindTyconRefAttribute g m attribSpec tcref (function | ([ ], _) -> Some true | ([ILAttribElem.Bool (v) ], _) -> Some v | _ -> None) (function - | (Attrib(_, _, [ ], _, _, _, _)) -> Some true - | (Attrib(_, _, [ AttribBoolArg v ], _, _, _, _)) -> Some v + | (Attrib(_, _, [ ], _, _, _, _)) -> Some true + | (Attrib(_, _, [ AttribBoolArg v ], _, _, _, _)) -> Some v | _ -> None) (function | ([ ], _) -> Some true | ([ Some ((:? bool as v) : obj) ], _) -> Some v | _ -> None) -let TryFindAttributeUsageAttribute g m tcref = +let TryFindAttributeUsageAttribute g m tcref = TryBindTyconRefAttribute g m g.attrib_AttributeUsageAttribute tcref - (fun (_, named) -> named |> List.tryPick (function ("AllowMultiple", _, _, ILAttribElem.Bool res) -> Some res | _ -> None)) + (fun (_, named) -> named |> List.tryPick (function ("AllowMultiple", _, _, ILAttribElem.Bool res) -> Some res | _ -> None)) (fun (Attrib(_, _, _, named, _, _, _)) -> named |> List.tryPick (function AttribNamedArg("AllowMultiple", _, _, AttribBoolArg(res) ) -> Some res | _ -> None)) - (fun (_, named) -> named |> List.tryPick (function ("AllowMultiple", Some ((:? bool as res) : obj)) -> Some res | _ -> None)) + (fun (_, named) -> named |> List.tryPick (function ("AllowMultiple", Some ((:? bool as res) : obj)) -> Some res | _ -> None)) /// Try to find a specific attribute on a type definition, where the attribute accepts a string argument. /// /// This is used to detect the 'DefaultMemberAttribute' and 'ConditionalAttribute' attributes (on type definitions) -let TryFindTyconRefStringAttribute g m attribSpec tcref = +let TryFindTyconRefStringAttribute g m attribSpec tcref = TryBindTyconRefAttribute g m attribSpec tcref (function ([ILAttribElem.String (Some(msg)) ], _) -> Some msg | _ -> None) - (function (Attrib(_, _, [ AttribStringArg(msg) ], _, _, _, _)) -> Some msg | _ -> None) + (function (Attrib(_, _, [ AttribStringArg(msg) ], _, _, _, _)) -> Some msg | _ -> None) (function ([ Some ((:? string as msg) : obj) ], _) -> Some msg | _ -> None) /// Check if a type definition has a specific attribute -let TyconRefHasAttribute g m attribSpec tcref = +let TyconRefHasAttribute g m attribSpec tcref = TryBindTyconRefAttribute g m attribSpec tcref (fun _ -> Some ()) (fun _ -> Some ()) @@ -3001,7 +3023,7 @@ let isSpanLikeTyconRef g m tcref = not (isByrefTyconRef g tcref) let isByrefLikeTy g m ty = - ty |> stripTyEqns g |> (function TType_app(tcref, _) -> isByrefLikeTyconRef g m tcref | _ -> false) + ty |> stripTyEqns g |> (function TType_app(tcref, _) -> isByrefLikeTyconRef g m tcref | _ -> false) let isSpanLikeTy g m ty = isByrefLikeTy g m ty && @@ -3026,7 +3048,7 @@ let destNativePtrTy g ty = | TType_app(tcref, [x]) when tyconRefEq g g.nativeptr_tcr tcref -> x | _ -> failwith "destNativePtrTy: not a native ptr type" -let isRefCellTy g ty = +let isRefCellTy g ty = match tryDestAppTy g ty with | ValueNone -> false | ValueSome tcref -> tyconRefEq g g.refcell_tcr_canon tcref @@ -3073,7 +3095,7 @@ let isLinqExpressionTy g ty = let tryDestLinqExpressionTy g ty = match argsOfAppTy g ty with - | [ty1] when isLinqExpressionTy g ty -> Some ty1 + | [ty1] when isLinqExpressionTy g ty -> Some ty1 | _ -> None let destLinqExpressionTy g ty = @@ -3100,9 +3122,9 @@ let (|BinopExpr|_|) _g expr = | Expr.App(Expr.Val(vref, _, _), _, _, [arg1;arg2], _) -> Some (vref, arg1, arg2) | _ -> None -let (|SpecificUnopExpr|_|) g vrefReqd expr = +let (|SpecificUnopExpr|_|) g vrefReqd expr = match expr with - | UnopExpr g (vref, arg1) when valRefEq g vref vrefReqd -> Some arg1 + | UnopExpr g (vref, arg1) when valRefEq g vref vrefReqd -> Some arg1 | _ -> None let (|SpecificBinopExpr|_|) g vrefReqd expr = @@ -3124,7 +3146,7 @@ let (|AttribBitwiseOrExpr|_|) g expr = // is defined. These get through type checking because enums implicitly support the '|||' operator through // the automatic resolution of undefined operators (see tc.fs, Item.ImplicitOp). This then compiles as an // application of a lambda to two arguments. We recognize this pattern here - | Expr.App(Expr.Lambda _, _, _, [arg1;arg2], _) when g.compilingFslib -> + | Expr.App(Expr.Lambda _, _, _, [arg1;arg2], _) when g.compilingFslib -> Some(arg1, arg2) | _ -> None @@ -3150,43 +3172,44 @@ let isTypeDefOfValRef g vref = let (|UncheckedDefaultOfExpr|_|) g expr = match expr with - | Expr.App(Expr.Val(vref, _, _), _, [ty], [], _) when isUncheckedDefaultOfValRef g vref -> Some ty + | Expr.App(Expr.Val(vref, _, _), _, [ty], [], _) when isUncheckedDefaultOfValRef g vref -> Some ty | _ -> None let (|TypeOfExpr|_|) g expr = match expr with - | Expr.App(Expr.Val(vref, _, _), _, [ty], [], _) when isTypeOfValRef g vref -> Some ty + | Expr.App(Expr.Val(vref, _, _), _, [ty], [], _) when isTypeOfValRef g vref -> Some ty | _ -> None let (|SizeOfExpr|_|) g expr = match expr with - | Expr.App(Expr.Val(vref, _, _), _, [ty], [], _) when isSizeOfValRef g vref -> Some ty + | Expr.App(Expr.Val(vref, _, _), _, [ty], [], _) when isSizeOfValRef g vref -> Some ty | _ -> None let (|TypeDefOfExpr|_|) g expr = match expr with - | Expr.App(Expr.Val(vref, _, _), _, [ty], [], _) when isTypeDefOfValRef g vref -> Some ty + | Expr.App(Expr.Val(vref, _, _), _, [ty], [], _) when isTypeDefOfValRef g vref -> Some ty | _ -> None - - //-------------------------------------------------------------------------- // DEBUG layout //--------------------------------------------------------------------------- -module DebugPrint = begin - open FSharp.Compiler.Layout - open PrettyTypes - let layoutRanges = ref false +module DebugPrint = + let layoutRanges = ref false let squareAngleL x = LeftL.leftBracketAngle ^^ x ^^ RightL.rightBracketAngle + let angleL x = sepL Literals.leftAngle ^^ x ^^ rightL Literals.rightAngle + let braceL x = leftL Literals.leftBrace ^^ x ^^ rightL Literals.rightBrace + let braceBarL x = leftL Literals.leftBraceBar ^^ x ^^ rightL Literals.rightBraceBar + let boolL = function true -> WordL.keywordTrue | false -> WordL.keywordFalse - let intL (n:int) = wordL (tagNumericLiteral (string n )) - let int64L (n:int64) = wordL (tagNumericLiteral (string n )) + let intL (n:int) = wordL (tagNumericLiteral (string n )) + + let int64L (n:int64) = wordL (tagNumericLiteral (string n )) let jlistL xL xmap = QueueList.foldBack (fun x z -> z @@ xL x) xmap emptyL @@ -3194,44 +3217,47 @@ module DebugPrint = begin let lvalopL x = match x with - | LAddrOf readonly -> wordL (tagText (sprintf "LAddrOf(%b)" readonly)) + | LAddrOf readonly -> wordL (tagText (sprintf "LAddrOf(%b)" readonly)) | LByrefGet -> wordL (tagText "LByrefGet") - | LSet -> wordL (tagText "LSet") + | LSet -> wordL (tagText "LSet") | LByrefSet -> wordL (tagText "LByrefSet") let angleBracketL l = leftL (tagText "<") ^^ l ^^ rightL (tagText ">") - let angleBracketListL l = angleBracketL (sepListL (sepL (tagText ",")) l) + let angleBracketListL l = angleBracketL (sepListL (sepL (tagText ",")) l) let layoutMemberFlags memFlags = - let stat = if memFlags.IsInstance || (memFlags.MemberKind = MemberKind.Constructor) then emptyL else wordL (tagText "static") - let stat = if memFlags.IsDispatchSlot then stat ++ wordL (tagText "abstract") - elif memFlags.IsOverrideOrExplicitImpl then stat ++ wordL (tagText "override") - else stat + let stat = + if memFlags.IsInstance || (memFlags.MemberKind = MemberKind.Constructor) then emptyL + else wordL (tagText "static") + let stat = + if memFlags.IsDispatchSlot then stat ++ wordL (tagText "abstract") + elif memFlags.IsOverrideOrExplicitImpl then stat ++ wordL (tagText "override") + else stat stat let stampL _n w = w - let layoutTyconRef (tc:TyconRef) = wordL (tagText tc.DisplayNameWithStaticParameters) |> stampL tc.Stamp - + let layoutTyconRef (tc:TyconRef) = + wordL (tagText tc.DisplayNameWithStaticParameters) |> stampL tc.Stamp let rec auxTypeL env ty = auxTypeWrapL env false ty - and auxTypeAtomL env ty = auxTypeWrapL env true ty + and auxTypeAtomL env ty = auxTypeWrapL env true ty and auxTyparsL env tcL prefix tinst = match tinst with | [] -> tcL | [t] -> let tL = auxTypeAtomL env t - if prefix then tcL ^^ angleBracketL tL - else tL ^^ tcL + if prefix then tcL ^^ angleBracketL tL + else tL ^^ tcL | _ -> let tinstL = List.map (auxTypeL env) tinst - if prefix then + if prefix then tcL ^^ angleBracketListL tinstL - else + else tupleL tinstL ^^ tcL and auxTypeWrapL env isAtomic ty = @@ -3239,15 +3265,15 @@ module DebugPrint = begin match stripTyparEqns ty with | TType_forall (typars, rty) -> (leftL (tagText "!") ^^ layoutTyparDecls typars --- auxTypeL env rty) |> wrap - | TType_ucase (UCRef(tcref, _), tinst) - | TType_app (tcref, tinst) -> + | TType_ucase (UCRef(tcref, _), tinst) + | TType_app (tcref, tinst) -> let prefix = tcref.IsPrefixDisplay let tcL = layoutTyconRef tcref auxTyparsL env tcL prefix tinst | TType_anon (anonInfo, tys) -> braceBarL (sepListL (wordL (tagText ";")) (List.map2 (fun nm ty -> wordL (tagField nm) --- auxTypeAtomL env ty) (Array.toList anonInfo.SortedNames) tys)) | TType_tuple (_tupInfo, tys) -> sepListL (wordL (tagText "*")) (List.map (auxTypeAtomL env) tys) |> wrap - | TType_fun (f, x) -> ((auxTypeAtomL env f ^^ wordL (tagText "->")) --- auxTypeL env x) |> wrap - | TType_var typar -> auxTyparWrapL env isAtomic typar + | TType_fun (f, x) -> ((auxTypeAtomL env f ^^ wordL (tagText "->")) --- auxTypeL env x) |> wrap + | TType_var typar -> auxTyparWrapL env isAtomic typar | TType_measure unt -> #if DEBUG leftL (tagText "{") ^^ @@ -3256,16 +3282,20 @@ module DebugPrint = begin | Some g -> let sortVars (vs:(Typar * Rational) list) = vs |> List.sortBy (fun (v, _) -> v.DisplayName) let sortCons (cs:(TyconRef * Rational) list) = cs |> List.sortBy (fun (c, _) -> c.DisplayName) - let negvs, posvs = ListMeasureVarOccsWithNonZeroExponents unt |> sortVars |> List.partition (fun (_, e) -> SignRational e < 0) + let negvs, posvs = ListMeasureVarOccsWithNonZeroExponents unt |> sortVars |> List.partition (fun (_, e) -> SignRational e < 0) let negcs, poscs = ListMeasureConOccsWithNonZeroExponents g false unt |> sortCons |> List.partition (fun (_, e) -> SignRational e < 0) let unparL (uv:Typar) = wordL (tagText ("'" + uv.DisplayName)) let unconL tc = layoutTyconRef tc let rationalL e = wordL (tagText(RationalToString e)) let measureToPowerL x e = if e = OneRational then x else x -- wordL (tagText "^") -- rationalL e - let prefix = spaceListL (List.map (fun (v, e) -> measureToPowerL (unparL v) e) posvs @ - List.map (fun (c, e) -> measureToPowerL (unconL c) e) poscs) - let postfix = spaceListL (List.map (fun (v, e) -> measureToPowerL (unparL v) (NegRational e)) negvs @ - List.map (fun (c, e) -> measureToPowerL (unconL c) (NegRational e)) negcs) + let prefix = + spaceListL + (List.map (fun (v, e) -> measureToPowerL (unparL v) e) posvs @ + List.map (fun (c, e) -> measureToPowerL (unconL c) e) poscs) + let postfix = + spaceListL + (List.map (fun (v, e) -> measureToPowerL (unparL v) (NegRational e)) negvs @ + List.map (fun (c, e) -> measureToPowerL (unconL c) (NegRational e)) negcs) match (negvs, negcs) with | [], [] -> prefix | _ -> prefix ^^ sepL (tagText "/") ^^ postfix) ^^ @@ -3297,9 +3327,9 @@ module DebugPrint = begin (varL ^^ sepL (tagText ":>") ^^ auxTyparConstraintTypL env typarConstraintTy) |> wrap | _ -> varL - and auxTypar2L env typar = auxTyparWrapL env false typar + and auxTypar2L env typar = auxTyparWrapL env false typar - and auxTyparAtomL env typar = auxTyparWrapL env true typar + and auxTyparAtomL env typar = auxTyparWrapL env true typar and auxTyparConstraintTypL env ty = auxTypeL env ty @@ -3312,7 +3342,7 @@ module DebugPrint = begin let rty = GetFSharpViewOfReturnType g rty let stat = layoutMemberFlags memFlags let argsL = sepListL (wordL (tagText "*")) (List.map (auxTypeAtomL env) argtys) - let resL = auxTypeL env rty + let resL = auxTypeL env rty let methodTypeL = (argsL ^^ wordL (tagText "->")) ++ resL bracketL (stat ++ bracketL (sepListL (wordL (tagText "or")) (List.map (auxTypeAtomL env) tys)) ++ wordL (tagText "member") --- (wordL (tagText nm) ^^ wordL (tagText ":") -- methodTypeL)) #else @@ -3326,11 +3356,11 @@ module DebugPrint = begin | TyparConstraint.CoercesTo(typarConstraintTy, _) -> auxTypar2L env tp ^^ wordL (tagText ":>") --- auxTyparConstraintTypL env typarConstraintTy | TyparConstraint.MayResolveMember(traitInfo, _) -> - auxTypar2L env tp ^^ wordL (tagText ":") --- auxTraitL env traitInfo + auxTypar2L env tp ^^ wordL (tagText ":") --- auxTraitL env traitInfo | TyparConstraint.DefaultsTo(_, ty, _) -> - wordL (tagText "default") ^^ auxTypar2L env tp ^^ wordL (tagText ":") ^^ auxTypeL env ty + wordL (tagText "default") ^^ auxTypar2L env tp ^^ wordL (tagText ":") ^^ auxTypeL env ty | TyparConstraint.IsEnum(ty, _) -> - auxTyparsL env (wordL (tagText "enum")) true [ty] |> constraintPrefix + auxTyparsL env (wordL (tagText "enum")) true [ty] |> constraintPrefix | TyparConstraint.IsDelegate(aty, bty, _) -> auxTyparsL env (wordL (tagText "delegate")) true [aty; bty] |> constraintPrefix | TyparConstraint.SupportsNull _ -> @@ -3340,22 +3370,23 @@ module DebugPrint = begin | TyparConstraint.SupportsEquality _ -> wordL (tagText "equality") |> constraintPrefix | TyparConstraint.IsNonNullableStruct _ -> - wordL (tagText "struct") |> constraintPrefix + wordL (tagText "struct") |> constraintPrefix | TyparConstraint.IsReferenceType _ -> wordL (tagText "not struct") |> constraintPrefix | TyparConstraint.IsUnmanaged _ -> wordL (tagText "unmanaged") |> constraintPrefix | TyparConstraint.SimpleChoice(tys, _) -> - bracketL (sepListL (sepL (tagText "|")) (List.map (auxTypeL env) tys)) |> constraintPrefix + bracketL (sepListL (sepL (tagText "|")) (List.map (auxTypeL env) tys)) |> constraintPrefix | TyparConstraint.RequiresDefaultConstructor _ -> - bracketL (wordL (tagText "new : unit -> ") ^^ (auxTypar2L env tp)) |> constraintPrefix + bracketL (wordL (tagText "new : unit -> ") ^^ (auxTypar2L env tp)) |> constraintPrefix and auxTyparConstraintsL env x = match x with - | [] -> emptyL - | cxs -> wordL (tagText "when") --- aboveListL (List.map (auxTyparConstraintL env) cxs) + | [] -> emptyL + | cxs -> wordL (tagText "when") --- aboveListL (List.map (auxTyparConstraintL env) cxs) + + and typarL tp = auxTypar2L SimplifyTypes.typeSimplificationInfo0 tp - and typarL tp = auxTypar2L SimplifyTypes.typeSimplificationInfo0 tp and typarAtomL tp = auxTyparAtomL SimplifyTypes.typeSimplificationInfo0 tp and typeAtomL tau = @@ -3378,27 +3409,23 @@ module DebugPrint = begin match env.postfixConstraints with | [] -> auxTypeL env tau | _ -> (auxTypeL env tau --- auxTyparConstraintsL env env.postfixConstraints) - and layoutTyparDecls tps = angleBracketListL (List.map typarDeclL tps) + and layoutTyparDecls tps = angleBracketListL (List.map typarDeclL tps) - //-------------------------------------------------------------------------- - // DEBUG layout - types - //-------------------------------------------------------------------------- - let rangeL m = wordL (tagText (stringOfRange m)) let instL tyL tys = match tys with - | [] -> emptyL + | [] -> emptyL | tys -> sepL (tagText "@[") ^^ commaListL (List.map tyL tys) ^^ rightL (tagText "]") - let valRefL (vr:ValRef) = + let valRefL (vr: ValRef) = wordL (tagText vr.LogicalName) |> stampL vr.Stamp let layoutAttrib (Attrib(_, k, _, _, _, _, _)) = leftL (tagText "[<") ^^ (match k with - | ILAttrib (ilmeth) -> wordL (tagText ilmeth.Name) - | FSAttrib (vref) -> valRefL vref) ^^ + | ILAttrib ilmeth -> wordL (tagText ilmeth.Name) + | FSAttrib vref -> valRefL vref) ^^ rightL (tagText ">]") let layoutAttribs attribs = aboveListL (List.map layoutAttrib attribs) @@ -3408,23 +3435,23 @@ module DebugPrint = begin leftL (tagText "arity<") ^^ intL tpNames.Length ^^ sepL (tagText ">[") ^^ commaListL (List.map intL ns) ^^ rightL (tagText "]") - let valL (vspec:Val) = - let vsL = wordL (tagText (DecompileOpName vspec.LogicalName)) |> stampL vspec.Stamp - let vsL = vsL -- layoutAttribs (vspec.Attribs) + let valL (v: Val) = + let vsL = wordL (tagText (DecompileOpName v.LogicalName)) |> stampL v.Stamp + let vsL = vsL -- layoutAttribs (v.Attribs) vsL - let typeOfValL (v:Val) = + let typeOfValL (v: Val) = (valL v - ^^ (if v.MustInline then wordL (tagText "inline ") else emptyL) + ^^ (if v.MustInline then wordL (tagText "inline ") else emptyL) ^^ (if v.IsMutable then wordL(tagText "mutable ") else emptyL) ^^ wordL (tagText ":")) -- typeL v.Type - let tslotparamL(TSlotParam(nmOpt, ty, inFlag, outFlag, _, _)) = + let tslotparamL (TSlotParam(nmOpt, ty, inFlag, outFlag, _, _)) = (optionL (tagText >> wordL) nmOpt) ^^ wordL(tagText ":") ^^ typeL ty ^^ - (if inFlag then wordL(tagText "[in]") else emptyL) ^^ - (if outFlag then wordL(tagText "[out]") else emptyL) ^^ + (if inFlag then wordL(tagText "[in]") else emptyL) ^^ + (if outFlag then wordL(tagText "[out]") else emptyL) ^^ (if inFlag then wordL(tagText "[opt]") else emptyL) let slotSigL (slotsig:SlotSig) = @@ -3435,59 +3462,64 @@ module DebugPrint = begin | Some g -> let rty = GetFSharpViewOfReturnType g rty (wordL(tagText "slot") --- (wordL (tagText nm)) ^^ wordL(tagText "@") ^^ typeL ty) -- - (wordL(tagText "LAM") --- spaceListL (List.map typarL tps1) ^^ rightL(tagText ".")) --- - (wordL(tagText "LAM") --- spaceListL (List.map typarL tps2) ^^ rightL(tagText ".")) --- + (wordL(tagText "LAM") --- spaceListL (List.map typarL tps1) ^^ rightL(tagText ".")) --- + (wordL(tagText "LAM") --- spaceListL (List.map typarL tps2) ^^ rightL(tagText ".")) --- (commaListL (List.map (List.map tslotparamL >> tupleL) pms)) ^^ (wordL(tagText "-> ")) --- (typeL rty) #else ignore slotsig wordL(tagText "slotsig") #endif - let rec MemberL (v:Val) (membInfo:ValMemberInfo) = - (aboveListL [ wordL(tagText "compiled_name! = ") ^^ wordL (tagText v.CompiledName) ; - wordL(tagText "membInfo-slotsig! = ") ^^ listL slotSigL membInfo.ImplementedSlotSigs ]) - and valAtBindL v = - let vL = valL v in + let rec memberL (v:Val) (membInfo:ValMemberInfo) = + aboveListL + [ wordL(tagText "compiled_name! = ") ^^ wordL (tagText v.CompiledName) + wordL(tagText "membInfo-slotsig! = ") ^^ listL slotSigL membInfo.ImplementedSlotSigs ] + + and valAtBindL v = + let vL = valL v let mutL = (if v.IsMutable then wordL(tagText "mutable") ++ vL else vL) - mutL --- (aboveListL (List.concat [[wordL(tagText ":") ^^ typeL v.Type]; - (match v.MemberInfo with None -> [] | Some mem_info -> [wordL(tagText "!") ^^ MemberL v mem_info]); - (match v.ValReprInfo with None -> [] | Some arity_info -> [wordL(tagText "#") ^^ arityInfoL arity_info])])) + mutL --- + aboveListL + [ yield wordL(tagText ":") ^^ typeL v.Type + match v.MemberInfo with None -> () | Some mem_info -> yield wordL(tagText "!") ^^ memberL v mem_info + match v.ValReprInfo with None -> () | Some arity_info -> yield wordL(tagText "#") ^^ arityInfoL arity_info] let unionCaseRefL (ucr:UnionCaseRef) = wordL (tagText ucr.CaseName) + let recdFieldRefL (rfref:RecdFieldRef) = wordL (tagText rfref.FieldName) - let identL (id:Ident) = wordL (tagText id.idText) + let identL (id:Ident) = wordL (tagText id.idText) // Note: We need nice printing of constants in order to print literals and attributes let constL c = let str = match c with - | Const.Bool x -> if x then "true" else "false" - | Const.SByte x -> (x |> string)+"y" - | Const.Byte x -> (x |> string)+"uy" - | Const.Int16 x -> (x |> string)+"s" - | Const.UInt16 x -> (x |> string)+"us" - | Const.Int32 x -> (x |> string) - | Const.UInt32 x -> (x |> string)+"u" - | Const.Int64 x -> (x |> string)+"L" - | Const.UInt64 x -> (x |> string)+"UL" - | Const.IntPtr x -> (x |> string)+"n" - | Const.UIntPtr x -> (x |> string)+"un" - | Const.Single d -> + | Const.Bool x -> if x then "true" else "false" + | Const.SByte x -> (x |> string)+"y" + | Const.Byte x -> (x |> string)+"uy" + | Const.Int16 x -> (x |> string)+"s" + | Const.UInt16 x -> (x |> string)+"us" + | Const.Int32 x -> (x |> string) + | Const.UInt32 x -> (x |> string)+"u" + | Const.Int64 x -> (x |> string)+"L" + | Const.UInt64 x -> (x |> string)+"UL" + | Const.IntPtr x -> (x |> string)+"n" + | Const.UIntPtr x -> (x |> string)+"un" + | Const.Single d -> (let s = d.ToString("g12", System.Globalization.CultureInfo.InvariantCulture) - if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s + if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s then s + ".0" else s) + "f" - | Const.Double d -> + | Const.Double d -> let s = d.ToString("g12", System.Globalization.CultureInfo.InvariantCulture) - if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s + if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s then s + ".0" else s - | Const.Char c -> "'" + c.ToString() + "'" - | Const.String bs -> "\"" + bs + "\"" - | Const.Unit -> "()" - | Const.Decimal bs -> string bs + "M" - | Const.Zero -> "default" + | Const.Char c -> "'" + c.ToString() + "'" + | Const.String bs -> "\"" + bs + "\"" + | Const.Unit -> "()" + | Const.Decimal bs -> string bs + "M" + | Const.Zero -> "default" wordL (tagText str) let rec tyconL (tycon:Tycon) = @@ -3508,11 +3540,11 @@ module DebugPrint = begin | _ -> tycon.ImmediateInterfacesOfFSharpTycon let iimpls = iimpls |> List.filter (fun (_, compgen, _) -> not compgen) // if TTyconInterface, the iimpls should be printed as inherited interfaces - if isNil adhoc && isNil iimpls - then emptyL + if isNil adhoc && isNil iimpls then + emptyL else let iimplsLs = iimpls |> List.map (fun (ty, _, _) -> wordL(tagText "interface") --- typeL ty) - let adhocLs = adhoc |> List.map (fun vref -> valAtBindL vref.Deref) + let adhocLs = adhoc |> List.map (fun vref -> valAtBindL vref.Deref) (wordL(tagText "with") @@-- aboveListL (iimplsLs @ adhocLs)) @@ wordL(tagText "end") let layoutUnionCaseArgTypes argtys = sepListL (wordL(tagText "*")) (List.map typeL argtys) @@ -3520,7 +3552,7 @@ module DebugPrint = begin let ucaseL prefixL (ucase: UnionCase) = let nmL = wordL (tagText (DemangleOperatorName ucase.Id.idText)) match ucase.RecdFields |> List.map (fun rfld -> rfld.FormalType) with - | [] -> (prefixL ^^ nmL) + | [] -> (prefixL ^^ nmL) | argtys -> (prefixL ^^ nmL ^^ wordL(tagText "of")) --- layoutUnionCaseArgTypes argtys let layoutUnionCases ucases = @@ -3535,7 +3567,7 @@ module DebugPrint = begin let tyconReprL (repr, tycon:Tycon) = match repr with | TRecdRepr _ -> - tycon.TrueFieldsAsList |> List.map (fun fld -> layoutRecdField fld ^^ rightL(tagText ";")) |> aboveListL + tycon.TrueFieldsAsList |> List.map (fun fld -> layoutRecdField fld ^^ rightL(tagText ";")) |> aboveListL | TFSharpObjectRepr r -> match r.fsobjmodel_kind with | TTyconDelegate _ -> @@ -3560,15 +3592,16 @@ module DebugPrint = begin tycon.MembersOfFSharpTyconSorted |> List.filter (fun v -> v.IsDispatchSlot) |> List.map (fun vref -> valAtBindL vref.Deref) - let vals = tycon.TrueFieldsAsList |> List.map (fun f -> (if f.IsStatic then wordL(tagText "static") else emptyL) ^^ wordL(tagText "val") ^^ layoutRecdField f) + let vals = tycon.TrueFieldsAsList |> List.map (fun f -> (if f.IsStatic then wordL(tagText "static") else emptyL) ^^ wordL(tagText "val") ^^ layoutRecdField f) let alldecls = inherits @ vsprs @ vals let emptyMeasure = match tycon.TypeOrMeasureKind with TyparKind.Measure -> isNil alldecls | _ -> false if emptyMeasure then emptyL else (wordL (tagText start) @@-- aboveListL alldecls) @@ wordL(tagText "end") - | TUnionRepr _ -> tycon.UnionCasesAsList |> layoutUnionCases |> aboveListL - | TAsmRepr _ -> wordL(tagText "(# ... #)") - | TMeasureableRepr ty -> typeL ty + | TUnionRepr _ -> tycon.UnionCasesAsList |> layoutUnionCases |> aboveListL + | TAsmRepr _ -> wordL(tagText "(# ... #)") + | TMeasureableRepr ty -> typeL ty | TILObjectRepr (TILObjectReprData(_, _, td)) -> wordL (tagText td.Name) | _ -> failwith "unreachable" + let reprL = match tycon.TypeReprInfo with #if !NO_EXTENSIONTYPING @@ -3577,23 +3610,19 @@ module DebugPrint = begin #endif | TNoRepr -> match tycon.TypeAbbrev with - | None -> lhsL @@-- memberLs + | None -> lhsL @@-- memberLs | Some a -> (lhsL ^^ wordL(tagText "=")) --- (typeL a @@ memberLs) | a -> let rhsL = tyconReprL (a, tycon) @@ memberLs (lhsL ^^ wordL(tagText "=")) @@-- rhsL reprL - - //-------------------------------------------------------------------------- - // layout - bind, expr, dtree etc. - //-------------------------------------------------------------------------- - and bindingL (TBind(v, repr, _)) = valAtBindL v --- (wordL(tagText "=") ^^ exprL repr) and exprL expr = exprWrapL false expr - and atomL expr = exprWrapL true expr // true means bracket if needed to be atomic expr + + and atomL expr = exprWrapL true expr // true means bracket if needed to be atomic expr and letRecL binds bodyL = let eqnsL = @@ -3605,62 +3634,62 @@ module DebugPrint = begin and letL bind bodyL = let eqnL = wordL(tagText "let") ^^ bindingL bind ^^ wordL(tagText "in") (eqnL @@ bodyL) - + and exprWrapL isAtomic expr = let wrap = bracketIfL isAtomic // wrap iff require atomic expr let lay = match expr with - | Expr.Const (c, _, _) -> constL c + | Expr.Const (c, _, _) -> constL c | Expr.Val (v, flags, _) -> let xL = valL v.Deref let xL = match flags with - | PossibleConstrainedCall _ -> xL ^^ rightL(tagText "") - | CtorValUsedAsSelfInit -> xL ^^ rightL(tagText "") + | PossibleConstrainedCall _ -> xL ^^ rightL(tagText "") + | CtorValUsedAsSelfInit -> xL ^^ rightL(tagText "") | CtorValUsedAsSuperInit -> xL ^^ rightL(tagText "") | VSlotDirectCall -> xL ^^ rightL(tagText "") | NormalValUse -> xL xL - | Expr.Sequential (x0, x1, flag, _, _) -> + | Expr.Sequential (expr1, expr2, flag, _, _) -> let flag = match flag with - | NormalSeq -> "; (*Seq*)" - | ThenDoSeq -> "; (*ThenDo*)" - ((exprL x0 ^^ rightL (tagText flag)) @@ exprL x1) |> wrap - | Expr.Lambda(_, _, baseValOpt, argvs, body, _, _) -> + | NormalSeq -> "; (*Seq*)" + | ThenDoSeq -> "; (*ThenDo*)" + ((exprL expr1 ^^ rightL (tagText flag)) @@ exprL expr2) |> wrap + | Expr.Lambda(_, _, baseValOpt, argvs, body, _, _) -> let formalsL = spaceListL (List.map valAtBindL argvs) in let bindingL = match baseValOpt with - | None -> wordL(tagText "lam") ^^ formalsL ^^ rightL(tagText ".") + | None -> wordL(tagText "lam") ^^ formalsL ^^ rightL(tagText ".") | Some basev -> wordL(tagText "lam") ^^ (leftL(tagText "base=") ^^ valAtBindL basev) --- formalsL ^^ rightL(tagText ".") in (bindingL ++ exprL body) |> wrap | Expr.TyLambda(_, argtyvs, body, _, _) -> - ((wordL(tagText "LAM") ^^ spaceListL (List.map typarL argtyvs) ^^ rightL(tagText ".")) ++ exprL body) |> wrap + ((wordL(tagText "LAM") ^^ spaceListL (List.map typarL argtyvs) ^^ rightL(tagText ".")) ++ exprL body) |> wrap | Expr.TyChoose(argtyvs, body, _) -> - ((wordL(tagText "CHOOSE") ^^ spaceListL (List.map typarL argtyvs) ^^ rightL(tagText ".")) ++ exprL body) |> wrap + ((wordL(tagText "CHOOSE") ^^ spaceListL (List.map typarL argtyvs) ^^ rightL(tagText ".")) ++ exprL body) |> wrap | Expr.App (f, _, tys, argtys, _) -> let flayout = atomL f appL flayout tys argtys |> wrap | Expr.LetRec (binds, body, _, _) -> letRecL binds (exprL body) |> wrap - | Expr.Let (bind, body, _, _) -> + | Expr.Let (bind, body, _, _) -> letL bind (exprL body) |> wrap | Expr.Link rX -> (wordL(tagText "RecLink") --- atomL (!rX)) |> wrap | Expr.Match (_, _, dtree, targets, _, _) -> leftL(tagText "[") ^^ (decisionTreeL dtree @@ aboveListL (List.mapi targetL (targets |> Array.toList)) ^^ rightL(tagText "]")) - | Expr.Op (TOp.UnionCase (c), _, args, _) -> + | Expr.Op (TOp.UnionCase (c), _, args, _) -> (unionCaseRefL c ++ spaceListL (List.map atomL args)) |> wrap | Expr.Op (TOp.ExnConstr (ecref), _, args, _) -> wordL (tagText ecref.LogicalName) ^^ bracketL (commaListL (List.map atomL args)) | Expr.Op (TOp.Tuple _, _, xs, _) -> tupleL (List.map exprL xs) - | Expr.Op (TOp.Recd (ctor, tc), _, xs, _) -> + | Expr.Op (TOp.Recd (ctor, tc), _, xs, _) -> let fields = tc.TrueInstanceFieldsAsList let lay fs x = (wordL (tagText fs.rfield_id.idText) ^^ sepL(tagText "=")) --- (exprL x) let ctorL = match ctor with - | RecdExpr -> emptyL + | RecdExpr -> emptyL | RecdExprIsObjInit-> wordL(tagText "(new)") leftL(tagText "{") ^^ semiListL (List.map2 lay fields xs) ^^ rightL(tagText "}") ^^ ctorL | Expr.Op (TOp.ValFieldSet rf, _, [rx;x], _) -> @@ -3689,7 +3718,7 @@ module DebugPrint = begin atomL x --- (wordL(tagText ":>") ^^ typeL ty) | Expr.Op (TOp.Reraise, [_], [], _) -> wordL(tagText "Rethrow!") - | Expr.Op (TOp.ILAsm (a, tys), tyargs, args, _) -> + | Expr.Op (TOp.ILAsm (a, tys), tyargs, args, _) -> let instrs = a |> List.map (sprintf "%+A" >> tagText >> wordL) |> spaceListL // %+A has + since instrs are from an "internal" type let instrs = leftL(tagText "(#") ^^ instrs ^^ rightL(tagText "#)") (appL instrs tyargs args --- @@ -3698,11 +3727,14 @@ module DebugPrint = begin (lvalopL lvop ^^ valRefL vr --- bracketL (commaListL (List.map atomL args))) |> wrap | Expr.Op (TOp.ILCall (_isVirtCall, _isProtectedCall, _valu, _isNewObjCall, _valUseFlags, _isProperty, _noTailCall, ilMethRef, tinst, minst, _tys), tyargs, args, _) -> let meth = ilMethRef.Name - wordL(tagText "ILCall") ^^ aboveListL [wordL(tagText "meth ") --- wordL (tagText ilMethRef.DeclaringTypeRef.FullName) ^^ sepL(tagText ".") ^^ wordL (tagText meth); - wordL(tagText "tinst ") --- listL typeL tinst; - wordL(tagText "minst ") --- listL typeL minst; - wordL(tagText "tyargs") --- listL typeL tyargs; - wordL(tagText "args ") --- listL exprL args] |> wrap + wordL(tagText "ILCall") ^^ + aboveListL + [ wordL(tagText "meth ") --- wordL (tagText ilMethRef.DeclaringTypeRef.FullName) ^^ sepL(tagText ".") ^^ wordL (tagText meth) + wordL(tagText "tinst ") --- listL typeL tinst + wordL(tagText "minst ") --- listL typeL minst + wordL(tagText "tyargs") --- listL typeL tyargs + wordL(tagText "args ") --- listL exprL args ] + |> wrap | Expr.Op (TOp.Array, [_], xs, _) -> leftL(tagText "[|") ^^ commaListL (List.map exprL xs) ^^ rightL(tagText "|]") | Expr.Op (TOp.While _, [], [x1;x2], _) -> @@ -3714,24 +3746,25 @@ module DebugPrint = begin | Expr.Op (TOp.TryFinally _, [_], [x1;x2], _) -> wordL(tagText "try") ^^ exprL x1 ^^ wordL(tagText "finally") ^^ exprL x2 ^^ rightL(tagText "}") | Expr.Op (TOp.Bytes _, _ , _ , _) -> - wordL(tagText "bytes++") - | Expr.Op (TOp.UInt16s _, _ , _ , _) -> wordL(tagText "uint16++") - | Expr.Op (TOp.RefAddrGet _, _tyargs, _args, _) -> wordL(tagText "GetRefLVal...") - | Expr.Op (TOp.TraitCall _, _tyargs, _args, _) -> wordL(tagText "traitcall...") + wordL(tagText "bytes++") + | Expr.Op (TOp.UInt16s _, _ , _ , _) -> wordL(tagText "uint16++") + | Expr.Op (TOp.RefAddrGet _, _tyargs, _args, _) -> wordL(tagText "GetRefLVal...") + | Expr.Op (TOp.TraitCall _, _tyargs, _args, _) -> wordL(tagText "traitcall...") | Expr.Op (TOp.ExnFieldGet _, _tyargs, _args, _) -> wordL(tagText "TOp.ExnFieldGet...") | Expr.Op (TOp.ExnFieldSet _, _tyargs, _args, _) -> wordL(tagText "TOp.ExnFieldSet...") | Expr.Op (TOp.TryFinally _, _tyargs, _args, _) -> wordL(tagText "TOp.TryFinally...") - | Expr.Op (TOp.TryCatch _, _tyargs, _args, _) -> wordL(tagText "TOp.TryCatch...") - | Expr.Op (_, _tys, args, _) -> wordL(tagText "Expr.Op ...") ^^ bracketL (commaListL (List.map atomL args)) - | Expr.Quote (a, _, _, _, _) -> leftL(tagText "<@") ^^ atomL a ^^ rightL(tagText "@>") - | Expr.Obj (_lambdaId, ty, basev, ccall, overrides, iimpls, _) -> - wordL(tagText "OBJ:") ^^ aboveListL [typeL ty; - exprL ccall; - optionL valAtBindL basev; - aboveListL (List.map overrideL overrides); - aboveListL (List.map iimplL iimpls)] - - | Expr.StaticOptimization (_tcs, csx, x, _) -> + | Expr.Op (TOp.TryCatch _, _tyargs, _args, _) -> wordL(tagText "TOp.TryCatch...") + | Expr.Op (_, _tys, args, _) -> wordL(tagText "Expr.Op ...") ^^ bracketL (commaListL (List.map atomL args)) + | Expr.Quote (a, _, _, _, _) -> leftL(tagText "<@") ^^ atomL a ^^ rightL(tagText "@>") + | Expr.Obj (_lambdaId, ty, basev, ccall, overrides, iimpls, _) -> + wordL(tagText "OBJ:") ^^ + aboveListL [typeL ty + exprL ccall + optionL valAtBindL basev + aboveListL (List.map overrideL overrides) + aboveListL (List.map iimplL iimpls)] + + | Expr.StaticOptimization (_tcs, csx, x, _) -> (wordL(tagText "opt") @@- (exprL x)) @@-- (wordL(tagText "|") ^^ exprL csx --- (wordL(tagText "when...") )) @@ -3754,15 +3787,18 @@ module DebugPrint = begin and mexprL x = match x with - | ModuleOrNamespaceExprWithSig(mtyp, defs, _) -> mdefL defs @@- (wordL(tagText ":") @@- entityTypeL mtyp) + | ModuleOrNamespaceExprWithSig(mtyp, defs, _) -> mdefL defs @@- (wordL(tagText ":") @@- entityTypeL mtyp) + and mdefsL defs = wordL(tagText "Module Defs") @@-- aboveListL(List.map mdefL defs) + and mdefL x = match x with - | TMDefRec(_, tycons , mbinds, _) -> aboveListL ((tycons |> List.map tyconL) @ List.map mbindL mbinds) + | TMDefRec(_, tycons , mbinds, _) -> aboveListL ((tycons |> List.map tyconL) @ List.map mbindL mbinds) | TMDefLet(bind, _) -> letL bind emptyL | TMDefDo(e, _) -> exprL e - | TMDefs defs -> mdefsL defs; + | TMDefs defs -> mdefsL defs | TMAbstract mexpr -> mexprL mexpr + and mbindL x = match x with | ModuleOrNamespaceBinding.Binding bind -> letL bind emptyL @@ -3770,16 +3806,16 @@ module DebugPrint = begin (wordL (tagText (if mspec.IsNamespace then "namespace" else "module")) ^^ (wordL (tagText mspec.DemangledModuleOrNamespaceName) |> stampL mspec.Stamp)) @@-- mdefL rhs and entityTypeL (mtyp:ModuleOrNamespaceType) = - aboveListL [jlistL typeOfValL mtyp.AllValsAndMembers; - jlistL tyconL mtyp.AllEntities;] + aboveListL [jlistL typeOfValL mtyp.AllValsAndMembers + jlistL tyconL mtyp.AllEntities;] and entityL (ms:ModuleOrNamespace) = - let header = wordL(tagText "module") ^^ (wordL (tagText ms.DemangledModuleOrNamespaceName) |> stampL ms.Stamp) ^^ wordL(tagText ":") + let header = wordL(tagText "module") ^^ (wordL (tagText ms.DemangledModuleOrNamespaceName) |> stampL ms.Stamp) ^^ wordL(tagText ":") let footer = wordL(tagText "end") let body = entityTypeL ms.ModuleOrNamespaceType (header @@-- body) @@ footer - and ccuL (ccu:CcuThunk) = entityL ccu.Contents + and ccuL (ccu:CcuThunk) = entityL ccu.Contents and decisionTreeL x = match x with @@ -3792,38 +3828,41 @@ module DebugPrint = begin (wordL(tagText "Switch") --- exprL test) @@-- (aboveListL (List.map dcaseL dcases) @@ match dflt with - | None -> emptyL + | None -> emptyL | Some dtree -> wordL(tagText "dflt:") --- decisionTreeL dtree) and dcaseL (TCase (test, dtree)) = (dtestL test ^^ wordL(tagText "//")) --- decisionTreeL dtree and dtestL x = match x with - | (DecisionTreeTest.UnionCase (c, tinst)) -> wordL(tagText "is") ^^ unionCaseRefL c ^^ instL typeL tinst - | (DecisionTreeTest.ArrayLength (n, ty)) -> wordL(tagText "length") ^^ intL n ^^ typeL ty - | (DecisionTreeTest.Const c ) -> wordL(tagText "is") ^^ constL c - | (DecisionTreeTest.IsNull ) -> wordL(tagText "isnull") - | (DecisionTreeTest.IsInst (_, ty) ) -> wordL(tagText "isinst") ^^ typeL ty - | (DecisionTreeTest.ActivePatternCase (exp, _, _, _, _)) -> wordL(tagText "query") ^^ exprL exp - + | (DecisionTreeTest.UnionCase (c, tinst)) -> wordL(tagText "is") ^^ unionCaseRefL c ^^ instL typeL tinst + | (DecisionTreeTest.ArrayLength (n, ty)) -> wordL(tagText "length") ^^ intL n ^^ typeL ty + | (DecisionTreeTest.Const c) -> wordL(tagText "is") ^^ constL c + | (DecisionTreeTest.IsNull ) -> wordL(tagText "isnull") + | (DecisionTreeTest.IsInst (_, ty)) -> wordL(tagText "isinst") ^^ typeL ty + | (DecisionTreeTest.ActivePatternCase (exp, _, _, _, _)) -> wordL(tagText "query") ^^ exprL exp + and targetL i (TTarget (argvs, body, _)) = leftL(tagText "T") ^^ intL i ^^ tupleL (flatValsL argvs) ^^ rightL(tagText ":") --- exprL body + and flatValsL vs = vs |> List.map valL and tmethodL (TObjExprMethod(TSlotSig(nm, _, _, _, _, _), _, tps, vs, e, _)) = (wordL(tagText "TObjExprMethod") --- (wordL (tagText nm)) ^^ wordL(tagText "=")) -- - (wordL(tagText "METH-LAM") --- angleBracketListL (List.map typarL tps) ^^ rightL(tagText ".")) --- - (wordL(tagText "meth-lam") --- tupleL (List.map (List.map valAtBindL >> tupleL) vs) ^^ rightL(tagText ".")) --- + (wordL(tagText "METH-LAM") --- angleBracketListL (List.map typarL tps) ^^ rightL(tagText ".")) --- + (wordL(tagText "meth-lam") --- tupleL (List.map (List.map valAtBindL >> tupleL) vs) ^^ rightL(tagText ".")) --- (atomL e) - and overrideL tmeth = wordL(tagText "with") ^^ tmethodL tmeth + + and overrideL tmeth = wordL(tagText "with") ^^ tmethodL tmeth + and iimplL (ty, tmeths) = wordL(tagText "impl") ^^ aboveListL (typeL ty :: List.map tmethodL tmeths) let showType x = Layout.showL (typeL x) + let showExpr x = Layout.showL (exprL x) - let traitL x = auxTraitL SimplifyTypes.typeSimplificationInfo0 x - let typarsL x = layoutTyparDecls x -end + let traitL x = auxTraitL SimplifyTypes.typeSimplificationInfo0 x + let typarsL x = layoutTyparDecls x //-------------------------------------------------------------------------- // Helpers related to type checking modules & namespaces @@ -3843,39 +3882,38 @@ let wrapModuleOrNamespaceExprInNamespace (id :Ident) cpath mexpr = // cleanup: make this a property let SigTypeOfImplFile (TImplFile(_, _, mexpr, _, _, _)) = mexpr.Type - //-------------------------------------------------------------------------- // Data structures representing what gets hidden and what gets remapped (i.e. renamed or alpha-converted) // when a module signature is applied to a module. //-------------------------------------------------------------------------- type SignatureRepackageInfo = - { RepackagedVals : (ValRef * ValRef) list; + { RepackagedVals: (ValRef * ValRef) list RepackagedEntities: (TyconRef * TyconRef) list } member remapInfo.ImplToSigMapping = { TypeEquivEnv.Empty with EquivTycons = TyconRefMap.OfList remapInfo.RepackagedEntities } static member Empty = { RepackagedVals = []; RepackagedEntities= [] } type SignatureHidingInfo = - { HiddenTycons : Zset; - HiddenTyconReprs : Zset; - HiddenVals : Zset; - HiddenRecdFields : Zset; - HiddenUnionCases : Zset } + { HiddenTycons: Zset + HiddenTyconReprs: Zset + HiddenVals: Zset + HiddenRecdFields: Zset + HiddenUnionCases: Zset } static member Empty = - { HiddenTycons = Zset.empty tyconOrder; - HiddenTyconReprs = Zset.empty tyconOrder; - HiddenVals = Zset.empty valOrder; - HiddenRecdFields = Zset.empty recdFieldRefOrder; + { HiddenTycons = Zset.empty tyconOrder + HiddenTyconReprs = Zset.empty tyconOrder + HiddenVals = Zset.empty valOrder + HiddenRecdFields = Zset.empty recdFieldRefOrder HiddenUnionCases = Zset.empty unionCaseRefOrder } -let addValRemap v v' tmenv = - { tmenv with valRemap= tmenv.valRemap.Add v (mkLocalValRef v') } +let addValRemap v vNew tmenv = + { tmenv with valRemap= tmenv.valRemap.Add v (mkLocalValRef vNew) } let mkRepackageRemapping mrpi = - { valRemap = ValMap.OfList (mrpi.RepackagedVals |> List.map (fun (vref, x) -> vref.Deref, x)); - tpinst = emptyTyparInst; + { valRemap = ValMap.OfList (mrpi.RepackagedVals |> List.map (fun (vref, x) -> vref.Deref, x)) + tpinst = emptyTyparInst tyconRefRemap = TyconRefMap.OfList mrpi.RepackagedEntities removeTraitSolutions = false } @@ -3903,27 +3941,28 @@ let accEntityRemap (msigty:ModuleOrNamespaceType) (entity:Entity) (mrpi, mhi) = else // The type representation is present in the signature. // Find the fields that have been hidden or which were non-public anyway. - mhi - |> Array.foldBack (fun (rfield:RecdField) mhi -> - match sigtycon.GetFieldByName(rfield.Name) with - | Some _ -> - // The field is in the signature. Hence it is not hidden. - mhi - | _ -> - // The field is not in the signature. Hence it is regarded as hidden. - let rfref = tcref.MakeNestedRecdFieldRef rfield - { mhi with HiddenRecdFields = Zset.add rfref mhi.HiddenRecdFields }) - entity.AllFieldsArray - |> List.foldBack (fun (ucase:UnionCase) mhi -> - match sigtycon.GetUnionCaseByName ucase.DisplayName with - | Some _ -> - // The constructor is in the signature. Hence it is not hidden. - mhi - | _ -> - // The constructor is not in the signature. Hence it is regarded as hidden. - let ucref = tcref.MakeNestedUnionCaseRef ucase - { mhi with HiddenUnionCases = Zset.add ucref mhi.HiddenUnionCases }) - (entity.UnionCasesAsList) + let mhi = + (entity.AllFieldsArray, mhi) ||> Array.foldBack (fun rfield mhi -> + match sigtycon.GetFieldByName(rfield.Name) with + | Some _ -> + // The field is in the signature. Hence it is not hidden. + mhi + | _ -> + // The field is not in the signature. Hence it is regarded as hidden. + let rfref = tcref.MakeNestedRecdFieldRef rfield + { mhi with HiddenRecdFields = Zset.add rfref mhi.HiddenRecdFields }) + + let mhi = + (entity.UnionCasesAsList, mhi) ||> List.foldBack (fun ucase mhi -> + match sigtycon.GetUnionCaseByName ucase.DisplayName with + | Some _ -> + // The constructor is in the signature. Hence it is not hidden. + mhi + | _ -> + // The constructor is not in the signature. Hence it is regarded as hidden. + let ucref = tcref.MakeNestedUnionCaseRef ucase + { mhi with HiddenUnionCases = Zset.add ucref mhi.HiddenUnionCases }) + mhi (mrpi, mhi) let accSubEntityRemap (msigty:ModuleOrNamespaceType) (entity:Entity) (mrpi, mhi) = @@ -3973,12 +4012,12 @@ let rec accEntityRemapFromModuleOrNamespaceType (mty:ModuleOrNamespaceType) (msi acc let rec accValRemapFromModuleOrNamespaceType g aenv (mty:ModuleOrNamespaceType) msigty acc = - let acc = (mty.AllEntities, acc) ||> QueueList.foldBack (fun e acc -> accValRemapFromModuleOrNamespaceType g aenv e.ModuleOrNamespaceType (getCorrespondingSigTy e.LogicalName msigty) acc) + let acc = (mty.AllEntities, acc) ||> QueueList.foldBack (fun e acc -> accValRemapFromModuleOrNamespaceType g aenv e.ModuleOrNamespaceType (getCorrespondingSigTy e.LogicalName msigty) acc) let acc = (mty.AllValsAndMembers, acc) ||> QueueList.foldBack (accValRemap g aenv msigty) acc let ComputeRemappingFromInferredSignatureToExplicitSignature g mty msigty = - // dprintf "ComputeRemappingFromInferredSignatureToExplicitSignature, \nmty = %s\nmmsigty=%s\n" (showL(entityTypeL mty)) (showL(entityTypeL msigty)); + // dprintf "ComputeRemappingFromInferredSignatureToExplicitSignature, \nmty = %s\nmmsigty=%s\n" (showL(entityTypeL mty)) (showL(entityTypeL msigty)) let ((mrpi, _) as entityRemap) = accEntityRemapFromModuleOrNamespaceType mty msigty (SignatureRepackageInfo.Empty, SignatureHidingInfo.Empty) let aenv = mrpi.ImplToSigMapping let valAndEntityRemap = accValRemapFromModuleOrNamespaceType g aenv mty msigty entityRemap @@ -4017,7 +4056,6 @@ and accEntityRemapFromModuleOrNamespaceBind msigty x acc = | ModuleOrNamespaceBinding.Module(mspec, def) -> accSubEntityRemap msigty mspec (accEntityRemapFromModuleOrNamespace (getCorrespondingSigTy mspec.LogicalName msigty) def acc) - let rec accValRemapFromModuleOrNamespace g aenv msigty x acc = match x with | TMDefRec(_, tycons, mbinds, _) -> @@ -4030,6 +4068,7 @@ let rec accValRemapFromModuleOrNamespace g aenv msigty x acc = | TMDefDo _ -> acc | TMDefs defs -> accValRemapFromModuleOrNamespaceDefs g aenv msigty defs acc | TMAbstract mexpr -> accValRemapFromModuleOrNamespaceType g aenv mexpr.Type msigty acc + and accValRemapFromModuleOrNamespaceBind g aenv msigty x acc = match x with | ModuleOrNamespaceBinding.Binding bind -> accValRemap g aenv msigty bind.Var acc @@ -4039,7 +4078,7 @@ and accValRemapFromModuleOrNamespaceBind g aenv msigty x acc = and accValRemapFromModuleOrNamespaceDefs g aenv msigty mdefs acc = List.foldBack (accValRemapFromModuleOrNamespace g aenv msigty) mdefs acc let ComputeRemappingFromImplementationToSignature g mdef msigty = - //if verbose then dprintf "ComputeRemappingFromImplementationToSignature, \nmdefs = %s\nmsigty=%s\n" (showL(DebugPrint.mdefL mdef)) (showL(DebugPrint.entityTypeL msigty)); + //if verbose then dprintf "ComputeRemappingFromImplementationToSignature, \nmdefs = %s\nmsigty=%s\n" (showL(DebugPrint.mdefL mdef)) (showL(DebugPrint.entityTypeL msigty)) let ((mrpi, _) as entityRemap) = accEntityRemapFromModuleOrNamespace msigty mdef (SignatureRepackageInfo.Empty, SignatureHidingInfo.Empty) let aenv = mrpi.ImplToSigMapping @@ -4057,23 +4096,21 @@ let accTyconHidingInfoAtAssemblyBoundary (tycon:Tycon) mhi = elif not (canAccessFromEverywhere tycon.TypeReprAccessibility) then { mhi with HiddenTyconReprs = Zset.add tycon mhi.HiddenTyconReprs } else - mhi - |> Array.foldBack - (fun (rfield:RecdField) mhi -> - if not (canAccessFromEverywhere rfield.Accessibility) then - let tcref = mkLocalTyconRef tycon - let rfref = tcref.MakeNestedRecdFieldRef rfield - { mhi with HiddenRecdFields = Zset.add rfref mhi.HiddenRecdFields } - else mhi) - tycon.AllFieldsArray - |> List.foldBack - (fun (ucase:UnionCase) mhi -> - if not (canAccessFromEverywhere ucase.Accessibility) then - let tcref = mkLocalTyconRef tycon - let ucref = tcref.MakeNestedUnionCaseRef ucase - { mhi with HiddenUnionCases = Zset.add ucref mhi.HiddenUnionCases } - else mhi) - (tycon.UnionCasesAsList) + let mhi = + (tycon.AllFieldsArray, mhi) ||> Array.foldBack (fun rfield mhi -> + if not (canAccessFromEverywhere rfield.Accessibility) then + let tcref = mkLocalTyconRef tycon + let rfref = tcref.MakeNestedRecdFieldRef rfield + { mhi with HiddenRecdFields = Zset.add rfref mhi.HiddenRecdFields } + else mhi) + let mhi = + (tycon.UnionCasesAsList, mhi) ||> List.foldBack (fun ucase mhi -> + if not (canAccessFromEverywhere ucase.Accessibility) then + let tcref = mkLocalTyconRef tycon + let ucref = tcref.MakeNestedUnionCaseRef ucase + { mhi with HiddenUnionCases = Zset.add ucref mhi.HiddenUnionCases } + else mhi) + mhi // Collect up the values hidden at the assembly boundary. This is used by IsHiddenVal to // determine if something is considered hidden. This is used in turn to eliminate optimization @@ -4097,7 +4134,7 @@ let rec accModuleOrNamespaceHidingInfoAtAssemblyBoundary mty acc = acc let ComputeHidingInfoAtAssemblyBoundary mty acc = -// dprintf "ComputeRemappingFromInferredSignatureToExplicitSignature, \nmty = %s\nmmsigty=%s\n" (showL(entityTypeL mty)) (showL(entityTypeL msigty)); +// dprintf "ComputeRemappingFromInferredSignatureToExplicitSignature, \nmty = %s\nmmsigty=%s\n" (showL(entityTypeL mty)) (showL(entityTypeL msigty)) accModuleOrNamespaceHidingInfoAtAssemblyBoundary mty acc //-------------------------------------------------------------------------- @@ -4106,7 +4143,7 @@ let ComputeHidingInfoAtAssemblyBoundary mty acc = let IsHidden setF accessF remapF debugF = let rec check mrmi x = - if verbose then dprintf "IsHidden %s ??\n" (showL (debugF x)); + if verbose then dprintf "IsHidden %s ??\n" (showL (debugF x)) // Internal/private? not (canAccessFromEverywhere (accessF x)) || (match mrmi with @@ -4118,7 +4155,7 @@ let IsHidden setF accessF remapF debugF = check rest (remapF rpi x)) fun mrmi x -> let res = check mrmi x - if verbose then dprintf "IsHidden, #mrmi = %d, %s = %b\n" mrmi.Length (showL (debugF x)) res; + if verbose then dprintf "IsHidden, #mrmi = %d, %s = %b\n" mrmi.Length (showL (debugF x)) res res let IsHiddenTycon mrmi x = IsHidden (fun mhi -> mhi.HiddenTycons) (fun tc -> tc.Accessibility) (fun rpi x -> (remapTyconRef rpi.tyconRefRemap (mkLocalTyconRef x)).Deref) DebugPrint.tyconL mrmi x @@ -4126,7 +4163,6 @@ let IsHiddenTyconRepr mrmi x = IsHidden (fun mhi -> mhi.HiddenTyconReprs) (fun v let IsHiddenVal mrmi x = IsHidden (fun mhi -> mhi.HiddenVals) (fun v -> v.Accessibility) (fun rpi x -> (remapValRef rpi (mkLocalValRef x)).Deref) DebugPrint.valL mrmi x let IsHiddenRecdField mrmi x = IsHidden (fun mhi -> mhi.HiddenRecdFields) (fun rfref -> rfref.RecdField.Accessibility) (fun rpi x -> remapRecdFieldRef rpi.tyconRefRemap x) DebugPrint.recdFieldRefL mrmi x - //-------------------------------------------------------------------------- // Generic operations on module types //-------------------------------------------------------------------------- @@ -4146,10 +4182,10 @@ let allEntitiesOfModuleOrNamespaceTy m = foldModuleOrNamespaceTy (fun ft acc -> // Free variables in terms. Are all constructs public accessible? //--------------------------------------------------------------------------- -let isPublicVal (lv:Val) = (lv.Accessibility = taccessPublic) +let isPublicVal (lv:Val) = (lv.Accessibility = taccessPublic) let isPublicUnionCase (ucr:UnionCaseRef) = (ucr.UnionCase.Accessibility = taccessPublic) let isPublicRecdField (rfr:RecdFieldRef) = (rfr.RecdField.Accessibility = taccessPublic) -let isPublicTycon (tcr:Tycon) = (tcr.Accessibility = taccessPublic) +let isPublicTycon (tcref:Tycon) = (tcref.Accessibility = taccessPublic) let freeVarsAllPublic fvs = // Are any non-public items used in the expr (which corresponded to the fvs)? @@ -4171,10 +4207,10 @@ let freeVarsAllPublic fvs = let freeTyvarsAllPublic tyvars = Zset.forall isPublicTycon tyvars.FreeTycons - -// Detect the subset of match expressions we treat in a linear way -// -- if then else -// -- match e with pat[vs] -> e1[vs] | _ -> e2 +/// Detect the subset of match expressions we process in a linear way (i.e. using tailcalls, rather than +/// unbounded stack) +/// -- if then else +/// -- match e with pat[vs] -> e1[vs] | _ -> e2 let (|LinearMatchExpr|_|) expr = match expr with @@ -4184,30 +4220,41 @@ let (|LinearMatchExpr|_|) expr = let rebuildLinearMatchExpr (sp, m, dtree, tg1, e2, sp2, m2, ty) = primMkMatch (sp, m, dtree, [|tg1;(TTarget([], e2, sp2))|], m2, ty) +/// Detect a subset of 'Expr.Op' expressions we process in a linear way (i.e. using tailcalls, rather than +/// unbounded stack). Only covers Cons(args,Cons(args,Cons(args,Cons(args,...._)))). +let (|LinearOpExpr|_|) expr = + match expr with + | Expr.Op ((TOp.UnionCase _ as op), tinst, args, m) when not args.IsEmpty -> + let argsFront, argLast = List.frontAndBack args + Some (op, tinst, argsFront, argLast, m) + | _ -> None + +let rebuildLinearOpExpr (op, tinst, argsFront, argLast, m) = + Expr.Op (op, tinst, argsFront@[argLast], m) //--------------------------------------------------------------------------- // Free variables in terms. All binders are distinct. //--------------------------------------------------------------------------- let emptyFreeVars = - { UsesMethodLocalConstructs=false; - UsesUnboundRethrow=false; - FreeLocalTyconReprs=emptyFreeTycons; - FreeLocals=emptyFreeLocals; - FreeTyvars=emptyFreeTyvars; - FreeRecdFields = emptyFreeRecdFields; + { UsesMethodLocalConstructs=false + UsesUnboundRethrow=false + FreeLocalTyconReprs=emptyFreeTycons + FreeLocals=emptyFreeLocals + FreeTyvars=emptyFreeTyvars + FreeRecdFields = emptyFreeRecdFields FreeUnionCases = emptyFreeUnionCases} let unionFreeVars fvs1 fvs2 = if fvs1 === emptyFreeVars then fvs2 else if fvs2 === emptyFreeVars then fvs1 else - { FreeLocals = unionFreeLocals fvs1.FreeLocals fvs2.FreeLocals; - FreeTyvars = unionFreeTyvars fvs1.FreeTyvars fvs2.FreeTyvars; - UsesMethodLocalConstructs = fvs1.UsesMethodLocalConstructs || fvs2.UsesMethodLocalConstructs; - UsesUnboundRethrow = fvs1.UsesUnboundRethrow || fvs2.UsesUnboundRethrow; - FreeLocalTyconReprs = unionFreeTycons fvs1.FreeLocalTyconReprs fvs2.FreeLocalTyconReprs; - FreeRecdFields = unionFreeRecdFields fvs1.FreeRecdFields fvs2.FreeRecdFields; - FreeUnionCases = unionFreeUnionCases fvs1.FreeUnionCases fvs2.FreeUnionCases; } + { FreeLocals = unionFreeLocals fvs1.FreeLocals fvs2.FreeLocals + FreeTyvars = unionFreeTyvars fvs1.FreeTyvars fvs2.FreeTyvars + UsesMethodLocalConstructs = fvs1.UsesMethodLocalConstructs || fvs2.UsesMethodLocalConstructs + UsesUnboundRethrow = fvs1.UsesUnboundRethrow || fvs2.UsesUnboundRethrow + FreeLocalTyconReprs = unionFreeTycons fvs1.FreeLocalTyconReprs fvs2.FreeLocalTyconReprs + FreeRecdFields = unionFreeRecdFields fvs1.FreeRecdFields fvs2.FreeRecdFields + FreeUnionCases = unionFreeUnionCases fvs1.FreeUnionCases fvs2.FreeUnionCases } let inline accFreeTyvars (opts:FreeVarOptions) f v acc = if not opts.collectInTypes then acc else @@ -4305,13 +4352,13 @@ and accUsedRecdOrUnionTyconRepr opts (tc:Tycon) fvs = then accLocalTyconRepr opts tc fvs else fvs -and accFreeUnionCaseRef opts cr fvs = +and accFreeUnionCaseRef opts ucref fvs = if not opts.includeUnionCases then fvs else - if Zset.contains cr fvs.FreeUnionCases then fvs + if Zset.contains ucref fvs.FreeUnionCases then fvs else - let fvs = fvs |> accUsedRecdOrUnionTyconRepr opts cr.Tycon - let fvs = fvs |> accFreevarsInTycon opts cr.TyconRef - { fvs with FreeUnionCases = Zset.add cr fvs.FreeUnionCases } + let fvs = fvs |> accUsedRecdOrUnionTyconRepr opts ucref.Tycon + let fvs = fvs |> accFreevarsInTycon opts ucref.TyconRef + { fvs with FreeUnionCases = Zset.add ucref fvs.FreeUnionCases } and accFreeRecdFieldRef opts rfref fvs = if not opts.includeRecdFields then fvs else @@ -4356,23 +4403,29 @@ and accFreeInExprLinear (opts:FreeVarOptions) x acc contf = and accFreeInExprNonLinear opts x acc = match x with + // BINDING CONSTRUCTS - | Expr.Lambda (_, ctorThisValOpt, baseValOpt, vs, b, _, rty) -> + | Expr.Lambda (_, ctorThisValOpt, baseValOpt, vs, bodyExpr, _, rty) -> unionFreeVars (Option.foldBack (boundLocalVal opts) ctorThisValOpt (Option.foldBack (boundLocalVal opts) baseValOpt (boundLocalVals opts vs (accFreeVarsInTy opts rty - (freeInExpr opts b))))) + (freeInExpr opts bodyExpr))))) acc - | Expr.TyLambda (_, vs, b, _, rty) -> - unionFreeVars (accFreeTyvars opts boundTypars vs (accFreeVarsInTy opts rty (freeInExpr opts b))) acc - | Expr.TyChoose (vs, b, _) -> - unionFreeVars (accFreeTyvars opts boundTypars vs (freeInExpr opts b)) acc - | Expr.LetRec (binds, e, _, cache) -> - unionFreeVars (freeVarsCacheCompute opts cache (fun () -> List.foldBack (bindLhs opts) binds (List.foldBack (accBindRhs opts) binds (freeInExpr opts e)))) acc + + | Expr.TyLambda (_, vs, bodyExpr, _, rty) -> + unionFreeVars (accFreeTyvars opts boundTypars vs (accFreeVarsInTy opts rty (freeInExpr opts bodyExpr))) acc + + | Expr.TyChoose (vs, bodyExpr, _) -> + unionFreeVars (accFreeTyvars opts boundTypars vs (freeInExpr opts bodyExpr)) acc + + | Expr.LetRec (binds, bodyExpr, _, cache) -> + unionFreeVars (freeVarsCacheCompute opts cache (fun () -> List.foldBack (bindLhs opts) binds (List.foldBack (accBindRhs opts) binds (freeInExpr opts bodyExpr)))) acc + | Expr.Let _ -> failwith "unreachable - linear expr" + | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, _) -> unionFreeVars (boundProtect @@ -4382,47 +4435,55 @@ and accFreeInExprNonLinear opts x acc = (accFreeInMethods opts overrides (List.foldBack (accFreeInInterfaceImpl opts) iimpls emptyFreeVars)))))) acc + // NON-BINDING CONSTRUCTS | Expr.Const _ -> acc + | Expr.Val (lvr, flags, _) -> accFreeInValFlags opts flags (accFreeValRef opts lvr acc) + | Expr.Quote (ast, {contents=Some(_, argTypes, argExprs, _data)}, _, _, ty) -> accFreeInExpr opts ast (accFreeInExprs opts argExprs (accFreeVarsInTys opts argTypes (accFreeVarsInTy opts ty acc))) + | Expr.Quote (ast, {contents=None}, _, _, ty) -> accFreeInExpr opts ast (accFreeVarsInTy opts ty acc) + | Expr.App(f0, f0ty, tyargs, args, _) -> accFreeVarsInTy opts f0ty (accFreeInExpr opts f0 (accFreeVarsInTys opts tyargs (accFreeInExprs opts args acc))) + | Expr.Link(eref) -> accFreeInExpr opts !eref acc - | Expr.Sequential (e1, e2, _, _, _) -> - let acc = accFreeInExpr opts e1 acc - // tail-call - this is required because we should be able to handle (((e1; e2); e3); e4; .... )) - accFreeInExpr opts e2 acc - | Expr.StaticOptimization (_, e2, e3, _) -> accFreeInExpr opts e2 (accFreeInExpr opts e3 acc) + | Expr.Sequential (expr1, expr2, _, _, _) -> + let acc = accFreeInExpr opts expr1 acc + // tail-call - linear expression + accFreeInExpr opts expr2 acc + + | Expr.StaticOptimization (_, expr2, expr3, _) -> + accFreeInExpr opts expr2 (accFreeInExpr opts expr3 acc) + | Expr.Match (_, _, dtree, targets, _, _) -> match x with // Handle if-then-else - | LinearMatchExpr(_, _, dtree, tg1, e2, _, _, _) -> + | LinearMatchExpr(_, _, dtree, target, bodyExpr, _, _, _) -> let acc = accFreeInDecisionTree opts dtree acc - let acc = accFreeInTarget opts tg1 acc - accFreeInExpr opts e2 acc // tailcall + let acc = accFreeInTarget opts target acc + accFreeInExpr opts bodyExpr acc // tailcall | _ -> let acc = accFreeInDecisionTree opts dtree acc accFreeInTargets opts targets acc - //| Expr.Op (TOp.TryCatch, tinst, [Expr.Lambda(_, _, [_], e1, _, _, _); Expr.Lambda(_, _, [_], e2, _, _, _); Expr.Lambda(_, _, [_], e3, _, _, _)], _) -> - | Expr.Op (TOp.TryCatch _, tinst, [e1;e2;e3], _) -> + | Expr.Op (TOp.TryCatch _, tinst, [expr1; expr2; expr3], _) -> unionFreeVars (accFreeVarsInTys opts tinst - (accFreeInExprs opts [e1;e2] acc)) - (bound_rethrow (accFreeInExpr opts e3 emptyFreeVars)) + (accFreeInExprs opts [expr1; expr2] acc)) + (bound_rethrow (accFreeInExpr opts expr3 emptyFreeVars)) | Expr.Op (op, tinst, args, _) -> let acc = accFreeInOp opts op acc @@ -4445,34 +4506,44 @@ and accFreeInOp opts op acc = | TOp.Goto _ | TOp.Label _ | TOp.Return | TOp.TupleFieldGet _ -> acc - | TOp.Tuple tupInfo -> accFreeTyvars opts accFreeInTupInfo tupInfo acc + | TOp.Tuple tupInfo -> + accFreeTyvars opts accFreeInTupInfo tupInfo acc + | TOp.AnonRecd anonInfo - | TOp.AnonRecdGet (anonInfo, _) -> accFreeTyvars opts accFreeInTupInfo anonInfo.TupInfo acc + | TOp.AnonRecdGet (anonInfo, _) -> + accFreeTyvars opts accFreeInTupInfo anonInfo.TupInfo acc - | TOp.UnionCaseTagGet tr -> accUsedRecdOrUnionTyconRepr opts tr.Deref acc + | TOp.UnionCaseTagGet tcref -> + accUsedRecdOrUnionTyconRepr opts tcref.Deref acc // Things containing just a union case reference - | TOp.UnionCaseProof cr - | TOp.UnionCase cr - | TOp.UnionCaseFieldGetAddr (cr, _, _) - | TOp.UnionCaseFieldGet (cr, _) - | TOp.UnionCaseFieldSet (cr, _) -> accFreeUnionCaseRef opts cr acc + | TOp.UnionCaseProof ucref + | TOp.UnionCase ucref + | TOp.UnionCaseFieldGetAddr (ucref, _, _) + | TOp.UnionCaseFieldGet (ucref, _) + | TOp.UnionCaseFieldSet (ucref, _) -> + accFreeUnionCaseRef opts ucref acc // Things containing just an exception reference - | TOp.ExnConstr ecr - | TOp.ExnFieldGet (ecr, _) - | TOp.ExnFieldSet (ecr, _) -> accFreeExnRef ecr acc + | TOp.ExnConstr ecref + | TOp.ExnFieldGet (ecref, _) + | TOp.ExnFieldSet (ecref, _) -> + accFreeExnRef ecref acc - | TOp.ValFieldGet fr - | TOp.ValFieldGetAddr (fr, _) - | TOp.ValFieldSet fr -> accFreeRecdFieldRef opts fr acc + | TOp.ValFieldGet fref + | TOp.ValFieldGetAddr (fref, _) + | TOp.ValFieldSet fref -> + accFreeRecdFieldRef opts fref acc - | TOp.Recd (kind, tcr) -> + | TOp.Recd (kind, tcref) -> let acc = accUsesFunctionLocalConstructs (kind = RecdExprIsObjInit) acc - (accUsedRecdOrUnionTyconRepr opts tcr.Deref (accFreeTyvars opts accFreeTycon tcr acc)) + (accUsedRecdOrUnionTyconRepr opts tcref.Deref (accFreeTyvars opts accFreeTycon tcref acc)) - | TOp.ILAsm (_, tys) -> accFreeVarsInTys opts tys acc - | TOp.Reraise -> accUsesRethrow true acc + | TOp.ILAsm (_, tys) -> + accFreeVarsInTys opts tys acc + + | TOp.Reraise -> + accUsesRethrow true acc | TOp.TraitCall(TTrait(tys, _, _, argtys, rty, sln)) -> Option.foldBack (accFreeVarsInTraitSln opts) sln.Value @@ -4480,8 +4551,8 @@ and accFreeInOp opts op acc = (accFreeVarsInTys opts argtys (Option.foldBack (accFreeVarsInTy opts) rty acc))) - | TOp.LValueOp (_, lvr) -> - accFreeValRef opts lvr acc + | TOp.LValueOp (_, vref) -> + accFreeValRef opts vref acc | TOp.ILCall (_, isProtectedCall, _, _, valUseFlags, _, _, _, enclTypeArgs, methTypeArgs, tys) -> accFreeVarsInTys opts enclTypeArgs @@ -4493,77 +4564,86 @@ and accFreeInOp opts op acc = and accFreeInTargets opts targets acc = Array.foldBack (accFreeInTarget opts) targets acc -and accFreeInTarget opts (TTarget(vs, e, _)) acc = - List.foldBack (boundLocalVal opts) vs (accFreeInExpr opts e acc) +and accFreeInTarget opts (TTarget(vs, expr, _)) acc = + List.foldBack (boundLocalVal opts) vs (accFreeInExpr opts expr acc) -and accFreeInFlatExprs opts (es:Exprs) acc = List.foldBack (accFreeInExpr opts) es acc +and accFreeInFlatExprs opts (exprs:Exprs) acc = List.foldBack (accFreeInExpr opts) exprs acc -and accFreeInExprs opts (es: Exprs) acc = - match es with +and accFreeInExprs opts (exprs: Exprs) acc = + match exprs with | [] -> acc + | [h]-> + // tailcall - e.g. Cons(x, Cons(x2, .......Cons(x1000000, Nil))) and [| x1; .... ; x1000000 |] + accFreeInExpr opts h acc | h::t -> let acc = accFreeInExpr opts h acc - // tailcall - e.g. Cons(x, Cons(x2, .......Cons(x1000000, Nil))) and [| x1; .... ; x1000000 |] accFreeInExprs opts t acc -and accFreeInSlotSig opts (TSlotSig(_, ty, _, _, _, _)) acc = accFreeVarsInTy opts ty acc +and accFreeInSlotSig opts (TSlotSig(_, ty, _, _, _, _)) acc = + accFreeVarsInTy opts ty acc -and freeInDecisionTree opts e = accFreeInDecisionTree opts e emptyFreeVars -and freeInExpr opts e = accFreeInExpr opts e emptyFreeVars +and freeInDecisionTree opts dtree = + accFreeInDecisionTree opts dtree emptyFreeVars + +and freeInExpr opts expr = + accFreeInExpr opts expr emptyFreeVars // Note: these are only an approximation - they are currently used only by the optimizer -let rec accFreeInModuleOrNamespace opts x acc = - match x with +let rec accFreeInModuleOrNamespace opts mexpr acc = + match mexpr with | TMDefRec(_, _, mbinds, _) -> List.foldBack (accFreeInModuleOrNamespaceBind opts) mbinds acc | TMDefLet(bind, _) -> accBindRhs opts bind acc | TMDefDo(e, _) -> accFreeInExpr opts e acc | TMDefs defs -> accFreeInModuleOrNamespaces opts defs acc | TMAbstract(ModuleOrNamespaceExprWithSig(_, mdef, _)) -> accFreeInModuleOrNamespace opts mdef acc // not really right, but sufficient for how this is used in optimization -and accFreeInModuleOrNamespaceBind opts x acc = - match x with + +and accFreeInModuleOrNamespaceBind opts mbind acc = + match mbind with | ModuleOrNamespaceBinding.Binding bind -> accBindRhs opts bind acc | ModuleOrNamespaceBinding.Module (_, def) -> accFreeInModuleOrNamespace opts def acc -and accFreeInModuleOrNamespaces opts x acc = - List.foldBack (accFreeInModuleOrNamespace opts) x acc -// NOTE: we don't yet need to ask for free variables in module expressions +and accFreeInModuleOrNamespaces opts mexprs acc = + List.foldBack (accFreeInModuleOrNamespace opts) mexprs acc + +let freeInBindingRhs opts bind = + accBindRhs opts bind emptyFreeVars -let freeInBindingRhs opts bind = accBindRhs opts bind emptyFreeVars -let freeInModuleOrNamespace opts mdef = accFreeInModuleOrNamespace opts mdef emptyFreeVars +let freeInModuleOrNamespace opts mdef = + accFreeInModuleOrNamespace opts mdef emptyFreeVars //--------------------------------------------------------------------------- // Destruct - rarely needed //--------------------------------------------------------------------------- -let rec stripLambda (e, ty) = - match e with - | Expr.Lambda (_, ctorThisValOpt, baseValOpt, v, b, _, rty) -> - if Option.isSome ctorThisValOpt then errorR(InternalError("skipping ctorThisValOpt", e.Range)); - if Option.isSome baseValOpt then errorR(InternalError("skipping baseValOpt", e.Range)); - let (vs', b', rty') = stripLambda (b, rty) - (v :: vs', b', rty') - | _ -> ([], e, ty) - -let rec stripLambdaN n e = +let rec stripLambda (expr, ty) = + match expr with + | Expr.Lambda (_, ctorThisValOpt, baseValOpt, v, bodyExpr, _, rty) -> + if Option.isSome ctorThisValOpt then errorR(InternalError("skipping ctorThisValOpt", expr.Range)) + if Option.isSome baseValOpt then errorR(InternalError("skipping baseValOpt", expr.Range)) + let (vs', bodyExpr', rty') = stripLambda (bodyExpr, rty) + (v :: vs', bodyExpr', rty') + | _ -> ([], expr, ty) + +let rec stripLambdaN n expr = assert (n >= 0) - match e with - | Expr.Lambda (_, ctorThisValOpt, baseValOpt, v, body, _, _) when n > 0 -> - if Option.isSome ctorThisValOpt then errorR(InternalError("skipping ctorThisValOpt", e.Range)); - if Option.isSome baseValOpt then errorR(InternalError("skipping baseValOpt", e.Range)); - let (vs, body', remaining) = stripLambdaN (n-1) body - (v :: vs, body', remaining) - | _ -> ([], e, n) - -let tryStripLambdaN n e = - match e with + match expr with + | Expr.Lambda (_, ctorThisValOpt, baseValOpt, v, bodyExpr, _, _) when n > 0 -> + if Option.isSome ctorThisValOpt then errorR(InternalError("skipping ctorThisValOpt", expr.Range)) + if Option.isSome baseValOpt then errorR(InternalError("skipping baseValOpt", expr.Range)) + let (vs, bodyExpr', remaining) = stripLambdaN (n-1) bodyExpr + (v :: vs, bodyExpr', remaining) + | _ -> ([], expr, n) + +let tryStripLambdaN n expr = + match expr with | Expr.Lambda(_, None, None, _, _, _, _) -> - let argvsl, body, remaining = stripLambdaN n e - if remaining = 0 then Some (argvsl, body) + let argvsl, bodyExpr, remaining = stripLambdaN n expr + if remaining = 0 then Some (argvsl, bodyExpr) else None | _ -> None -let stripTopLambda (e, ty) = - let tps, taue, tauty = match e with Expr.TyLambda (_, tps, b, _, rty) -> tps, b, rty | _ -> [], e, ty +let stripTopLambda (expr, ty) = + let tps, taue, tauty = match expr with Expr.TyLambda (_, tps, b, _, rty) -> tps, b, rty | _ -> [], expr, ty let vs, body, rty = stripLambda (taue, tauty) tps, vs, body, rty @@ -4572,7 +4652,7 @@ type AllowTypeDirectedDetupling = Yes | No // This is used to infer arities of expressions // i.e. base the chosen arity on the syntactic expression shape and type of arguments -let InferArityOfExpr g allowTypeDirectedDetupling ty partialArgAttribsL retAttribs e = +let InferArityOfExpr g allowTypeDirectedDetupling ty partialArgAttribsL retAttribs expr = let rec stripLambda_notypes e = match e with | Expr.Lambda (_, _, _, vs, b, _, _) -> @@ -4586,7 +4666,7 @@ let InferArityOfExpr g allowTypeDirectedDetupling ty partialArgAttribsL retAttri let vs, body = stripLambda_notypes taue tps, vs, body - let tps, vsl, _ = stripTopLambdaNoTypes e + let tps, vsl, _ = stripTopLambdaNoTypes expr let fun_arity = vsl.Length let dtys, _ = stripFunTyN g fun_arity (snd (tryDestForallTy g ty)) let partialArgAttribsL = Array.ofList partialArgAttribsL @@ -4611,10 +4691,10 @@ let InferArityOfExpr g allowTypeDirectedDetupling ty partialArgAttribsL retAttri let retInfo : ArgReprInfo = { Attribs = retAttribs; Name = None } ValReprInfo (ValReprInfo.InferTyparInfo tps, curriedArgInfos, retInfo) -let InferArityOfExprBinding g allowTypeDirectedDetupling (v:Val) e = +let InferArityOfExprBinding g allowTypeDirectedDetupling (v:Val) expr = match v.ValReprInfo with | Some info -> info - | None -> InferArityOfExpr g allowTypeDirectedDetupling v.Type [] [] e + | None -> InferArityOfExpr g allowTypeDirectedDetupling v.Type [] [] expr //------------------------------------------------------------------------- // Check if constraints are satisfied that allow us to use more optimized @@ -4651,12 +4731,10 @@ let underlyingTypeOfEnumTy (g: TcGlobals) ty = | Some rf -> rf.FormalType | None -> error(InternalError("no 'value__' field found for enumeration type " + tycon.LogicalName, tycon.Range)) - // CLEANUP NOTE: Get rid of this mutation. let setValHasNoArity (f:Val) = f.SetValReprInfo None; f - //-------------------------------------------------------------------------- // Resolve static optimization constraints //-------------------------------------------------------------------------- @@ -4725,7 +4803,6 @@ let mkStaticOptimizationExpr g (cs, e1, e2, m) = // Used to inline expressions. //-------------------------------------------------------------------------- - type ValCopyFlag = | CloneAll | CloneAllAndMarkExprValsAsCompilerGenerated @@ -4841,8 +4918,16 @@ and copyAndRemapAndBindVal g compgen tmenv v = fixupValData g compgen tmenvinner v2 v2, tmenvinner -and remapExpr (g: TcGlobals) (compgen:ValCopyFlag) (tmenv:Remap) x = - match x with +and remapExpr (g: TcGlobals) (compgen:ValCopyFlag) (tmenv:Remap) expr = + match expr with + + // Handle the linear cases for arbitrary-sized inputs + | LinearOpExpr _ + | LinearMatchExpr _ + | Expr.Sequential _ + | Expr.Let _ -> + remapLinearExpr g compgen tmenv expr (fun x -> x) + // Binding constructs - see also dtrees below | Expr.Lambda (_, ctorThisValOpt, baseValOpt, vs, b, m, rty) -> let ctorThisValOpt, tmenv = Option.mapFold (copyAndRemapAndBindVal g compgen) tmenv ctorThisValOpt @@ -4851,39 +4936,44 @@ and remapExpr (g: TcGlobals) (compgen:ValCopyFlag) (tmenv:Remap) x = let b = remapExpr g compgen tmenv b let rty = remapType tmenv rty Expr.Lambda (newUnique(), ctorThisValOpt, baseValOpt, vs, b, m, rty) + | Expr.TyLambda (_, tps, b, m, rty) -> let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv tps mkTypeLambda m tps' (remapExpr g compgen tmenvinner b, remapType tmenvinner rty) + | Expr.TyChoose (tps, b, m) -> let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv tps Expr.TyChoose(tps', remapExpr g compgen tmenvinner b, m) + | Expr.LetRec (binds, e, m, _) -> let binds', tmenvinner = copyAndRemapAndBindBindings g compgen tmenv binds Expr.LetRec (binds', remapExpr g compgen tmenvinner e, m, NewFreeVarsCache()) - | Expr.Sequential _ - | Expr.Let _ -> remapLinearExpr g compgen tmenv x (fun x -> x) + | Expr.Match (spBind, exprm, pt, targets, m, ty) -> primMkMatch (spBind, exprm, remapDecisionTree g compgen tmenv pt, targets |> Array.map (remapTarget g compgen tmenv), m, remapType tmenv ty) - // Other constructs + | Expr.Val (vr, vf, m) -> let vr' = remapValRef tmenv vr let vf' = remapValFlags tmenv vf - if vr === vr' && vf === vf' then x + if vr === vr' && vf === vf' then expr else Expr.Val (vr', vf', m) + | Expr.Quote (a, {contents=Some(typeDefs, argTypes, argExprs, data)}, isFromQueryExpression, m, ty) -> // fix value of compgen for both original expression and pickled AST let compgen = fixValCopyFlagForQuotations compgen Expr.Quote (remapExpr g compgen tmenv a, {contents=Some(typeDefs, remapTypesAux tmenv argTypes, remapExprs g compgen tmenv argExprs, data)}, isFromQueryExpression, m, remapType tmenv ty) + | Expr.Quote (a, {contents=None}, isFromQueryExpression, m, ty) -> Expr.Quote (remapExpr g (fixValCopyFlagForQuotations compgen) tmenv a, {contents=None}, isFromQueryExpression, m, remapType tmenv ty) + | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, m) -> let basev', tmenvinner = Option.mapFold (copyAndRemapAndBindVal g compgen) tmenv basev - mkObjExpr(remapType tmenv ty, basev', - remapExpr g compgen tmenv basecall, - List.map (remapMethod g compgen tmenvinner) overrides, - List.map (remapInterfaceImpl g compgen tmenvinner) iimpls, m) + mkObjExpr (remapType tmenv ty, basev', + remapExpr g compgen tmenv basecall, + List.map (remapMethod g compgen tmenvinner) overrides, + List.map (remapInterfaceImpl g compgen tmenvinner) iimpls, m) // Addresses of immutable field may "leak" across assembly boundaries - see CanTakeAddressOfRecdFieldRef below. // This is "ok", in the sense that it is always valid to fix these up to be uses @@ -4912,7 +5002,7 @@ and remapExpr (g: TcGlobals) (compgen:ValCopyFlag) (tmenv:Remap) x = let op' = remapOp tmenv op let tinst' = remapTypes tmenv tinst let args' = remapExprs g compgen tmenv args - if op === op' && tinst === tinst' && args === args' then x + if op === op' && tinst === tinst' && args === args' then expr else Expr.Op (op', tinst', args', m) | Expr.App(e1, e1ty, tyargs, args, m) -> @@ -4920,45 +5010,59 @@ and remapExpr (g: TcGlobals) (compgen:ValCopyFlag) (tmenv:Remap) x = let e1ty' = remapPossibleForallTy g tmenv e1ty let tyargs' = remapTypes tmenv tyargs let args' = remapExprs g compgen tmenv args - if e1 === e1' && e1ty === e1ty' && tyargs === tyargs' && args === args' then x + if e1 === e1' && e1ty === e1ty' && tyargs === tyargs' && args === args' then expr else Expr.App(e1', e1ty', tyargs', args', m) + | Expr.Link(eref) -> remapExpr g compgen tmenv !eref + | Expr.StaticOptimization (cs, e2, e3, m) -> // note that type instantiation typically resolve the static constraints here mkStaticOptimizationExpr g (List.map (remapConstraint tmenv) cs, remapExpr g compgen tmenv e2, remapExpr g compgen tmenv e3, m) | Expr.Const (c, m, ty) -> let ty' = remapType tmenv ty - if ty === ty' then x else Expr.Const (c, m, ty') + if ty === ty' then expr else Expr.Const (c, m, ty') and remapTarget g compgen tmenv (TTarget(vs, e, spTarget)) = let vs', tmenvinner = copyAndRemapAndBindVals g compgen tmenv vs TTarget(vs', remapExpr g compgen tmenvinner e, spTarget) -and remapLinearExpr g compgen tmenv e contf = - match e with - | Expr.Let (bind, e, m, _) -> - let bind', tmenvinner = copyAndRemapAndBindBinding g compgen tmenv bind - // tailcall - remapLinearExpr g compgen tmenvinner e (contf << mkLetBind m bind') +and remapLinearExpr g compgen tmenv expr contf = - | Expr.Sequential (e1, e2, dir, spSeq, m) -> - let e1' = remapExpr g compgen tmenv e1 - // tailcall - remapLinearExpr g compgen tmenv e2 (contf << (fun e2' -> - if e1 === e1' && e2 === e2' then e - else Expr.Sequential (e1', e2', dir, spSeq, m))) + match expr with - | LinearMatchExpr (spBind, exprm, dtree, tg1, e2, sp2, m2, ty) -> - let dtree = remapDecisionTree g compgen tmenv dtree - let tg1 = remapTarget g compgen tmenv tg1 - let ty = remapType tmenv ty - // tailcall - remapLinearExpr g compgen tmenv e2 (contf << (fun e2 -> - rebuildLinearMatchExpr (spBind, exprm, dtree, tg1, e2, sp2, m2, ty))) + | Expr.Let (bind, bodyExpr, m, _) -> + let bind', tmenvinner = copyAndRemapAndBindBinding g compgen tmenv bind + // tailcall for the linear position + remapLinearExpr g compgen tmenvinner bodyExpr (contf << mkLetBind m bind') + + | Expr.Sequential (expr1, expr2, dir, spSeq, m) -> + let expr1' = remapExpr g compgen tmenv expr1 + // tailcall for the linear position + remapLinearExpr g compgen tmenv expr2 (contf << (fun expr2' -> + if expr1 === expr1' && expr2 === expr2' then expr + else Expr.Sequential (expr1', expr2', dir, spSeq, m))) + + | LinearMatchExpr (spBind, exprm, dtree, tg1, expr2, sp2, m2, ty) -> + let dtree' = remapDecisionTree g compgen tmenv dtree + let tg1' = remapTarget g compgen tmenv tg1 + let ty' = remapType tmenv ty + // tailcall for the linear position + remapLinearExpr g compgen tmenv expr2 (contf << (fun expr2' -> + rebuildLinearMatchExpr (spBind, exprm, dtree', tg1', expr2', sp2, m2, ty'))) + + | LinearOpExpr (op, tyargs, argsFront, argLast, m) -> + let op' = remapOp tmenv op + let tinst' = remapTypes tmenv tyargs + let argsFront' = remapExprs g compgen tmenv argsFront + // tailcall for the linear position + remapLinearExpr g compgen tmenv argLast (contf << (fun argLast' -> + if op === op' && tyargs === tinst' && argsFront === argsFront' && argLast === argLast' then expr + else rebuildLinearOpExpr (op', tinst', argsFront', argLast', m))) - | _ -> contf (remapExpr g compgen tmenv e) + | _ -> + contf (remapExpr g compgen tmenv expr) and remapConstraint tyenv c = match c with @@ -4967,38 +5071,38 @@ and remapConstraint tyenv c = and remapOp tmenv op = match op with - | TOp.Recd (ctor, tcr) -> TOp.Recd(ctor, remapTyconRef tmenv.tyconRefRemap tcr) - | TOp.UnionCaseTagGet tcr -> TOp.UnionCaseTagGet(remapTyconRef tmenv.tyconRefRemap tcr) - | TOp.UnionCase(ucref) -> TOp.UnionCase(remapUnionCaseRef tmenv.tyconRefRemap ucref) - | TOp.UnionCaseProof(ucref) -> TOp.UnionCaseProof(remapUnionCaseRef tmenv.tyconRefRemap ucref) - | TOp.ExnConstr ec -> TOp.ExnConstr(remapTyconRef tmenv.tyconRefRemap ec) - | TOp.ExnFieldGet(ec, n) -> TOp.ExnFieldGet(remapTyconRef tmenv.tyconRefRemap ec, n) - | TOp.ExnFieldSet(ec, n) -> TOp.ExnFieldSet(remapTyconRef tmenv.tyconRefRemap ec, n) - | TOp.ValFieldSet rfref -> TOp.ValFieldSet(remapRecdFieldRef tmenv.tyconRefRemap rfref) - | TOp.ValFieldGet rfref -> TOp.ValFieldGet(remapRecdFieldRef tmenv.tyconRefRemap rfref) - | TOp.ValFieldGetAddr (rfref, readonly) -> TOp.ValFieldGetAddr(remapRecdFieldRef tmenv.tyconRefRemap rfref, readonly) - | TOp.UnionCaseFieldGet(ucref, n) -> TOp.UnionCaseFieldGet(remapUnionCaseRef tmenv.tyconRefRemap ucref, n) - | TOp.UnionCaseFieldGetAddr(ucref, n, readonly) -> TOp.UnionCaseFieldGetAddr(remapUnionCaseRef tmenv.tyconRefRemap ucref, n, readonly) - | TOp.UnionCaseFieldSet(ucref, n) -> TOp.UnionCaseFieldSet(remapUnionCaseRef tmenv.tyconRefRemap ucref, n) - | TOp.ILAsm (instrs, tys) -> + | TOp.Recd (ctor, tcref) -> TOp.Recd(ctor, remapTyconRef tmenv.tyconRefRemap tcref) + | TOp.UnionCaseTagGet tcref -> TOp.UnionCaseTagGet(remapTyconRef tmenv.tyconRefRemap tcref) + | TOp.UnionCase ucref -> TOp.UnionCase(remapUnionCaseRef tmenv.tyconRefRemap ucref) + | TOp.UnionCaseProof ucref -> TOp.UnionCaseProof(remapUnionCaseRef tmenv.tyconRefRemap ucref) + | TOp.ExnConstr ec -> TOp.ExnConstr(remapTyconRef tmenv.tyconRefRemap ec) + | TOp.ExnFieldGet (ec, n) -> TOp.ExnFieldGet(remapTyconRef tmenv.tyconRefRemap ec, n) + | TOp.ExnFieldSet (ec, n) -> TOp.ExnFieldSet(remapTyconRef tmenv.tyconRefRemap ec, n) + | TOp.ValFieldSet rfref -> TOp.ValFieldSet(remapRecdFieldRef tmenv.tyconRefRemap rfref) + | TOp.ValFieldGet rfref -> TOp.ValFieldGet(remapRecdFieldRef tmenv.tyconRefRemap rfref) + | TOp.ValFieldGetAddr (rfref, readonly) -> TOp.ValFieldGetAddr(remapRecdFieldRef tmenv.tyconRefRemap rfref, readonly) + | TOp.UnionCaseFieldGet (ucref, n) -> TOp.UnionCaseFieldGet(remapUnionCaseRef tmenv.tyconRefRemap ucref, n) + | TOp.UnionCaseFieldGetAddr (ucref, n, readonly) -> TOp.UnionCaseFieldGetAddr(remapUnionCaseRef tmenv.tyconRefRemap ucref, n, readonly) + | TOp.UnionCaseFieldSet (ucref, n) -> TOp.UnionCaseFieldSet(remapUnionCaseRef tmenv.tyconRefRemap ucref, n) + | TOp.ILAsm (instrs, tys) -> let tys2 = remapTypes tmenv tys if tys === tys2 then op else TOp.ILAsm (instrs, tys2) - | TOp.TraitCall(traitInfo) -> TOp.TraitCall(remapTraitAux tmenv traitInfo) - | TOp.LValueOp (kind, lvr) -> TOp.LValueOp (kind, remapValRef tmenv lvr) + | TOp.TraitCall traitInfo -> TOp.TraitCall(remapTraitAux tmenv traitInfo) + | TOp.LValueOp (kind, lvr) -> TOp.LValueOp (kind, remapValRef tmenv lvr) | TOp.ILCall (isVirtCall, isProtectedCall, valu, isNewObjCall, valUseFlags, isProperty, noTailCall, ilMethRef, enclTypeArgs, methTypeArgs, tys) -> TOp.ILCall (isVirtCall, isProtectedCall, valu, isNewObjCall, remapValFlags tmenv valUseFlags, isProperty, noTailCall, ilMethRef, remapTypes tmenv enclTypeArgs, remapTypes tmenv methTypeArgs, remapTypes tmenv tys) | _ -> op - and remapValFlags tmenv x = match x with | PossibleConstrainedCall ty -> PossibleConstrainedCall (remapType tmenv ty) | _ -> x and remapExprs g compgen tmenv es = List.mapq (remapExpr g compgen tmenv) es + and remapFlatExprs g compgen tmenv es = List.mapq (remapExpr g compgen tmenv) es and remapDecisionTree g compgen tmenv x = @@ -5009,10 +5113,10 @@ and remapDecisionTree g compgen tmenv x = let test' = match test with | DecisionTreeTest.UnionCase (uc, tinst) -> DecisionTreeTest.UnionCase(remapUnionCaseRef tmenv.tyconRefRemap uc, remapTypes tmenv tinst) - | DecisionTreeTest.ArrayLength (n, ty) -> DecisionTreeTest.ArrayLength(n, remapType tmenv ty) - | DecisionTreeTest.Const _ -> test - | DecisionTreeTest.IsInst (srcty, tgty) -> DecisionTreeTest.IsInst (remapType tmenv srcty, remapType tmenv tgty) - | DecisionTreeTest.IsNull -> DecisionTreeTest.IsNull + | DecisionTreeTest.ArrayLength (n, ty) -> DecisionTreeTest.ArrayLength(n, remapType tmenv ty) + | DecisionTreeTest.Const _ -> test + | DecisionTreeTest.IsInst (srcty, tgty) -> DecisionTreeTest.IsInst (remapType tmenv srcty, remapType tmenv tgty) + | DecisionTreeTest.IsNull -> DecisionTreeTest.IsNull | DecisionTreeTest.ActivePatternCase _ -> failwith "DecisionTreeTest.ActivePatternCase should only be used during pattern match compilation" TCase(test', remapDecisionTree g compgen tmenv y)) csl, Option.map (remapDecisionTree g compgen tmenv) dflt, @@ -5048,34 +5152,38 @@ and remapInterfaceImpl g compgen tmenv (ty, overrides) = and remapRecdField g tmenv x = { x with - rfield_type = x.rfield_type |> remapPossibleForallTy g tmenv; - rfield_pattribs = x.rfield_pattribs |> remapAttribs g tmenv; - rfield_fattribs = x.rfield_fattribs |> remapAttribs g tmenv; } -and remapRecdFields g tmenv (x:TyconRecdFields) = x.AllFieldsAsList |> List.map (remapRecdField g tmenv) |> MakeRecdFieldsTable + rfield_type = x.rfield_type |> remapPossibleForallTy g tmenv + rfield_pattribs = x.rfield_pattribs |> remapAttribs g tmenv + rfield_fattribs = x.rfield_fattribs |> remapAttribs g tmenv } + +and remapRecdFields g tmenv (x:TyconRecdFields) = + x.AllFieldsAsList |> List.map (remapRecdField g tmenv) |> MakeRecdFieldsTable and remapUnionCase g tmenv (x:UnionCase) = { x with - FieldTable = x.FieldTable |> remapRecdFields g tmenv; - ReturnType = x.ReturnType |> remapType tmenv; - Attribs = x.Attribs |> remapAttribs g tmenv; } -and remapUnionCases g tmenv (x:TyconUnionData) = x.UnionCasesAsList |> List.map (remapUnionCase g tmenv)|> MakeUnionCases + FieldTable = x.FieldTable |> remapRecdFields g tmenv + ReturnType = x.ReturnType |> remapType tmenv + Attribs = x.Attribs |> remapAttribs g tmenv } + +and remapUnionCases g tmenv (x:TyconUnionData) = + x.UnionCasesAsList |> List.map (remapUnionCase g tmenv) |> MakeUnionCases and remapFsObjData g tmenv x = { x with fsobjmodel_kind = (match x.fsobjmodel_kind with | TTyconDelegate slotsig -> TTyconDelegate (remapSlotSig (remapAttribs g tmenv) tmenv slotsig) - | TTyconClass | TTyconInterface | TTyconStruct | TTyconEnum -> x.fsobjmodel_kind); - fsobjmodel_vslots = x.fsobjmodel_vslots |> List.map (remapValRef tmenv); + | TTyconClass | TTyconInterface | TTyconStruct | TTyconEnum -> x.fsobjmodel_kind) + fsobjmodel_vslots = x.fsobjmodel_vslots |> List.map (remapValRef tmenv) fsobjmodel_rfields = x.fsobjmodel_rfields |> remapRecdFields g tmenv } and remapTyconRepr g tmenv repr = match repr with - | TFSharpObjectRepr x -> TFSharpObjectRepr (remapFsObjData g tmenv x) - | TRecdRepr x -> TRecdRepr (remapRecdFields g tmenv x) - | TUnionRepr x -> TUnionRepr (remapUnionCases g tmenv x) - | TILObjectRepr _ -> failwith "cannot remap IL type definitions" + | TFSharpObjectRepr x -> TFSharpObjectRepr (remapFsObjData g tmenv x) + | TRecdRepr x -> TRecdRepr (remapRecdFields g tmenv x) + | TUnionRepr x -> TUnionRepr (remapUnionCases g tmenv x) + | TILObjectRepr _ -> failwith "cannot remap IL type definitions" #if !NO_EXTENSIONTYPING | TProvidedNamespaceExtensionPoint _ -> repr | TProvidedTypeExtensionPoint info -> @@ -5089,19 +5197,19 @@ and remapTyconRepr g tmenv repr = let ctxt = st.Context.RemapTyconRefs(unbox >> remapTyconRef tmenv.tyconRefRemap >> box) ProvidedType.ApplyContext (st, ctxt)) } #endif - | TNoRepr _ -> repr - | TAsmRepr _ -> repr - | TMeasureableRepr x -> TMeasureableRepr (remapType tmenv x) + | TNoRepr _ -> repr + | TAsmRepr _ -> repr + | TMeasureableRepr x -> TMeasureableRepr (remapType tmenv x) and remapTyconAug tmenv (x:TyconAugmentation) = { x with - tcaug_equals = x.tcaug_equals |> Option.map (mapPair (remapValRef tmenv, remapValRef tmenv)); - tcaug_compare = x.tcaug_compare |> Option.map (mapPair (remapValRef tmenv, remapValRef tmenv)); - tcaug_compare_withc = x.tcaug_compare_withc |> Option.map(remapValRef tmenv); - tcaug_hash_and_equals_withc = x.tcaug_hash_and_equals_withc |> Option.map (mapTriple (remapValRef tmenv, remapValRef tmenv, remapValRef tmenv)); - tcaug_adhoc = x.tcaug_adhoc |> NameMap.map (List.map (remapValRef tmenv)); - tcaug_adhoc_list = x.tcaug_adhoc_list |> ResizeArray.map (fun (flag, vref) -> (flag, remapValRef tmenv vref)); - tcaug_super = x.tcaug_super |> Option.map (remapType tmenv); + tcaug_equals = x.tcaug_equals |> Option.map (mapPair (remapValRef tmenv, remapValRef tmenv)) + tcaug_compare = x.tcaug_compare |> Option.map (mapPair (remapValRef tmenv, remapValRef tmenv)) + tcaug_compare_withc = x.tcaug_compare_withc |> Option.map(remapValRef tmenv) + tcaug_hash_and_equals_withc = x.tcaug_hash_and_equals_withc |> Option.map (mapTriple (remapValRef tmenv, remapValRef tmenv, remapValRef tmenv)) + tcaug_adhoc = x.tcaug_adhoc |> NameMap.map (List.map (remapValRef tmenv)) + tcaug_adhoc_list = x.tcaug_adhoc_list |> ResizeArray.map (fun (flag, vref) -> (flag, remapValRef tmenv vref)) + tcaug_super = x.tcaug_super |> Option.map (remapType tmenv) tcaug_interfaces = x.tcaug_interfaces |> List.map (map1Of3 (remapType tmenv)) } and remapTyconExnInfo g tmenv inp = @@ -5119,8 +5227,8 @@ and remapMemberInfo g m topValInfo ty ty' tmenv x = let renaming, _ = mkTyparToTyparRenaming tpsOrig tps let tmenv = { tmenv with tpinst = tmenv.tpinst @ renaming } { x with - ApparentEnclosingEntity = x.ApparentEnclosingEntity |> remapTyconRef tmenv.tyconRefRemap ; - ImplementedSlotSigs = x.ImplementedSlotSigs |> List.map (remapSlotSig (remapAttribs g tmenv) tmenv); + ApparentEnclosingEntity = x.ApparentEnclosingEntity |> remapTyconRef tmenv.tyconRefRemap + ImplementedSlotSigs = x.ImplementedSlotSigs |> List.map (remapSlotSig (remapAttribs g tmenv) tmenv) } and copyAndRemapAndBindModTy g compgen tmenv mty = @@ -5138,7 +5246,7 @@ and renameTycon tyenv x = let res = tyenv.tyconRefRemap.[mkLocalTyconRef x] res with :? KeyNotFoundException -> - errorR(InternalError("couldn't remap internal tycon " + showL(DebugPrint.tyconL x), x.Range)); + errorR(InternalError("couldn't remap internal tycon " + showL(DebugPrint.tyconL x), x.Range)) mkLocalTyconRef x tcref.Deref @@ -5170,7 +5278,7 @@ and copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs = let res = tmenvinner.valRemap.[v] res with :? KeyNotFoundException -> - errorR(InternalError(sprintf "couldn't remap internal value '%s'" v.LogicalName, v.Range)); + errorR(InternalError(sprintf "couldn't remap internal value '%s'" v.LogicalName, v.Range)) mkLocalValRef v vref.Deref @@ -5180,7 +5288,7 @@ and copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs = let res = tmenvinner.tyconRefRemap.[mkLocalTyconRef tycon] res with :? KeyNotFoundException -> - errorR(InternalError("couldn't remap internal tycon " + showL(DebugPrint.tyconL tycon), tycon.Range)); + errorR(InternalError("couldn't remap internal tycon " + showL(DebugPrint.tyconL tycon), tycon.Range)) mkLocalTyconRef tycon tcref.Deref @@ -5269,14 +5377,14 @@ and remapAndRenameModDef g compgen tmenv mdef = let tycons = tycons |> List.map (renameTycon tmenv) let mbinds = mbinds |> List.map (remapAndRenameModBind g compgen tmenv) TMDefRec(isRec, tycons, mbinds, m) - | TMDefLet(bind, m) -> + | TMDefLet(bind, m) -> let v = bind.Var let bind = remapAndRenameBind g compgen tmenv bind (renameVal tmenv v) TMDefLet(bind, m) - | TMDefDo(e, m) -> + | TMDefDo(e, m) -> let e = remapExpr g compgen tmenv e TMDefDo(e, m) - | TMDefs defs -> + | TMDefs defs -> let defs = remapAndRenameModDefs g compgen tmenv defs TMDefs defs | TMAbstract mexpr -> @@ -5297,9 +5405,11 @@ and remapAndRenameModBind g compgen tmenv x = and remapImplFile g compgen tmenv mv = mapAccImplFile (remapAndBindModuleOrNamespaceExprWithSig g compgen) tmenv mv -let copyModuleOrNamespaceType g compgen mtyp = copyAndRemapAndBindModTy g compgen Remap.Empty mtyp |> fst -let copyExpr g compgen e = remapExpr g compgen Remap.Empty e -let copyImplFile g compgen e = remapImplFile g compgen Remap.Empty e |> fst +let copyModuleOrNamespaceType g compgen mtyp = copyAndRemapAndBindModTy g compgen Remap.Empty mtyp |> fst + +let copyExpr g compgen e = remapExpr g compgen Remap.Empty e + +let copyImplFile g compgen e = remapImplFile g compgen Remap.Empty e |> fst let instExpr g tpinst e = remapExpr g CloneAll (mkInstRemap tpinst) e @@ -5310,33 +5420,58 @@ let instExpr g tpinst e = remapExpr g CloneAll (mkInstRemap tpinst) e let rec remarkExpr m x = match x with - | Expr.Lambda (uniq, ctorThisValOpt, baseValOpt, vs, b, _, rty) -> Expr.Lambda (uniq, ctorThisValOpt, baseValOpt, vs, remarkExpr m b, m, rty) - | Expr.TyLambda (uniq, tps, b, _, rty) -> Expr.TyLambda (uniq, tps, remarkExpr m b, m, rty) - | Expr.TyChoose (tps, b, _) -> Expr.TyChoose (tps, remarkExpr m b, m) - | Expr.LetRec (binds, e, _, fvs) -> Expr.LetRec (remarkBinds m binds, remarkExpr m e, m, fvs) - | Expr.Let (bind, e, _, fvs) -> Expr.Let (remarkBind m bind, remarkExpr m e, m, fvs) - | Expr.Match (_, _, pt, targets, _, ty) -> primMkMatch (NoSequencePointAtInvisibleBinding, m, remarkDecisionTree m pt, Array.map (fun (TTarget(vs, e, _)) ->TTarget(vs, remarkExpr m e, SuppressSequencePointAtTarget)) targets, m, ty) - | Expr.Val (x, valUseFlags, _) -> Expr.Val (x, valUseFlags, m) - | Expr.Quote (a, conv, isFromQueryExpression, _, ty) -> Expr.Quote (remarkExpr m a, conv, isFromQueryExpression, m, ty) + | Expr.Lambda (uniq, ctorThisValOpt, baseValOpt, vs, b, _, rty) -> + Expr.Lambda (uniq, ctorThisValOpt, baseValOpt, vs, remarkExpr m b, m, rty) + + | Expr.TyLambda (uniq, tps, b, _, rty) -> + Expr.TyLambda (uniq, tps, remarkExpr m b, m, rty) + + | Expr.TyChoose (tps, b, _) -> + Expr.TyChoose (tps, remarkExpr m b, m) + + | Expr.LetRec (binds, e, _, fvs) -> + Expr.LetRec (remarkBinds m binds, remarkExpr m e, m, fvs) + + | Expr.Let (bind, e, _, fvs) -> + Expr.Let (remarkBind m bind, remarkExpr m e, m, fvs) + + | Expr.Match (_, _, pt, targets, _, ty) -> + let targetsR = targets |> Array.map (fun (TTarget(vs, e, _)) -> TTarget(vs, remarkExpr m e, SuppressSequencePointAtTarget)) + primMkMatch (NoSequencePointAtInvisibleBinding, m, remarkDecisionTree m pt, targetsR, m, ty) + + | Expr.Val (x, valUseFlags, _) -> + Expr.Val (x, valUseFlags, m) + + | Expr.Quote (a, conv, isFromQueryExpression, _, ty) -> + Expr.Quote (remarkExpr m a, conv, isFromQueryExpression, m, ty) + | Expr.Obj (n, ty, basev, basecall, overrides, iimpls, _) -> Expr.Obj (n, ty, basev, remarkExpr m basecall, - List.map (remarkObjExprMethod m) overrides, - List.map (remarkInterfaceImpl m) iimpls, m) + List.map (remarkObjExprMethod m) overrides, + List.map (remarkInterfaceImpl m) iimpls, m) + | Expr.Op (op, tinst, args, _) -> let op = match op with | TOp.TryFinally(_, _) -> TOp.TryFinally(NoSequencePointAtTry, NoSequencePointAtFinally) | TOp.TryCatch(_, _) -> TOp.TryCatch(NoSequencePointAtTry, NoSequencePointAtWith) | _ -> op - Expr.Op (op, tinst, remarkExprs m args, m) + | Expr.Link (eref) -> // Preserve identity of fixup nodes during remarkExpr - eref := remarkExpr m !eref; + eref := remarkExpr m !eref x - | Expr.App(e1, e1ty, tyargs, args, _) -> Expr.App(remarkExpr m e1, e1ty, tyargs, remarkExprs m args, m) - | Expr.Sequential (e1, e2, dir, _, _) -> Expr.Sequential (remarkExpr m e1, remarkExpr m e2, dir, SuppressSequencePointOnExprOfSequential, m) - | Expr.StaticOptimization (eqns, e2, e3, _) -> Expr.StaticOptimization (eqns, remarkExpr m e2, remarkExpr m e3, m) + + | Expr.App(e1, e1ty, tyargs, args, _) -> + Expr.App(remarkExpr m e1, e1ty, tyargs, remarkExprs m args, m) + + | Expr.Sequential (e1, e2, dir, _, _) -> + Expr.Sequential (remarkExpr m e1, remarkExpr m e2, dir, SuppressSequencePointOnExprOfSequential, m) + + | Expr.StaticOptimization (eqns, e2, e3, _) -> + Expr.StaticOptimization (eqns, remarkExpr m e2, remarkExpr m e3, m) + | Expr.Const (c, _, ty) -> Expr.Const (c, m, ty) and remarkObjExprMethod m (TObjExprMethod(slotsig, attribs, tps, vs, e, _)) = @@ -5351,9 +5486,13 @@ and remarkFlatExprs m es = es |> List.map (remarkExpr m) and remarkDecisionTree m x = match x with - | TDSwitch(e1, csl, dflt, _) -> TDSwitch(remarkExpr m e1, List.map (fun (TCase(test, y)) -> TCase(test, remarkDecisionTree m y)) csl, Option.map (remarkDecisionTree m) dflt, m) - | TDSuccess (es, n) -> TDSuccess (remarkFlatExprs m es, n) - | TDBind (bind, rest) -> TDBind(remarkBind m bind, remarkDecisionTree m rest) + | TDSwitch(e1, csl, dflt, _) -> + let cslR = csl |> List.map (fun (TCase(test, y)) -> TCase(test, remarkDecisionTree m y)) + TDSwitch(remarkExpr m e1, cslR, Option.map (remarkDecisionTree m) dflt, m) + | TDSuccess (es, n) -> + TDSuccess (remarkFlatExprs m es, n) + | TDBind (bind, rest) -> + TDBind(remarkBind m bind, remarkDecisionTree m rest) and remarkBinds m binds = List.map (remarkBind m) binds @@ -5361,13 +5500,14 @@ and remarkBinds m binds = List.map (remarkBind m) binds and remarkBind m (TBind(v, repr, _)) = TBind(v, remarkExpr m repr, NoSequencePointAtStickyBinding) - //-------------------------------------------------------------------------- // Mutability analysis //-------------------------------------------------------------------------- let isRecdOrStructFieldDefinitelyMutable (f:RecdField) = not f.IsStatic && f.IsMutable + let isUnionCaseDefinitelyMutable (uc:UnionCase) = uc.FieldTable.FieldsByIndex |> Array.exists isRecdOrStructFieldDefinitelyMutable + let isUnionCaseRefDefinitelyMutable (uc:UnionCaseRef) = uc.UnionCase |> isUnionCaseDefinitelyMutable /// This is an incomplete check for .NET struct types. Returning 'false' doesn't mean the thing is immutable. @@ -5398,7 +5538,7 @@ let isUnionCaseFieldMutable (g: TcGlobals) (ucref:UnionCaseRef) n = (ucref.FieldByIndex n).IsMutable let isExnFieldMutable ecref n = - if n < 0 || n >= List.length (recdFieldsOfExnDefRef ecref) then errorR(InternalError(sprintf "isExnFieldMutable, exnc = %s, n = %d" ecref.LogicalName n, ecref.Range)); + if n < 0 || n >= List.length (recdFieldsOfExnDefRef ecref) then errorR(InternalError(sprintf "isExnFieldMutable, exnc = %s, n = %d" ecref.LogicalName n, ecref.Range)) (recdFieldOfExnDefRefByIdx ecref n).IsMutable let useGenuineField (tycon:Tycon) (f:RecdField) = @@ -5413,9 +5553,11 @@ let ComputeFieldName tycon f = //------------------------------------------------------------------------- let isQuotedExprTy g ty = match tryAppTy g ty with ValueSome (tcref, _) -> tyconRefEq g tcref g.expr_tcr | _ -> false + let destQuotedExprTy g ty = match tryAppTy g ty with ValueSome (_, [ty]) -> ty | _ -> failwith "destQuotedExprTy" let mkQuotedExprTy (g:TcGlobals) ty = TType_app(g.expr_tcr, [ty]) + let mkRawQuotedExprTy (g:TcGlobals) = TType_app(g.raw_expr_tcr, []) let mkAnyTupledTy (g:TcGlobals) tupInfo tys = @@ -5428,12 +5570,14 @@ let mkAnyAnonRecdTy (_g:TcGlobals) anonInfo tys = TType_anon(anonInfo, tys) let mkRefTupledTy g tys = mkAnyTupledTy g tupInfoRef tys + let mkRefTupledVarsTy g vs = mkRefTupledTy g (typesOfVals vs) let mkMethodTy g argtys rty = mkIteratedFunTy (List.map (mkRefTupledTy g) argtys) rty + let mkArrayType (g:TcGlobals) ty = TType_app (g.array_tcr_nice, [ty]) -let mkByteArrayTy (g:TcGlobals) = mkArrayType g g.byte_ty +let mkByteArrayTy (g:TcGlobals) = mkArrayType g g.byte_ty //-------------------------------------------------------------------------- // tyOfExpr @@ -5485,8 +5629,8 @@ let rec tyOfExpr g e = | TOp.TraitCall (TTrait(_, _, _, _, ty, _)) -> GetFSharpViewOfReturnType g ty | TOp.Reraise -> (match tinst with [rtn_ty] -> rtn_ty | _ -> failwith "bad TOp.Reraise node") | TOp.Goto _ | TOp.Label _ | TOp.Return -> - //assert false; - //errorR(InternalError("unexpected goto/label/return in tyOfExpr", m)); + //assert false + //errorR(InternalError("unexpected goto/label/return in tyOfExpr", m)) // It doesn't matter what type we return here. This is only used in free variable analysis in the code generator g.unit_ty @@ -5534,7 +5678,7 @@ let rec mkExprApplAux g f fty argsl m = | _ -> // Don't combine. 'f' is not an application - if not (isFunTy g fty) then error(InternalError("expected a function type", m)); + if not (isFunTy g fty) then error(InternalError("expected a function type", m)) primMkApp (f, fty) [] argsl m @@ -5550,48 +5694,47 @@ let rec mkAppsAux g f fty tyargsl argsl m = mkExprApplAux g f fty argsl m let mkApps g ((f, fty), tyargsl, argl, m) = mkAppsAux g f fty tyargsl argl m -let mkTyAppExpr m (f, fty) tyargs = match tyargs with [] -> f | _ -> primMkApp (f, fty) tyargs [] m +let mkTyAppExpr m (f, fty) tyargs = match tyargs with [] -> f | _ -> primMkApp (f, fty) tyargs [] m //-------------------------------------------------------------------------- // Decision tree reduction //-------------------------------------------------------------------------- let rec accTargetsOfDecisionTree tree acc = - match tree with - | TDSwitch (_, edges, dflt, _) -> List.foldBack (fun (c:DecisionTreeCase) -> accTargetsOfDecisionTree c.CaseTree) edges (Option.foldBack accTargetsOfDecisionTree dflt acc) - | TDSuccess (_, i) -> i::acc - | TDBind (_, rest) -> accTargetsOfDecisionTree rest acc + match tree with + | TDSwitch (_, cases, dflt, _) -> + List.foldBack (fun (c:DecisionTreeCase) -> accTargetsOfDecisionTree c.CaseTree) cases + (Option.foldBack accTargetsOfDecisionTree dflt acc) + | TDSuccess (_, i) -> i::acc + | TDBind (_, rest) -> accTargetsOfDecisionTree rest acc -let rec mapAccTipsOfDecisionTree f tree = +let rec mapTargetsOfDecisionTree f tree = match tree with - | TDSwitch (e, edges, dflt, m) -> TDSwitch (e, List.map (mapAccTipsOfEdge f) edges, Option.map (mapAccTipsOfDecisionTree f) dflt, m) - | TDSuccess (es, i) -> f es i - | TDBind (bind, rest) -> TDBind(bind, mapAccTipsOfDecisionTree f rest) -and mapAccTipsOfEdge f (TCase(x, t)) = - TCase(x, mapAccTipsOfDecisionTree f t) + | TDSwitch (e, cases, dflt, m) -> TDSwitch (e, List.map (mapTargetsOfDecisionTreeCase f) cases, Option.map (mapTargetsOfDecisionTree f) dflt, m) + | TDSuccess (es, i) -> TDSuccess(es, f i) + | TDBind (bind, rest) -> TDBind(bind, mapTargetsOfDecisionTree f rest) -let mapTargetsOfDecisionTree f tree = mapAccTipsOfDecisionTree (fun es i -> TDSuccess(es, f i)) tree +and mapTargetsOfDecisionTreeCase f (TCase(x, t)) = + TCase(x, mapTargetsOfDecisionTree f t) // Dead target elimination let eliminateDeadTargetsFromMatch tree (targets:_[]) = let used = accTargetsOfDecisionTree tree [] |> ListSet.setify (=) |> Array.ofList if used.Length < targets.Length then - Array.sortInPlace used; + Array.sortInPlace used let ntargets = targets.Length let tree' = let remap = Array.create ntargets (-1) - Array.iteri (fun i tgn -> remap.[tgn] <- i) used; + Array.iteri (fun i tgn -> remap.[tgn] <- i) used tree |> mapTargetsOfDecisionTree (fun tgn -> - if remap.[tgn] = -1 then failwith "eliminateDeadTargetsFromMatch: failure while eliminating unused targets"; + if remap.[tgn] = -1 then failwith "eliminateDeadTargetsFromMatch: failure while eliminating unused targets" remap.[tgn]) let targets' = Array.map (Array.get targets) used tree', targets' else tree, targets - - let rec targetOfSuccessDecisionTree tree = match tree with | TDSwitch _ -> None @@ -5601,8 +5744,8 @@ let rec targetOfSuccessDecisionTree tree = /// Check a decision tree only has bindings that immediately cover a 'Success' let rec decisionTreeHasNonTrivialBindings tree = match tree with - | TDSwitch (_, edges, dflt, _) -> - edges |> List.exists (fun c -> decisionTreeHasNonTrivialBindings c.CaseTree) || + | TDSwitch (_, cases, dflt, _) -> + cases |> List.exists (fun c -> decisionTreeHasNonTrivialBindings c.CaseTree) || dflt |> Option.exists decisionTreeHasNonTrivialBindings | TDSuccess _ -> false | TDBind (_, t) -> Option.isNone (targetOfSuccessDecisionTree t) @@ -5621,9 +5764,9 @@ let foldLinearBindingTargetsOfMatch tree (targets: _[]) = // Build a map showing how each target might be reached let rec accumulateTipsOfDecisionTree accBinds tree = match tree with - | TDSwitch (_, edges, dflt, _) -> + | TDSwitch (_, cases, dflt, _) -> assert (isNil accBinds) // No switches under bindings - for edge in edges do accumulateTipsOfDecisionTree accBinds edge.CaseTree + for edge in cases do accumulateTipsOfDecisionTree accBinds edge.CaseTree match dflt with | None -> () | Some tree -> accumulateTipsOfDecisionTree accBinds tree @@ -5653,7 +5796,7 @@ let foldLinearBindingTargetsOfMatch tree (targets: _[]) = | Some i when isLinearTgtIdx i -> TDSuccess([], i) | _ -> match tree with - | TDSwitch (e, edges, dflt, m) -> TDSwitch (e, List.map rebuildDecisionTreeEdge edges, Option.map rebuildDecisionTree dflt, m) + | TDSwitch (e, cases, dflt, m) -> TDSwitch (e, List.map rebuildDecisionTreeEdge cases, Option.map rebuildDecisionTree dflt, m) | TDSuccess _ -> tree | TDBind _ -> tree @@ -5681,10 +5824,10 @@ let foldLinearBindingTargetsOfMatch tree (targets: _[]) = let rec simplifyTrivialMatch spBind exprm matchm ty tree (targets : _[]) = match tree with | TDSuccess(es, n) -> - if n >= targets.Length then failwith "simplifyTrivialMatch: target out of range"; + if n >= targets.Length then failwith "simplifyTrivialMatch: target out of range" // REVIEW: should we use _spTarget here? let (TTarget(vs, rhs, _spTarget)) = targets.[n] - if vs.Length <> es.Length then failwith ("simplifyTrivialMatch: invalid argument, n = " + string n + ", List.length targets = " + string targets.Length); + if vs.Length <> es.Length then failwith ("simplifyTrivialMatch: invalid argument, n = " + string n + ", List.length targets = " + string targets.Length) // These are non-sticky - any sequence point for 'rhs' goes on 'rhs' _after_ the bindings have been made mkInvisibleLetsFromBindings rhs.Range vs es rhs | _ -> @@ -5701,7 +5844,6 @@ let mkAndSimplifyMatch spBind exprm matchm ty tree targets = let tree, targets = foldLinearBindingTargetsOfMatch tree targets simplifyTrivialMatch spBind exprm matchm ty tree targets - //------------------------------------------------------------------------- // mkExprAddrOfExprAux //------------------------------------------------------------------------- @@ -5731,7 +5873,6 @@ let isRecdOrStructTyReadOnly (g: TcGlobals) m ty = | ValueNone -> false | ValueSome tcref -> isRecdOrStructTyconRefReadOnly g m tcref - let CanTakeAddressOf g m ty mut = match mut with | NeverMutates -> true @@ -5885,7 +6026,9 @@ let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress None, mkArrayElemAddress g (readonly, ilInstrReadOnlyAnnotation, isNativePtr, shape, elemTy, (aexpr::args), m), readonly, writeonly // LVALUE: "&meth(args)" where meth has a byref or inref return. Includes "&span.[idx]". - | Expr.Let(TBind(vref, e, _), Expr.Op(TOp.LValueOp (LByrefGet, vref2), _, _, _), _, _) when (valRefEq g (mkLocalValRef vref) vref2) && (MustTakeAddressOfByrefGet g vref2 || CanTakeAddressOfByrefGet g vref2 mut) -> + | Expr.Let(TBind(vref, e, _), Expr.Op(TOp.LValueOp (LByrefGet, vref2), _, _, _), _, _) + when (valRefEq g (mkLocalValRef vref) vref2) && + (MustTakeAddressOfByrefGet g vref2 || CanTakeAddressOfByrefGet g vref2 mut) -> let ty = tyOfExpr g e let readonly = isInByrefTy g ty let writeonly = isOutByrefTy g ty @@ -5995,7 +6138,7 @@ let rec IterateRecursiveFixups g (selfv : Val option) rvs ((access : Expr), set) (mkTupleFieldGet g (tupInfo, access, argtys, n, m), (fun e -> // NICE: it would be better to do this check in the type checker - errorR(Error(FSComp.SR.tastRecursiveValuesMayNotBeInConstructionOfTuple(), m)); + errorR(Error(FSComp.SR.tastRecursiveValuesMayNotBeInConstructionOfTuple(), m)) e))) | Expr.Op (TOp.UnionCase (c), tinst, args, m) -> @@ -6006,7 +6149,7 @@ let rec IterateRecursiveFixups g (selfv : Val option) rvs ((access : Expr), set) // NICE: it would be better to do this check in the type checker let tcref = c.TyconRef if not (c.FieldByIndex(n)).IsMutable && not (entityRefInThisAssembly g.compilingFslib tcref) then - errorR(Error(FSComp.SR.tastRecursiveValuesMayNotAppearInConstructionOfType(tcref.LogicalName), m)); + errorR(Error(FSComp.SR.tastRecursiveValuesMayNotAppearInConstructionOfType(tcref.LogicalName), m)) mkUnionCaseFieldSet (access, c, tinst, n, e, m)))) | Expr.Op (TOp.Recd (_, tcref), tinst, args, m) -> @@ -6017,7 +6160,7 @@ let rec IterateRecursiveFixups g (selfv : Val option) rvs ((access : Expr), set) (fun e -> // NICE: it would be better to do this check in the type checker if not fspec.IsMutable && not (entityRefInThisAssembly g.compilingFslib tcref) then - errorR(Error(FSComp.SR.tastRecursiveValuesMayNotBeAssignedToNonMutableField(fspec.rfield_id.idText, tcref.LogicalName), m)); + errorR(Error(FSComp.SR.tastRecursiveValuesMayNotBeAssignedToNonMutableField(fspec.rfield_id.idText, tcref.LogicalName), m)) mkRecdFieldSetViaExprAddr (access, fref, tinst, e, m))) arg ) | Expr.Val _ | Expr.Lambda _ @@ -6027,9 +6170,6 @@ let rec IterateRecursiveFixups g (selfv : Val option) rvs ((access : Expr), set) rvs selfv access set exprToFix | _ -> () - - - //-------------------------------------------------------------------------- // computations on constraints //-------------------------------------------------------------------------- @@ -6039,33 +6179,30 @@ let JoinTyparStaticReq r1 r2 = | NoStaticReq, r | r, NoStaticReq -> r | HeadTypeStaticReq, r | r, HeadTypeStaticReq -> r - - //------------------------------------------------------------------------- // ExprFolder - fold steps //------------------------------------------------------------------------- -type ExprFolder<'T> = - { exprIntercept : ('T -> Expr -> 'T) -> 'T -> Expr -> 'T option; +type ExprFolder<'State> = + { exprIntercept : (* recurseF *) ('State -> Expr -> 'State) -> (* noInterceptF *) ('State -> Expr -> 'State) -> 'State -> Expr -> 'State // the bool is 'bound in dtree' - valBindingSiteIntercept : 'T -> bool * Val -> 'T; + valBindingSiteIntercept : 'State -> bool * Val -> 'State // these values are always bound to these expressions. bool indicates 'recursively' - nonRecBindingsIntercept : 'T -> Binding -> 'T; - recBindingsIntercept : 'T -> Bindings -> 'T; - dtreeIntercept : 'T -> DecisionTree -> 'T; - targetIntercept : ('T -> Expr -> 'T) -> 'T -> DecisionTreeTarget -> 'T option; - tmethodIntercept : ('T -> Expr -> 'T) -> 'T -> ObjExprMethod -> 'T option; + nonRecBindingsIntercept : 'State -> Binding -> 'State + recBindingsIntercept : 'State -> Bindings -> 'State + dtreeIntercept : 'State -> DecisionTree -> 'State + targetIntercept : (* recurseF *) ('State -> Expr -> 'State) -> 'State -> DecisionTreeTarget -> 'State option + tmethodIntercept : (* recurseF *) ('State -> Expr -> 'State) -> 'State -> ObjExprMethod -> 'State option } let ExprFolder0 = - { exprIntercept = (fun _exprF _z _x -> None); - valBindingSiteIntercept = (fun z _b -> z); - nonRecBindingsIntercept = (fun z _bs -> z); - recBindingsIntercept = (fun z _bs -> z); - dtreeIntercept = (fun z _dt -> z); - targetIntercept = (fun _exprF _z _x -> None); - tmethodIntercept = (fun _exprF _z _x -> None); } - + { exprIntercept = (fun _recurseF noInterceptF z x -> noInterceptF z x) + valBindingSiteIntercept = (fun z _b -> z) + nonRecBindingsIntercept = (fun z _bs -> z) + recBindingsIntercept = (fun z _bs -> z) + dtreeIntercept = (fun z _dt -> z) + targetIntercept = (fun _exprF _z _x -> None) + tmethodIntercept = (fun _exprF _z _x -> None) } //------------------------------------------------------------------------- // FoldExpr @@ -6074,54 +6211,78 @@ let ExprFolder0 = /// Adapted from usage info folding. /// Collecting from exprs at moment. /// To collect ids etc some additional folding needed, over formals etc. -type ExprFolders<'State> (folders : _ ExprFolder) = - let mutable exprFClosure = Unchecked.defaultof<_> // prevent reallocation of closure - let rec exprsF z xs = List.fold exprFClosure z xs - and exprF (z: 'State) x = - match folders.exprIntercept exprFClosure z x with // fold this node, then recurse - | Some z -> z // intercepted - | None -> // structurally recurse - match x with - | Expr.Const _ -> z - | Expr.Val _ -> z - | Expr.Op (_c, _tyargs, args, _) -> exprsF z args - | Expr.Sequential (x0, x1, _dir, _, _) -> exprsF z [x0;x1] - | Expr.Lambda(_lambdaId , _ctorThisValOpt, _baseValOpt, _argvs, body, _m, _rty) -> exprF z body - | Expr.TyLambda(_lambdaId, _argtyvs, body, _m, _rty) -> exprF z body - | Expr.TyChoose(_, body, _) -> exprF z body - - | Expr.App (f, _fty, _tys, argtys, _) -> - let z = exprF z f - let z = exprsF z argtys - z - | Expr.LetRec (binds, body, _, _) -> - let z = valBindsF false z binds - let z = exprF z body - z - | Expr.Let (bind, body, _, _) -> - let z = valBindF false z bind - let z = exprF z body - z - | Expr.Link rX -> exprF z (!rX) - - | Expr.Match (_spBind, _exprm, dtree, targets, _m, _ty) -> - let z = dtreeF z dtree - let z = Array.fold targetF z targets - z - | Expr.Quote(e, {contents=Some(_typeDefs, _argTypes, argExprs, _)}, _, _, _) -> - let z = exprF z e - exprsF z argExprs - - | Expr.Quote(e, {contents=None}, _, _m, _) -> - exprF z e - - | Expr.Obj (_n, _typ, _basev, basecall, overrides, iimpls, _m) -> - let z = exprF z basecall - let z = List.fold tmethodF z overrides - let z = List.fold (foldOn snd (List.fold tmethodF)) z iimpls - z - - | Expr.StaticOptimization (_tcs, csx, x, _) -> exprsF z [csx;x] +type ExprFolders<'State> (folders : ExprFolder<'State>) = + let mutable exprFClosure = Unchecked.defaultof<'State -> Expr -> 'State> // prevent reallocation of closure + let mutable exprNoInterceptFClosure = Unchecked.defaultof<'State -> Expr -> 'State> // prevent reallocation of closure + + let rec exprsF z xs = + List.fold exprFClosure z xs + + and exprF (z: 'State) (x: Expr) = + folders.exprIntercept exprFClosure exprNoInterceptFClosure z x + + and exprNoInterceptF (z: 'State) (x: Expr) = + match x with + + | Expr.Const _ -> z + + | Expr.Val _ -> z + + | LinearOpExpr (_op, _tyargs, argsHead, argLast, _m) -> + let z = exprsF z argsHead + // tailcall + exprF z argLast + + | Expr.Op (_c, _tyargs, args, _) -> + exprsF z args + + | Expr.Sequential (x0, x1, _dir, _, _) -> + let z = exprF z x0 + exprF z x1 + + | Expr.Lambda(_lambdaId , _ctorThisValOpt, _baseValOpt, _argvs, body, _m, _rty) -> + exprF z body + + | Expr.TyLambda(_lambdaId, _argtyvs, body, _m, _rty) -> + exprF z body + + | Expr.TyChoose(_, body, _) -> + exprF z body + + | Expr.App (f, _fty, _tys, argtys, _) -> + let z = exprF z f + exprsF z argtys + + | Expr.LetRec (binds, body, _, _) -> + let z = valBindsF false z binds + exprF z body + + | Expr.Let (bind, body, _, _) -> + let z = valBindF false z bind + exprF z body + + | Expr.Link rX -> exprF z (!rX) + + | Expr.Match (_spBind, _exprm, dtree, targets, _m, _ty) -> + let z = dtreeF z dtree + let z = Array.fold targetF z targets.[0..targets.Length - 2] + // tailcall + targetF z targets.[targets.Length - 1] + + | Expr.Quote(e, {contents=Some(_typeDefs, _argTypes, argExprs, _)}, _, _, _) -> + let z = exprF z e + exprsF z argExprs + + | Expr.Quote(e, {contents=None}, _, _m, _) -> + exprF z e + + | Expr.Obj (_n, _typ, _basev, basecall, overrides, iimpls, _m) -> + let z = exprF z basecall + let z = List.fold tmethodF z overrides + List.fold (foldOn snd (List.fold tmethodF)) z iimpls + + | Expr.StaticOptimization (_tcs, csx, x, _) -> + exprsF z [csx;x] and valBindF dtree z bind = let z = folders.nonRecBindingsIntercept z bind @@ -6172,7 +6333,7 @@ type ExprFolders<'State> (folders : _ ExprFolder) = and mdefF z x = match x with | TMDefRec(_, _, mbinds, _) -> - (* REVIEW: also iterate the abstract slot vspecs hidden in the _vslots field in the tycons *) + // REVIEW: also iterate the abstract slot vspecs hidden in the _vslots field in the tycons let z = List.fold mbindF z mbinds z | TMDefLet(bind, _) -> valBindF false z bind @@ -6188,10 +6349,12 @@ type ExprFolders<'State> (folders : _ ExprFolder) = and implF z x = foldTImplFile mexprF z x do exprFClosure <- exprF // allocate one instance of this closure + do exprNoInterceptFClosure <- exprNoInterceptF // allocate one instance of this closure member x.FoldExpr = exprF member x.FoldImplFile = implF let FoldExpr folders state expr = ExprFolders(folders).FoldExpr state expr + let FoldImplFile folders state implFile = ExprFolders(folders).FoldImplFile state implFile #if DEBUG @@ -6201,7 +6364,7 @@ let FoldImplFile folders state implFile = ExprFolders(folders).FoldImplFile stat let ExprStats x = let count = ref 0 - let folders = {ExprFolder0 with exprIntercept = (fun _ _ _ -> (count := !count + 1; None))} + let folders = {ExprFolder0 with exprIntercept = (fun _ noInterceptF z x -> (count := !count + 1; noInterceptF z x))} let () = FoldExpr folders () x string !count + " TExpr nodes" #endif @@ -6211,36 +6374,57 @@ let ExprStats x = //------------------------------------------------------------------------- let mkString (g:TcGlobals) m n = Expr.Const(Const.String n, m, g.string_ty) + let mkBool (g:TcGlobals) m b = Expr.Const(Const.Bool b, m, g.bool_ty) + let mkByte (g:TcGlobals) m b = Expr.Const(Const.Byte b, m, g.byte_ty) + let mkUInt16 (g:TcGlobals) m b = Expr.Const(Const.UInt16 b, m, g.uint16_ty) + let mkTrue g m = mkBool g m true + let mkFalse g m = mkBool g m false + let mkUnit (g:TcGlobals) m = Expr.Const(Const.Unit, m, g.unit_ty) + let mkInt32 (g:TcGlobals) m n = Expr.Const(Const.Int32 n, m, g.int32_ty) + let mkInt g m n = mkInt32 g m (n) + let mkZero g m = mkInt g m 0 + let mkOne g m = mkInt g m 1 + let mkTwo g m = mkInt g m 2 + let mkMinusOne g m = mkInt g m (-1) let destInt32 = function Expr.Const(Const.Int32 n, _, _) -> Some n | _ -> None -let isIDelegateEventType g ty = match tryDestAppTy g ty with ValueSome tcref -> tyconRefEq g g.fslib_IDelegateEvent_tcr tcref | _ -> false +let isIDelegateEventType g ty = + match tryDestAppTy g ty with + | ValueSome tcref -> tyconRefEq g g.fslib_IDelegateEvent_tcr tcref + | _ -> false + let destIDelegateEventType g ty = if isIDelegateEventType g ty then match argsOfAppTy g ty with | [ty1] -> ty1 | _ -> failwith "destIDelegateEventType: internal error" else failwith "destIDelegateEventType: not an IDelegateEvent type" + let mkIEventType (g:TcGlobals) ty1 ty2 = TType_app (g.fslib_IEvent2_tcr, [ty1;ty2]) + let mkIObservableType (g:TcGlobals) ty1 = TType_app (g.tcref_IObservable, [ty1]) + let mkIObserverType (g:TcGlobals) ty1 = TType_app (g.tcref_IObserver, [ty1]) let mkRefCellContentsRef (g:TcGlobals) = mkRecdFieldRef g.refcell_tcr_canon "contents" let mkSequential spSeq m e1 e2 = Expr.Sequential(e1, e2, NormalSeq, spSeq, m) + let mkCompGenSequential m e1 e2 = mkSequential SuppressSequencePointOnExprOfSequential m e1 e2 + let rec mkSequentials spSeq g m es = match es with | [e] -> e @@ -6259,14 +6443,14 @@ let mkAnyTupled g m tupInfo es tys = | [e] -> e | _ -> Expr.Op (TOp.Tuple tupInfo, tys, es, m) - let mkRefTupled g m es tys = mkAnyTupled g m tupInfoRef es tys + let mkRefTupledNoTypes g m args = mkRefTupled g m args (List.map (tyOfExpr g) args) + let mkRefTupledVars g m vs = mkRefTupled g m (List.map (exprForVal m) vs) (typesOfVals vs) let mkAnonRecd (_g:TcGlobals) m anonInfo es tys = Expr.Op (TOp.AnonRecd (anonInfo),tys,es,m) - //-------------------------------------------------------------------------- // Permute expressions //-------------------------------------------------------------------------- @@ -6276,7 +6460,7 @@ let inversePerm (sigma:int array) = let invSigma = Array.create n -1 for i = 0 to n-1 do let sigma_i = sigma.[i] - // assert( invSigma.[sigma_i] = -1 ); + // assert( invSigma.[sigma_i] = -1 ) invSigma.[sigma_i] <- i invSigma @@ -6349,10 +6533,13 @@ let mkRecordExpr g (lnk, tcref, tinst, rfrefs:RecdFieldRef list, args, m) = //------------------------------------------------------------------------- let mkRefCell g m ty e = mkRecordExpr g (RecdExpr, g.refcell_tcr_canon, [ty], [mkRefCellContentsRef g], [e], m) + let mkRefCellGet g m ty e = mkRecdFieldGetViaExprAddr (e, mkRefCellContentsRef g, [ty], m) + let mkRefCellSet g m ty e1 e2 = mkRecdFieldSetViaExprAddr (e1, mkRefCellContentsRef g, [ty], e2, m) let mkNil (g:TcGlobals) m ty = mkUnionCaseExpr (g.nil_ucref, [ty], [], m) + let mkCons (g:TcGlobals) ty h t = mkUnionCaseExpr (g.cons_ucref, [ty], [h;t], unionRanges h.Range t.Range) let mkCompGenLocalAndInvisbleBind g nm m e = @@ -6364,13 +6551,19 @@ let mkCompGenLocalAndInvisbleBind g nm m e = //---------------------------------------------------------------------------- let box = IL.I_box (mkILTyvarTy 0us) + let isinst = IL.I_isinst (mkILTyvarTy 0us) + let unbox = IL.I_unbox_any (mkILTyvarTy 0us) + let mkUnbox ty e m = mkAsmExpr ([ unbox ], [ty], [e], [ ty ], m) + let mkBox ty e m = mkAsmExpr ([box], [], [e], [ty], m) + let mkIsInst ty e m = mkAsmExpr ([ isinst ], [ty], [e], [ ty ], m) let mspec_Type_GetTypeFromHandle (g: TcGlobals) = IL.mkILNonGenericStaticMethSpecInTy(g.ilg.typ_Type, "GetTypeFromHandle", [g.iltyp_RuntimeTypeHandle], g.ilg.typ_Type) + let mspec_String_Length (g: TcGlobals) = mkILNonGenericInstanceMethSpecInTy (g.ilg.typ_String, "get_Length", [], g.ilg.typ_Int32) let mspec_String_Concat2 (g: TcGlobals) = @@ -6388,7 +6581,8 @@ let mspec_String_Concat_Array (g: TcGlobals) = let fspec_Missing_Value (g: TcGlobals) = IL.mkILFieldSpecInTy(g.iltyp_Missing, "Value", g.iltyp_Missing) let mkInitializeArrayMethSpec (g: TcGlobals) = - mkILNonGenericStaticMethSpecInTy(mkILNonGenericBoxedTy(g.FindSysILTypeRef "System.Runtime.CompilerServices.RuntimeHelpers"), "InitializeArray", [g.ilg.typ_Array;g.iltyp_RuntimeFieldHandle], ILType.Void) + let tref = g.FindSysILTypeRef "System.Runtime.CompilerServices.RuntimeHelpers" + mkILNonGenericStaticMethSpecInTy(mkILNonGenericBoxedTy tref, "InitializeArray", [g.ilg.typ_Array;g.iltyp_RuntimeFieldHandle], ILType.Void) let mkInvalidCastExnNewobj (g: TcGlobals) = mkNormalNewobj (mkILCtorMethSpecForTy (mkILNonGenericBoxedTy (g.FindSysILTypeRef "System.InvalidCastException"), [])) @@ -6399,102 +6593,168 @@ let typedExprForIntrinsic _g m (IntrinsicValRef(_, _, _, ty, _) as i) = exprForValRef m vref, ty let mkCallGetGenericComparer (g:TcGlobals) m = typedExprForIntrinsic g m g.get_generic_comparer_info |> fst + let mkCallGetGenericEREqualityComparer (g:TcGlobals) m = typedExprForIntrinsic g m g.get_generic_er_equality_comparer_info |> fst + let mkCallGetGenericPEREqualityComparer (g:TcGlobals) m = typedExprForIntrinsic g m g.get_generic_per_equality_comparer_info |> fst -let mkCallUnbox (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.unbox_info, [[ty]], [ e1 ], m) -let mkCallUnboxFast (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.unbox_fast_info, [[ty]], [ e1 ], m) -let mkCallTypeTest (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.istype_info, [[ty]], [ e1 ], m) -let mkCallTypeOf (g:TcGlobals) m ty = mkApps g (typedExprForIntrinsic g m g.typeof_info, [[ty]], [ ], m) -let mkCallTypeDefOf (g:TcGlobals) m ty = mkApps g (typedExprForIntrinsic g m g.typedefof_info, [[ty]], [ ], m) - -let mkCallDispose (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.dispose_info, [[ty]], [ e1 ], m) -let mkCallSeq (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.seq_info, [[ty]], [ e1 ], m) -let mkCallCreateInstance (g:TcGlobals) m ty = mkApps g (typedExprForIntrinsic g m g.create_instance_info, [[ty]], [ mkUnit g m ], m) - -let mkCallGetQuerySourceAsEnumerable (g:TcGlobals) m ty1 ty2 e1 = mkApps g (typedExprForIntrinsic g m g.query_source_as_enum_info, [[ty1;ty2]], [ e1; mkUnit g m ], m) -let mkCallNewQuerySource (g:TcGlobals) m ty1 ty2 e1 = mkApps g (typedExprForIntrinsic g m g.new_query_source_info, [[ty1;ty2]], [ e1 ], m) - -let mkCallCreateEvent (g:TcGlobals) m ty1 ty2 e1 e2 e3 = mkApps g (typedExprForIntrinsic g m g.create_event_info, [[ty1;ty2]], [ e1;e2;e3 ], m) -let mkCallGenericComparisonWithComparerOuter (g:TcGlobals) m ty comp e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_comparison_withc_outer_info, [[ty]], [ comp;e1;e2 ], m) -let mkCallGenericEqualityEROuter (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_equality_er_outer_info, [[ty]], [ e1;e2 ], m) -let mkCallGenericEqualityWithComparerOuter (g:TcGlobals) m ty comp e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_equality_withc_outer_info, [[ty]], [comp;e1;e2], m) -let mkCallGenericHashWithComparerOuter (g:TcGlobals) m ty comp e1 = mkApps g (typedExprForIntrinsic g m g.generic_hash_withc_outer_info, [[ty]], [comp;e1], m) - -let mkCallEqualsOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.equals_operator_info, [[ty]], [ e1;e2 ], m) -let mkCallNotEqualsOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.not_equals_operator, [[ty]], [ e1;e2 ], m) -let mkCallLessThanOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.less_than_operator, [[ty]], [ e1;e2 ], m) -let mkCallLessThanOrEqualsOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.less_than_or_equals_operator, [[ty]], [ e1;e2 ], m) -let mkCallGreaterThanOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.greater_than_operator, [[ty]], [ e1;e2 ], m) -let mkCallGreaterThanOrEqualsOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.greater_than_or_equals_operator, [[ty]], [ e1;e2 ], m) +let mkCallUnbox (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.unbox_info, [[ty]], [ e1 ], m) + +let mkCallUnboxFast (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.unbox_fast_info, [[ty]], [ e1 ], m) + +let mkCallTypeTest (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.istype_info, [[ty]], [ e1 ], m) + +let mkCallTypeOf (g:TcGlobals) m ty = mkApps g (typedExprForIntrinsic g m g.typeof_info, [[ty]], [ ], m) + +let mkCallTypeDefOf (g:TcGlobals) m ty = mkApps g (typedExprForIntrinsic g m g.typedefof_info, [[ty]], [ ], m) + +let mkCallDispose (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.dispose_info, [[ty]], [ e1 ], m) + +let mkCallSeq (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.seq_info, [[ty]], [ e1 ], m) + +let mkCallCreateInstance (g:TcGlobals) m ty = mkApps g (typedExprForIntrinsic g m g.create_instance_info, [[ty]], [ mkUnit g m ], m) + +let mkCallGetQuerySourceAsEnumerable (g:TcGlobals) m ty1 ty2 e1 = mkApps g (typedExprForIntrinsic g m g.query_source_as_enum_info, [[ty1;ty2]], [ e1; mkUnit g m ], m) + +let mkCallNewQuerySource (g:TcGlobals) m ty1 ty2 e1 = mkApps g (typedExprForIntrinsic g m g.new_query_source_info, [[ty1;ty2]], [ e1 ], m) + +let mkCallCreateEvent (g:TcGlobals) m ty1 ty2 e1 e2 e3 = mkApps g (typedExprForIntrinsic g m g.create_event_info, [[ty1;ty2]], [ e1;e2;e3 ], m) + +let mkCallGenericComparisonWithComparerOuter (g:TcGlobals) m ty comp e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_comparison_withc_outer_info, [[ty]], [ comp;e1;e2 ], m) + +let mkCallGenericEqualityEROuter (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_equality_er_outer_info, [[ty]], [ e1;e2 ], m) + +let mkCallGenericEqualityWithComparerOuter (g:TcGlobals) m ty comp e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_equality_withc_outer_info, [[ty]], [comp;e1;e2], m) + +let mkCallGenericHashWithComparerOuter (g:TcGlobals) m ty comp e1 = mkApps g (typedExprForIntrinsic g m g.generic_hash_withc_outer_info, [[ty]], [comp;e1], m) + +let mkCallEqualsOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.equals_operator_info, [[ty]], [ e1;e2 ], m) + +let mkCallNotEqualsOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.not_equals_operator, [[ty]], [ e1;e2 ], m) + +let mkCallLessThanOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.less_than_operator, [[ty]], [ e1;e2 ], m) + +let mkCallLessThanOrEqualsOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.less_than_or_equals_operator, [[ty]], [ e1;e2 ], m) + +let mkCallGreaterThanOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.greater_than_operator, [[ty]], [ e1;e2 ], m) + +let mkCallGreaterThanOrEqualsOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.greater_than_or_equals_operator, [[ty]], [ e1;e2 ], m) let mkCallAdditionOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.unchecked_addition_info, [[ty; ty; ty]], [e1;e2], m) + let mkCallSubtractionOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.unchecked_subtraction_info, [[ty; ty; ty]], [e1;e2], m) + let mkCallMultiplyOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.unchecked_multiply_info, [[ty; ty; ty]], [e1;e2], m) + let mkCallDivisionOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.unchecked_division_info, [[ty; ty; ty]], [e1;e2], m) + let mkCallModulusOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.unchecked_modulus_info, [[ty; ty; ty]], [e1;e2], m) + let mkCallBitwiseAndOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.bitwise_and_info, [[ty]], [e1;e2], m) + let mkCallBitwiseOrOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.bitwise_or_info, [[ty]], [e1;e2], m) + let mkCallBitwiseXorOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.bitwise_xor_info, [[ty]], [e1;e2], m) + let mkCallShiftLeftOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.bitwise_shift_left_info, [[ty]], [e1;e2], m) + let mkCallShiftRightOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.bitwise_shift_right_info, [[ty]], [e1;e2], m) -let mkCallUnaryNegOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.unchecked_unary_minus_info, [[ty]], [e1], m) -let mkCallUnaryNotOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.bitwise_unary_not_info, [[ty]], [e1], m) +let mkCallUnaryNegOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.unchecked_unary_minus_info, [[ty]], [e1], m) + +let mkCallUnaryNotOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.bitwise_unary_not_info, [[ty]], [e1], m) + +let mkCallAdditionChecked (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.checked_addition_info, [[ty; ty; ty]], [e1;e2], m) -let mkCallAdditionChecked (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.checked_addition_info, [[ty; ty; ty]], [e1;e2], m) let mkCallSubtractionChecked (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.checked_subtraction_info, [[ty; ty; ty]], [e1;e2], m) -let mkCallMultiplyChecked (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.checked_multiply_info, [[ty; ty; ty]], [e1;e2], m) -let mkCallUnaryNegChecked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.checked_unary_minus_info, [[ty]], [e1], m) - -let mkCallToByteChecked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.byte_checked_info, [[ty]], [e1], m) -let mkCallToSByteChecked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.sbyte_checked_info, [[ty]], [e1], m) -let mkCallToInt16Checked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int16_checked_info, [[ty]], [e1], m) -let mkCallToUInt16Checked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.uint16_checked_info, [[ty]], [e1], m) -let mkCallToIntChecked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int_checked_info, [[ty]], [e1], m) -let mkCallToInt32Checked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int32_checked_info, [[ty]], [e1], m) -let mkCallToUInt32Checked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.uint32_checked_info, [[ty]], [e1], m) -let mkCallToInt64Checked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int64_checked_info, [[ty]], [e1], m) -let mkCallToUInt64Checked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.uint64_checked_info, [[ty]], [e1], m) -let mkCallToIntPtrChecked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.nativeint_checked_info, [[ty]], [e1], m) -let mkCallToUIntPtrChecked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.unativeint_checked_info, [[ty]], [e1], m) - -let mkCallToByteOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.byte_operator_info, [[ty]], [e1], m) -let mkCallToSByteOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.sbyte_operator_info, [[ty]], [e1], m) -let mkCallToInt16Operator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int16_operator_info, [[ty]], [e1], m) -let mkCallToUInt16Operator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.uint16_operator_info, [[ty]], [e1], m) -let mkCallToIntOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int_operator_info, [[ty]], [e1], m) -let mkCallToInt32Operator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int32_operator_info, [[ty]], [e1], m) -let mkCallToUInt32Operator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.uint32_operator_info, [[ty]], [e1], m) -let mkCallToInt64Operator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int64_operator_info, [[ty]], [e1], m) -let mkCallToUInt64Operator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.uint64_operator_info, [[ty]], [e1], m) -let mkCallToSingleOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.float32_operator_info, [[ty]], [e1], m) -let mkCallToDoubleOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.float_operator_info, [[ty]], [e1], m) -let mkCallToIntPtrOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.nativeint_operator_info, [[ty]], [e1], m) + +let mkCallMultiplyChecked (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.checked_multiply_info, [[ty; ty; ty]], [e1;e2], m) + +let mkCallUnaryNegChecked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.checked_unary_minus_info, [[ty]], [e1], m) + +let mkCallToByteChecked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.byte_checked_info, [[ty]], [e1], m) + +let mkCallToSByteChecked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.sbyte_checked_info, [[ty]], [e1], m) + +let mkCallToInt16Checked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int16_checked_info, [[ty]], [e1], m) + +let mkCallToUInt16Checked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.uint16_checked_info, [[ty]], [e1], m) + +let mkCallToIntChecked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int_checked_info, [[ty]], [e1], m) + +let mkCallToInt32Checked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int32_checked_info, [[ty]], [e1], m) + +let mkCallToUInt32Checked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.uint32_checked_info, [[ty]], [e1], m) + +let mkCallToInt64Checked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int64_checked_info, [[ty]], [e1], m) + +let mkCallToUInt64Checked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.uint64_checked_info, [[ty]], [e1], m) + +let mkCallToIntPtrChecked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.nativeint_checked_info, [[ty]], [e1], m) + +let mkCallToUIntPtrChecked (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.unativeint_checked_info, [[ty]], [e1], m) + +let mkCallToByteOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.byte_operator_info, [[ty]], [e1], m) + +let mkCallToSByteOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.sbyte_operator_info, [[ty]], [e1], m) + +let mkCallToInt16Operator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int16_operator_info, [[ty]], [e1], m) + +let mkCallToUInt16Operator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.uint16_operator_info, [[ty]], [e1], m) + +let mkCallToIntOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int_operator_info, [[ty]], [e1], m) + +let mkCallToInt32Operator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int32_operator_info, [[ty]], [e1], m) + +let mkCallToUInt32Operator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.uint32_operator_info, [[ty]], [e1], m) + +let mkCallToInt64Operator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int64_operator_info, [[ty]], [e1], m) + +let mkCallToUInt64Operator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.uint64_operator_info, [[ty]], [e1], m) + +let mkCallToSingleOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.float32_operator_info, [[ty]], [e1], m) + +let mkCallToDoubleOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.float_operator_info, [[ty]], [e1], m) + +let mkCallToIntPtrOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.nativeint_operator_info, [[ty]], [e1], m) + let mkCallToUIntPtrOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.unativeint_operator_info, [[ty]], [e1], m) -let mkCallToCharOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.char_operator_info, [[ty]], [e1], m) -let mkCallToEnumOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.enum_operator_info, [[ty]], [e1], m) +let mkCallToCharOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.char_operator_info, [[ty]], [e1], m) + +let mkCallToEnumOperator (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.enum_operator_info, [[ty]], [e1], m) + +let mkCallArrayLength (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.array_length_info, [[ty]], [e1], m) + +let mkCallArrayGet (g:TcGlobals) m ty e1 idx1 = mkApps g (typedExprForIntrinsic g m g.array_get_info, [[ty]], [ e1 ; idx1 ], m) + +let mkCallArray2DGet (g:TcGlobals) m ty e1 idx1 idx2 = mkApps g (typedExprForIntrinsic g m g.array2D_get_info, [[ty]], [ e1 ; idx1; idx2 ], m) + +let mkCallArray3DGet (g:TcGlobals) m ty e1 idx1 idx2 idx3 = mkApps g (typedExprForIntrinsic g m g.array3D_get_info, [[ty]], [ e1 ; idx1; idx2; idx3 ], m) -let mkCallArrayLength (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.array_length_info, [[ty]], [e1], m) -let mkCallArrayGet (g:TcGlobals) m ty e1 idx1 = mkApps g (typedExprForIntrinsic g m g.array_get_info, [[ty]], [ e1 ; idx1 ], m) -let mkCallArray2DGet (g:TcGlobals) m ty e1 idx1 idx2 = mkApps g (typedExprForIntrinsic g m g.array2D_get_info, [[ty]], [ e1 ; idx1; idx2 ], m) -let mkCallArray3DGet (g:TcGlobals) m ty e1 idx1 idx2 idx3 = mkApps g (typedExprForIntrinsic g m g.array3D_get_info, [[ty]], [ e1 ; idx1; idx2; idx3 ], m) let mkCallArray4DGet (g:TcGlobals) m ty e1 idx1 idx2 idx3 idx4 = mkApps g (typedExprForIntrinsic g m g.array4D_get_info, [[ty]], [ e1 ; idx1; idx2; idx3; idx4 ], m) -let mkCallArraySet (g:TcGlobals) m ty e1 idx1 v = mkApps g (typedExprForIntrinsic g m g.array_set_info, [[ty]], [ e1 ; idx1; v ], m) -let mkCallArray2DSet (g:TcGlobals) m ty e1 idx1 idx2 v = mkApps g (typedExprForIntrinsic g m g.array2D_set_info, [[ty]], [ e1 ; idx1; idx2; v ], m) -let mkCallArray3DSet (g:TcGlobals) m ty e1 idx1 idx2 idx3 v = mkApps g (typedExprForIntrinsic g m g.array3D_set_info, [[ty]], [ e1 ; idx1; idx2; idx3; v ], m) + +let mkCallArraySet (g:TcGlobals) m ty e1 idx1 v = mkApps g (typedExprForIntrinsic g m g.array_set_info, [[ty]], [ e1 ; idx1; v ], m) + +let mkCallArray2DSet (g:TcGlobals) m ty e1 idx1 idx2 v = mkApps g (typedExprForIntrinsic g m g.array2D_set_info, [[ty]], [ e1 ; idx1; idx2; v ], m) + +let mkCallArray3DSet (g:TcGlobals) m ty e1 idx1 idx2 idx3 v = mkApps g (typedExprForIntrinsic g m g.array3D_set_info, [[ty]], [ e1 ; idx1; idx2; idx3; v ], m) + let mkCallArray4DSet (g:TcGlobals) m ty e1 idx1 idx2 idx3 idx4 v = mkApps g (typedExprForIntrinsic g m g.array4D_set_info, [[ty]], [ e1 ; idx1; idx2; idx3; idx4; v ], m) -let mkCallHash (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.hash_info, [[ty]], [ e1 ], m) -let mkCallBox (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.box_info, [[ty]], [ e1 ], m) -let mkCallIsNull (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.isnull_info, [[ty]], [ e1 ], m) -let mkCallIsNotNull (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.isnotnull_info, [[ty]], [ e1 ], m) -let mkCallRaise (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.raise_info, [[ty]], [ e1 ], m) +let mkCallHash (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.hash_info, [[ty]], [ e1 ], m) -let mkCallNewDecimal (g:TcGlobals) m (e1, e2, e3, e4, e5) = mkApps g (typedExprForIntrinsic g m g.new_decimal_info, [], [ e1;e2;e3;e4;e5 ], m) +let mkCallBox (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.box_info, [[ty]], [ e1 ], m) -let mkCallNewFormat (g:TcGlobals) m aty bty cty dty ety e1 = mkApps g (typedExprForIntrinsic g m g.new_format_info, [[aty;bty;cty;dty;ety]], [ e1 ], m) +let mkCallIsNull (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.isnull_info, [[ty]], [ e1 ], m) + +let mkCallIsNotNull (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.isnotnull_info, [[ty]], [ e1 ], m) + +let mkCallRaise (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.raise_info, [[ty]], [ e1 ], m) + +let mkCallNewDecimal (g:TcGlobals) m (e1, e2, e3, e4, e5) = mkApps g (typedExprForIntrinsic g m g.new_decimal_info, [], [ e1;e2;e3;e4;e5 ], m) + +let mkCallNewFormat (g:TcGlobals) m aty bty cty dty ety e1 = mkApps g (typedExprForIntrinsic g m g.new_format_info, [[aty;bty;cty;dty;ety]], [ e1 ], m) let TryEliminateDesugaredConstants g m c = match c with @@ -6509,6 +6769,7 @@ let TryEliminateDesugaredConstants g m c = None let mkSeqTy (g:TcGlobals) ty = mkAppTy g.seq_tcr [ty] + let mkIEnumeratorTy (g:TcGlobals) ty = mkAppTy g.tcref_System_Collections_Generic_IEnumerator [ty] let mkCallSeqCollect g m alphaTy betaTy arg1 arg2 = @@ -6597,10 +6858,13 @@ let mkCallQuoteToLinqLambdaExpression g m ty e1 = mkApps g (typedExprForIntrinsic g m g.quote_to_linq_lambda_info , [[ty]], [e1], m) let mkLazyDelayed g m ty f = mkApps g (typedExprForIntrinsic g m g.lazy_create_info, [[ty]], [ f ], m) + let mkLazyForce g m ty e = mkApps g (typedExprForIntrinsic g m g.lazy_force_info, [[ty]], [ e; mkUnit g m ], m) let mkGetString g m e1 e2 = mkApps g (typedExprForIntrinsic g m g.getstring_info, [], [e1;e2], m) + let mkGetStringChar = mkGetString + let mkGetStringLength g m e = let mspec = mspec_String_Length g /// ILCall(useCallvirt, isProtected, valu, newobj, valUseFlags, isProp, noTailCall, mref, actualTypeInst, actualMethInst, retTy) @@ -6629,6 +6893,7 @@ let mkStaticCall_String_Concat_Array g m arg = // Generated by the optimizer and the encoding of 'for' loops let mkDecr (g:TcGlobals) m e = mkAsmExpr([ IL.AI_sub ], [], [e; mkOne g m], [g.int_ty], m) + let mkIncr (g:TcGlobals) m e = mkAsmExpr([ IL.AI_add ], [], [mkOne g m; e], [g.int_ty], m) // Generated by the pattern match compiler and the optimizer for @@ -6637,6 +6902,7 @@ let mkIncr (g:TcGlobals) m e = mkAsmExpr([ IL.AI_add ], [], [mkOne g m; e], [g. // // NOTE: The conv.i4 assumes that int_ty is int32. Note: ldlen returns native UNSIGNED int let mkLdlen (g:TcGlobals) m arre = mkAsmExpr ([ IL.I_ldlen; (IL.AI_conv IL.DT_I4) ], [], [ arre ], [ g.int_ty ], m) + let mkLdelem (_g:TcGlobals) m ty arre idxe = mkAsmExpr ([ IL.I_ldelem_any (ILArrayShape.SingleDimensional, mkILTyvarTy 0us) ], [ty], [ arre;idxe ], [ ty ], m) // This is generated in equality/compare/hash augmentations and in the pattern match compiler. @@ -6644,25 +6910,24 @@ let mkLdelem (_g:TcGlobals) m ty arre idxe = mkAsmExpr ([ IL.I_ldelem_any (ILArr // // Note: this is IL assembly code, don't go inserting this in expressions which will be exposed via quotations let mkILAsmCeq (g:TcGlobals) m e1 e2 = mkAsmExpr ([ IL.AI_ceq ], [], [e1; e2], [g.bool_ty], m) + let mkILAsmClt (g:TcGlobals) m e1 e2 = mkAsmExpr ([ IL.AI_clt ], [], [e1; e2], [g.bool_ty], m) // This is generated in the initialization of the "ctorv" field in the typechecker's compilation of // an implicit class construction. let mkNull m ty = Expr.Const(Const.Zero, m, ty) -//---------------------------------------------------------------------------- -// rethrow -//---------------------------------------------------------------------------- - -(* throw, rethrow *) let mkThrow m ty e = mkAsmExpr ([ IL.I_throw ], [], [e], [ty], m) + let destThrow = function | Expr.Op (TOp.ILAsm([IL.I_throw], [ty2]), [], [e], m) -> Some (m, ty2, e) | _ -> None + let isThrow x = Option.isSome (destThrow x) -// rethrow - parsed as library call - internally represented as op form. +// reraise - parsed as library call - internally represented as op form. let mkReraiseLibCall (g:TcGlobals) ty m = let ve, vt = typedExprForIntrinsic g m g.reraise_info in Expr.App(ve, vt, [ty], [mkUnit g m], m) + let mkReraise m returnTy = Expr.Op (TOp.Reraise, [returnTy], [], m) (* could suppress unitArg *) //---------------------------------------------------------------------------- @@ -6684,8 +6949,11 @@ let mkCompilationMappingAttrPrim (g:TcGlobals) k nums = ((mkILNonGenericValueTy (tref_SourceConstructFlags g)) :: (nums |> List.map (fun _ -> g.ilg.typ_Int32))), ((k :: nums) |> List.map (fun n -> ILAttribElem.Int32(n))), []) + let mkCompilationMappingAttr g kind = mkCompilationMappingAttrPrim g kind [] + let mkCompilationMappingAttrWithSeqNum g kind seqNum = mkCompilationMappingAttrPrim g kind [seqNum] + let mkCompilationMappingAttrWithVariantNumAndSeqNum g kind varNum seqNum = mkCompilationMappingAttrPrim g kind [varNum;seqNum] let mkCompilationArgumentCountsAttr (g:TcGlobals) nums = @@ -6704,11 +6972,12 @@ let mkCompilationMappingAttrForQuotationResource (g:TcGlobals) (nm, tys: ILTypeR [ ILAttribElem.String (Some nm); ILAttribElem.Array (g.ilg.typ_Type, [ for ty in tys -> ILAttribElem.TypeRef (Some ty) ]) ], []) -#if !NO_EXTENSIONTYPING //---------------------------------------------------------------------------- // Decode extensible typing attributes //---------------------------------------------------------------------------- +#if !NO_EXTENSIONTYPING + let isTypeProviderAssemblyAttr (cattr:ILAttribute) = cattr.Method.DeclaringType.BasicQualifiedName = typeof.FullName @@ -6730,27 +6999,30 @@ let TryDecodeTypeProviderAssemblyAttr ilg (cattr:ILAttribute) = //---------------------------------------------------------------------------- let tname_SignatureDataVersionAttr = FSharpLib.Core + ".FSharpInterfaceDataVersionAttribute" + let tnames_SignatureDataVersionAttr = splitILTypeName tname_SignatureDataVersionAttr + let tref_SignatureDataVersionAttr () = mkILTyRef(IlxSettings.ilxFsharpCoreLibScopeRef (), tname_SignatureDataVersionAttr) let mkSignatureDataVersionAttr (g:TcGlobals) ((v1, v2, v3, _) : ILVersionInfo) = mkILCustomAttribute g.ilg (tref_SignatureDataVersionAttr(), [g.ilg.typ_Int32;g.ilg.typ_Int32;g.ilg.typ_Int32], - [ILAttribElem.Int32 (int32 v1); - ILAttribElem.Int32 (int32 v2) ; + [ILAttribElem.Int32 (int32 v1) + ILAttribElem.Int32 (int32 v2) ILAttribElem.Int32 (int32 v3)], []) let tname_AutoOpenAttr = FSharpLib.Core + ".AutoOpenAttribute" let IsSignatureDataVersionAttr cattr = isILAttribByName ([], tname_SignatureDataVersionAttr) cattr + let TryFindAutoOpenAttr (ilg : IL.ILGlobals) cattr = if isILAttribByName ([], tname_AutoOpenAttr) cattr then match decodeILAttribData ilg cattr with | [ILAttribElem.String s], _ -> s | [], _ -> None | _ -> - warning(Failure(FSComp.SR.tastUnexpectedDecodeOfAutoOpenAttribute())); + warning(Failure(FSComp.SR.tastUnexpectedDecodeOfAutoOpenAttribute())) None else None @@ -6763,7 +7035,7 @@ let TryFindInternalsVisibleToAttr ilg cattr = | [ILAttribElem.String s], _ -> s | [], _ -> None | _ -> - warning(Failure(FSComp.SR.tastUnexpectedDecodeOfInternalsVisibleToAttribute())); + warning(Failure(FSComp.SR.tastUnexpectedDecodeOfInternalsVisibleToAttribute())) None else None @@ -6774,7 +7046,7 @@ let IsMatchingSignatureDataVersionAttr ilg ((v1, v2, v3, _) : ILVersionInfo) ca | [ILAttribElem.Int32 u1; ILAttribElem.Int32 u2;ILAttribElem.Int32 u3 ], _ -> (v1 = uint16 u1) && (v2 = uint16 u2) && (v3 = uint16 u3) | _ -> - warning(Failure(FSComp.SR.tastUnexpectedDecodeOfInterfaceDataVersionAttribute())); + warning(Failure(FSComp.SR.tastUnexpectedDecodeOfInterfaceDataVersionAttribute())) false let mkCompilerGeneratedAttr (g:TcGlobals) n = @@ -6788,7 +7060,6 @@ let mkCompilerGeneratedAttr (g:TcGlobals) n = // "(mvs, body)" where mvs has the List.length "arity". //-------------------------------------------------------------------------- - let untupledToRefTupled g vs = let untupledTys = typesOfVals vs let m = (List.head vs).Range @@ -6802,7 +7073,7 @@ let untupledToRefTupled g vs = // where the N's will be identical. let AdjustArityOfLambdaBody g arity (vs:Val list) body = let nvs = vs.Length - if not (nvs = arity || nvs = 1 || arity = 1) then failwith ("lengths don't add up"); + if not (nvs = arity || nvs = 1 || arity = 1) then failwith ("lengths don't add up") if arity = 0 then vs, body elif nvs = arity then @@ -6810,7 +7081,7 @@ let AdjustArityOfLambdaBody g arity (vs:Val list) body = elif nvs = 1 then let v = vs.Head let untupledTys = destRefTupleTy g v.Type - if (untupledTys.Length <> arity) then failwith "length untupledTys <> arity"; + if (untupledTys.Length <> arity) then failwith "length untupledTys <> arity" let dummyvs, dummyes = untupledTys |> List.mapi (fun i ty -> mkCompGenLocal v.Range (v.LogicalName + "_" + string i) ty) @@ -6829,7 +7100,6 @@ let MultiLambdaToTupledLambda g vs body = | vs -> let tupledv, untupler = untupledToRefTupled g vs tupledv, untupler body - let (|RefTuple|_|) expr = match expr with @@ -6854,7 +7124,6 @@ let MultiLambdaToTupledLambdaIfNeeded g (vs, arg) body = //------------------------------------------------------------------------ let rec MakeApplicationAndBetaReduceAux g (f, fty, tyargsl : TType list list, argsl: Expr list, m) = - (* let verbose = true in *) match f with | Expr.Let(bind, body, mlet, _) -> // Lift bindings out, i.e. (let x = e in f) y --> let x = e in f y @@ -6940,11 +7209,6 @@ let AdjustValForExpectedArity g m (vref:ValRef) flags topValInfo = // Build a type-lambda expression for the toplevel value if needed... mkTypeLambda m tps' (tauexpr, tauty), tps' +-> tauty - -//--------------------------------------------------------------------------- -// - - let IsSubsumptionExpr g expr = match expr with | Expr.Op (TOp.Coerce, [inputTy;actualTy], [_], _) -> @@ -6959,10 +7223,10 @@ let stripTupledFunTy g ty = let (|ExprValWithPossibleTypeInst|_|) expr = match expr with - | Expr.App(Expr.Val(vref, flags, m), _fty, tyargs, [], _) -> - Some(vref, flags, tyargs, m) - | Expr.Val(vref, flags, m) -> - Some(vref, flags, [], m) + | Expr.App (Expr.Val (vref, flags, m), _fty, tyargs, [], _) -> + Some (vref, flags, tyargs, m) + | Expr.Val (vref, flags, m) -> + Some (vref, flags, [], m) | _ -> None @@ -7321,7 +7585,7 @@ let LinearizeTopMatchAux g parent (spBind, m, tree, targets, m2, ty) = let tmpTy = mkRefTupledVarsTy g vs let tmp, tmpe = mkCompGenLocal m "matchResultHolder" tmpTy - AdjustValToTopVal tmp parent ValReprInfo.emptyValData; + AdjustValToTopVal tmp parent ValReprInfo.emptyValData let newTg = TTarget (fvs, mkRefTupledVars g m fvs, spTarget) let fixup (TTarget (tvs, tx, spTarget)) = @@ -7729,10 +7993,10 @@ let isSealedTy g ty = true let isComInteropTy g ty = - let tcr = tcrefOfAppTy g ty + let tcref = tcrefOfAppTy g ty match g.attrib_ComImportAttribute with | None -> false - | Some attr -> TryFindFSharpBoolAttribute g attr tcr.Attribs = Some(true) + | Some attr -> TryFindFSharpBoolAttribute g attr tcref.Attribs = Some(true) let ValSpecIsCompiledAsInstance g (v:Val) = match v.MemberInfo with @@ -7790,7 +8054,7 @@ type ActivePatternElemRef with | None -> error(InternalError("not an active pattern name", vref.Range)) | Some apinfo -> let nms = apinfo.ActiveTags - if n < 0 || n >= List.length nms then error(InternalError("name_of_apref: index out of range for active pattern reference", vref.Range)); + if n < 0 || n >= List.length nms then error(InternalError("name_of_apref: index out of range for active pattern reference", vref.Range)) List.item n nms let mkChoiceTyconRef (g:TcGlobals) m n = @@ -7846,9 +8110,9 @@ let doesActivePatternHaveFreeTypars g (v:ValRef) = [] type ExprRewritingEnv = - { PreIntercept: ((Expr -> Expr) -> Expr -> Expr option) option; - PostTransform: Expr -> Expr option; - PreInterceptBinding: ((Expr -> Expr) -> Binding -> Binding option) option; + { PreIntercept: ((Expr -> Expr) -> Expr -> Expr option) option + PostTransform: Expr -> Expr option + PreInterceptBinding: ((Expr -> Expr) -> Binding -> Binding option) option IsUnderQuotations: bool } let rec rewriteBind env bind = @@ -7866,6 +8130,8 @@ and rewriteBinds env binds = List.map (rewriteBind env) binds and RewriteExpr env expr = match expr with + | LinearOpExpr _ + | LinearMatchExpr _ | Expr.Let _ | Expr.Sequential _ -> rewriteLinearExpr env expr (fun e -> e) @@ -7948,29 +8214,41 @@ and rewriteLinearExpr env expr contf = // schedule a rewrite on the way back up by adding to the continuation let contf = contf << postRewriteExpr env match preRewriteExpr env expr with - | Some expr -> contf expr (* done - intercepted! *) + | Some expr -> contf expr | None -> match expr with - | Expr.Let (bind, body, m, _) -> + | Expr.Let (bind, bodyExpr, m, _) -> let bind = rewriteBind env bind - rewriteLinearExpr env body (contf << (fun body' -> - mkLetBind m bind body')) - | Expr.Sequential (e1, e2, dir, spSeq, m) -> - let e1' = RewriteExpr env e1 - rewriteLinearExpr env e2 (contf << (fun e2' -> - if e1 === e1' && e2 === e2' then expr - else Expr.Sequential(e1', e2', dir, spSeq, m))) - | LinearMatchExpr (spBind, exprm, dtree, tg1, e2, sp2, m2, ty) -> + // tailcall + rewriteLinearExpr env bodyExpr (contf << (fun bodyExpr' -> + mkLetBind m bind bodyExpr')) + + | Expr.Sequential (expr1, expr2, dir, spSeq, m) -> + let expr1' = RewriteExpr env expr1 + // tailcall + rewriteLinearExpr env expr2 (contf << (fun expr2' -> + if expr1 === expr1' && expr2 === expr2' then expr + else Expr.Sequential(expr1', expr2', dir, spSeq, m))) + + | LinearOpExpr (op, tyargs, argsFront, argLast, m) -> + let argsFront' = rewriteExprs env argsFront + // tailcall + rewriteLinearExpr env argLast (contf << (fun argLast' -> + if argsFront === argsFront' && argLast === argLast' then expr + else rebuildLinearOpExpr (op, tyargs, argsFront', argLast', m))) + + | LinearMatchExpr (spBind, exprm, dtree, tg1, expr2, sp2, m2, ty) -> let dtree = rewriteDecisionTree env dtree - let tg1 = rewriteTarget env tg1 + let tg1' = rewriteTarget env tg1 // tailcall - rewriteLinearExpr env e2 (contf << (fun e2 -> - rebuildLinearMatchExpr (spBind, exprm, dtree, tg1, e2, sp2, m2, ty))) + rewriteLinearExpr env expr2 (contf << (fun expr2' -> + rebuildLinearMatchExpr (spBind, exprm, dtree, tg1', expr2', sp2, m2, ty))) | _ -> - (* no longer linear *) + // no longer linear, no tailcall contf (RewriteExpr env expr) and rewriteExprs env exprs = List.mapq (RewriteExpr env) exprs + and rewriteFlatExprs env exprs = List.mapq (RewriteExpr env) exprs and rewriteDecisionTree env x = @@ -8280,7 +8558,7 @@ let rec EvalAttribArgExpr g x = #if ALLOW_ARITHMETIC_OPS_IN_LITERAL_EXPRESSIONS_AND_ATTRIBUTE_ARGS EvalArithBinOp (Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+)) g v1 v2 #else - errorR (Error ( FSComp.SR.tastNotAConstantExpression(), x.Range)); + errorR (Error ( FSComp.SR.tastNotAConstantExpression(), x.Range)) x #endif #if ALLOW_ARITHMETIC_OPS_IN_LITERAL_EXPRESSIONS_AND_ATTRIBUTE_ARGS @@ -8290,7 +8568,7 @@ let rec EvalAttribArgExpr g x = EvalArithBinOp (Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*)) g (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2) #endif | _ -> - errorR (Error ( FSComp.SR.tastNotAConstantExpression(), x.Range)); + errorR (Error ( FSComp.SR.tastNotAConstantExpression(), x.Range)) x @@ -8347,7 +8625,7 @@ let GetTypeOfIntrinsicMemberInCompiledForm g (vref:ValRef) = let _, origArgInfos, _, _ = GetTopValTypeInFSharpForm g topValInfo vref.Type vref.Range match origArgInfos with | [] -> - errorR(InternalError("value does not have a valid member type", vref.Range)); + errorR(InternalError("value does not have a valid member type", vref.Range)) argInfos | h::_ -> h ::argInfos else argInfos @@ -8479,7 +8757,7 @@ let DetectAndOptimizeForExpression g option expr = | _, CompiledInt32RangeForEachExpr g (startExpr, (1 | -1 as step), finishExpr, elemVar, bodyExpr, ranges) -> let (_mEnumExpr, _mBody, spForLoop, _mForLoop, _spWhileLoop, mWholeExpr) = ranges - mkFastForLoop g (spForLoop, mWholeExpr, elemVar, startExpr, (step = 1), finishExpr, bodyExpr) + mkFastForLoop g (spForLoop, mWholeExpr, elemVar, startExpr, (step = 1), finishExpr, bodyExpr) | OptimizeAllForExpressions, CompiledForEachExpr g (enumerableTy, enumerableExpr, elemVar, bodyExpr, ranges) -> @@ -8492,18 +8770,19 @@ let DetectAndOptimizeForExpression g option expr = // let elem = str.[idx] // body elem - let strVar , strExpr = mkCompGenLocal mEnumExpr "str" enumerableTy - let idxVar , idxExpr = mkCompGenLocal elemVar.Range "idx" g.int32_ty + let strVar, strExpr = mkCompGenLocal mEnumExpr "str" enumerableTy + let idxVar, idxExpr = mkCompGenLocal elemVar.Range "idx" g.int32_ty - let lengthExpr = mkGetStringLength g mForLoop strExpr - let charExpr = mkGetStringChar g mForLoop strExpr idxExpr + let lengthExpr = mkGetStringLength g mForLoop strExpr + let charExpr = mkGetStringChar g mForLoop strExpr idxExpr - let startExpr = mkZero g mForLoop - let finishExpr = mkDecr g mForLoop lengthExpr - let loopItemExpr = mkCoerceIfNeeded g elemVar.Type g.char_ty charExpr // for compat reasons, loop item over string is sometimes object, not char - let bodyExpr = mkCompGenLet mForLoop elemVar loopItemExpr bodyExpr - let forExpr = mkFastForLoop g (spForLoop, mWholeExpr, idxVar, startExpr, true, finishExpr, bodyExpr) - let expr = mkCompGenLet mEnumExpr strVar enumerableExpr forExpr + let startExpr = mkZero g mForLoop + let finishExpr = mkDecr g mForLoop lengthExpr + // for compat reasons, loop item over string is sometimes object, not char + let loopItemExpr = mkCoerceIfNeeded g elemVar.Type g.char_ty charExpr + let bodyExpr = mkCompGenLet mForLoop elemVar loopItemExpr bodyExpr + let forExpr = mkFastForLoop g (spForLoop, mWholeExpr, idxVar, startExpr, true, finishExpr, bodyExpr) + let expr = mkCompGenLet mEnumExpr strVar enumerableExpr forExpr expr @@ -8517,28 +8796,26 @@ let DetectAndOptimizeForExpression g option expr = // $current <- $next // $next <- $tailOrNull - let IndexHead = 0 - let IndexTail = 1 + let IndexHead = 0 + let IndexTail = 1 - let currentVar , currentExpr = mkMutableCompGenLocal mEnumExpr "current" enumerableTy - let nextVar , nextExpr = mkMutableCompGenLocal mEnumExpr "next" enumerableTy - let elemTy = destListTy g enumerableTy + let currentVar, currentExpr = mkMutableCompGenLocal mEnumExpr "current" enumerableTy + let nextVar, nextExpr = mkMutableCompGenLocal mEnumExpr "next" enumerableTy + let elemTy = destListTy g enumerableTy - let guardExpr = mkNonNullTest g mForLoop nextExpr - let headOrDefaultExpr = mkUnionCaseFieldGetUnprovenViaExprAddr (currentExpr, g.cons_ucref, [elemTy], IndexHead, mForLoop) - let tailOrNullExpr = mkUnionCaseFieldGetUnprovenViaExprAddr (currentExpr, g.cons_ucref, [elemTy], IndexTail, mForLoop) - let bodyExpr = + let guardExpr = mkNonNullTest g mForLoop nextExpr + let headOrDefaultExpr = mkUnionCaseFieldGetUnprovenViaExprAddr (currentExpr, g.cons_ucref, [elemTy], IndexHead, mForLoop) + let tailOrNullExpr = mkUnionCaseFieldGetUnprovenViaExprAddr (currentExpr, g.cons_ucref, [elemTy], IndexTail, mForLoop) + let bodyExpr = mkCompGenLet mForLoop elemVar headOrDefaultExpr (mkCompGenSequential mForLoop bodyExpr (mkCompGenSequential mForLoop (mkValSet mForLoop (mkLocalValRef currentVar) nextExpr) - (mkValSet mForLoop (mkLocalValRef nextVar) tailOrNullExpr) - ) - ) + (mkValSet mForLoop (mkLocalValRef nextVar) tailOrNullExpr))) let expr = - // let mutable current = enumerableExpr + // let mutable current = enumerableExpr let spBind = (match spForLoop with SequencePointAtForLoop(spStart) -> SequencePointAtBinding(spStart) | NoSequencePointAtForLoop -> NoSequencePointAtStickyBinding) mkLet spBind mEnumExpr currentVar enumerableExpr // let mutable next = current.TailOrNull @@ -8550,6 +8827,7 @@ let DetectAndOptimizeForExpression g option expr = else expr + | _ -> expr // Used to remove Expr.Link for inner expressions in pattern matches diff --git a/src/fsharp/TastOps.fsi b/src/fsharp/TastOps.fsi index c719406d5aee764c9057da7d118e87f12d684e79..6098625122fd5734a788e33e836764438a198719 100755 --- a/src/fsharp/TastOps.fsi +++ b/src/fsharp/TastOps.fsi @@ -1357,7 +1357,7 @@ module DebugPrint = /// A set of function parameters (visitor) for folding over expressions type ExprFolder<'State> = - { exprIntercept : ('State -> Expr -> 'State) -> 'State -> Expr -> 'State option + { exprIntercept : (* recurseF *) ('State -> Expr -> 'State) -> (* noInterceptF *) ('State -> Expr -> 'State) -> 'State -> Expr -> 'State valBindingSiteIntercept : 'State -> bool * Val -> 'State nonRecBindingsIntercept : 'State -> Binding -> 'State recBindingsIntercept : 'State -> Bindings -> 'State @@ -2261,6 +2261,10 @@ val (|LinearMatchExpr|_|) : Expr -> (SequencePointInfoForBinding * range * Decis val rebuildLinearMatchExpr : (SequencePointInfoForBinding * range * DecisionTree * DecisionTreeTarget * Expr * SequencePointInfoForTarget * range * TType) -> Expr +val (|LinearOpExpr|_|) : Expr -> (TOp * TypeInst * Expr list * Expr * range) option + +val rebuildLinearOpExpr : (TOp * TypeInst * Expr list * Expr * range) -> Expr + val mkCoerceIfNeeded : TcGlobals -> tgtTy: TType -> srcTy: TType -> Expr -> Expr val (|InnerExprPat|) : Expr -> Expr diff --git a/src/fsharp/TastPickle.fs b/src/fsharp/TastPickle.fs index caf1892bd6415c3f5ac45217e08308583da03d2c..c988d3b338f6333b20e06da1ea16f34fb6d64218 100644 --- a/src/fsharp/TastPickle.fs +++ b/src/fsharp/TastPickle.fs @@ -1,14 +1,14 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.TastPickle +module internal FSharp.Compiler.TastPickle open System.Collections.Generic open System.Text open Internal.Utilities -open FSharp.Compiler -open FSharp.Compiler.AbstractIL +open FSharp.Compiler +open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.AbstractIL.Internal +open FSharp.Compiler.AbstractIL.Internal open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.Tastops @@ -24,19 +24,19 @@ open FSharp.Compiler.ErrorLogger let verbose = false -let ffailwith fileName str = +let ffailwith fileName str = let msg = FSComp.SR.pickleErrorReadingWritingMetadata(fileName, str) System.Diagnostics.Debug.Assert(false, msg) failwith msg - + // Fixup pickled data w.r.t. a set of CCU thunks indexed by name [] -type PickledDataWithReferences<'rawData> = +type PickledDataWithReferences<'rawData> = { /// The data that uses a collection of CcuThunks internally RawData: 'rawData /// The assumptions that need to be fixed up - FixupThunks: CcuThunk [] } + FixupThunks: CcuThunk [] } member x.Fixup loader = x.FixupThunks |> Array.iter (fun reqd -> reqd.Fixup(loader reqd.AssemblyName)) @@ -44,21 +44,21 @@ type PickledDataWithReferences<'rawData> = /// Like Fixup but loader may return None, in which case there is no fixup. member x.OptionalFixup loader = - x.FixupThunks + x.FixupThunks |> Array.iter(fun reqd-> - match loader reqd.AssemblyName with + match loader reqd.AssemblyName with | Some(loaded) -> reqd.Fixup(loaded) | None -> reqd.FixupOrphaned() ) x.RawData - + //--------------------------------------------------------------------------- // Basic pickle/unpickle state //--------------------------------------------------------------------------- [] -type Table<'T> = - { name: string; +type Table<'T> = + { name: string tbl: Dictionary<'T, int> mutable rows: ResizeArray<'T> mutable count: int } @@ -70,27 +70,27 @@ type Table<'T> = tbl.tbl.[x] <- n tbl.rows.Add(x) n - member tbl.FindOrAdd x = + member tbl.FindOrAdd x = let mutable res = Unchecked.defaultof<_> - let ok = tbl.tbl.TryGetValue(x,&res) + let ok = tbl.tbl.TryGetValue(x, &res) if ok then res else tbl.Add x - static member Create n = + static member Create n = { name = n - tbl = new System.Collections.Generic.Dictionary<_,_>(1000, HashIdentity.Structural) + tbl = new System.Collections.Generic.Dictionary<_, _>(1000, HashIdentity.Structural) rows= new ResizeArray<_>(1000) count=0 } [] -type InputTable<'T> = +type InputTable<'T> = { itbl_name: string itbl_rows: 'T array } let new_itbl n r = { itbl_name=n; itbl_rows=r } [] -type NodeOutTable<'Data,'Node> = +type NodeOutTable<'Data, 'Node> = { NodeStamp : ('Node -> Stamp) NodeName : ('Node -> string) GetRange : ('Node -> range) @@ -100,7 +100,7 @@ type NodeOutTable<'Data,'Node> = member x.Size = x.Table.Size // inline this to get known-type-information through to the HashMultiMap constructor - static member inline Create (stampF,nameF,rangeF,derefF,nm) = + static member inline Create (stampF, nameF, rangeF, derefF, nm) = { NodeStamp = stampF NodeName = nameF GetRange = rangeF @@ -109,17 +109,17 @@ type NodeOutTable<'Data,'Node> = Table = Table<_>.Create nm } [] -type WriterState = - { os: ByteBuffer +type WriterState = + { os: ByteBuffer oscope: CcuThunk - occus: Table - oentities: NodeOutTable - otypars: NodeOutTable - ovals: NodeOutTable - oanoninfos: NodeOutTable - ostrings: Table - opubpaths: Table - onlerefs: Table + occus: Table + oentities: NodeOutTable + otypars: NodeOutTable + ovals: NodeOutTable + oanoninfos: NodeOutTable + ostrings: Table + opubpaths: Table + onlerefs: Table osimpletys: Table oglobals : TcGlobals mutable isStructThisArgPos : bool @@ -128,31 +128,31 @@ type WriterState = oInMem : bool } let pfailwith st str = ffailwith st.ofile str - + [] -type NodeInTable<'Data,'Node> = +type NodeInTable<'Data, 'Node> = { LinkNode : ('Node -> 'Data -> unit) IsLinked : ('Node -> bool) - Name : string + Name : string Nodes : 'Node[] } member x.Get n = x.Nodes.[n] member x.Count = x.Nodes.Length - static member Create (mkEmpty, lnk, isLinked, nm, n) = + static member Create (mkEmpty, lnk, isLinked, nm, n) = { LinkNode = lnk; IsLinked = isLinked; Name = nm; Nodes = Array.init n (fun _i -> mkEmpty() ) } [] -type ReaderState = - { is: ByteStream +type ReaderState = + { is: ByteStream iilscope: ILScopeRef - iccus: InputTable - ientities: NodeInTable - itypars: NodeInTable - ivals: NodeInTable - ianoninfos: NodeInTable + iccus: InputTable + ientities: NodeInTable + itypars: NodeInTable + ivals: NodeInTable + ianoninfos: NodeInTable istrings: InputTable - ipubpaths: InputTable - inlerefs: InputTable + ipubpaths: InputTable + inlerefs: InputTable isimpletys: InputTable ifile: string iILModule : ILModuleDef option // the Abstract IL metadata for the DLL being read @@ -163,47 +163,47 @@ let ufailwith st str = ffailwith st.ifile str //--------------------------------------------------------------------------- // Basic pickle/unpickle operations //--------------------------------------------------------------------------- - + type 'T pickler = 'T -> WriterState -> unit let p_byte b st = st.os.EmitIntAsByte b let p_bool b st = p_byte (if b then 1 else 0) st -let prim_p_int32 i st = +let prim_p_int32 i st = p_byte (b0 i) st p_byte (b1 i) st p_byte (b2 i) st p_byte (b3 i) st -/// Compress integers according to the same scheme used by CLR metadata -/// This halves the size of pickled data -let p_int32 n st = - if n >= 0 && n <= 0x7F then +/// Compress integers according to the same scheme used by CLR metadata +/// This halves the size of pickled data +let p_int32 n st = + if n >= 0 && n <= 0x7F then p_byte (b0 n) st - else if n >= 0x80 && n <= 0x3FFF then - p_byte ( (0x80 ||| (n >>> 8))) st - p_byte ( (n &&& 0xFF)) st - else + else if n >= 0x80 && n <= 0x3FFF then + p_byte ( (0x80 ||| (n >>> 8))) st + p_byte ( (n &&& 0xFF)) st + else p_byte 0xFF st prim_p_int32 n st let space = () -let p_space n () st = - for i = 0 to n - 1 do +let p_space n () st = + for i = 0 to n - 1 do p_byte 0 st /// Represents space that was reserved but is now possibly used -let p_used_space1 f st = +let p_used_space1 f st = p_byte 1 st f st // leave more space p_space 1 space st -let p_bytes (s:byte[]) st = +let p_bytes (s:byte[]) st = let len = s.Length p_int32 (len) st st.os.EmitBytes s -let p_prim_string (s:string) st = +let p_prim_string (s:string) st = let bytes = Encoding.UTF8.GetBytes s let len = bytes.Length p_int32 (len) st @@ -215,13 +215,13 @@ let p_uint8 (i:byte) st = p_byte (int i) st let p_int16 (i:int16) st = p_int32 (int32 i) st let p_uint16 (x:uint16) st = p_int32 (int32 x) st let p_uint32 (x:uint32) st = p_int32 (int32 x) st -let p_int64 (i:int64) st = +let p_int64 (i:int64) st = p_int32 (int32 (i &&& 0xFFFFFFFFL)) st p_int32 (int32 (i >>> 32)) st let p_uint64 (x:uint64) st = p_int64 (int64 x) st -let bits_of_float32 (x:float32) = System.BitConverter.ToInt32(System.BitConverter.GetBytes(x),0) +let bits_of_float32 (x:float32) = System.BitConverter.ToInt32(System.BitConverter.GetBytes(x), 0) let bits_of_float (x:float) = System.BitConverter.DoubleToInt64Bits(x) let p_single i st = p_int32 (bits_of_float32 i) st @@ -229,67 +229,67 @@ let p_double i st = p_int64 (bits_of_float i) st let p_ieee64 i st = p_int64 (bits_of_float i) st let p_char i st = p_uint16 (uint16 (int32 i)) st -let inline p_tup2 p1 p2 (a,b) (st:WriterState) = +let inline p_tup2 p1 p2 (a, b) (st:WriterState) = (p1 a st : unit); (p2 b st : unit) -let inline p_tup3 p1 p2 p3 (a,b,c) (st:WriterState) = +let inline p_tup3 p1 p2 p3 (a, b, c) (st:WriterState) = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit) -let inline p_tup4 p1 p2 p3 p4 (a,b,c,d) (st:WriterState) = +let inline p_tup4 p1 p2 p3 p4 (a, b, c, d) (st:WriterState) = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit); (p4 d st : unit) -let inline p_tup5 p1 p2 p3 p4 p5 (a,b,c,d,e) (st:WriterState) = +let inline p_tup5 p1 p2 p3 p4 p5 (a, b, c, d, e) (st:WriterState) = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit); (p4 d st : unit); (p5 e st : unit) -let inline p_tup6 p1 p2 p3 p4 p5 p6 (a,b,c,d,e,f) (st:WriterState) = +let inline p_tup6 p1 p2 p3 p4 p5 p6 (a, b, c, d, e, f) (st:WriterState) = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit); (p4 d st : unit); (p5 e st : unit); (p6 f st : unit) -let inline p_tup7 p1 p2 p3 p4 p5 p6 p7 (a,b,c,d,e,f,x7) (st:WriterState) = +let inline p_tup7 p1 p2 p3 p4 p5 p6 p7 (a, b, c, d, e, f, x7) (st:WriterState) = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit); (p4 d st : unit); (p5 e st : unit); (p6 f st : unit); (p7 x7 st : unit) -let inline p_tup8 p1 p2 p3 p4 p5 p6 p7 p8 (a,b,c,d,e,f,x7,x8) (st:WriterState) = +let inline p_tup8 p1 p2 p3 p4 p5 p6 p7 p8 (a, b, c, d, e, f, x7, x8) (st:WriterState) = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit); (p4 d st : unit); (p5 e st : unit); (p6 f st : unit); (p7 x7 st : unit); (p8 x8 st : unit) -let inline p_tup9 p1 p2 p3 p4 p5 p6 p7 p8 p9 (a,b,c,d,e,f,x7,x8,x9) (st:WriterState) = +let inline p_tup9 p1 p2 p3 p4 p5 p6 p7 p8 p9 (a, b, c, d, e, f, x7, x8, x9) (st:WriterState) = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit); (p4 d st : unit); (p5 e st : unit); (p6 f st : unit); (p7 x7 st : unit); (p8 x8 st : unit); (p9 x9 st : unit) -let inline p_tup10 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 (a,b,c,d,e,f,x7,x8,x9,x10) (st:WriterState) = +let inline p_tup10 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 (a, b, c, d, e, f, x7, x8, x9, x10) (st:WriterState) = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit); (p4 d st : unit); (p5 e st : unit); (p6 f st : unit); (p7 x7 st : unit); (p8 x8 st : unit); (p9 x9 st : unit); (p10 x10 st : unit) -let inline p_tup11 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 (a,b,c,d,e,f,x7,x8,x9,x10,x11) (st:WriterState) = +let inline p_tup11 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 (a, b, c, d, e, f, x7, x8, x9, x10, x11) (st:WriterState) = (p1 a st : unit); (p2 b st : unit); (p3 c st : unit); (p4 d st : unit); (p5 e st : unit); (p6 f st : unit); (p7 x7 st : unit); (p8 x8 st : unit); (p9 x9 st : unit); (p10 x10 st : unit); (p11 x11 st : unit) let u_byte st = int (st.is.ReadByte()) type unpickler<'T> = ReaderState -> 'T -let u_bool st = let b = u_byte st in (b = 1) +let u_bool st = let b = u_byte st in (b = 1) -let prim_u_int32 st = +let prim_u_int32 st = let b0 = (u_byte st) let b1 = (u_byte st) let b2 = (u_byte st) let b3 = (u_byte st) b0 ||| (b1 <<< 8) ||| (b2 <<< 16) ||| (b3 <<< 24) -let u_int32 st = +let u_int32 st = let b0 = u_byte st - if b0 <= 0x7F then b0 - else if b0 <= 0xbf then + if b0 <= 0x7F then b0 + else if b0 <= 0xbf then let b0 = b0 &&& 0x7F let b1 = (u_byte st) (b0 <<< 8) ||| b1 - else + else assert(b0 = 0xFF) prim_u_int32 st -let u_bytes st = +let u_bytes st = let n = (u_int32 st) st.is.ReadBytes n -let u_prim_string st = +let u_prim_string st = let len = (u_int32 st) st.is.ReadUtf8String len @@ -299,13 +299,13 @@ let u_uint8 st = byte (u_byte st) let u_int16 st = int16 (u_int32 st) let u_uint16 st = uint16 (u_int32 st) let u_uint32 st = uint32 (u_int32 st) -let u_int64 st = +let u_int64 st = let b1 = (int64 (u_int32 st)) &&& 0xFFFFFFFFL let b2 = int64 (u_int32 st) b1 ||| (b2 <<< 32) let u_uint64 st = uint64 (u_int64 st) -let float32_of_bits (x:int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes(x),0) +let float32_of_bits (x:int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes(x), 0) let float_of_bits (x:int64) = System.BitConverter.Int64BitsToDouble(x) let u_single st = float32_of_bits (u_int32 st) @@ -314,101 +314,101 @@ let u_double st = float_of_bits (u_int64 st) let u_ieee64 st = float_of_bits (u_int64 st) let u_char st = char (int32 (u_uint16 st)) -let u_space n st = - for i = 0 to n - 1 do +let u_space n st = + for i = 0 to n - 1 do let b = u_byte st - if b <> 0 then + if b <> 0 then warning(Error(FSComp.SR.pickleUnexpectedNonZero st.ifile, range0)) - + /// Represents space that was reserved but is now possibly used -let u_used_space1 f st = +let u_used_space1 f st = let b = u_byte st - match b with + match b with | 0 -> None - | 1 -> - let x = f st + | 1 -> + let x = f st u_space 1 st Some x - | _ -> + | _ -> warning(Error(FSComp.SR.pickleUnexpectedNonZero st.ifile, range0)); None -let inline u_tup2 p1 p2 (st:ReaderState) = let a = p1 st in let b = p2 st in (a,b) +let inline u_tup2 p1 p2 (st:ReaderState) = let a = p1 st in let b = p2 st in (a, b) let inline u_tup3 p1 p2 p3 (st:ReaderState) = - let a = p1 st in let b = p2 st in let c = p3 st in (a,b,c) + let a = p1 st in let b = p2 st in let c = p3 st in (a, b, c) let inline u_tup4 p1 p2 p3 p4 (st:ReaderState) = - let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in (a,b,c,d) + let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in (a, b, c, d) let inline u_tup5 p1 p2 p3 p4 p5 (st:ReaderState) = - let a = p1 st - let b = p2 st - let c = p3 st - let d = p4 st - let e = p5 st - (a,b,c,d,e) + let a = p1 st + let b = p2 st + let c = p3 st + let d = p4 st + let e = p5 st + (a, b, c, d, e) let inline u_tup6 p1 p2 p3 p4 p5 p6 (st:ReaderState) = - let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in let f = p6 st in (a,b,c,d,e,f) + let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in let f = p6 st in (a, b, c, d, e, f) let inline u_tup7 p1 p2 p3 p4 p5 p6 p7 (st:ReaderState) = - let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in let f = p6 st in let x7 = p7 st in (a,b,c,d,e,f,x7) + let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in let f = p6 st in let x7 = p7 st in (a, b, c, d, e, f, x7) let inline u_tup8 p1 p2 p3 p4 p5 p6 p7 p8 (st:ReaderState) = - let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in let f = p6 st in let x7 = p7 st in let x8 = p8 st in (a,b,c,d,e,f,x7,x8) + let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in let f = p6 st in let x7 = p7 st in let x8 = p8 st in (a, b, c, d, e, f, x7, x8) let inline u_tup9 p1 p2 p3 p4 p5 p6 p7 p8 p9 (st:ReaderState) = - let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in let f = p6 st in let x7 = p7 st in let x8 = p8 st in let x9 = p9 st in (a,b,c,d,e,f,x7,x8,x9) + let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in let f = p6 st in let x7 = p7 st in let x8 = p8 st in let x9 = p9 st in (a, b, c, d, e, f, x7, x8, x9) let inline u_tup10 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 (st:ReaderState) = let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in let f = p6 st in let x7 = p7 st in let x8 = p8 st in - let x9 = p9 st in let x10 = p10 st in (a,b,c,d,e,f,x7,x8,x9,x10) + let x9 = p9 st in let x10 = p10 st in (a, b, c, d, e, f, x7, x8, x9, x10) let inline u_tup11 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 (st:ReaderState) = let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in let f = p6 st in let x7 = p7 st in let x8 = p8 st in - let x9 = p9 st in let x10 = p10 st in let x11 = p11 st in (a,b,c,d,e,f,x7,x8,x9,x10,x11) + let x9 = p9 st in let x10 = p10 st in let x11 = p11 st in (a, b, c, d, e, f, x7, x8, x9, x10, x11) let inline u_tup12 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 (st:ReaderState) = let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in let f = p6 st in let x7 = p7 st in let x8 = p8 st in let x9 = p9 st in let x10 = p10 st in let x11 = p11 st in let x12 = p12 st in - (a,b,c,d,e,f,x7,x8,x9,x10,x11,x12) + (a, b, c, d, e, f, x7, x8, x9, x10, x11, x12) let inline u_tup13 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 (st:ReaderState) = let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in let f = p6 st in let x7 = p7 st in let x8 = p8 st in let x9 = p9 st in let x10 = p10 st in let x11 = p11 st in let x12 = p12 st in let x13 = p13 st in - (a,b,c,d,e,f,x7,x8,x9,x10,x11,x12,x13) + (a, b, c, d, e, f, x7, x8, x9, x10, x11, x12, x13) let inline u_tup14 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 (st:ReaderState) = let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in let f = p6 st in let x7 = p7 st in let x8 = p8 st in let x9 = p9 st in let x10 = p10 st in let x11 = p11 st in let x12 = p12 st in let x13 = p13 st in let x14 = p14 st in - (a,b,c,d,e,f,x7,x8,x9,x10,x11,x12,x13,x14) + (a, b, c, d, e, f, x7, x8, x9, x10, x11, x12, x13, x14) let inline u_tup15 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 (st:ReaderState) = let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in let f = p6 st in let x7 = p7 st in let x8 = p8 st in let x9 = p9 st in let x10 = p10 st in let x11 = p11 st in let x12 = p12 st in let x13 = p13 st in let x14 = p14 st in let x15 = p15 st in - (a,b,c,d,e,f,x7,x8,x9,x10,x11,x12,x13,x14,x15) + (a, b, c, d, e, f, x7, x8, x9, x10, x11, x12, x13, x14, x15) let inline u_tup16 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 p16 (st:ReaderState) = let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in let f = p6 st in let x7 = p7 st in let x8 = p8 st in let x9 = p9 st in let x10 = p10 st in let x11 = p11 st in let x12 = p12 st in let x13 = p13 st in let x14 = p14 st in let x15 = p15 st in let x16 = p16 st in - (a,b,c,d,e,f,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16) + (a, b, c, d, e, f, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16) let inline u_tup17 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 p16 p17 (st:ReaderState) = let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in let f = p6 st in let x7 = p7 st in let x8 = p8 st in let x9 = p9 st in let x10 = p10 st in let x11 = p11 st in let x12 = p12 st in let x13 = p13 st in let x14 = p14 st in let x15 = p15 st in let x16 = p16 st in let x17 = p17 st in - (a,b,c,d,e,f,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17) + (a, b, c, d, e, f, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17) //--------------------------------------------------------------------------- @@ -418,51 +418,51 @@ let inline u_tup17 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 p16 p17 (s // exception Nope // ctxt is for debugging -let p_osgn_ref (_ctxt:string) (outMap : NodeOutTable<_,_>) x st = +let p_osgn_ref (_ctxt:string) (outMap : NodeOutTable<_, _>) x st = let idx = outMap.Table.FindOrAdd (outMap.NodeStamp x) - //if ((idx = 0) && outMap.Name = "oentities") then - // let msg = - // sprintf "idx %d#%d in table %s has name '%s', was defined at '%s' and is referenced from context %s\n" - // idx (outMap.NodeStamp x) - // outMap.Name (outMap.NodeName x) - // (stringOfRange (outMap.GetRange x)) + //if ((idx = 0) && outMap.Name = "oentities") then + // let msg = + // sprintf "idx %d#%d in table %s has name '%s', was defined at '%s' and is referenced from context %s\n" + // idx (outMap.NodeStamp x) + // outMap.Name (outMap.NodeName x) + // (stringOfRange (outMap.GetRange x)) // _ctxt // System.Diagnostics.Debug.Assert(false, msg ) p_int idx st -let p_osgn_decl (outMap : NodeOutTable<_,_>) p x st = +let p_osgn_decl (outMap : NodeOutTable<_, _>) p x st = let stamp = outMap.NodeStamp x let idx = outMap.Table.FindOrAdd stamp //dprintf "decl %d#%d in table %s has name %s\n" idx (outMap.NodeStamp x) outMap.Name (outMap.NodeName x) - p_tup2 p_int p (idx,outMap.Deref x) st + p_tup2 p_int p (idx, outMap.Deref x) st -let u_osgn_ref (inMap: NodeInTable<_,_>) st = +let u_osgn_ref (inMap: NodeInTable<_, _>) st = let n = u_int st - if n < 0 || n >= inMap.Count then ufailwith st ("u_osgn_ref: out of range, table = "+inMap.Name+", n = "+string n) + if n < 0 || n >= inMap.Count then ufailwith st ("u_osgn_ref: out of range, table = "+inMap.Name+", n = "+string n) inMap.Get n -let u_osgn_decl (inMap: NodeInTable<_,_>) u st = - let idx,data = u_tup2 u_int u st - // dprintf "unpickling osgn %d in table %s\n" idx nm +let u_osgn_decl (inMap: NodeInTable<_, _>) u st = + let idx, data = u_tup2 u_int u st + // dprintf "unpickling osgn %d in table %s\n" idx nm let res = inMap.Get idx inMap.LinkNode res data res //--------------------------------------------------------------------------- -// Pickle/unpickle operations for interned nodes +// Pickle/unpickle operations for interned nodes //--------------------------------------------------------------------------- let encode_uniq (tbl: Table<_>) key = tbl.FindOrAdd key -let lookup_uniq st tbl n = +let lookup_uniq st tbl n = let arr = tbl.itbl_rows - if n < 0 || n >= arr.Length then ufailwith st ("lookup_uniq in table "+tbl.itbl_name+" out of range, n = "+string n+ ", sizeof(tab) = " + string (Array.length arr)) + if n < 0 || n >= arr.Length then ufailwith st ("lookup_uniq in table "+tbl.itbl_name+" out of range, n = "+string n+ ", sizeof(tab) = " + string (Array.length arr)) arr.[n] //--------------------------------------------------------------------------- // Pickle/unpickle arrays and lists. For lists use the same binary format as arrays so we can switch // between internal representations relatively easily -//------------------------------------------------------------------------- - +//------------------------------------------------------------------------- + let p_array_core f (x: 'T[]) st = for i = 0 to x.Length-1 do f x.[i] st @@ -477,7 +477,7 @@ let p_array_ext extraf f (x: 'T[]) st = let n = x.Length let n = if Option.isSome extraf then n ||| 0x80000000 else n p_int n st - match extraf with + match extraf with | None -> () | Some f -> f st p_array_core f x st @@ -486,30 +486,30 @@ let p_list_core f (xs: 'T list) st = for x in xs do f x st -let p_list f x st = +let p_list f x st = p_int (List.length x) st p_list_core f x st -let p_list_ext extraf f x st = +let p_list_ext extraf f x st = let n = List.length x let n = if Option.isSome extraf then n ||| 0x80000000 else n p_int n st - match extraf with + match extraf with | None -> () | Some f -> f st p_list_core f x st -let p_List f (x: 'T list) st = p_list f x st +let p_List f (x: 'T list) st = p_list f x st let p_wrap (f: 'T -> 'U) (p : 'U pickler) : 'T pickler = (fun x st -> p (f x) st) let p_option f x st = - match x with + match x with | None -> p_byte 0 st | Some h -> p_byte 1 st; f h st // Pickle lazy values in such a way that they can, in some future F# compiler version, be read back // lazily. However, a lazy reader is not used in this version because the value may contain the definitions of some -// OSGN nodes. -let private p_lazy_impl p v st = +// OSGN nodes. +let private p_lazy_impl p v st = let fixupPos1 = st.os.Position // We fix these up after prim_p_int32 0 st @@ -545,19 +545,19 @@ let private p_lazy_impl p v st = st.os.FixupInt32 fixupPos6 ovalsIdx1 st.os.FixupInt32 fixupPos7 ovalsIdx2 -let p_lazy p x st = +let p_lazy p x st = p_lazy_impl p (Lazy.force x) st -let p_maybe_lazy p (x: MaybeLazy<_>) st = +let p_maybe_lazy p (x: MaybeLazy<_>) st = p_lazy_impl p x.Value st -let p_hole () = +let p_hole () = let h = ref (None : ('T -> WriterState -> unit) option) - (fun f -> h := Some f),(fun x st -> match !h with Some f -> f x st | None -> pfailwith st "p_hole: unfilled hole") + (fun f -> h := Some f), (fun x st -> match !h with Some f -> f x st | None -> pfailwith st "p_hole: unfilled hole") -let p_hole2 () = +let p_hole2 () = let h = ref (None : ('Arg -> 'T -> WriterState -> unit) option) - (fun f -> h := Some f),(fun arg x st -> match !h with Some f -> f arg x st | None -> pfailwith st "p_hole2: unfilled hole") + (fun f -> h := Some f), (fun arg x st -> match !h with Some f -> f arg x st | None -> pfailwith st "p_hole2: unfilled hole") let u_array_core f n st = let res = Array.zeroCreate n @@ -573,8 +573,8 @@ let u_array f st = // When the marker bit is not set this is identical to u_array, and extraf is not called let u_array_ext extraf f st = let n = u_int st - let extraItem = - if n &&& 0x80000000 = 0x80000000 then + let extraItem = + if n &&& 0x80000000 = 0x80000000 then Some (extraf st) else None @@ -585,13 +585,13 @@ let u_list_core f n st = [ for _ in 1..n do yield f st ] -let u_list f st = +let u_list f st = let n = u_int st u_list_core f n st -let u_list_ext extra f st = +let u_list_ext extra f st = let n = u_int st - let extraItem = - if n &&& 0x80000000 = 0x80000000 then + let extraItem = + if n &&& 0x80000000 = 0x80000000 then Some (extra st) else None @@ -615,19 +615,19 @@ let u_array_revi f st = let n = u_int st let res = Array.zeroCreate n for i = 0 to n-1 do - res.[i] <- f st (n-1-i) + res.[i] <- f st (n-1-i) res -// Mark up default constraints with a priority in reverse order: last gets 0 etc. See comment on TyparConstraint.DefaultsTo +// Mark up default constraints with a priority in reverse order: last gets 0 etc. See comment on TyparConstraint.DefaultsTo let u_list_revi f st = let n = u_int st [ for i = 0 to n-1 do yield f st (n-1-i) ] - - + + let u_wrap (f: 'U -> 'T) (u : 'U unpickler) : 'T unpickler = (fun st -> f (u st)) -let u_option f st = +let u_option f st = let tag = u_byte st match tag with | 0 -> None @@ -636,11 +636,11 @@ let u_option f st = // Boobytrap an OSGN node with a force of a lazy load of a bunch of pickled data #if LAZY_UNPICKLE -let wire (x:osgn<_>) (res:Lazy<_>) = +let wire (x:osgn<_>) (res:Lazy<_>) = x.osgnTripWire <- Some(fun () -> res.Force() |> ignore) #endif -let u_lazy u st = +let u_lazy u st = // Read the number of bytes in the record let len = prim_u_int32 st // fixupPos1 @@ -659,10 +659,10 @@ let u_lazy u st = st.is.Skip len // This is the lazy computation that wil force the unpickling of the term. // This term must contain OSGN definitions of the given nodes. - let res = + let res = lazy (let st = { st with is = st.is.CloneAndSeek idx1 } u st) - /// Force the reading of the data as a "tripwire" for each of the OSGN thunks + /// Force the reading of the data as a "tripwire" for each of the OSGN thunks for i = otyconsIdx1 to otyconsIdx2-1 do wire (st.ientities.Get(i)) res done for i = ovalsIdx1 to ovalsIdx2-1 do wire (st.ivals.Get(i)) res done for i = otyparsIdx1 to otyparsIdx2-1 do wire (st.itypars.Get(i)) res done @@ -670,19 +670,19 @@ let u_lazy u st = #else ignore (len, otyconsIdx1, otyconsIdx2, otyparsIdx1, otyparsIdx2, ovalsIdx1, ovalsIdx2) Lazy.CreateFromValue(u st) -#endif +#endif -let u_hole () = +let u_hole () = let h = ref (None : 'T unpickler option) - (fun f -> h := Some f),(fun st -> match !h with Some f -> f st | None -> ufailwith st "u_hole: unfilled hole") + (fun f -> h := Some f), (fun st -> match !h with Some f -> f st | None -> ufailwith st "u_hole: unfilled hole") //--------------------------------------------------------------------------- -// Pickle/unpickle F# interface data +// Pickle/unpickle F# interface data //--------------------------------------------------------------------------- -// Strings -// A huge number of these occur in pickled F# data, so make them unique +// Strings +// A huge number of these occur in pickled F# data, so make them unique let encode_string stringTab x = encode_uniq stringTab x let decode_string x = x let lookup_string st stringTab x = lookup_uniq st stringTab x @@ -697,25 +697,25 @@ let p_string s st = p_int (encode_string st.ostrings s) st let p_strings = p_list p_string let p_ints = p_list p_int -// CCU References -// A huge number of these occur in pickled F# data, so make them unique -let encode_ccuref ccuTab (x:CcuThunk) = encode_uniq ccuTab x.AssemblyName +// CCU References +// A huge number of these occur in pickled F# data, so make them unique +let encode_ccuref ccuTab (x:CcuThunk) = encode_uniq ccuTab x.AssemblyName let decode_ccuref x = x let lookup_ccuref st ccuTab x = lookup_uniq st ccuTab x -let u_encoded_ccuref st = - match u_byte st with +let u_encoded_ccuref st = + match u_byte st with | 0 -> u_prim_string st | n -> ufailwith st ("u_encoded_ccuref: found number " + string n) let u_ccuref st = lookup_uniq st st.iccus (u_int st) -let p_encoded_ccuref x st = +let p_encoded_ccuref x st = p_byte 0 st // leave a dummy tag to make room for future encodings of ccurefs p_prim_string x st let p_ccuref s st = p_int (encode_ccuref st.occus s) st -// References to public items in this module -// A huge number of these occur in pickled F# data, so make them unique +// References to public items in this module +// A huge number of these occur in pickled F# data, so make them unique let decode_pubpath st stringTab a = PubPath(Array.map (lookup_string st stringTab) a) let lookup_pubpath st pubpathTab x = lookup_uniq st pubpathTab x let u_encoded_pubpath = u_array u_int @@ -725,20 +725,20 @@ let encode_pubpath stringTab pubpathTab (PubPath(a)) = encode_uniq pubpathTab (A let p_encoded_pubpath = p_array p_int let p_pubpath x st = p_int (encode_pubpath st.ostrings st.opubpaths x) st -// References to other modules -// A huge number of these occur in pickled F# data, so make them unique -let decode_nleref st ccuTab stringTab (a,b) = mkNonLocalEntityRef (lookup_ccuref st ccuTab a) (Array.map (lookup_string st stringTab) b) +// References to other modules +// A huge number of these occur in pickled F# data, so make them unique +let decode_nleref st ccuTab stringTab (a, b) = mkNonLocalEntityRef (lookup_ccuref st ccuTab a) (Array.map (lookup_string st stringTab) b) let lookup_nleref st nlerefTab x = lookup_uniq st nlerefTab x let u_encoded_nleref = u_tup2 u_int (u_array u_int) let u_nleref st = lookup_uniq st st.inlerefs (u_int st) -let encode_nleref ccuTab stringTab nlerefTab thisCcu (nleref: NonLocalEntityRef) = +let encode_nleref ccuTab stringTab nlerefTab thisCcu (nleref: NonLocalEntityRef) = #if !NO_EXTENSIONTYPING // Remap references to statically-linked Entity nodes in provider-generated entities to point to the current assembly. // References to these nodes _do_ appear in F# assembly metadata, because they may be public. - let nleref = - match nleref.Deref.PublicPath with - | Some pubpath when nleref.Deref.IsProvidedGeneratedTycon -> + let nleref = + match nleref.Deref.PublicPath with + | Some pubpath when nleref.Deref.IsProvidedGeneratedTycon -> if verbose then dprintfn "remapping pickled reference to provider-generated type %s" nleref.Deref.DisplayNameWithStaticParameters rescopePubPath thisCcu pubpath | _ -> nleref @@ -746,14 +746,14 @@ let encode_nleref ccuTab stringTab nlerefTab thisCcu (nleref: NonLocalEntityRef) ignore thisCcu #endif - let (NonLocalEntityRef(a,b)) = nleref + let (NonLocalEntityRef(a, b)) = nleref encode_uniq nlerefTab (encode_ccuref ccuTab a, Array.map (encode_string stringTab) b) let p_encoded_nleref = p_tup2 p_int (p_array p_int) let p_nleref x st = p_int (encode_nleref st.occus st.ostrings st.onlerefs st.oscope x) st -// Simple types are types like "int", represented as TType(Ref_nonlocal(...,"int"),[]). -// A huge number of these occur in pickled F# data, so make them unique. -let decode_simpletyp st _ccuTab _stringTab nlerefTab a = TType_app(ERefNonLocal (lookup_nleref st nlerefTab a),[]) +// Simple types are types like "int", represented as TType(Ref_nonlocal(..., "int"), []). +// A huge number of these occur in pickled F# data, so make them unique. +let decode_simpletyp st _ccuTab _stringTab nlerefTab a = TType_app(ERefNonLocal (lookup_nleref st nlerefTab a), []) let lookup_simpletyp st simpleTyTab x = lookup_uniq st simpleTyTab x let u_encoded_simpletyp st = u_int st let u_encoded_anoninfo st = u_int st @@ -764,40 +764,40 @@ let p_encoded_anoninfo x st = p_int x st let p_simpletyp x st = p_int (encode_simpletyp st.occus st.ostrings st.onlerefs st.osimpletys st.oscope x) st let pickleObjWithDanglingCcus inMem file g scope p x = - let ccuNameTab,(ntycons, ntypars, nvals, nanoninfos),stringTab,pubpathTab,nlerefTab,simpleTyTab,phase1bytes = - let st1 = - { os = ByteBuffer.Create 100000 + let ccuNameTab, (ntycons, ntypars, nvals, nanoninfos), stringTab, pubpathTab, nlerefTab, simpleTyTab, phase1bytes = + let st1 = + { os = ByteBuffer.Create 100000 oscope=scope - occus= Table<_>.Create "occus" - oentities=NodeOutTable<_,_>.Create((fun (tc:Tycon) -> tc.Stamp),(fun tc -> tc.LogicalName),(fun tc -> tc.Range),(fun osgn -> osgn),"otycons") - otypars=NodeOutTable<_,_>.Create((fun (tp:Typar) -> tp.Stamp),(fun tp -> tp.DisplayName),(fun tp -> tp.Range),(fun osgn -> osgn),"otypars") - ovals=NodeOutTable<_,_>.Create((fun (v:Val) -> v.Stamp),(fun v -> v.LogicalName),(fun v -> v.Range),(fun osgn -> osgn),"ovals") - oanoninfos=NodeOutTable<_,_>.Create((fun (v:AnonRecdTypeInfo) -> v.Stamp),(fun v -> string v.Stamp),(fun _ -> range0),id,"oanoninfos") + occus= Table<_>.Create "occus" + oentities=NodeOutTable<_, _>.Create((fun (tc:Tycon) -> tc.Stamp), (fun tc -> tc.LogicalName), (fun tc -> tc.Range), (fun osgn -> osgn), "otycons") + otypars=NodeOutTable<_, _>.Create((fun (tp:Typar) -> tp.Stamp), (fun tp -> tp.DisplayName), (fun tp -> tp.Range), (fun osgn -> osgn), "otypars") + ovals=NodeOutTable<_, _>.Create((fun (v:Val) -> v.Stamp), (fun v -> v.LogicalName), (fun v -> v.Range), (fun osgn -> osgn), "ovals") + oanoninfos=NodeOutTable<_, _>.Create((fun (v:AnonRecdTypeInfo) -> v.Stamp), (fun v -> string v.Stamp), (fun _ -> range0), id, "oanoninfos") ostrings=Table<_>.Create "ostrings" - onlerefs=Table<_>.Create "onlerefs" - opubpaths=Table<_>.Create "opubpaths" - osimpletys=Table<_>.Create "osimpletys" + onlerefs=Table<_>.Create "onlerefs" + opubpaths=Table<_>.Create "opubpaths" + osimpletys=Table<_>.Create "osimpletys" oglobals=g ofile=file oInMem=inMem isStructThisArgPos = false} p x st1 - let sizes = + let sizes = st1.oentities.Size, st1.otypars.Size, st1.ovals.Size, - st1.oanoninfos.Size - st1.occus, sizes, st1.ostrings, st1.opubpaths,st1.onlerefs, st1.osimpletys, st1.os.Close() + st1.oanoninfos.Size + st1.occus, sizes, st1.ostrings, st1.opubpaths, st1.onlerefs, st1.osimpletys, st1.os.Close() - let phase2bytes = - let st2 = - { os = ByteBuffer.Create 100000 + let phase2bytes = + let st2 = + { os = ByteBuffer.Create 100000 oscope=scope - occus= Table<_>.Create "occus (fake)" - oentities=NodeOutTable<_,_>.Create((fun (tc:Tycon) -> tc.Stamp),(fun tc -> tc.LogicalName),(fun tc -> tc.Range),(fun osgn -> osgn),"otycons") - otypars=NodeOutTable<_,_>.Create((fun (tp:Typar) -> tp.Stamp),(fun tp -> tp.DisplayName),(fun tp -> tp.Range),(fun osgn -> osgn),"otypars") - ovals=NodeOutTable<_,_>.Create((fun (v:Val) -> v.Stamp),(fun v -> v.LogicalName),(fun v -> v.Range),(fun osgn -> osgn),"ovals") - oanoninfos=NodeOutTable<_,_>.Create((fun (v:AnonRecdTypeInfo) -> v.Stamp),(fun v -> string v.Stamp),(fun _ -> range0),id,"oanoninfos") + occus= Table<_>.Create "occus (fake)" + oentities=NodeOutTable<_, _>.Create((fun (tc:Tycon) -> tc.Stamp), (fun tc -> tc.LogicalName), (fun tc -> tc.Range), (fun osgn -> osgn), "otycons") + otypars=NodeOutTable<_, _>.Create((fun (tp:Typar) -> tp.Stamp), (fun tp -> tp.DisplayName), (fun tp -> tp.Range), (fun osgn -> osgn), "otypars") + ovals=NodeOutTable<_, _>.Create((fun (v:Val) -> v.Stamp), (fun v -> v.LogicalName), (fun v -> v.Range), (fun osgn -> osgn), "ovals") + oanoninfos=NodeOutTable<_, _>.Create((fun (v:AnonRecdTypeInfo) -> v.Stamp), (fun v -> string v.Stamp), (fun _ -> range0), id, "oanoninfos") ostrings=Table<_>.Create "ostrings (fake)" opubpaths=Table<_>.Create "opubpaths (fake)" onlerefs=Table<_>.Create "onlerefs (fake)" @@ -811,42 +811,42 @@ let pickleObjWithDanglingCcus inMem file g scope p x = let z1 = if nanoninfos > 0 then -ntycons-1 else ntycons p_int z1 st2 p_tup2 p_int p_int (ntypars, nvals) st2 - if nanoninfos > 0 then + if nanoninfos > 0 then p_int nanoninfos st2 p_tup5 - (p_array p_encoded_string) - (p_array p_encoded_pubpath) - (p_array p_encoded_nleref) - (p_array p_encoded_simpletyp) - p_bytes - (stringTab.AsArray,pubpathTab.AsArray,nlerefTab.AsArray,simpleTyTab.AsArray,phase1bytes) + (p_array p_encoded_string) + (p_array p_encoded_pubpath) + (p_array p_encoded_nleref) + (p_array p_encoded_simpletyp) + p_bytes + (stringTab.AsArray, pubpathTab.AsArray, nlerefTab.AsArray, simpleTyTab.AsArray, phase1bytes) st2 st2.os.Close() phase2bytes - -let check (ilscope:ILScopeRef) (inMap : NodeInTable<_,_>) = + +let check (ilscope:ILScopeRef) (inMap : NodeInTable<_, _>) = for i = 0 to inMap.Count - 1 do let n = inMap.Get i - if not (inMap.IsLinked n) then + if not (inMap.IsLinked n) then warning(Error(FSComp.SR.pickleMissingDefinition (i, inMap.Name, ilscope.QualifiedName), range0)) - // Note for compiler developers: to get information about which item this index relates to, - // enable the conditional in Pickle.p_osgn_ref to refer to the given index number and recompile - // an identical copy of the source for the DLL containing the data being unpickled. A message will + // Note for compiler developers: to get information about which item this index relates to, + // enable the conditional in Pickle.p_osgn_ref to refer to the given index number and recompile + // an identical copy of the source for the DLL containing the data being unpickled. A message will // then be printed indicating the name of the item. let unpickleObjWithDanglingCcus file ilscope (iILModule:ILModuleDef option) u (phase2bytes:byte[]) = - let st2 = - { is = ByteStream.FromBytes (phase2bytes,0,phase2bytes.Length) + let st2 = + { is = ByteStream.FromBytes (phase2bytes, 0, phase2bytes.Length) iilscope= ilscope - iccus= new_itbl "iccus (fake)" [| |] - ientities= NodeInTable<_,_>.Create (Tycon.NewUnlinked, (fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"itycons",0) - itypars= NodeInTable<_,_>.Create (Typar.NewUnlinked, (fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"itypars",0) - ivals = NodeInTable<_,_>.Create (Val.NewUnlinked , (fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"ivals",0) - ianoninfos=NodeInTable<_,_>.Create(AnonRecdTypeInfo.NewUnlinked, (fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"ianoninfos",0); - istrings = new_itbl "istrings (fake)" [| |] - inlerefs = new_itbl "inlerefs (fake)" [| |] - ipubpaths = new_itbl "ipubpaths (fake)" [| |] - isimpletys = new_itbl "isimpletys (fake)" [| |] + iccus= new_itbl "iccus (fake)" [| |] + ientities= NodeInTable<_, _>.Create (Tycon.NewUnlinked, (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "itycons", 0) + itypars= NodeInTable<_, _>.Create (Typar.NewUnlinked, (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "itypars", 0) + ivals = NodeInTable<_, _>.Create (Val.NewUnlinked , (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "ivals", 0) + ianoninfos=NodeInTable<_, _>.Create(AnonRecdTypeInfo.NewUnlinked, (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "ianoninfos", 0) + istrings = new_itbl "istrings (fake)" [| |] + inlerefs = new_itbl "inlerefs (fake)" [| |] + ipubpaths = new_itbl "ipubpaths (fake)" [| |] + isimpletys = new_itbl "isimpletys (fake)" [| |] ifile=file iILModule = iILModule } let ccuNameTab = u_array u_encoded_ccuref st2 @@ -854,33 +854,33 @@ let unpickleObjWithDanglingCcus file ilscope (iILModule:ILModuleDef option) u (p let ntycons = if z1 < 0 then -z1-1 else z1 let ntypars, nvals = u_tup2 u_int u_int st2 let nanoninfos = if z1 < 0 then u_int st2 else 0 - let stringTab,pubpathTab,nlerefTab,simpleTyTab,phase1bytes = + let stringTab, pubpathTab, nlerefTab, simpleTyTab, phase1bytes = u_tup5 - (u_array u_encoded_string) - (u_array u_encoded_pubpath) - (u_array u_encoded_nleref) - (u_array u_encoded_simpletyp) - u_bytes + (u_array u_encoded_string) + (u_array u_encoded_pubpath) + (u_array u_encoded_nleref) + (u_array u_encoded_simpletyp) + u_bytes st2 let ccuTab = new_itbl "iccus" (Array.map (CcuThunk.CreateDelayed) ccuNameTab) let stringTab = new_itbl "istrings" (Array.map decode_string stringTab) let pubpathTab = new_itbl "ipubpaths" (Array.map (decode_pubpath st2 stringTab) pubpathTab) let nlerefTab = new_itbl "inlerefs" (Array.map (decode_nleref st2 ccuTab stringTab) nlerefTab) let simpletypTab = new_itbl "simpleTyTab" (Array.map (decode_simpletyp st2 ccuTab stringTab nlerefTab) simpleTyTab) - let data = - let st1 = - { is = ByteStream.FromBytes (phase1bytes,0,phase1bytes.Length) - iccus= ccuTab + let data = + let st1 = + { is = ByteStream.FromBytes (phase1bytes, 0, phase1bytes.Length) + iccus= ccuTab iilscope= ilscope - ientities= NodeInTable<_,_>.Create(Tycon.NewUnlinked,(fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"itycons",ntycons) - itypars= NodeInTable<_,_>.Create(Typar.NewUnlinked,(fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"itypars",ntypars) - ivals= NodeInTable<_,_>.Create(Val.NewUnlinked ,(fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"ivals",nvals) - ianoninfos=NodeInTable<_,_>.Create(AnonRecdTypeInfo.NewUnlinked, (fun osgn tg -> osgn.Link tg),(fun osgn -> osgn.IsLinked),"ianoninfos",nanoninfos); + ientities= NodeInTable<_, _>.Create(Tycon.NewUnlinked, (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "itycons", ntycons) + itypars= NodeInTable<_, _>.Create(Typar.NewUnlinked, (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "itypars", ntypars) + ivals= NodeInTable<_, _>.Create(Val.NewUnlinked , (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "ivals", nvals) + ianoninfos=NodeInTable<_, _>.Create(AnonRecdTypeInfo.NewUnlinked, (fun osgn tg -> osgn.Link tg), (fun osgn -> osgn.IsLinked), "ianoninfos", nanoninfos) istrings = stringTab ipubpaths = pubpathTab inlerefs = nlerefTab isimpletys = simpletypTab - ifile=file + ifile=file iILModule = iILModule } let res = u st1 #if !LAZY_UNPICKLE @@ -891,96 +891,96 @@ let unpickleObjWithDanglingCcus file ilscope (iILModule:ILModuleDef option) u (p res {RawData=data; FixupThunks=ccuTab.itbl_rows } - + //========================================================================= // PART II //========================================================================= //--------------------------------------------------------------------------- -// Pickle/unpickle for Abstract IL data, up to IL instructions +// Pickle/unpickle for Abstract IL data, up to IL instructions //--------------------------------------------------------------------------- -let p_ILPublicKey x st = - match x with +let p_ILPublicKey x st = + match x with | PublicKey b -> p_byte 0 st; p_bytes b st | PublicKeyToken b -> p_byte 1 st; p_bytes b st let p_ILVersion x st = p_tup4 p_uint16 p_uint16 p_uint16 p_uint16 x st -let p_ILModuleRef (x:ILModuleRef) st = - p_tup3 p_string p_bool (p_option p_bytes) (x.Name,x.HasMetadata,x.Hash) st +let p_ILModuleRef (x:ILModuleRef) st = + p_tup3 p_string p_bool (p_option p_bytes) (x.Name, x.HasMetadata, x.Hash) st let p_ILAssemblyRef (x:ILAssemblyRef) st = p_byte 0 st // leave a dummy tag to make room for future encodings of assembly refs p_tup6 p_string (p_option p_bytes) (p_option p_ILPublicKey) p_bool (p_option p_ILVersion) (p_option p_string) - ( x.Name,x.Hash,x.PublicKey,x.Retargetable,x.Version,x.Locale) st + ( x.Name, x.Hash, x.PublicKey, x.Retargetable, x.Version, x.Locale) st -let p_ILScopeRef x st = - match x with +let p_ILScopeRef x st = + match x with | ILScopeRef.Local -> p_byte 0 st | ILScopeRef.Module mref -> p_byte 1 st; p_ILModuleRef mref st | ILScopeRef.Assembly aref -> p_byte 2 st; p_ILAssemblyRef aref st -let u_ILPublicKey st = +let u_ILPublicKey st = let tag = u_byte st match tag with - | 0 -> u_bytes st |> PublicKey - | 1 -> u_bytes st |> PublicKeyToken + | 0 -> u_bytes st |> PublicKey + | 1 -> u_bytes st |> PublicKeyToken | _ -> ufailwith st "u_ILPublicKey" let u_ILVersion st = u_tup4 u_uint16 u_uint16 u_uint16 u_uint16 st -let u_ILModuleRef st = - let (a,b,c) = u_tup3 u_string u_bool (u_option u_bytes) st +let u_ILModuleRef st = + let (a, b, c) = u_tup3 u_string u_bool (u_option u_bytes) st ILModuleRef.Create(a, b, c) let u_ILAssemblyRef st = let tag = u_byte st match tag with - | 0 -> - let a,b,c,d,e,f = u_tup6 u_string (u_option u_bytes) (u_option u_ILPublicKey) u_bool (u_option u_ILVersion) (u_option u_string) st + | 0 -> + let a, b, c, d, e, f = u_tup6 u_string (u_option u_bytes) (u_option u_ILPublicKey) u_bool (u_option u_ILVersion) (u_option u_string) st ILAssemblyRef.Create(a, b, c, d, e, f) | _ -> ufailwith st "u_ILAssemblyRef" -// IL scope references are rescoped as they are unpickled. This means -// the pickler accepts IL fragments containing ILScopeRef.Local and adjusts them +// IL scope references are rescoped as they are unpickled. This means +// the pickler accepts IL fragments containing ILScopeRef.Local and adjusts them // to be absolute scope references. -let u_ILScopeRef st = - let res = +let u_ILScopeRef st = + let res = let tag = u_byte st match tag with | 0 -> ILScopeRef.Local - | 1 -> u_ILModuleRef st |> ILScopeRef.Module - | 2 -> u_ILAssemblyRef st |> ILScopeRef.Assembly - | _ -> ufailwith st "u_ILScopeRef" - let res = rescopeILScopeRef st.iilscope res + | 1 -> u_ILModuleRef st |> ILScopeRef.Module + | 2 -> u_ILAssemblyRef st |> ILScopeRef.Assembly + | _ -> ufailwith st "u_ILScopeRef" + let res = rescopeILScopeRef st.iilscope res res -let p_ILHasThis x st = - p_byte (match x with +let p_ILHasThis x st = + p_byte (match x with | ILThisConvention.Instance -> 0 | ILThisConvention.InstanceExplicit -> 1 | ILThisConvention.Static -> 2) st let p_ILArrayShape = p_wrap (fun (ILArrayShape x) -> x) (p_list (p_tup2 (p_option p_int32) (p_option p_int32))) -let rec p_ILType ty st = - match ty with +let rec p_ILType ty st = + match ty with | ILType.Void -> p_byte 0 st - | ILType.Array (shape,ty) -> p_byte 1 st; p_tup2 p_ILArrayShape p_ILType (shape,ty) st + | ILType.Array (shape, ty) -> p_byte 1 st; p_tup2 p_ILArrayShape p_ILType (shape, ty) st | ILType.Value tspec -> p_byte 2 st; p_ILTypeSpec tspec st | ILType.Boxed tspec -> p_byte 3 st; p_ILTypeSpec tspec st | ILType.Ptr ty -> p_byte 4 st; p_ILType ty st | ILType.Byref ty -> p_byte 5 st; p_ILType ty st | ILType.FunctionPointer csig -> p_byte 6 st; p_ILCallSig csig st | ILType.TypeVar n -> p_byte 7 st; p_uint16 n st - | ILType.Modified (req,tref,ty) -> p_byte 8 st; p_tup3 p_bool p_ILTypeRef p_ILType (req,tref,ty) st + | ILType.Modified (req, tref, ty) -> p_byte 8 st; p_tup3 p_bool p_ILTypeRef p_ILType (req, tref, ty) st and p_ILTypes tys = p_list p_ILType tys -and p_ILBasicCallConv x st = - p_byte (match x with +and p_ILBasicCallConv x st = + p_byte (match x with | ILArgConvention.Default -> 0 | ILArgConvention.CDecl -> 1 | ILArgConvention.StdCall -> 2 @@ -988,58 +988,58 @@ and p_ILBasicCallConv x st = | ILArgConvention.FastCall -> 4 | ILArgConvention.VarArg -> 5) st -and p_ILCallConv (Callconv(x,y)) st = p_tup2 p_ILHasThis p_ILBasicCallConv (x,y) st +and p_ILCallConv (Callconv(x, y)) st = p_tup2 p_ILHasThis p_ILBasicCallConv (x, y) st -and p_ILCallSig x st = p_tup3 p_ILCallConv p_ILTypes p_ILType (x.CallingConv,x.ArgTypes,x.ReturnType) st +and p_ILCallSig x st = p_tup3 p_ILCallConv p_ILTypes p_ILType (x.CallingConv, x.ArgTypes, x.ReturnType) st -and p_ILTypeRef (x:ILTypeRef) st = p_tup3 p_ILScopeRef p_strings p_string (x.Scope,x.Enclosing,x.Name) st +and p_ILTypeRef (x:ILTypeRef) st = p_tup3 p_ILScopeRef p_strings p_string (x.Scope, x.Enclosing, x.Name) st -and p_ILTypeSpec (a:ILTypeSpec) st = p_tup2 p_ILTypeRef p_ILTypes (a.TypeRef,a.GenericArgs) st +and p_ILTypeSpec (a:ILTypeSpec) st = p_tup2 p_ILTypeRef p_ILTypes (a.TypeRef, a.GenericArgs) st -let u_ILBasicCallConv st = - match u_byte st with - | 0 -> ILArgConvention.Default - | 1 -> ILArgConvention.CDecl - | 2 -> ILArgConvention.StdCall - | 3 -> ILArgConvention.ThisCall - | 4 -> ILArgConvention.FastCall +let u_ILBasicCallConv st = + match u_byte st with + | 0 -> ILArgConvention.Default + | 1 -> ILArgConvention.CDecl + | 2 -> ILArgConvention.StdCall + | 3 -> ILArgConvention.ThisCall + | 4 -> ILArgConvention.FastCall | 5 -> ILArgConvention.VarArg | _ -> ufailwith st "u_ILBasicCallConv" -let u_ILHasThis st = - match u_byte st with - | 0 -> ILThisConvention.Instance - | 1 -> ILThisConvention.InstanceExplicit - | 2 -> ILThisConvention.Static +let u_ILHasThis st = + match u_byte st with + | 0 -> ILThisConvention.Instance + | 1 -> ILThisConvention.InstanceExplicit + | 2 -> ILThisConvention.Static | _ -> ufailwith st "u_ILHasThis" -let u_ILCallConv st = let a,b = u_tup2 u_ILHasThis u_ILBasicCallConv st in Callconv(a,b) -let u_ILTypeRef st = let a,b,c = u_tup3 u_ILScopeRef u_strings u_string st in ILTypeRef.Create(a, b, c) +let u_ILCallConv st = let a, b = u_tup2 u_ILHasThis u_ILBasicCallConv st in Callconv(a, b) +let u_ILTypeRef st = let a, b, c = u_tup3 u_ILScopeRef u_strings u_string st in ILTypeRef.Create(a, b, c) let u_ILArrayShape = u_wrap (fun x -> ILArrayShape x) (u_list (u_tup2 (u_option u_int32) (u_option u_int32))) -let rec u_ILType st = +let rec u_ILType st = let tag = u_byte st match tag with | 0 -> ILType.Void - | 1 -> u_tup2 u_ILArrayShape u_ILType st |> ILType.Array - | 2 -> u_ILTypeSpec st |> ILType.Value + | 1 -> u_tup2 u_ILArrayShape u_ILType st |> ILType.Array + | 2 -> u_ILTypeSpec st |> ILType.Value | 3 -> u_ILTypeSpec st |> mkILBoxedType - | 4 -> u_ILType st |> ILType.Ptr + | 4 -> u_ILType st |> ILType.Ptr | 5 -> u_ILType st |> ILType.Byref - | 6 -> u_ILCallSig st |> ILType.FunctionPointer + | 6 -> u_ILCallSig st |> ILType.FunctionPointer | 7 -> u_uint16 st |> mkILTyvarTy - | 8 -> u_tup3 u_bool u_ILTypeRef u_ILType st |> ILType.Modified + | 8 -> u_tup3 u_bool u_ILTypeRef u_ILType st |> ILType.Modified | _ -> ufailwith st "u_ILType" and u_ILTypes st = u_list u_ILType st -and u_ILCallSig = u_wrap (fun (a,b,c) -> {CallingConv=a; ArgTypes=b; ReturnType=c}) (u_tup3 u_ILCallConv u_ILTypes u_ILType) +and u_ILCallSig = u_wrap (fun (a, b, c) -> {CallingConv=a; ArgTypes=b; ReturnType=c}) (u_tup3 u_ILCallConv u_ILTypes u_ILType) -and u_ILTypeSpec st = let a,b = u_tup2 u_ILTypeRef u_ILTypes st in ILTypeSpec.Create(a,b) +and u_ILTypeSpec st = let a, b = u_tup2 u_ILTypeRef u_ILTypes st in ILTypeSpec.Create(a, b) -let p_ILMethodRef (x: ILMethodRef) st = p_tup6 p_ILTypeRef p_ILCallConv p_int p_string p_ILTypes p_ILType (x.DeclaringTypeRef,x.CallingConv,x.GenericArity,x.Name,x.ArgTypes,x.ReturnType) st +let p_ILMethodRef (x: ILMethodRef) st = p_tup6 p_ILTypeRef p_ILCallConv p_int p_string p_ILTypes p_ILType (x.DeclaringTypeRef, x.CallingConv, x.GenericArity, x.Name, x.ArgTypes, x.ReturnType) st let p_ILFieldRef (x: ILFieldRef) st = p_tup3 p_ILTypeRef p_string p_ILType (x.DeclaringTypeRef, x.Name, x.Type) st @@ -1047,231 +1047,231 @@ let p_ILMethodSpec (x: ILMethodSpec) st = p_tup3 p_ILMethodRef p_ILType p_ILType let p_ILFieldSpec (x : ILFieldSpec) st = p_tup2 p_ILFieldRef p_ILType (x.FieldRef, x.DeclaringType) st -let p_ILBasicType x st = - p_int (match x with - | DT_R -> 0 - | DT_I1 -> 1 - | DT_U1 -> 2 - | DT_I2 -> 3 - | DT_U2 -> 4 - | DT_I4 -> 5 - | DT_U4 -> 6 - | DT_I8 -> 7 - | DT_U8 -> 8 - | DT_R4 -> 9 - | DT_R8 -> 10 - | DT_I -> 11 - | DT_U -> 12 +let p_ILBasicType x st = + p_int (match x with + | DT_R -> 0 + | DT_I1 -> 1 + | DT_U1 -> 2 + | DT_I2 -> 3 + | DT_U2 -> 4 + | DT_I4 -> 5 + | DT_U4 -> 6 + | DT_I8 -> 7 + | DT_U8 -> 8 + | DT_R4 -> 9 + | DT_R8 -> 10 + | DT_I -> 11 + | DT_U -> 12 | DT_REF -> 13) st let p_ILVolatility x st = p_int (match x with Volatile -> 0 | Nonvolatile -> 1) st let p_ILReadonly x st = p_int (match x with ReadonlyAddress -> 0 | NormalAddress -> 1) st -let u_ILMethodRef st = - let x1,x2,x3,x4,x5,x6 = u_tup6 u_ILTypeRef u_ILCallConv u_int u_string u_ILTypes u_ILType st - ILMethodRef.Create(x1,x2,x4,x3,x5,x6) +let u_ILMethodRef st = + let x1, x2, x3, x4, x5, x6 = u_tup6 u_ILTypeRef u_ILCallConv u_int u_string u_ILTypes u_ILType st + ILMethodRef.Create(x1, x2, x4, x3, x5, x6) -let u_ILFieldRef st = - let x1,x2,x3 = u_tup3 u_ILTypeRef u_string u_ILType st +let u_ILFieldRef st = + let x1, x2, x3 = u_tup3 u_ILTypeRef u_string u_ILType st {DeclaringTypeRef=x1;Name=x2;Type=x3} -let u_ILMethodSpec st = - let x1,x2,x3 = u_tup3 u_ILMethodRef u_ILType u_ILTypes st - ILMethodSpec.Create(x2,x1,x3) +let u_ILMethodSpec st = + let x1, x2, x3 = u_tup3 u_ILMethodRef u_ILType u_ILTypes st + ILMethodSpec.Create(x2, x1, x3) -let u_ILFieldSpec st = - let x1,x2 = u_tup2 u_ILFieldRef u_ILType st +let u_ILFieldSpec st = + let x1, x2 = u_tup2 u_ILFieldRef u_ILType st {FieldRef=x1;DeclaringType=x2} -let u_ILBasicType st = - match u_int st with - | 0 -> DT_R - | 1 -> DT_I1 - | 2 -> DT_U1 - | 3 -> DT_I2 - | 4 -> DT_U2 - | 5 -> DT_I4 - | 6 -> DT_U4 - | 7 -> DT_I8 - | 8 -> DT_U8 - | 9 -> DT_R4 - | 10 -> DT_R8 - | 11 -> DT_I - | 12 -> DT_U - | 13 -> DT_REF +let u_ILBasicType st = + match u_int st with + | 0 -> DT_R + | 1 -> DT_I1 + | 2 -> DT_U1 + | 3 -> DT_I2 + | 4 -> DT_U2 + | 5 -> DT_I4 + | 6 -> DT_U4 + | 7 -> DT_I8 + | 8 -> DT_U8 + | 9 -> DT_R4 + | 10 -> DT_R8 + | 11 -> DT_I + | 12 -> DT_U + | 13 -> DT_REF | _ -> ufailwith st "u_ILBasicType" - + let u_ILVolatility st = (match u_int st with 0 -> Volatile | 1 -> Nonvolatile | _ -> ufailwith st "u_ILVolatility" ) let u_ILReadonly st = (match u_int st with 0 -> ReadonlyAddress | 1 -> NormalAddress | _ -> ufailwith st "u_ILReadonly" ) - -let [] itag_nop = 0 + +let [] itag_nop = 0 let [] itag_ldarg = 1 -let [] itag_ldnull = 2 +let [] itag_ldnull = 2 let [] itag_ilzero = 3 -let [] itag_call = 4 +let [] itag_call = 4 let [] itag_add = 5 -let [] itag_sub = 6 +let [] itag_sub = 6 let [] itag_mul = 7 -let [] itag_div = 8 -let [] itag_div_un = 9 -let [] itag_rem = 10 -let [] itag_rem_un = 11 -let [] itag_and = 12 -let [] itag_or = 13 -let [] itag_xor = 14 -let [] itag_shl = 15 -let [] itag_shr = 16 -let [] itag_shr_un = 17 -let [] itag_neg = 18 -let [] itag_not = 19 +let [] itag_div = 8 +let [] itag_div_un = 9 +let [] itag_rem = 10 +let [] itag_rem_un = 11 +let [] itag_and = 12 +let [] itag_or = 13 +let [] itag_xor = 14 +let [] itag_shl = 15 +let [] itag_shr = 16 +let [] itag_shr_un = 17 +let [] itag_neg = 18 +let [] itag_not = 19 let [] itag_conv = 20 -let [] itag_conv_un = 21 +let [] itag_conv_un = 21 let [] itag_conv_ovf = 22 let [] itag_conv_ovf_un = 23 -let [] itag_callvirt = 24 -let [] itag_ldobj = 25 -let [] itag_ldstr = 26 -let [] itag_castclass = 27 -let [] itag_isinst = 28 -let [] itag_unbox = 29 -let [] itag_throw = 30 -let [] itag_ldfld = 31 -let [] itag_ldflda = 32 -let [] itag_stfld = 33 -let [] itag_ldsfld = 34 -let [] itag_ldsflda = 35 -let [] itag_stsfld = 36 -let [] itag_stobj = 37 -let [] itag_box = 38 -let [] itag_newarr = 39 -let [] itag_ldlen = 40 -let [] itag_ldelema = 41 -let [] itag_ckfinite = 42 -let [] itag_ldtoken = 43 -let [] itag_add_ovf = 44 -let [] itag_add_ovf_un = 45 -let [] itag_mul_ovf = 46 -let [] itag_mul_ovf_un = 47 -let [] itag_sub_ovf = 48 -let [] itag_sub_ovf_un = 49 +let [] itag_callvirt = 24 +let [] itag_ldobj = 25 +let [] itag_ldstr = 26 +let [] itag_castclass = 27 +let [] itag_isinst = 28 +let [] itag_unbox = 29 +let [] itag_throw = 30 +let [] itag_ldfld = 31 +let [] itag_ldflda = 32 +let [] itag_stfld = 33 +let [] itag_ldsfld = 34 +let [] itag_ldsflda = 35 +let [] itag_stsfld = 36 +let [] itag_stobj = 37 +let [] itag_box = 38 +let [] itag_newarr = 39 +let [] itag_ldlen = 40 +let [] itag_ldelema = 41 +let [] itag_ckfinite = 42 +let [] itag_ldtoken = 43 +let [] itag_add_ovf = 44 +let [] itag_add_ovf_un = 45 +let [] itag_mul_ovf = 46 +let [] itag_mul_ovf_un = 47 +let [] itag_sub_ovf = 48 +let [] itag_sub_ovf_un = 49 let [] itag_ceq = 50 let [] itag_cgt = 51 let [] itag_cgt_un = 52 let [] itag_clt = 53 let [] itag_clt_un = 54 -let [] itag_ldvirtftn = 55 -let [] itag_localloc = 56 -let [] itag_rethrow = 57 +let [] itag_ldvirtftn = 55 +let [] itag_localloc = 56 +let [] itag_rethrow = 57 let [] itag_sizeof = 58 let [] itag_ldelem_any = 59 let [] itag_stelem_any = 60 let [] itag_unbox_any = 61 let [] itag_ldlen_multi = 62 let [] itag_initobj = 63 // currently unused, added for forward compat, see https://visualfsharp.codeplex.com/SourceControl/network/forks/jackpappas/fsharpcontrib/contribution/7134 -let [] itag_initblk = 64 // currently unused, added for forward compat -let [] itag_cpobj = 65 // currently unused, added for forward compat -let [] itag_cpblk = 66 // currently unused, added for forward compat +let [] itag_initblk = 64 // currently unused, added for forward compat +let [] itag_cpobj = 65 // currently unused, added for forward compat +let [] itag_cpblk = 66 // currently unused, added for forward compat -let simple_instrs = - [ itag_add, AI_add - itag_add_ovf, AI_add_ovf +let simple_instrs = + [ itag_add, AI_add + itag_add_ovf, AI_add_ovf itag_add_ovf_un, AI_add_ovf_un - itag_and, AI_and - itag_div, AI_div - itag_div_un, AI_div_un - itag_ceq, AI_ceq - itag_cgt, AI_cgt - itag_cgt_un, AI_cgt_un - itag_clt, AI_clt - itag_clt_un, AI_clt_un - itag_mul, AI_mul - itag_mul_ovf, AI_mul_ovf + itag_and, AI_and + itag_div, AI_div + itag_div_un, AI_div_un + itag_ceq, AI_ceq + itag_cgt, AI_cgt + itag_cgt_un, AI_cgt_un + itag_clt, AI_clt + itag_clt_un, AI_clt_un + itag_mul, AI_mul + itag_mul_ovf, AI_mul_ovf itag_mul_ovf_un, AI_mul_ovf_un - itag_rem, AI_rem - itag_rem_un, AI_rem_un - itag_shl, AI_shl - itag_shr, AI_shr - itag_shr_un, AI_shr_un - itag_sub, AI_sub - itag_sub_ovf, AI_sub_ovf - itag_sub_ovf_un, AI_sub_ovf_un - itag_xor, AI_xor - itag_or, AI_or - itag_neg, AI_neg - itag_not, AI_not - itag_ldnull, AI_ldnull - itag_ckfinite, AI_ckfinite - itag_nop, AI_nop - itag_localloc, I_localloc - itag_throw, I_throw - itag_ldlen, I_ldlen - itag_rethrow, I_rethrow - itag_rethrow, I_rethrow - itag_initblk, I_initblk (Aligned,Nonvolatile) - itag_cpblk, I_cpblk (Aligned,Nonvolatile) + itag_rem, AI_rem + itag_rem_un, AI_rem_un + itag_shl, AI_shl + itag_shr, AI_shr + itag_shr_un, AI_shr_un + itag_sub, AI_sub + itag_sub_ovf, AI_sub_ovf + itag_sub_ovf_un, AI_sub_ovf_un + itag_xor, AI_xor + itag_or, AI_or + itag_neg, AI_neg + itag_not, AI_not + itag_ldnull, AI_ldnull + itag_ckfinite, AI_ckfinite + itag_nop, AI_nop + itag_localloc, I_localloc + itag_throw, I_throw + itag_ldlen, I_ldlen + itag_rethrow, I_rethrow + itag_rethrow, I_rethrow + itag_initblk, I_initblk (Aligned, Nonvolatile) + itag_cpblk, I_cpblk (Aligned, Nonvolatile) ] -let encode_table = Dictionary<_,_>(300, HashIdentity.Structural) -let _ = List.iter (fun (icode,i) -> encode_table.[i] <- icode) simple_instrs +let encode_table = Dictionary<_, _>(300, HashIdentity.Structural) +let _ = List.iter (fun (icode, i) -> encode_table.[i] <- icode) simple_instrs let encode_instr si = encode_table.[si] let isNoArgInstr s = encode_table.ContainsKey s -let decoders = - [ itag_ldarg, u_uint16 >> mkLdarg - itag_call, u_ILMethodSpec >> (fun a -> I_call (Normalcall,a,None)) - itag_callvirt, u_ILMethodSpec >> (fun a -> I_callvirt (Normalcall,a,None)) - itag_ldvirtftn, u_ILMethodSpec >> I_ldvirtftn - itag_conv, u_ILBasicType >> (fun a -> (AI_conv a)) - itag_conv_ovf, u_ILBasicType >> (fun a -> (AI_conv_ovf a)) +let decoders = + [ itag_ldarg, u_uint16 >> mkLdarg + itag_call, u_ILMethodSpec >> (fun a -> I_call (Normalcall, a, None)) + itag_callvirt, u_ILMethodSpec >> (fun a -> I_callvirt (Normalcall, a, None)) + itag_ldvirtftn, u_ILMethodSpec >> I_ldvirtftn + itag_conv, u_ILBasicType >> (fun a -> (AI_conv a)) + itag_conv_ovf, u_ILBasicType >> (fun a -> (AI_conv_ovf a)) itag_conv_ovf_un, u_ILBasicType >> (fun a -> (AI_conv_ovf_un a)) - itag_ldfld, u_tup2 u_ILVolatility u_ILFieldSpec >> (fun (b,c) -> I_ldfld (Aligned,b,c)) - itag_ldflda, u_ILFieldSpec >> I_ldflda - itag_ldsfld, u_tup2 u_ILVolatility u_ILFieldSpec >> (fun (a,b) -> I_ldsfld (a,b)) - itag_ldsflda, u_ILFieldSpec >> I_ldsflda - itag_stfld, u_tup2 u_ILVolatility u_ILFieldSpec >> (fun (b,c) -> I_stfld (Aligned,b,c)) - itag_stsfld, u_tup2 u_ILVolatility u_ILFieldSpec >> (fun (a,b) -> I_stsfld (a,b)) - itag_ldtoken, u_ILType >> (fun a -> I_ldtoken (ILToken.ILType a)) - itag_ldstr, u_string >> I_ldstr - itag_box, u_ILType >> I_box - itag_unbox, u_ILType >> I_unbox - itag_unbox_any, u_ILType >> I_unbox_any - itag_newarr, u_tup2 u_ILArrayShape u_ILType >> (fun (a,b) -> I_newarr(a,b)) - itag_stelem_any, u_tup2 u_ILArrayShape u_ILType >> (fun (a,b) -> I_stelem_any(a,b)) - itag_ldelem_any, u_tup2 u_ILArrayShape u_ILType >> (fun (a,b) -> I_ldelem_any(a,b)) - itag_ldelema, u_tup3 u_ILReadonly u_ILArrayShape u_ILType >> (fun (a,b,c) -> I_ldelema(a,false,b,c)) - itag_castclass, u_ILType >> I_castclass - itag_isinst, u_ILType >> I_isinst - itag_ldobj, u_ILType >> (fun c -> I_ldobj (Aligned,Nonvolatile,c)) - itag_stobj, u_ILType >> (fun c -> I_stobj (Aligned,Nonvolatile,c)) - itag_sizeof, u_ILType >> I_sizeof - itag_ldlen_multi, u_tup2 u_int32 u_int32 >> (fun (a,b) -> EI_ldlen_multi (a,b)) - itag_ilzero, u_ILType >> EI_ilzero - itag_ilzero, u_ILType >> EI_ilzero - itag_initobj, u_ILType >> I_initobj - itag_cpobj, u_ILType >> I_cpobj - ] - -let decode_tab = + itag_ldfld, u_tup2 u_ILVolatility u_ILFieldSpec >> (fun (b, c) -> I_ldfld (Aligned, b, c)) + itag_ldflda, u_ILFieldSpec >> I_ldflda + itag_ldsfld, u_tup2 u_ILVolatility u_ILFieldSpec >> (fun (a, b) -> I_ldsfld (a, b)) + itag_ldsflda, u_ILFieldSpec >> I_ldsflda + itag_stfld, u_tup2 u_ILVolatility u_ILFieldSpec >> (fun (b, c) -> I_stfld (Aligned, b, c)) + itag_stsfld, u_tup2 u_ILVolatility u_ILFieldSpec >> (fun (a, b) -> I_stsfld (a, b)) + itag_ldtoken, u_ILType >> (fun a -> I_ldtoken (ILToken.ILType a)) + itag_ldstr, u_string >> I_ldstr + itag_box, u_ILType >> I_box + itag_unbox, u_ILType >> I_unbox + itag_unbox_any, u_ILType >> I_unbox_any + itag_newarr, u_tup2 u_ILArrayShape u_ILType >> (fun (a, b) -> I_newarr(a, b)) + itag_stelem_any, u_tup2 u_ILArrayShape u_ILType >> (fun (a, b) -> I_stelem_any(a, b)) + itag_ldelem_any, u_tup2 u_ILArrayShape u_ILType >> (fun (a, b) -> I_ldelem_any(a, b)) + itag_ldelema, u_tup3 u_ILReadonly u_ILArrayShape u_ILType >> (fun (a, b, c) -> I_ldelema(a, false, b, c)) + itag_castclass, u_ILType >> I_castclass + itag_isinst, u_ILType >> I_isinst + itag_ldobj, u_ILType >> (fun c -> I_ldobj (Aligned, Nonvolatile, c)) + itag_stobj, u_ILType >> (fun c -> I_stobj (Aligned, Nonvolatile, c)) + itag_sizeof, u_ILType >> I_sizeof + itag_ldlen_multi, u_tup2 u_int32 u_int32 >> (fun (a, b) -> EI_ldlen_multi (a, b)) + itag_ilzero, u_ILType >> EI_ilzero + itag_ilzero, u_ILType >> EI_ilzero + itag_initobj, u_ILType >> I_initobj + itag_cpobj, u_ILType >> I_cpobj + ] + +let decode_tab = let tab = Array.init 256 (fun n -> (fun st -> ufailwith st ("no decoder for instruction "+string n))) - let add_instr (icode,f) = tab.[icode] <- f + let add_instr (icode, f) = tab.[icode] <- f List.iter add_instr decoders - List.iter (fun (icode,mk) -> add_instr (icode,(fun _ -> mk))) simple_instrs + List.iter (fun (icode, mk) -> add_instr (icode, (fun _ -> mk))) simple_instrs tab let p_ILInstr x st = match x with | si when isNoArgInstr si -> p_byte (encode_instr si) st - | I_call(Normalcall,mspec,None) -> p_byte itag_call st; p_ILMethodSpec mspec st - | I_callvirt(Normalcall,mspec,None) -> p_byte itag_callvirt st; p_ILMethodSpec mspec st + | I_call(Normalcall, mspec, None) -> p_byte itag_call st; p_ILMethodSpec mspec st + | I_callvirt(Normalcall, mspec, None) -> p_byte itag_callvirt st; p_ILMethodSpec mspec st | I_ldvirtftn mspec -> p_byte itag_ldvirtftn st; p_ILMethodSpec mspec st | I_ldarg x -> p_byte itag_ldarg st; p_uint16 x st | AI_conv a -> p_byte itag_conv st; p_ILBasicType a st | AI_conv_ovf a -> p_byte itag_conv_ovf st; p_ILBasicType a st | AI_conv_ovf_un a -> p_byte itag_conv_ovf_un st; p_ILBasicType a st - | I_ldfld (Aligned,b,c) -> p_byte itag_ldfld st; p_tup2 p_ILVolatility p_ILFieldSpec (b,c) st - | I_ldsfld (a,b) -> p_byte itag_ldsfld st; p_tup2 p_ILVolatility p_ILFieldSpec (a,b) st - | I_stfld (Aligned,b,c) -> p_byte itag_stfld st; p_tup2 p_ILVolatility p_ILFieldSpec (b,c) st - | I_stsfld (a,b) -> p_byte itag_stsfld st; p_tup2 p_ILVolatility p_ILFieldSpec (a,b) st + | I_ldfld (Aligned, b, c) -> p_byte itag_ldfld st; p_tup2 p_ILVolatility p_ILFieldSpec (b, c) st + | I_ldsfld (a, b) -> p_byte itag_ldsfld st; p_tup2 p_ILVolatility p_ILFieldSpec (a, b) st + | I_stfld (Aligned, b, c) -> p_byte itag_stfld st; p_tup2 p_ILVolatility p_ILFieldSpec (b, c) st + | I_stsfld (a, b) -> p_byte itag_stsfld st; p_tup2 p_ILVolatility p_ILFieldSpec (a, b) st | I_ldflda c -> p_byte itag_ldflda st; p_ILFieldSpec c st | I_ldsflda a -> p_byte itag_ldsflda st; p_ILFieldSpec a st | I_ldtoken (ILToken.ILType ty) -> p_byte itag_ldtoken st; p_ILType ty st @@ -1279,26 +1279,26 @@ let p_ILInstr x st = | I_box ty -> p_byte itag_box st; p_ILType ty st | I_unbox ty -> p_byte itag_unbox st; p_ILType ty st | I_unbox_any ty -> p_byte itag_unbox_any st; p_ILType ty st - | I_newarr (a,b) -> p_byte itag_newarr st; p_tup2 p_ILArrayShape p_ILType (a,b) st - | I_stelem_any (a,b) -> p_byte itag_stelem_any st; p_tup2 p_ILArrayShape p_ILType (a,b) st - | I_ldelem_any (a,b) -> p_byte itag_ldelem_any st; p_tup2 p_ILArrayShape p_ILType (a,b) st - | I_ldelema (a,_,b,c) -> p_byte itag_ldelema st; p_tup3 p_ILReadonly p_ILArrayShape p_ILType (a,b,c) st + | I_newarr (a, b) -> p_byte itag_newarr st; p_tup2 p_ILArrayShape p_ILType (a, b) st + | I_stelem_any (a, b) -> p_byte itag_stelem_any st; p_tup2 p_ILArrayShape p_ILType (a, b) st + | I_ldelem_any (a, b) -> p_byte itag_ldelem_any st; p_tup2 p_ILArrayShape p_ILType (a, b) st + | I_ldelema (a, _, b, c) -> p_byte itag_ldelema st; p_tup3 p_ILReadonly p_ILArrayShape p_ILType (a, b, c) st | I_castclass ty -> p_byte itag_castclass st; p_ILType ty st | I_isinst ty -> p_byte itag_isinst st; p_ILType ty st - | I_ldobj (Aligned,Nonvolatile,c) -> p_byte itag_ldobj st; p_ILType c st - | I_stobj (Aligned,Nonvolatile,c) -> p_byte itag_stobj st; p_ILType c st + | I_ldobj (Aligned, Nonvolatile, c) -> p_byte itag_ldobj st; p_ILType c st + | I_stobj (Aligned, Nonvolatile, c) -> p_byte itag_stobj st; p_ILType c st | I_sizeof ty -> p_byte itag_sizeof st; p_ILType ty st - | EI_ldlen_multi (n,m) -> p_byte itag_ldlen_multi st; p_tup2 p_int32 p_int32 (n,m) st + | EI_ldlen_multi (n, m) -> p_byte itag_ldlen_multi st; p_tup2 p_int32 p_int32 (n, m) st | EI_ilzero a -> p_byte itag_ilzero st; p_ILType a st - | I_initobj c -> p_byte itag_initobj st; p_ILType c st - | I_cpobj c -> p_byte itag_cpobj st; p_ILType c st - | i -> pfailwith st (sprintf "the IL instruction '%+A' cannot be emitted" i) + | I_initobj c -> p_byte itag_initobj st; p_ILType c st + | I_cpobj c -> p_byte itag_cpobj st; p_ILType c st + | i -> pfailwith st (sprintf "the IL instruction '%+A' cannot be emitted" i) -let u_ILInstr st = +let u_ILInstr st = let n = u_byte st decode_tab.[n] st - + //--------------------------------------------------------------------------- // Pickle/unpickle for F# types and module signatures @@ -1312,58 +1312,58 @@ let u_Map uk uv = u_wrap Map.ofList (u_list (u_tup2 uk uv)) let u_qlist uv = u_wrap QueueList.ofList (u_list uv) let u_namemap u = u_Map u_string u -let p_pos (x: pos) st = p_tup2 p_int p_int (x.Line,x.Column) st +let p_pos (x: pos) st = p_tup2 p_int p_int (x.Line, x.Column) st let p_range (x: range) st = p_tup3 p_string p_pos p_pos (x.FileName, x.Start, x.End) st let p_dummy_range : range pickler = fun _x _st -> () -let p_ident (x: Ident) st = p_tup2 p_string p_range (x.idText,x.idRange) st +let p_ident (x: Ident) st = p_tup2 p_string p_range (x.idText, x.idRange) st let p_xmldoc (XmlDoc x) st = p_array p_string x st let u_pos st = let a = u_int st in let b = u_int st in mkPos a b let u_range st = let a = u_string st in let b = u_pos st in let c = u_pos st in mkRange a b c -// Most ranges (e.g. on optimization expressions) can be elided from stored data +// Most ranges (e.g. on optimization expressions) can be elided from stored data let u_dummy_range : range unpickler = fun _st -> range0 -let u_ident st = let a = u_string st in let b = u_range st in ident(a,b) +let u_ident st = let a = u_string st in let b = u_range st in ident(a, b) let u_xmldoc st = XmlDoc (u_array u_string st) let p_local_item_ref ctxt tab st = p_osgn_ref ctxt tab st -let p_tcref ctxt (x:EntityRef) st = - match x with +let p_tcref ctxt (x:EntityRef) st = + match x with | ERefLocal x -> p_byte 0 st; p_local_item_ref ctxt st.oentities x st | ERefNonLocal x -> p_byte 1 st; p_nleref x st -let p_ucref (UCRef(a,b)) st = p_tup2 (p_tcref "ucref") p_string (a,b) st -let p_rfref (RFRef(a,b)) st = p_tup2 (p_tcref "rfref") p_string (a,b) st +let p_ucref (UCRef(a, b)) st = p_tup2 (p_tcref "ucref") p_string (a, b) st +let p_rfref (RFRef(a, b)) st = p_tup2 (p_tcref "rfref") p_string (a, b) st let p_tpref x st = p_local_item_ref "typar" st.otypars x st let u_local_item_ref tab st = u_osgn_ref tab st -let u_tcref st = +let u_tcref st = let tag = u_byte st match tag with - | 0 -> u_local_item_ref st.ientities st |> ERefLocal - | 1 -> u_nleref st |> ERefNonLocal + | 0 -> u_local_item_ref st.ientities st |> ERefLocal + | 1 -> u_nleref st |> ERefNonLocal | _ -> ufailwith st "u_item_ref" - -let u_ucref st = let a,b = u_tup2 u_tcref u_string st in UCRef(a,b) -let u_rfref st = let a,b = u_tup2 u_tcref u_string st in RFRef(a,b) +let u_ucref st = let a, b = u_tup2 u_tcref u_string st in UCRef(a, b) + +let u_rfref st = let a, b = u_tup2 u_tcref u_string st in RFRef(a, b) let u_tpref st = u_local_item_ref st.itypars st // forward reference -let fill_p_ty2,p_ty2 = p_hole2() +let fill_p_ty2, p_ty2 = p_hole2() let p_ty = p_ty2 false let p_tys = (p_list p_ty) -let fill_p_attribs,p_attribs = p_hole() +let fill_p_attribs, p_attribs = p_hole() // In F# 4.5, the type of the "this" pointer for structs is considered to be inref for the purposes of checking the implementation // of the struct. However for backwards compat reaons we can't serialize this as the type. -let checkForInRefStructThisArg st ty = +let checkForInRefStructThisArg st ty = let g = st.oglobals let _, tauTy = tryDestForallTy g ty isFunTy g tauTy && isFunTy g (rangeOfFunTy g tauTy) && isInByrefTy g (domainOfFunTy g tauTy) @@ -1374,28 +1374,28 @@ let p_nonlocal_val_ref (nlv:NonLocalValOrMemberRef) st = let pkey = key.PartialKey p_tcref "nlvref" a st p_option p_string pkey.MemberParentMangledName st - p_bool pkey.MemberIsOverride st - p_string pkey.LogicalName st - p_int pkey.TotalArgCount st - let isStructThisArgPos = - match key.TypeForLinkage with + p_bool pkey.MemberIsOverride st + p_string pkey.LogicalName st + p_int pkey.TotalArgCount st + let isStructThisArgPos = + match key.TypeForLinkage with | None -> false | Some ty -> checkForInRefStructThisArg st ty p_option (p_ty2 isStructThisArgPos) key.TypeForLinkage st -let rec p_vref ctxt x st = - match x with +let rec p_vref ctxt x st = + match x with | VRefLocal x -> p_byte 0 st; p_local_item_ref ctxt st.ovals x st | VRefNonLocal x -> p_byte 1 st; p_nonlocal_val_ref x st -let p_vrefs ctxt = p_list (p_vref ctxt) +let p_vrefs ctxt = p_list (p_vref ctxt) -let fill_u_ty,u_ty = u_hole() +let fill_u_ty, u_ty = u_hole() let u_tys = (u_list u_ty) -let fill_u_attribs,u_attribs = u_hole() +let fill_u_attribs, u_attribs = u_hole() -let u_nonlocal_val_ref st : NonLocalValOrMemberRef = - let a = u_tcref st +let u_nonlocal_val_ref st : NonLocalValOrMemberRef = + let a = u_tcref st let b1 = u_option u_string st let b2 = u_bool st let b3 = u_string st @@ -1403,23 +1403,23 @@ let u_nonlocal_val_ref st : NonLocalValOrMemberRef = let d = u_option u_ty st { EnclosingEntity = a ItemKey=ValLinkageFullKey({ MemberParentMangledName=b1; MemberIsOverride=b2;LogicalName=b3; TotalArgCount=c }, d) } - -let u_vref st = + +let u_vref st = let tag = u_byte st match tag with | 0 -> u_local_item_ref st.ivals st |> (fun x -> VRefLocal x) | 1 -> u_nonlocal_val_ref st |> (fun x -> VRefNonLocal x) | _ -> ufailwith st "u_item_ref" - -let u_vrefs = u_list u_vref + +let u_vrefs = u_list u_vref let p_kind x st = p_byte (match x with | TyparKind.Type -> 0 | TyparKind.Measure -> 1) st -let p_member_kind x st = - p_byte (match x with +let p_member_kind x st = + p_byte (match x with | MemberKind.Member -> 0 | MemberKind.PropertyGet -> 1 | MemberKind.PropertySet -> 2 @@ -1433,91 +1433,91 @@ let u_kind st = | 1 -> TyparKind.Measure | _ -> ufailwith st "u_kind" -let u_member_kind st = - match u_byte st with - | 0 -> MemberKind.Member - | 1 -> MemberKind.PropertyGet - | 2 -> MemberKind.PropertySet +let u_member_kind st = + match u_byte st with + | 0 -> MemberKind.Member + | 1 -> MemberKind.PropertyGet + | 2 -> MemberKind.PropertySet | 3 -> MemberKind.Constructor | 4 -> MemberKind.ClassConstructor | _ -> ufailwith st "u_member_kind" -let p_MemberFlags x st = - p_tup6 p_bool p_bool p_bool p_bool p_bool p_member_kind - (x.IsInstance, - false (* _x3UnusedBoolInFormat *), - x.IsDispatchSlot, - x.IsOverrideOrExplicitImpl, - x.IsFinal, +let p_MemberFlags x st = + p_tup6 p_bool p_bool p_bool p_bool p_bool p_member_kind + (x.IsInstance, + false (* _x3UnusedBoolInFormat *), + x.IsDispatchSlot, + x.IsOverrideOrExplicitImpl, + x.IsFinal, x.MemberKind) st -let u_MemberFlags st = - let x2,_x3UnusedBoolInFormat,x4,x5,x6,x7 = u_tup6 u_bool u_bool u_bool u_bool u_bool u_member_kind st +let u_MemberFlags st = + let x2, _x3UnusedBoolInFormat, x4, x5, x6, x7 = u_tup6 u_bool u_bool u_bool u_bool u_bool u_member_kind st { IsInstance=x2 IsDispatchSlot=x4 IsOverrideOrExplicitImpl=x5 IsFinal=x6 MemberKind=x7} -let fill_u_Expr_hole,u_expr_fwd = u_hole() -let fill_p_Expr_hole,p_expr_fwd = p_hole() +let fill_u_Expr_hole, u_expr_fwd = u_hole() +let fill_p_Expr_hole, p_expr_fwd = p_hole() -let p_anonInfo_data (anonInfo: AnonRecdTypeInfo) st = +let p_anonInfo_data (anonInfo: AnonRecdTypeInfo) st = p_tup3 p_ccuref p_bool (p_array p_ident) (anonInfo.Assembly, evalTupInfoIsStruct anonInfo.TupInfo, anonInfo.SortedIds) st -let p_anonInfo x st = +let p_anonInfo x st = p_osgn_decl st.oanoninfos p_anonInfo_data x st -let p_trait_sln sln st = - match sln with - | ILMethSln(a,b,c,d) -> - p_byte 0 st; p_tup4 p_ty (p_option p_ILTypeRef) p_ILMethodRef p_tys (a,b,c,d) st - | FSMethSln(a,b,c) -> - p_byte 1 st; p_tup3 p_ty (p_vref "trait") p_tys (a,b,c) st - | BuiltInSln -> +let p_trait_sln sln st = + match sln with + | ILMethSln(a, b, c, d) -> + p_byte 0 st; p_tup4 p_ty (p_option p_ILTypeRef) p_ILMethodRef p_tys (a, b, c, d) st + | FSMethSln(a, b, c) -> + p_byte 1 st; p_tup3 p_ty (p_vref "trait") p_tys (a, b, c) st + | BuiltInSln -> p_byte 2 st - | ClosedExprSln expr -> + | ClosedExprSln expr -> p_byte 3 st; p_expr_fwd expr st - | FSRecdFieldSln(a,b,c) -> - p_byte 4 st; p_tup3 p_tys p_rfref p_bool (a,b,c) st + | FSRecdFieldSln(a, b, c) -> + p_byte 4 st; p_tup3 p_tys p_rfref p_bool (a, b, c) st | FSAnonRecdFieldSln(a, b, c) -> - p_byte 5 st; p_tup3 p_anonInfo p_tys p_int (a,b,c) st + p_byte 5 st; p_tup3 p_anonInfo p_tys p_int (a, b, c) st -let p_trait (TTrait(a,b,c,d,e,f)) st = - p_tup6 p_tys p_string p_MemberFlags p_tys (p_option p_ty) (p_option p_trait_sln) (a,b,c,d,e,!f) st +let p_trait (TTrait(a, b, c, d, e, f)) st = + p_tup6 p_tys p_string p_MemberFlags p_tys (p_option p_ty) (p_option p_trait_sln) (a, b, c, d, e, !f) st -let u_anonInfo_data st = - let (ccu, info, nms) = u_tup3 u_ccuref u_bool (u_array u_ident) st +let u_anonInfo_data st = + let (ccu, info, nms) = u_tup3 u_ccuref u_bool (u_array u_ident) st AnonRecdTypeInfo.Create (ccu, mkTupInfo info, nms) -let u_anonInfo st = - u_osgn_decl st.ianoninfos u_anonInfo_data st +let u_anonInfo st = + u_osgn_decl st.ianoninfos u_anonInfo_data st // We have to store trait solutions since they can occur in optimization data -let u_trait_sln st = +let u_trait_sln st = let tag = u_byte st - match tag with - | 0 -> - let (a,b,c,d) = u_tup4 u_ty (u_option u_ILTypeRef) u_ILMethodRef u_tys st - ILMethSln(a,b,c,d) - | 1 -> - let (a,b,c) = u_tup3 u_ty u_vref u_tys st - FSMethSln(a,b,c) - | 2 -> + match tag with + | 0 -> + let (a, b, c, d) = u_tup4 u_ty (u_option u_ILTypeRef) u_ILMethodRef u_tys st + ILMethSln(a, b, c, d) + | 1 -> + let (a, b, c) = u_tup3 u_ty u_vref u_tys st + FSMethSln(a, b, c) + | 2 -> BuiltInSln - | 3 -> + | 3 -> ClosedExprSln (u_expr_fwd st) - | 4 -> - let (a,b,c) = u_tup3 u_tys u_rfref u_bool st - FSRecdFieldSln(a,b,c) - | 5 -> - let (a,b,c) = u_tup3 u_anonInfo u_tys u_int st + | 4 -> + let (a, b, c) = u_tup3 u_tys u_rfref u_bool st + FSRecdFieldSln(a, b, c) + | 5 -> + let (a, b, c) = u_tup3 u_anonInfo u_tys u_int st FSAnonRecdFieldSln(a, b, c) - | _ -> ufailwith st "u_trait_sln" + | _ -> ufailwith st "u_trait_sln" -let u_trait st = - let a,b,c,d,e,f = u_tup6 u_tys u_string u_MemberFlags u_tys (u_option u_ty) (u_option u_trait_sln) st - TTrait (a,b,c,d,e,ref f) +let u_trait st = + let a, b, c, d, e, f = u_tup6 u_tys u_string u_MemberFlags u_tys (u_option u_ty) (u_option u_trait_sln) st + TTrait (a, b, c, d, e, ref f) let p_rational q st = p_int32 (GetNumerator q) st; p_int32 (GetDenominator q) st @@ -1530,14 +1530,14 @@ let p_measure_one = p_byte 4 // Pickle a unit-of-measure variable or constructor let p_measure_varcon unt st = - match unt with + match unt with | Measure.Con tcref -> p_measure_con tcref st | Measure.Var v -> p_measure_var v st | _ -> pfailwith st ("p_measure_varcon: expected measure variable or constructor") // Pickle a positive integer power of a unit-of-measure variable or constructor let rec p_measure_pospower unt n st = - if n = 1 + if n = 1 then p_measure_varcon unt st else p_byte 2 st; p_measure_varcon unt st; p_measure_pospower unt (n-1) st @@ -1550,103 +1550,103 @@ let p_measure_intpower unt n st = // Pickle a rational power of a unit-of-measure variable or constructor let rec p_measure_power unt q st = if q = ZeroRational then p_measure_one st - elif GetDenominator q = 1 - then p_measure_intpower unt (GetNumerator q) st + elif GetDenominator q = 1 + then p_measure_intpower unt (GetNumerator q) st else p_byte 5 st; p_measure_varcon unt st; p_rational q st // Pickle a normalized unit-of-measure expression -// Normalized means of the form cv1 ^ q1 * ... * cvn ^ qn +// Normalized means of the form cv1 ^ q1 * ... * cvn ^ qn // where q1, ..., qn are non-zero, and cv1, ..., cvn are distinct unit-of-measure variables or constructors let rec p_normalized_measure unt st = - let unt = stripUnitEqnsAux false unt - match unt with + let unt = stripUnitEqnsAux false unt + match unt with | Measure.Con tcref -> p_measure_con tcref st | Measure.Inv x -> p_byte 1 st; p_normalized_measure x st - | Measure.Prod(x1,x2) -> p_byte 2 st; p_normalized_measure x1 st; p_normalized_measure x2 st + | Measure.Prod(x1, x2) -> p_byte 2 st; p_normalized_measure x1 st; p_normalized_measure x2 st | Measure.Var v -> p_measure_var v st | Measure.One -> p_measure_one st - | Measure.RationalPower(x,q) -> p_measure_power x q st + | Measure.RationalPower(x, q) -> p_measure_power x q st -// By normalizing the unit-of-measure and treating integer powers as a special case, -// we ensure that the pickle format for rational powers of units (byte 5 followed by -// numerator and denominator) is used only when absolutely necessary, maintaining +// By normalizing the unit-of-measure and treating integer powers as a special case, +// we ensure that the pickle format for rational powers of units (byte 5 followed by +// numerator and denominator) is used only when absolutely necessary, maintaining // compatibility of formats with versions prior to F# 4.0. // // See https://github.com/Microsoft/visualfsharp/issues/69 let p_measure_expr unt st = p_normalized_measure (normalizeMeasure st.oglobals unt) st let u_rational st = - let a,b = u_tup2 u_int32 u_int32 st in DivRational (intToRational a) (intToRational b) + let a, b = u_tup2 u_int32 u_int32 st in DivRational (intToRational a) (intToRational b) let rec u_measure_expr st = let tag = u_byte st match tag with | 0 -> let a = u_tcref st in Measure.Con a | 1 -> let a = u_measure_expr st in Measure.Inv a - | 2 -> let a,b = u_tup2 u_measure_expr u_measure_expr st in Measure.Prod (a,b) + | 2 -> let a, b = u_tup2 u_measure_expr u_measure_expr st in Measure.Prod (a, b) | 3 -> let a = u_tpref st in Measure.Var a | 4 -> Measure.One - | 5 -> let a = u_measure_expr st in let b = u_rational st in Measure.RationalPower (a,b) + | 5 -> let a = u_measure_expr st in let b = u_rational st in Measure.RationalPower (a, b) | _ -> ufailwith st "u_measure_expr" -let p_tyar_constraint x st = - match x with - | TyparConstraint.CoercesTo (a,_) -> p_byte 0 st; p_ty a st - | TyparConstraint.MayResolveMember(traitInfo,_) -> p_byte 1 st; p_trait traitInfo st - | TyparConstraint.DefaultsTo(_,rty,_) -> p_byte 2 st; p_ty rty st +let p_tyar_constraint x st = + match x with + | TyparConstraint.CoercesTo (a, _) -> p_byte 0 st; p_ty a st + | TyparConstraint.MayResolveMember(traitInfo, _) -> p_byte 1 st; p_trait traitInfo st + | TyparConstraint.DefaultsTo(_, rty, _) -> p_byte 2 st; p_ty rty st | TyparConstraint.SupportsNull _ -> p_byte 3 st | TyparConstraint.IsNonNullableStruct _ -> p_byte 4 st | TyparConstraint.IsReferenceType _ -> p_byte 5 st | TyparConstraint.RequiresDefaultConstructor _ -> p_byte 6 st - | TyparConstraint.SimpleChoice(tys,_) -> p_byte 7 st; p_tys tys st - | TyparConstraint.IsEnum(ty,_) -> p_byte 8 st; p_ty ty st - | TyparConstraint.IsDelegate(aty,bty,_) -> p_byte 9 st; p_ty aty st; p_ty bty st + | TyparConstraint.SimpleChoice(tys, _) -> p_byte 7 st; p_tys tys st + | TyparConstraint.IsEnum(ty, _) -> p_byte 8 st; p_ty ty st + | TyparConstraint.IsDelegate(aty, bty, _) -> p_byte 9 st; p_ty aty st; p_ty bty st | TyparConstraint.SupportsComparison _ -> p_byte 10 st | TyparConstraint.SupportsEquality _ -> p_byte 11 st | TyparConstraint.IsUnmanaged _ -> p_byte 12 st let p_tyar_constraints = (p_list p_tyar_constraint) -let u_tyar_constraint st = +let u_tyar_constraint st = let tag = u_byte st match tag with - | 0 -> u_ty st |> (fun a _ -> TyparConstraint.CoercesTo (a,range0) ) - | 1 -> u_trait st |> (fun a _ -> TyparConstraint.MayResolveMember(a,range0)) - | 2 -> u_ty st |> (fun a ridx -> TyparConstraint.DefaultsTo(ridx,a,range0)) + | 0 -> u_ty st |> (fun a _ -> TyparConstraint.CoercesTo (a, range0) ) + | 1 -> u_trait st |> (fun a _ -> TyparConstraint.MayResolveMember(a, range0)) + | 2 -> u_ty st |> (fun a ridx -> TyparConstraint.DefaultsTo(ridx, a, range0)) | 3 -> (fun _ -> TyparConstraint.SupportsNull range0) | 4 -> (fun _ -> TyparConstraint.IsNonNullableStruct range0) | 5 -> (fun _ -> TyparConstraint.IsReferenceType range0) | 6 -> (fun _ -> TyparConstraint.RequiresDefaultConstructor range0) - | 7 -> u_tys st |> (fun a _ -> TyparConstraint.SimpleChoice(a,range0)) - | 8 -> u_ty st |> (fun a _ -> TyparConstraint.IsEnum(a,range0)) - | 9 -> u_tup2 u_ty u_ty st |> (fun (a,b) _ -> TyparConstraint.IsDelegate(a,b,range0)) + | 7 -> u_tys st |> (fun a _ -> TyparConstraint.SimpleChoice(a, range0)) + | 8 -> u_ty st |> (fun a _ -> TyparConstraint.IsEnum(a, range0)) + | 9 -> u_tup2 u_ty u_ty st |> (fun (a, b) _ -> TyparConstraint.IsDelegate(a, b, range0)) | 10 -> (fun _ -> TyparConstraint.SupportsComparison range0) | 11 -> (fun _ -> TyparConstraint.SupportsEquality range0) | 12 -> (fun _ -> TyparConstraint.IsUnmanaged range0) - | _ -> ufailwith st "u_tyar_constraint" + | _ -> ufailwith st "u_tyar_constraint" let u_tyar_constraints = (u_list_revi u_tyar_constraint) -let p_tyar_spec_data (x:Typar) st = +let p_tyar_spec_data (x:Typar) st = p_tup5 - p_ident + p_ident p_attribs p_int64 p_tyar_constraints p_xmldoc - (x.typar_id,x.Attribs,int64 x.typar_flags.PickledBits,x.Constraints,x.XmlDoc) st + (x.typar_id, x.Attribs, int64 x.typar_flags.PickledBits, x.Constraints, x.XmlDoc) st -let p_tyar_spec (x:Typar) st = +let p_tyar_spec (x:Typar) st = //Disabled, workaround for bug 2721: if x.Rigidity <> TyparRigidity.Rigid then warning(Error(sprintf "p_tyar_spec: typar#%d is not rigid" x.Stamp, x.Range)) - if x.IsFromError then warning(Error((0,"p_tyar_spec: from error"), x.Range)) + if x.IsFromError then warning(Error((0, "p_tyar_spec: from error"), x.Range)) p_osgn_decl st.otypars p_tyar_spec_data x st let p_tyar_specs = (p_list p_tyar_spec) -let u_tyar_spec_data st = - let a,c,d,e,g = u_tup5 u_ident u_attribs u_int64 u_tyar_constraints u_xmldoc st - { typar_id=a +let u_tyar_spec_data st = + let a, c, d, e, g = u_tup5 u_ident u_attribs u_int64 u_tyar_constraints u_xmldoc st + { typar_id=a typar_stamp=newStamp() typar_flags=TyparFlags(int32 d) typar_solution=None @@ -1656,8 +1656,8 @@ let u_tyar_spec_data st = | XmlDoc [||], [], [] -> None | _ -> Some { typar_il_name = None; typar_xmldoc = g; typar_constraints = e; typar_attribs = c } } -let u_tyar_spec st = - u_osgn_decl st.itypars u_tyar_spec_data st +let u_tyar_spec st = + u_osgn_decl st.itypars u_tyar_spec_data st let u_tyar_specs = (u_list u_tyar_spec) @@ -1665,36 +1665,36 @@ let _ = fill_p_ty2 (fun isStructThisArgPos ty st -> let ty = stripTyparEqns ty // See comment on 'checkForInRefStructThisArg' - let ty = - if isInByrefTy st.oglobals ty && isStructThisArgPos then - // Convert the inref to a byref - mkByrefTy st.oglobals (destByrefTy st.oglobals ty) + let ty = + if isInByrefTy st.oglobals ty && isStructThisArgPos then + // Convert the inref to a byref + mkByrefTy st.oglobals (destByrefTy st.oglobals ty) else ty - match ty with - | TType_tuple (tupInfo,l) -> - if evalTupInfoIsStruct tupInfo then + match ty with + | TType_tuple (tupInfo, l) -> + if evalTupInfoIsStruct tupInfo then p_byte 8 st; p_tys l st else p_byte 0 st; p_tys l st - | TType_app(ERefNonLocal nleref,[]) -> p_byte 1 st; p_simpletyp nleref st - | TType_app (tc,tinst) -> p_byte 2 st; p_tup2 (p_tcref "typ") p_tys (tc,tinst) st - | TType_fun (d,r) -> + | TType_app(ERefNonLocal nleref, []) -> p_byte 1 st; p_simpletyp nleref st + | TType_app (tc, tinst) -> p_byte 2 st; p_tup2 (p_tcref "typ") p_tys (tc, tinst) st + | TType_fun (d, r) -> p_byte 3 st // Note, the "this" argument may be found in the domain position of a function type, so propagate the isStructThisArgPos value p_ty2 isStructThisArgPos d st p_ty r st | TType_var r -> p_byte 4 st; p_tpref r st - | TType_forall (tps,r) -> + | TType_forall (tps, r) -> p_byte 5 st p_tyar_specs tps st // Note, the "this" argument may be found in the body of a generic forall type, so propagate the isStructThisArgPos value p_ty2 isStructThisArgPos r st | TType_measure unt -> p_byte 6 st; p_measure_expr unt st - | TType_ucase (uc,tinst) -> p_byte 7 st; p_tup2 p_ucref p_tys (uc,tinst) st + | TType_ucase (uc, tinst) -> p_byte 7 st; p_tup2 p_ucref p_tys (uc, tinst) st // p_byte 8 taken by TType_tuple above - | TType_anon (anonInfo, l) -> + | TType_anon (anonInfo, l) -> p_byte 9 st p_anonInfo anonInfo st p_tys l st) @@ -1703,90 +1703,90 @@ let _ = fill_u_ty (fun st -> let tag = u_byte st match tag with | 0 -> let l = u_tys st in TType_tuple (tupInfoRef, l) - | 1 -> u_simpletyp st - | 2 -> let tc = u_tcref st in let tinst = u_tys st in TType_app (tc,tinst) - | 3 -> let d = u_ty st in let r = u_ty st in TType_fun (d,r) + | 1 -> u_simpletyp st + | 2 -> let tc = u_tcref st in let tinst = u_tys st in TType_app (tc, tinst) + | 3 -> let d = u_ty st in let r = u_ty st in TType_fun (d, r) | 4 -> let r = u_tpref st in r.AsType - | 5 -> let tps = u_tyar_specs st in let r = u_ty st in TType_forall (tps,r) + | 5 -> let tps = u_tyar_specs st in let r = u_ty st in TType_forall (tps, r) | 6 -> let unt = u_measure_expr st in TType_measure unt - | 7 -> let uc = u_ucref st in let tinst = u_tys st in TType_ucase (uc,tinst) + | 7 -> let uc = u_ucref st in let tinst = u_tys st in TType_ucase (uc, tinst) | 8 -> let l = u_tys st in TType_tuple (tupInfoStruct, l) | 9 -> let anonInfo = u_anonInfo st in let l = u_tys st in TType_anon (anonInfo, l) | _ -> ufailwith st "u_typ") - - -let fill_p_binds,p_binds = p_hole() -let fill_p_targets,p_targets = p_hole() -let fill_p_Exprs,p_Exprs = p_hole() -let fill_p_constraints,p_constraints = p_hole() -let fill_p_Vals,p_Vals = p_hole() - -let fill_u_binds,u_binds = u_hole() -let fill_u_targets,u_targets = u_hole() -let fill_u_Exprs,u_Exprs = u_hole() -let fill_u_constraints,u_constraints = u_hole() -let fill_u_Vals,u_Vals = u_hole() - -let p_ArgReprInfo (x:ArgReprInfo) st = - p_attribs x.Attribs st + + +let fill_p_binds, p_binds = p_hole() +let fill_p_targets, p_targets = p_hole() +let fill_p_Exprs, p_Exprs = p_hole() +let fill_p_constraints, p_constraints = p_hole() +let fill_p_Vals, p_Vals = p_hole() + +let fill_u_binds, u_binds = u_hole() +let fill_u_targets, u_targets = u_hole() +let fill_u_Exprs, u_Exprs = u_hole() +let fill_u_constraints, u_constraints = u_hole() +let fill_u_Vals, u_Vals = u_hole() + +let p_ArgReprInfo (x:ArgReprInfo) st = + p_attribs x.Attribs st p_option p_ident x.Name st -let p_TyparReprInfo (TyparReprInfo(a,b)) st = - p_ident a st +let p_TyparReprInfo (TyparReprInfo(a, b)) st = + p_ident a st p_kind b st -let p_ValReprInfo (ValReprInfo (a,args,ret)) st = - p_list p_TyparReprInfo a st - p_list (p_list p_ArgReprInfo) args st +let p_ValReprInfo (ValReprInfo (a, args, ret)) st = + p_list p_TyparReprInfo a st + p_list (p_list p_ArgReprInfo) args st p_ArgReprInfo ret st -let u_ArgReprInfo st = - let a = u_attribs st - let b = u_option u_ident st - match a,b with - | [],None -> ValReprInfo.unnamedTopArg1 - | _ -> { Attribs = a; Name = b } +let u_ArgReprInfo st = + let a = u_attribs st + let b = u_option u_ident st + match a, b with + | [], None -> ValReprInfo.unnamedTopArg1 + | _ -> { Attribs = a; Name = b } -let u_TyparReprInfo st = +let u_TyparReprInfo st = let a = u_ident st - let b = u_kind st - TyparReprInfo(a,b) + let b = u_kind st + TyparReprInfo(a, b) -let u_ValReprInfo st = +let u_ValReprInfo st = let a = u_list u_TyparReprInfo st let b = u_list (u_list u_ArgReprInfo) st let c = u_ArgReprInfo st - ValReprInfo (a,b,c) + ValReprInfo (a, b, c) -let p_ranges x st = +let p_ranges x st = p_option (p_tup2 p_range p_range) x st -let p_istype x st = - match x with +let p_istype x st = + match x with | FSharpModuleWithSuffix -> p_byte 0 st | ModuleOrType -> p_byte 1 st | Namespace -> p_byte 2 st -let p_cpath (CompPath(a,b)) st = - p_tup2 p_ILScopeRef (p_list (p_tup2 p_string p_istype)) (a,b) st +let p_cpath (CompPath(a, b)) st = + p_tup2 p_ILScopeRef (p_list (p_tup2 p_string p_istype)) (a, b) st let u_ranges st = u_option (u_tup2 u_range u_range) st -let u_istype st = +let u_istype st = let tag = u_byte st match tag with - | 0 -> FSharpModuleWithSuffix - | 1 -> ModuleOrType - | 2 -> Namespace + | 0 -> FSharpModuleWithSuffix + | 1 -> ModuleOrType + | 2 -> Namespace | _ -> ufailwith st "u_istype" -let u_cpath st = let a,b = u_tup2 u_ILScopeRef (u_list (u_tup2 u_string u_istype)) st in (CompPath(a,b)) +let u_cpath st = let a, b = u_tup2 u_ILScopeRef (u_list (u_tup2 u_string u_istype)) st in (CompPath(a, b)) let rec dummy x = x -and p_tycon_repr x st = +and p_tycon_repr x st = // The leading "p_byte 1" and "p_byte 0" come from the F# 2.0 format, which used an option value at this point. - match x with + match x with | TRecdRepr fs -> p_byte 1 st; p_byte 0 st; p_rfield_table fs st; false | TUnionRepr x -> p_byte 1 st; p_byte 1 st; p_array p_unioncase_spec (x.CasesTable.CasesByIndex) st; false | TAsmRepr ilty -> p_byte 1 st; p_byte 2 st; p_ILType ilty st; false @@ -1794,24 +1794,24 @@ and p_tycon_repr x st = | TMeasureableRepr ty -> p_byte 1 st; p_byte 4 st; p_ty ty st; false | TNoRepr -> p_byte 0 st; false #if !NO_EXTENSIONTYPING - | TProvidedTypeExtensionPoint info -> - if info.IsErased then + | TProvidedTypeExtensionPoint info -> + if info.IsErased then // Pickle erased type definitions as a NoRepr p_byte 0 st; false else // Pickle generated type definitions as a TAsmRepr - p_byte 1 st; p_byte 2 st; p_ILType (mkILBoxedType(ILTypeSpec.Create(ExtensionTyping.GetILTypeRefOfProvidedType(info.ProvidedType ,range0),[]))) st; true + p_byte 1 st; p_byte 2 st; p_ILType (mkILBoxedType(ILTypeSpec.Create(ExtensionTyping.GetILTypeRefOfProvidedType(info.ProvidedType , range0), []))) st; true | TProvidedNamespaceExtensionPoint _ -> p_byte 0 st; false #endif - | TILObjectRepr (TILObjectReprData (_,_,td)) -> error (Failure("Unexpected IL type definition"+td.Name)) + | TILObjectRepr (TILObjectReprData (_, _, td)) -> error (Failure("Unexpected IL type definition"+td.Name)) -and p_tycon_objmodel_data x st = - p_tup3 p_tycon_objmodel_kind (p_vrefs "vslots") p_rfield_table +and p_tycon_objmodel_data x st = + p_tup3 p_tycon_objmodel_kind (p_vrefs "vslots") p_rfield_table (x.fsobjmodel_kind, x.fsobjmodel_vslots, x.fsobjmodel_rfields) st and p_attribs_ext f x st = p_list_ext f p_attrib x st -and p_unioncase_spec x st = +and p_unioncase_spec x st = p_rfield_table x.FieldTable st p_ty x.ReturnType st p_string x.CompiledName st @@ -1824,7 +1824,7 @@ and p_unioncase_spec x st = and p_exnc_spec_data x st = p_entity_spec_data x st and p_exnc_repr x st = - match x with + match x with | TExnAbbrevRepr x -> p_byte 0 st; (p_tcref "exn abbrev") x st | TExnAsmRepr x -> p_byte 1 st; p_ILTypeRef x st | TExnFresh x -> p_byte 2 st; p_rfield_table x st @@ -1834,24 +1834,24 @@ and p_exnc_spec x st = p_entity_spec x st and p_access (TAccess n) st = p_list p_cpath n st -and p_recdfield_spec x st = +and p_recdfield_spec x st = p_bool x.rfield_mutable st p_bool x.rfield_volatile st p_ty x.rfield_type st p_bool x.rfield_static st p_bool x.rfield_secret st p_option p_const x.rfield_const st - p_ident x.rfield_id st + p_ident x.rfield_id st p_attribs_ext (if st.oInMem then Some (p_xmldoc x.XmlDoc) else None) x.rfield_pattribs st p_attribs x.rfield_fattribs st p_string x.rfield_xmldocsig st p_access x.rfield_access st -and p_rfield_table x st = +and p_rfield_table x st = p_array p_recdfield_spec (x.FieldsByIndex) st -and p_entity_spec_data (x:Entity) st = - p_tyar_specs (x.entity_typars.Force(x.entity_range)) st +and p_entity_spec_data (x:Entity) st = + p_tyar_specs (x.entity_typars.Force(x.entity_range)) st p_string x.entity_logical_name st p_option p_string x.EntityCompiledName st p_range x.entity_range st @@ -1874,29 +1874,29 @@ and p_entity_spec_data (x:Entity) st = p_space 1 () st -and p_tcaug p st = +and p_tcaug p st = p_tup9 (p_option (p_tup2 (p_vref "compare_obj") (p_vref "compare"))) (p_option (p_vref "compare_withc")) (p_option (p_tup3 (p_vref "hash_obj") (p_vref "hash_withc") (p_vref "equals_withc"))) (p_option (p_tup2 (p_vref "hash") (p_vref "equals"))) - (p_list (p_tup2 p_string (p_vref "adhoc"))) + (p_list (p_tup2 p_string (p_vref "adhoc"))) (p_list (p_tup3 p_ty p_bool p_dummy_range)) (p_option p_ty) p_bool (p_space 1) - (p.tcaug_compare, - p.tcaug_compare_withc, - p.tcaug_hash_and_equals_withc, - p.tcaug_equals, - (p.tcaug_adhoc_list - |> ResizeArray.toList + (p.tcaug_compare, + p.tcaug_compare_withc, + p.tcaug_hash_and_equals_withc, + p.tcaug_equals, + (p.tcaug_adhoc_list + |> ResizeArray.toList // Explicit impls of interfaces only get kept in the adhoc list // in order to get check the well-formedness of an interface. - // Keeping them across assembly boundaries is not valid, because relinking their ValRefs - // does not work correctly (they may get incorrectly relinked to a default member) - |> List.filter (fun (isExplicitImpl,_) -> not isExplicitImpl) - |> List.map (fun (_,vref) -> vref.LogicalName, vref)), + // Keeping them across assembly boundaries is not valid, because relinking their ValRefs + // does not work correctly (they may get incorrectly relinked to a default member) + |> List.filter (fun (isExplicitImpl, _) -> not isExplicitImpl) + |> List.map (fun (_, vref) -> vref.LogicalName, vref)), p.tcaug_interfaces, p.tcaug_super, p.tcaug_abstract, @@ -1904,53 +1904,53 @@ and p_tcaug p st = and p_entity_spec x st = p_osgn_decl st.oentities p_entity_spec_data x st -and p_parentref x st = - match x with +and p_parentref x st = + match x with | ParentNone -> p_byte 0 st | Parent x -> p_byte 1 st; p_tcref "parent tycon" x st -and p_attribkind x st = - match x with +and p_attribkind x st = + match x with | ILAttrib x -> p_byte 0 st; p_ILMethodRef x st | FSAttrib x -> p_byte 1 st; p_vref "attrib" x st -and p_attrib (Attrib (a,b,c,d,e,_targets,f)) st = // AttributeTargets are not preserved - p_tup6 (p_tcref "attrib") p_attribkind (p_list p_attrib_expr) (p_list p_attrib_arg) p_bool p_dummy_range (a,b,c,d,e,f) st +and p_attrib (Attrib (a, b, c, d, e, _targets, f)) st = // AttributeTargets are not preserved + p_tup6 (p_tcref "attrib") p_attribkind (p_list p_attrib_expr) (p_list p_attrib_arg) p_bool p_dummy_range (a, b, c, d, e, f) st -and p_attrib_expr (AttribExpr(e1,e2)) st = - p_tup2 p_expr p_expr (e1,e2) st +and p_attrib_expr (AttribExpr(e1, e2)) st = + p_tup2 p_expr p_expr (e1, e2) st -and p_attrib_arg (AttribNamedArg(a,b,c,d)) st = - p_tup4 p_string p_ty p_bool p_attrib_expr (a,b,c,d) st +and p_attrib_arg (AttribNamedArg(a, b, c, d)) st = + p_tup4 p_string p_ty p_bool p_attrib_expr (a, b, c, d) st -and p_member_info (x:ValMemberInfo) st = - p_tup4 (p_tcref "member_info") p_MemberFlags (p_list p_slotsig) p_bool - (x.ApparentEnclosingEntity,x.MemberFlags,x.ImplementedSlotSigs,x.IsImplemented) st +and p_member_info (x:ValMemberInfo) st = + p_tup4 (p_tcref "member_info") p_MemberFlags (p_list p_slotsig) p_bool + (x.ApparentEnclosingEntity, x.MemberFlags, x.ImplementedSlotSigs, x.IsImplemented) st -and p_tycon_objmodel_kind x st = - match x with +and p_tycon_objmodel_kind x st = + match x with | TTyconClass -> p_byte 0 st | TTyconInterface -> p_byte 1 st | TTyconStruct -> p_byte 2 st | TTyconDelegate ss -> p_byte 3 st; p_slotsig ss st | TTyconEnum -> p_byte 4 st -and p_mustinline x st = - p_byte (match x with +and p_mustinline x st = + p_byte (match x with | ValInline.PseudoVal -> 0 | ValInline.Always -> 1 | ValInline.Optional -> 2 | ValInline.Never -> 3) st -and p_basethis x st = - p_byte (match x with +and p_basethis x st = + p_byte (match x with | BaseVal -> 0 | CtorThisVal -> 1 | NormalVal -> 2 | MemberThisVal -> 3) st -and p_vrefFlags x st = - match x with +and p_vrefFlags x st = + match x with | NormalValUse -> p_byte 0 st | CtorValUsedAsSuperInit -> p_byte 1 st | CtorValUsedAsSelfInit -> p_byte 2 st @@ -1962,7 +1962,7 @@ and p_ValData x st = p_option p_string x.ValCompiledName st // only keep range information on published values, not on optimization data p_ranges (x.ValReprInfo |> Option.map (fun _ -> x.val_range, x.DefinitionRange)) st - + let isStructThisArgPos = x.IsMember && checkForInRefStructThisArg st x.Type p_ty2 isStructThisArgPos x.val_type st @@ -1978,70 +1978,70 @@ and p_ValData x st = p_used_space1 (p_xmldoc x.XmlDoc) st else p_space 1 () st - -and p_Val x st = + +and p_Val x st = p_osgn_decl st.ovals p_ValData x st -and p_modul_typ (x: ModuleOrNamespaceType) st = +and p_modul_typ (x: ModuleOrNamespaceType) st = p_tup3 p_istype (p_qlist p_Val) (p_qlist p_entity_spec) - (x.ModuleOrNamespaceKind,x.AllValsAndMembers,x.AllEntities) + (x.ModuleOrNamespaceKind, x.AllValsAndMembers, x.AllEntities) st -and u_tycon_repr st = +and u_tycon_repr st = let tag1 = u_byte st match tag1 with | 0 -> (fun _flagBit -> TNoRepr) - | 1 -> + | 1 -> let tag2 = u_byte st match tag2 with - | 0 -> - let v = u_rfield_table st + | 0 -> + let v = u_rfield_table st (fun _flagBit -> TRecdRepr v) - | 1 -> - let v = u_list u_unioncase_spec st + | 1 -> + let v = u_list u_unioncase_spec st (fun _flagBit -> MakeUnionRepr v) - | 2 -> - let v = u_ILType st + | 2 -> + let v = u_ILType st // This is the F# 3.0 extension to the format used for F# provider-generated types, which record an ILTypeRef in the format - // You can think of an F# 2.0 reader as always taking the path where 'flagBit' is false. Thus the F# 2.0 reader will + // You can think of an F# 2.0 reader as always taking the path where 'flagBit' is false. Thus the F# 2.0 reader will // interpret provider-generated types as TAsmRepr. - (fun flagBit -> - if flagBit then + (fun flagBit -> + if flagBit then let iltref = v.TypeRef - match st.iILModule with + match st.iILModule with | None -> TNoRepr - | Some iILModule -> - try - let rec find acc enclosingTypeNames (tdefs:ILTypeDefs) = - match enclosingTypeNames with + | Some iILModule -> + try + let rec find acc enclosingTypeNames (tdefs:ILTypeDefs) = + match enclosingTypeNames with | [] -> List.rev acc, tdefs.FindByName iltref.Name | h::t -> let nestedTypeDef = tdefs.FindByName h find (tdefs.FindByName h :: acc) t nestedTypeDef.NestedTypes - let nestedILTypeDefs,ilTypeDef = find [] iltref.Enclosing iILModule.TypeDefs - TILObjectRepr(TILObjectReprData(st.iilscope,nestedILTypeDefs,ilTypeDef)) - with _ -> + let nestedILTypeDefs, ilTypeDef = find [] iltref.Enclosing iILModule.TypeDefs + TILObjectRepr(TILObjectReprData(st.iilscope, nestedILTypeDefs, ilTypeDef)) + with _ -> System.Diagnostics.Debug.Assert(false, sprintf "failed to find IL backing metadata for cross-assembly generated type %s" iltref.FullName) TNoRepr - else + else TAsmRepr v) - | 3 -> - let v = u_tycon_objmodel_data st + | 3 -> + let v = u_tycon_objmodel_data st (fun _flagBit -> TFSharpObjectRepr v) - | 4 -> - let v = u_ty st + | 4 -> + let v = u_ty st (fun _flagBit -> TMeasureableRepr v) | _ -> ufailwith st "u_tycon_repr" | _ -> ufailwith st "u_tycon_repr" - -and u_tycon_objmodel_data st = - let x1,x2,x3 = u_tup3 u_tycon_objmodel_kind u_vrefs u_rfield_table st + +and u_tycon_objmodel_data st = + let x1, x2, x3 = u_tup3 u_tycon_objmodel_kind u_vrefs u_rfield_table st {fsobjmodel_kind=x1; fsobjmodel_vslots=x2; fsobjmodel_rfields=x3 } - + and u_attribs_ext extraf st = u_list_ext extraf u_attrib st -and u_unioncase_spec st = +and u_unioncase_spec st = let a = u_rfield_table st let b = u_ty st @@ -2052,16 +2052,16 @@ and u_unioncase_spec st = let xmldoc, e = u_attribs_ext u_xmldoc st let f = u_string st let i = u_access st - { FieldTable=a - ReturnType=b - Id=d + { FieldTable=a + ReturnType=b + Id=d Attribs=e XmlDoc= defaultArg xmldoc XmlDoc.Empty XmlDocSig=f - Accessibility=i + Accessibility=i OtherRangeOpt=None } - -and u_exnc_spec_data st = u_entity_spec_data st + +and u_exnc_spec_data st = u_entity_spec_data st and u_exnc_repr st = let tag = u_byte st @@ -2071,15 +2071,15 @@ and u_exnc_repr st = | 2 -> u_rfield_table st |> TExnFresh | 3 -> TExnNone | _ -> ufailwith st "u_exnc_repr" - + and u_exnc_spec st = u_entity_spec st -and u_access st = - match u_list u_cpath st with - | [] -> taccessPublic // save unnecessary allocations +and u_access st = + match u_list u_cpath st with + | [] -> taccessPublic // save unnecessary allocations | res -> TAccess res -and u_recdfield_spec st = +and u_recdfield_spec st = let a = u_bool st let b = u_bool st let c1 = u_ty st @@ -2092,25 +2092,25 @@ and u_recdfield_spec st = let e2 = u_attribs st let f = u_string st let g = u_access st - { rfield_mutable=a - rfield_volatile=b - rfield_type=c1 - rfield_static=c2 - rfield_secret=c2b - rfield_const=c3 - rfield_id=d + { rfield_mutable=a + rfield_volatile=b + rfield_type=c1 + rfield_static=c2 + rfield_secret=c2b + rfield_const=c3 + rfield_id=d rfield_pattribs=e1 rfield_fattribs=e2 rfield_xmldoc= defaultArg xmldoc XmlDoc.Empty - rfield_xmldocsig=f + rfield_xmldocsig=f rfield_access=g rfield_name_generated = false rfield_other_range = None } and u_rfield_table st = MakeRecdFieldsTable (u_list u_recdfield_spec st) -and u_entity_spec_data st : Entity = - let x1,x2a,x2b,x2c,x3,(x4a,x4b),x6,x7f,x8,x9,_x10,x10b,x11,x12,x13,x14,x15 = +and u_entity_spec_data st : Entity = + let x1, x2a, x2b, x2c, x3, (x4a, x4b), x6, x7f, x8, x9, _x10, x10b, x11, x12, x13, x14, x15 = u_tup17 u_tyar_specs u_string @@ -2120,14 +2120,14 @@ and u_entity_spec_data st : Entity = (u_tup2 u_access u_access) u_attribs u_tycon_repr - (u_option u_ty) - u_tcaug - u_string + (u_option u_ty) + u_tcaug + u_string u_kind u_int64 (u_option u_cpath ) - (u_lazy u_modul_typ) - u_exnc_repr + (u_lazy u_modul_typ) + u_exnc_repr (u_used_space1 u_xmldoc) st // We use a bit that was unused in the F# 2.0 format to indicate two possible representations in the F# 3.0 tycon_repr format @@ -2145,12 +2145,12 @@ and u_entity_spec_data st : Entity = entity_flags=EntityFlags(x11) entity_cpath=x12 entity_modul_contents=MaybeLazy.Lazy x13 - entity_il_repr_cache=newCache() + entity_il_repr_cache=newCache() entity_opt_data= match x2b, x10b, x15, x8, x4a, x4b, x14 with | None, TyparKind.Type, None, None, TAccess [], TAccess [], TExnNone -> None - | _ -> - Some { Entity.NewEmptyEntityOptData() with + | _ -> + Some { Entity.NewEmptyEntityOptData() with entity_compiled_name = x2b entity_kind = x10b entity_xmldoc= defaultArg x15 XmlDoc.Empty @@ -2159,100 +2159,100 @@ and u_entity_spec_data st : Entity = entity_accessiblity = x4a entity_tycon_repr_accessibility = x4b entity_exn_info = x14 } - } + } -and u_tcaug st = - let a1,a2,a3,b2,c,d,e,g,_space = +and u_tcaug st = + let a1, a2, a3, b2, c, d, e, g, _space = u_tup9 (u_option (u_tup2 u_vref u_vref)) (u_option u_vref) (u_option (u_tup3 u_vref u_vref u_vref)) (u_option (u_tup2 u_vref u_vref)) (u_list (u_tup2 u_string u_vref)) - (u_list (u_tup3 u_ty u_bool u_dummy_range)) + (u_list (u_tup3 u_ty u_bool u_dummy_range)) (u_option u_ty) - u_bool + u_bool (u_space 1) - st - {tcaug_compare=a1 - tcaug_compare_withc=a2 - tcaug_hash_and_equals_withc=a3 - tcaug_equals=b2 + st + {tcaug_compare=a1 + tcaug_compare_withc=a2 + tcaug_hash_and_equals_withc=a3 + tcaug_equals=b2 // only used for code generation and checking - hence don't care about the values when reading back in - tcaug_hasObjectGetHashCode=false - tcaug_adhoc_list= new ResizeArray<_> (c |> List.map (fun (_,vref) -> (false, vref))) - tcaug_adhoc=NameMultiMap.ofList c + tcaug_hasObjectGetHashCode=false + tcaug_adhoc_list= new ResizeArray<_> (c |> List.map (fun (_, vref) -> (false, vref))) + tcaug_adhoc=NameMultiMap.ofList c tcaug_interfaces=d tcaug_super=e // pickled type definitions are always closed (i.e. no more intrinsic members allowed) - tcaug_closed=true + tcaug_closed=true tcaug_abstract=g} - -and u_entity_spec st = - u_osgn_decl st.ientities u_entity_spec_data st -and u_parentref st = +and u_entity_spec st = + u_osgn_decl st.ientities u_entity_spec_data st + +and u_parentref st = let tag = u_byte st match tag with | 0 -> ParentNone - | 1 -> u_tcref st |> Parent - | _ -> ufailwith st "u_attribkind" + | 1 -> u_tcref st |> Parent + | _ -> ufailwith st "u_attribkind" -and u_attribkind st = +and u_attribkind st = let tag = u_byte st match tag with - | 0 -> u_ILMethodRef st |> ILAttrib - | 1 -> u_vref st |> FSAttrib - | _ -> ufailwith st "u_attribkind" + | 0 -> u_ILMethodRef st |> ILAttrib + | 1 -> u_vref st |> FSAttrib + | _ -> ufailwith st "u_attribkind" -and u_attrib st : Attrib = - let a,b,c,d,e,f = u_tup6 u_tcref u_attribkind (u_list u_attrib_expr) (u_list u_attrib_arg) u_bool u_dummy_range st - Attrib(a,b,c,d,e,None,f) // AttributeTargets are not preserved +and u_attrib st : Attrib = + let a, b, c, d, e, f = u_tup6 u_tcref u_attribkind (u_list u_attrib_expr) (u_list u_attrib_arg) u_bool u_dummy_range st + Attrib(a, b, c, d, e, None, f) // AttributeTargets are not preserved -and u_attrib_expr st = - let a,b = u_tup2 u_expr u_expr st - AttribExpr(a,b) +and u_attrib_expr st = + let a, b = u_tup2 u_expr u_expr st + AttribExpr(a, b) -and u_attrib_arg st = - let a,b,c,d = u_tup4 u_string u_ty u_bool u_attrib_expr st - AttribNamedArg(a,b,c,d) +and u_attrib_arg st = + let a, b, c, d = u_tup4 u_string u_ty u_bool u_attrib_expr st + AttribNamedArg(a, b, c, d) -and u_member_info st : ValMemberInfo = - let x2,x3,x4,x5 = u_tup4 u_tcref u_MemberFlags (u_list u_slotsig) u_bool st +and u_member_info st : ValMemberInfo = + let x2, x3, x4, x5 = u_tup4 u_tcref u_MemberFlags (u_list u_slotsig) u_bool st { ApparentEnclosingEntity=x2 MemberFlags=x3 ImplementedSlotSigs=x4 IsImplemented=x5 } -and u_tycon_objmodel_kind st = +and u_tycon_objmodel_kind st = let tag = u_byte st match tag with - | 0 -> TTyconClass - | 1 -> TTyconInterface - | 2 -> TTyconStruct + | 0 -> TTyconClass + | 1 -> TTyconInterface + | 2 -> TTyconStruct | 3 -> u_slotsig st |> TTyconDelegate - | 4 -> TTyconEnum + | 4 -> TTyconEnum | _ -> ufailwith st "u_tycon_objmodel_kind" -and u_mustinline st = - match u_byte st with - | 0 -> ValInline.PseudoVal - | 1 -> ValInline.Always - | 2 -> ValInline.Optional - | 3 -> ValInline.Never +and u_mustinline st = + match u_byte st with + | 0 -> ValInline.PseudoVal + | 1 -> ValInline.Always + | 2 -> ValInline.Optional + | 3 -> ValInline.Never | _ -> ufailwith st "u_mustinline" -and u_basethis st = - match u_byte st with - | 0 -> BaseVal - | 1 -> CtorThisVal - | 2 -> NormalVal +and u_basethis st = + match u_byte st with + | 0 -> BaseVal + | 1 -> CtorThisVal + | 2 -> NormalVal | 3 -> MemberThisVal | _ -> ufailwith st "u_basethis" -and u_vrefFlags st = - match u_byte st with - | 0 -> NormalValUse +and u_vrefFlags st = + match u_byte st with + | 0 -> NormalValUse | 1 -> CtorValUsedAsSuperInit | 2 -> CtorValUsedAsSelfInit | 3 -> PossibleConstrainedCall (u_ty st) @@ -2260,34 +2260,34 @@ and u_vrefFlags st = | _ -> ufailwith st "u_vrefFlags" and u_ValData st = - let x1,x1z,x1a,x2,x4,x8,x9,x10,x12,x13,x13b,x14,x15 = + let x1, x1z, x1a, x2, x4, x8, x9, x10, x12, x13, x13b, x14, x15 = u_tup13 u_string (u_option u_string) u_ranges - u_ty + u_ty u_int64 - (u_option u_member_info) - u_attribs + (u_option u_member_info) + u_attribs (u_option u_ValReprInfo) u_string u_access u_parentref - (u_option u_const) + (u_option u_const) (u_used_space1 u_xmldoc) st { val_logical_name = x1 - val_range = (match x1a with None -> range0 | Some(a,_) -> a) + val_range = (match x1a with None -> range0 | Some(a, _) -> a) val_type = x2 val_stamp = newStamp() val_flags = ValFlags(x4) val_opt_data = match x1z, x1a, x10, x14, x13, x15, x8, x13b, x12, x9 with | None, None, None, None, TAccess [], None, None, ParentNone, "", [] -> None - | _ -> + | _ -> Some { val_compiled_name = x1z - val_other_range = (match x1a with None -> None | Some(_,b) -> Some(b,true)) + val_other_range = (match x1a with None -> None | Some(_, b) -> Some(b, true)) val_defn = None val_repr_info = x10 val_const = x14 @@ -2299,24 +2299,24 @@ and u_ValData st = val_attribs = x9 } } -and u_Val st = u_osgn_decl st.ivals u_ValData st +and u_Val st = u_osgn_decl st.ivals u_ValData st -and u_modul_typ st = - let x1,x3,x5 = +and u_modul_typ st = + let x1, x3, x5 = u_tup3 u_istype (u_qlist u_Val) (u_qlist u_entity_spec) st - ModuleOrNamespaceType(x1,x3,x5) + ModuleOrNamespaceType(x1, x3, x5) //--------------------------------------------------------------------------- // Pickle/unpickle for F# expressions (for optimization data) //--------------------------------------------------------------------------- -and p_const x st = - match x with +and p_const x st = + match x with | Const.Bool x -> p_byte 0 st; p_bool x st | Const.SByte x -> p_byte 1 st; p_int8 x st | Const.Byte x -> p_byte 2 st; p_uint8 x st @@ -2336,131 +2336,131 @@ and p_const x st = | Const.Zero -> p_byte 16 st | Const.Decimal s -> p_byte 17 st; p_array p_int32 (System.Decimal.GetBits(s)) st -and u_const st = +and u_const st = let tag = u_byte st match tag with - | 0 -> u_bool st |> Const.Bool - | 1 -> u_int8 st |> Const.SByte - | 2 -> u_uint8 st |> Const.Byte - | 3 -> u_int16 st |> Const.Int16 - | 4 -> u_uint16 st |> Const.UInt16 - | 5 -> u_int32 st |> Const.Int32 - | 6 -> u_uint32 st |> Const.UInt32 + | 0 -> u_bool st |> Const.Bool + | 1 -> u_int8 st |> Const.SByte + | 2 -> u_uint8 st |> Const.Byte + | 3 -> u_int16 st |> Const.Int16 + | 4 -> u_uint16 st |> Const.UInt16 + | 5 -> u_int32 st |> Const.Int32 + | 6 -> u_uint32 st |> Const.UInt32 | 7 -> u_int64 st |> Const.Int64 | 8 -> u_uint64 st |> Const.UInt64 | 9 -> u_int64 st |> Const.IntPtr | 10 -> u_uint64 st |> Const.UIntPtr | 11 -> u_single st |> Const.Single | 12 -> u_int64 st |> float_of_bits |> Const.Double - | 13 -> u_char st |> Const.Char + | 13 -> u_char st |> Const.Char | 14 -> u_string st |> Const.String | 15 -> Const.Unit | 16 -> Const.Zero | 17 -> u_array u_int32 st |> (fun bits -> Const.Decimal (new System.Decimal(bits))) - | _ -> ufailwith st "u_const" + | _ -> ufailwith st "u_const" -and p_dtree x st = - match x with - | TDSwitch (a,b,c,d) -> p_byte 0 st; p_tup4 p_expr (p_list p_dtree_case) (p_option p_dtree) p_dummy_range (a,b,c,d) st - | TDSuccess (a,b) -> p_byte 1 st; p_tup2 p_Exprs p_int (a,b) st - | TDBind (a,b) -> p_byte 2 st; p_tup2 p_bind p_dtree (a,b) st +and p_dtree x st = + match x with + | TDSwitch (a, b, c, d) -> p_byte 0 st; p_tup4 p_expr (p_list p_dtree_case) (p_option p_dtree) p_dummy_range (a, b, c, d) st + | TDSuccess (a, b) -> p_byte 1 st; p_tup2 p_Exprs p_int (a, b) st + | TDBind (a, b) -> p_byte 2 st; p_tup2 p_bind p_dtree (a, b) st -and p_dtree_case (TCase(a,b)) st = p_tup2 p_dtree_discrim p_dtree (a,b) st +and p_dtree_case (TCase(a, b)) st = p_tup2 p_dtree_discrim p_dtree (a, b) st -and p_dtree_discrim x st = - match x with - | DecisionTreeTest.UnionCase (ucref,tinst) -> p_byte 0 st; p_tup2 p_ucref p_tys (ucref,tinst) st +and p_dtree_discrim x st = + match x with + | DecisionTreeTest.UnionCase (ucref, tinst) -> p_byte 0 st; p_tup2 p_ucref p_tys (ucref, tinst) st | DecisionTreeTest.Const c -> p_byte 1 st; p_const c st | DecisionTreeTest.IsNull -> p_byte 2 st - | DecisionTreeTest.IsInst (srcty,tgty) -> p_byte 3 st; p_ty srcty st; p_ty tgty st - | DecisionTreeTest.ArrayLength (n,ty) -> p_byte 4 st; p_tup2 p_int p_ty (n,ty) st + | DecisionTreeTest.IsInst (srcty, tgty) -> p_byte 3 st; p_ty srcty st; p_ty tgty st + | DecisionTreeTest.ArrayLength (n, ty) -> p_byte 4 st; p_tup2 p_int p_ty (n, ty) st | DecisionTreeTest.ActivePatternCase _ -> pfailwith st "DecisionTreeTest.ActivePatternCase: only used during pattern match compilation" -and p_target (TTarget(a,b,_)) st = p_tup2 p_Vals p_expr (a,b) st -and p_bind (TBind(a,b,_)) st = p_tup2 p_Val p_expr (a,b) st +and p_target (TTarget(a, b, _)) st = p_tup2 p_Vals p_expr (a, b) st +and p_bind (TBind(a, b, _)) st = p_tup2 p_Val p_expr (a, b) st and p_lval_op_kind x st = p_byte (match x with LAddrOf _ -> 0 | LByrefGet -> 1 | LSet -> 2 | LByrefSet -> 3) st -and p_recdInfo x st = - match x with +and p_recdInfo x st = + match x with | RecdExpr -> () | RecdExprIsObjInit -> pfailwith st "explicit object constructors can't be inlined and should not have optimization information" -and u_dtree st = +and u_dtree st = let tag = u_byte st match tag with - | 0 -> u_tup4 u_expr (u_list u_dtree_case) (u_option u_dtree) u_dummy_range st |> TDSwitch + | 0 -> u_tup4 u_expr (u_list u_dtree_case) (u_option u_dtree) u_dummy_range st |> TDSwitch | 1 -> u_tup2 u_Exprs u_int st |> TDSuccess | 2 -> u_tup2 u_bind u_dtree st |> TDBind - | _ -> ufailwith st "u_dtree" + | _ -> ufailwith st "u_dtree" -and u_dtree_case st = let a,b = u_tup2 u_dtree_discrim u_dtree st in (TCase(a,b)) +and u_dtree_case st = let a, b = u_tup2 u_dtree_discrim u_dtree st in (TCase(a, b)) -and u_dtree_discrim st = +and u_dtree_discrim st = let tag = u_byte st match tag with - | 0 -> u_tup2 u_ucref u_tys st |> DecisionTreeTest.UnionCase - | 1 -> u_const st |> DecisionTreeTest.Const - | 2 -> DecisionTreeTest.IsNull + | 0 -> u_tup2 u_ucref u_tys st |> DecisionTreeTest.UnionCase + | 1 -> u_const st |> DecisionTreeTest.Const + | 2 -> DecisionTreeTest.IsNull | 3 -> u_tup2 u_ty u_ty st |> DecisionTreeTest.IsInst | 4 -> u_tup2 u_int u_ty st |> DecisionTreeTest.ArrayLength - | _ -> ufailwith st "u_dtree_discrim" + | _ -> ufailwith st "u_dtree_discrim" -and u_target st = let a,b = u_tup2 u_Vals u_expr st in (TTarget(a,b,SuppressSequencePointAtTarget)) +and u_target st = let a, b = u_tup2 u_Vals u_expr st in (TTarget(a, b, SuppressSequencePointAtTarget)) -and u_bind st = let a = u_Val st in let b = u_expr st in TBind(a,b,NoSequencePointAtStickyBinding) +and u_bind st = let a = u_Val st in let b = u_expr st in TBind(a, b, NoSequencePointAtStickyBinding) and u_lval_op_kind st = - match u_byte st with + match u_byte st with | 0 -> LAddrOf false - | 1 -> LByrefGet - | 2 -> LSet - | 3 -> LByrefSet + | 1 -> LByrefGet + | 2 -> LSet + | 3 -> LByrefSet | _ -> ufailwith st "uval_op_kind" - -and p_op x st = - match x with + +and p_op x st = + match x with | TOp.UnionCase c -> p_byte 0 st; p_ucref c st | TOp.ExnConstr c -> p_byte 1 st; p_tcref "op" c st - | TOp.Tuple tupInfo -> - if evalTupInfoIsStruct tupInfo then + | TOp.Tuple tupInfo -> + if evalTupInfoIsStruct tupInfo then p_byte 29 st - else + else p_byte 2 st - | TOp.Recd (a,b) -> p_byte 3 st; p_tup2 p_recdInfo (p_tcref "recd op") (a,b) st + | TOp.Recd (a, b) -> p_byte 3 st; p_tup2 p_recdInfo (p_tcref "recd op") (a, b) st | TOp.ValFieldSet (a) -> p_byte 4 st; p_rfref a st | TOp.ValFieldGet (a) -> p_byte 5 st; p_rfref a st | TOp.UnionCaseTagGet (a) -> p_byte 6 st; p_tcref "cnstr op" a st - | TOp.UnionCaseFieldGet (a,b) -> p_byte 7 st; p_tup2 p_ucref p_int (a,b) st - | TOp.UnionCaseFieldSet (a,b) -> p_byte 8 st; p_tup2 p_ucref p_int (a,b) st - | TOp.ExnFieldGet (a,b) -> p_byte 9 st; p_tup2 (p_tcref "exn op") p_int (a,b) st - | TOp.ExnFieldSet (a,b) -> p_byte 10 st; p_tup2 (p_tcref "exn op") p_int (a,b) st - | TOp.TupleFieldGet (tupInfo,a) -> - if evalTupInfoIsStruct tupInfo then + | TOp.UnionCaseFieldGet (a, b) -> p_byte 7 st; p_tup2 p_ucref p_int (a, b) st + | TOp.UnionCaseFieldSet (a, b) -> p_byte 8 st; p_tup2 p_ucref p_int (a, b) st + | TOp.ExnFieldGet (a, b) -> p_byte 9 st; p_tup2 (p_tcref "exn op") p_int (a, b) st + | TOp.ExnFieldSet (a, b) -> p_byte 10 st; p_tup2 (p_tcref "exn op") p_int (a, b) st + | TOp.TupleFieldGet (tupInfo, a) -> + if evalTupInfoIsStruct tupInfo then p_byte 30 st; p_int a st - else + else p_byte 11 st; p_int a st - | TOp.ILAsm (a,b) -> p_byte 12 st; p_tup2 (p_list p_ILInstr) p_tys (a,b) st + | TOp.ILAsm (a, b) -> p_byte 12 st; p_tup2 (p_list p_ILInstr) p_tys (a, b) st | TOp.RefAddrGet _ -> p_byte 13 st | TOp.UnionCaseProof (a) -> p_byte 14 st; p_ucref a st | TOp.Coerce -> p_byte 15 st | TOp.TraitCall (b) -> p_byte 16 st; p_trait b st - | TOp.LValueOp (a,b) -> p_byte 17 st; p_tup2 p_lval_op_kind (p_vref "lval") (a,b) st - | TOp.ILCall (a1,a2,a3,a4,a5,a7,a8,a9,b,c,d) - -> p_byte 18 st; p_tup11 p_bool p_bool p_bool p_bool p_vrefFlags p_bool p_bool p_ILMethodRef p_tys p_tys p_tys (a1,a2,a3,a4,a5,a7,a8,a9,b,c,d) st + | TOp.LValueOp (a, b) -> p_byte 17 st; p_tup2 p_lval_op_kind (p_vref "lval") (a, b) st + | TOp.ILCall (a1, a2, a3, a4, a5, a7, a8, a9, b, c, d) + -> p_byte 18 st; p_tup11 p_bool p_bool p_bool p_bool p_vrefFlags p_bool p_bool p_ILMethodRef p_tys p_tys p_tys (a1, a2, a3, a4, a5, a7, a8, a9, b, c, d) st | TOp.Array -> p_byte 19 st | TOp.While _ -> p_byte 20 st - | TOp.For(_,dir) -> p_byte 21 st; p_int (match dir with FSharpForLoopUp -> 0 | CSharpForLoopUp -> 1 | FSharpForLoopDown -> 2) st + | TOp.For(_, dir) -> p_byte 21 st; p_int (match dir with FSharpForLoopUp -> 0 | CSharpForLoopUp -> 1 | FSharpForLoopDown -> 2) st | TOp.Bytes bytes -> p_byte 22 st; p_bytes bytes st | TOp.TryCatch _ -> p_byte 23 st | TOp.TryFinally _ -> p_byte 24 st | TOp.ValFieldGetAddr (a, _) -> p_byte 25 st; p_rfref a st | TOp.UInt16s arr -> p_byte 26 st; p_array p_uint16 arr st | TOp.Reraise -> p_byte 27 st - | TOp.UnionCaseFieldGetAddr (a,b, _) -> p_byte 28 st; p_tup2 p_ucref p_int (a,b) st + | TOp.UnionCaseFieldGetAddr (a, b, _) -> p_byte 28 st; p_tup2 p_ucref p_int (a, b) st // Note tag byte 29 is taken for struct tuples, see above // Note tag byte 30 is taken for struct tuples, see above (* 29: TOp.Tuple when evalTupInfoIsStruct tupInfo = true *) @@ -2469,7 +2469,7 @@ and p_op x st = | TOp.AnonRecdGet (info, n) -> p_byte 32 st; p_anonInfo info st; p_int n st | TOp.Goto _ | TOp.Label _ | TOp.Return -> failwith "unexpected backend construct in pickled TAST" -and u_op st = +and u_op st = let tag = u_byte st match tag with | 0 -> let a = u_ucref st @@ -2478,191 +2478,191 @@ and u_op st = TOp.ExnConstr a | 2 -> TOp.Tuple tupInfoRef | 3 -> let b = u_tcref st - TOp.Recd (RecdExpr,b) + TOp.Recd (RecdExpr, b) | 4 -> let a = u_rfref st - TOp.ValFieldSet a + TOp.ValFieldSet a | 5 -> let a = u_rfref st - TOp.ValFieldGet a + TOp.ValFieldGet a | 6 -> let a = u_tcref st - TOp.UnionCaseTagGet a + TOp.UnionCaseTagGet a | 7 -> let a = u_ucref st let b = u_int st - TOp.UnionCaseFieldGet (a,b) + TOp.UnionCaseFieldGet (a, b) | 8 -> let a = u_ucref st let b = u_int st - TOp.UnionCaseFieldSet (a,b) + TOp.UnionCaseFieldSet (a, b) | 9 -> let a = u_tcref st let b = u_int st - TOp.ExnFieldGet (a,b) + TOp.ExnFieldGet (a, b) | 10 -> let a = u_tcref st let b = u_int st - TOp.ExnFieldSet (a,b) + TOp.ExnFieldSet (a, b) | 11 -> let a = u_int st - TOp.TupleFieldGet (tupInfoRef, a) + TOp.TupleFieldGet (tupInfoRef, a) | 12 -> let a = (u_list u_ILInstr) st let b = u_tys st - TOp.ILAsm (a,b) + TOp.ILAsm (a, b) | 13 -> TOp.RefAddrGet false // ok to set the 'readonly' flag on these operands to false on re-read since the flag is only used for typechecking purposes | 14 -> let a = u_ucref st - TOp.UnionCaseProof a + TOp.UnionCaseProof a | 15 -> TOp.Coerce | 16 -> let a = u_trait st TOp.TraitCall a | 17 -> let a = u_lval_op_kind st let b = u_vref st - TOp.LValueOp (a,b) - | 18 -> let (a1,a2,a3,a4,a5,a7,a8,a9) = (u_tup8 u_bool u_bool u_bool u_bool u_vrefFlags u_bool u_bool u_ILMethodRef) st + TOp.LValueOp (a, b) + | 18 -> let (a1, a2, a3, a4, a5, a7, a8, a9) = (u_tup8 u_bool u_bool u_bool u_bool u_vrefFlags u_bool u_bool u_ILMethodRef) st let b = u_tys st let c = u_tys st let d = u_tys st - TOp.ILCall (a1,a2,a3,a4,a5,a7,a8,a9,b,c,d) + TOp.ILCall (a1, a2, a3, a4, a5, a7, a8, a9, b, c, d) | 19 -> TOp.Array | 20 -> TOp.While (NoSequencePointAtWhileLoop, NoSpecialWhileLoopMarker) | 21 -> let dir = match u_int st with 0 -> FSharpForLoopUp | 1 -> CSharpForLoopUp | 2 -> FSharpForLoopDown | _ -> failwith "unknown for loop" TOp.For (NoSequencePointAtForLoop, dir) | 22 -> TOp.Bytes (u_bytes st) - | 23 -> TOp.TryCatch(NoSequencePointAtTry,NoSequencePointAtWith) - | 24 -> TOp.TryFinally(NoSequencePointAtTry,NoSequencePointAtFinally) + | 23 -> TOp.TryCatch(NoSequencePointAtTry, NoSequencePointAtWith) + | 24 -> TOp.TryFinally(NoSequencePointAtTry, NoSequencePointAtFinally) | 25 -> let a = u_rfref st TOp.ValFieldGetAddr (a, false) | 26 -> TOp.UInt16s (u_array u_uint16 st) | 27 -> TOp.Reraise | 28 -> let a = u_ucref st let b = u_int st - TOp.UnionCaseFieldGetAddr (a,b, false) + TOp.UnionCaseFieldGetAddr (a, b, false) | 29 -> TOp.Tuple tupInfoStruct | 30 -> let a = u_int st - TOp.TupleFieldGet (tupInfoStruct, a) - | 31 -> let info = u_anonInfo st - TOp.AnonRecd (info) - | 32 -> let info = u_anonInfo st - let n = u_int st - TOp.AnonRecdGet (info, n) - | _ -> ufailwith st "u_op" - -and p_expr expr st = - match expr with + TOp.TupleFieldGet (tupInfoStruct, a) + | 31 -> let info = u_anonInfo st + TOp.AnonRecd (info) + | 32 -> let info = u_anonInfo st + let n = u_int st + TOp.AnonRecdGet (info, n) + | _ -> ufailwith st "u_op" + +and p_expr expr st = + match expr with | Expr.Link e -> p_expr !e st - | Expr.Const (x,m,ty) -> p_byte 0 st; p_tup3 p_const p_dummy_range p_ty (x,m,ty) st - | Expr.Val (a,b,m) -> p_byte 1 st; p_tup3 (p_vref "val") p_vrefFlags p_dummy_range (a,b,m) st - | Expr.Op(a,b,c,d) -> p_byte 2 st; p_tup4 p_op p_tys p_Exprs p_dummy_range (a,b,c,d) st - | Expr.Sequential (a,b,c,_,d) -> p_byte 3 st; p_tup4 p_expr p_expr p_int p_dummy_range (a,b,(match c with NormalSeq -> 0 | ThenDoSeq -> 1),d) st - | Expr.Lambda (_,a1,b0,b1,c,d,e) -> p_byte 4 st; p_tup6 (p_option p_Val) (p_option p_Val) p_Vals p_expr p_dummy_range p_ty (a1,b0,b1,c,d,e) st - | Expr.TyLambda (_,b,c,d,e) -> p_byte 5 st; p_tup4 p_tyar_specs p_expr p_dummy_range p_ty (b,c,d,e) st - | Expr.App (a1,a2,b,c,d) -> p_byte 6 st; p_tup5 p_expr p_ty p_tys p_Exprs p_dummy_range (a1,a2,b,c,d) st - | Expr.LetRec (a,b,c,_) -> p_byte 7 st; p_tup3 p_binds p_expr p_dummy_range (a,b,c) st - | Expr.Let (a,b,c,_) -> p_byte 8 st; p_tup3 p_bind p_expr p_dummy_range (a,b,c) st - | Expr.Match (_,a,b,c,d,e) -> p_byte 9 st; p_tup5 p_dummy_range p_dtree p_targets p_dummy_range p_ty (a,b,c,d,e) st - | Expr.Obj(_,b,c,d,e,f,g) -> p_byte 10 st; p_tup6 p_ty (p_option p_Val) p_expr p_methods p_intfs p_dummy_range (b,c,d,e,f,g) st - | Expr.StaticOptimization(a,b,c,d) -> p_byte 11 st; p_tup4 p_constraints p_expr p_expr p_dummy_range (a,b,c,d) st - | Expr.TyChoose (a,b,c) -> p_byte 12 st; p_tup3 p_tyar_specs p_expr p_dummy_range (a,b,c) st - | Expr.Quote(ast,_,_,m,ty) -> p_byte 13 st; p_tup3 p_expr p_dummy_range p_ty (ast,m,ty) st - -and u_expr st = + | Expr.Const (x, m, ty) -> p_byte 0 st; p_tup3 p_const p_dummy_range p_ty (x, m, ty) st + | Expr.Val (a, b, m) -> p_byte 1 st; p_tup3 (p_vref "val") p_vrefFlags p_dummy_range (a, b, m) st + | Expr.Op(a, b, c, d) -> p_byte 2 st; p_tup4 p_op p_tys p_Exprs p_dummy_range (a, b, c, d) st + | Expr.Sequential (a, b, c, _, d) -> p_byte 3 st; p_tup4 p_expr p_expr p_int p_dummy_range (a, b, (match c with NormalSeq -> 0 | ThenDoSeq -> 1), d) st + | Expr.Lambda (_, a1, b0, b1, c, d, e) -> p_byte 4 st; p_tup6 (p_option p_Val) (p_option p_Val) p_Vals p_expr p_dummy_range p_ty (a1, b0, b1, c, d, e) st + | Expr.TyLambda (_, b, c, d, e) -> p_byte 5 st; p_tup4 p_tyar_specs p_expr p_dummy_range p_ty (b, c, d, e) st + | Expr.App (a1, a2, b, c, d) -> p_byte 6 st; p_tup5 p_expr p_ty p_tys p_Exprs p_dummy_range (a1, a2, b, c, d) st + | Expr.LetRec (a, b, c, _) -> p_byte 7 st; p_tup3 p_binds p_expr p_dummy_range (a, b, c) st + | Expr.Let (a, b, c, _) -> p_byte 8 st; p_tup3 p_bind p_expr p_dummy_range (a, b, c) st + | Expr.Match (_, a, b, c, d, e) -> p_byte 9 st; p_tup5 p_dummy_range p_dtree p_targets p_dummy_range p_ty (a, b, c, d, e) st + | Expr.Obj(_, b, c, d, e, f, g) -> p_byte 10 st; p_tup6 p_ty (p_option p_Val) p_expr p_methods p_intfs p_dummy_range (b, c, d, e, f, g) st + | Expr.StaticOptimization(a, b, c, d) -> p_byte 11 st; p_tup4 p_constraints p_expr p_expr p_dummy_range (a, b, c, d) st + | Expr.TyChoose (a, b, c) -> p_byte 12 st; p_tup3 p_tyar_specs p_expr p_dummy_range (a, b, c) st + | Expr.Quote(ast, _, _, m, ty) -> p_byte 13 st; p_tup3 p_expr p_dummy_range p_ty (ast, m, ty) st + +and u_expr st = let tag = u_byte st match tag with | 0 -> let a = u_const st let b = u_dummy_range st let c = u_ty st - Expr.Const (a,b,c) + Expr.Const (a, b, c) | 1 -> let a = u_vref st let b = u_vrefFlags st let c = u_dummy_range st - Expr.Val (a,b,c) + Expr.Val (a, b, c) | 2 -> let a = u_op st let b = u_tys st let c = u_Exprs st let d = u_dummy_range st - Expr.Op (a,b,c,d) + Expr.Op (a, b, c, d) | 3 -> let a = u_expr st let b = u_expr st let c = u_int st let d = u_dummy_range st - Expr.Sequential (a,b,(match c with 0 -> NormalSeq | 1 -> ThenDoSeq | _ -> ufailwith st "specialSeqFlag"),SuppressSequencePointOnExprOfSequential,d) + Expr.Sequential (a, b, (match c with 0 -> NormalSeq | 1 -> ThenDoSeq | _ -> ufailwith st "specialSeqFlag"), SuppressSequencePointOnExprOfSequential, d) | 4 -> let a0 = u_option u_Val st let b0 = u_option u_Val st let b1 = u_Vals st let c = u_expr st let d = u_dummy_range st let e = u_ty st - Expr.Lambda (newUnique(),a0,b0,b1,c,d,e) + Expr.Lambda (newUnique(), a0, b0, b1, c, d, e) | 5 -> let b = u_tyar_specs st let c = u_expr st let d = u_dummy_range st let e = u_ty st - Expr.TyLambda (newUnique(),b,c,d,e) + Expr.TyLambda (newUnique(), b, c, d, e) | 6 -> let a1 = u_expr st let a2 = u_ty st let b = u_tys st let c = u_Exprs st let d = u_dummy_range st - Expr.App (a1,a2,b,c,d) + Expr.App (a1, a2, b, c, d) | 7 -> let a = u_binds st let b = u_expr st let c = u_dummy_range st - Expr.LetRec (a,b,c,NewFreeVarsCache()) + Expr.LetRec (a, b, c, NewFreeVarsCache()) | 8 -> let a = u_bind st let b = u_expr st let c = u_dummy_range st - Expr.Let (a,b,c,NewFreeVarsCache()) + Expr.Let (a, b, c, NewFreeVarsCache()) | 9 -> let a = u_dummy_range st let b = u_dtree st let c = u_targets st let d = u_dummy_range st let e = u_ty st - Expr.Match (NoSequencePointAtStickyBinding,a,b,c,d,e) + Expr.Match (NoSequencePointAtStickyBinding, a, b, c, d, e) | 10 -> let b = u_ty st let c = (u_option u_Val) st let d = u_expr st let e = u_methods st let f = u_intfs st let g = u_dummy_range st - Expr.Obj (newUnique(),b,c,d,e,f,g) + Expr.Obj (newUnique(), b, c, d, e, f, g) | 11 -> let a = u_constraints st let b = u_expr st let c = u_expr st let d = u_dummy_range st - Expr.StaticOptimization (a,b,c,d) + Expr.StaticOptimization (a, b, c, d) | 12 -> let a = u_tyar_specs st let b = u_expr st let c = u_dummy_range st - Expr.TyChoose (a,b,c) + Expr.TyChoose (a, b, c) | 13 -> let b = u_expr st let c = u_dummy_range st let d = u_ty st - Expr.Quote (b,ref None,false,c,d) // isFromQueryExpression=false - | _ -> ufailwith st "u_expr" + Expr.Quote (b, ref None, false, c, d) // isFromQueryExpression=false + | _ -> ufailwith st "u_expr" -and p_static_optimization_constraint x st = +and p_static_optimization_constraint x st = match x with - | TTyconEqualsTycon (a,b) -> p_byte 0 st; p_tup2 p_ty p_ty (a,b) st + | TTyconEqualsTycon (a, b) -> p_byte 0 st; p_tup2 p_ty p_ty (a, b) st | TTyconIsStruct(a) -> p_byte 1 st; p_ty a st -and p_slotparam (TSlotParam (a,b,c,d,e,f)) st = p_tup6 (p_option p_string) p_ty p_bool p_bool p_bool p_attribs (a,b,c,d,e,f) st -and p_slotsig (TSlotSig (a,b,c,d,e,f)) st = p_tup6 p_string p_ty p_tyar_specs p_tyar_specs (p_list (p_list p_slotparam)) (p_option p_ty) (a,b,c,d,e,f) st -and p_method (TObjExprMethod (a,b,c,d,e,f)) st = p_tup6 p_slotsig p_attribs p_tyar_specs (p_list p_Vals) p_expr p_dummy_range (a,b,c,d,e,f) st +and p_slotparam (TSlotParam (a, b, c, d, e, f)) st = p_tup6 (p_option p_string) p_ty p_bool p_bool p_bool p_attribs (a, b, c, d, e, f) st +and p_slotsig (TSlotSig (a, b, c, d, e, f)) st = p_tup6 p_string p_ty p_tyar_specs p_tyar_specs (p_list (p_list p_slotparam)) (p_option p_ty) (a, b, c, d, e, f) st +and p_method (TObjExprMethod (a, b, c, d, e, f)) st = p_tup6 p_slotsig p_attribs p_tyar_specs (p_list p_Vals) p_expr p_dummy_range (a, b, c, d, e, f) st and p_methods x st = p_list p_method x st and p_intf x st = p_tup2 p_ty p_methods x st and p_intfs x st = p_list p_intf x st -and u_static_optimization_constraint st = +and u_static_optimization_constraint st = let tag = u_byte st match tag with | 0 -> u_tup2 u_ty u_ty st |> TTyconEqualsTycon | 1 -> u_ty st |> TTyconIsStruct - | _ -> ufailwith st "u_static_optimization_constraint" + | _ -> ufailwith st "u_static_optimization_constraint" -and u_slotparam st = - let a,b,c,d,e,f = u_tup6 (u_option u_string) u_ty u_bool u_bool u_bool u_attribs st - TSlotParam(a,b,c,d,e,f) +and u_slotparam st = + let a, b, c, d, e, f = u_tup6 (u_option u_string) u_ty u_bool u_bool u_bool u_attribs st + TSlotParam(a, b, c, d, e, f) -and u_slotsig st = - let a,b,c,d,e,f = u_tup6 u_string u_ty u_tyar_specs u_tyar_specs (u_list (u_list u_slotparam)) (u_option u_ty) st - TSlotSig(a,b,c,d,e,f) +and u_slotsig st = + let a, b, c, d, e, f = u_tup6 u_string u_ty u_tyar_specs u_tyar_specs (u_list (u_list u_slotparam)) (u_option u_ty) st + TSlotSig(a, b, c, d, e, f) -and u_method st = - let a,b,c,d,e,f = u_tup6 u_slotsig u_attribs u_tyar_specs (u_list u_Vals) u_expr u_dummy_range st - TObjExprMethod(a,b,c,d,e,f) +and u_method st = + let a, b, c, d, e, f = u_tup6 u_slotsig u_attribs u_tyar_specs (u_list u_Vals) u_expr u_dummy_range st + TObjExprMethod(a, b, c, d, e, f) and u_methods st = u_list u_method st @@ -2688,16 +2688,16 @@ let _ = fill_u_attribs (u_list u_attrib) let _ = fill_u_Vals (u_list u_Val) //--------------------------------------------------------------------------- -// Pickle/unpickle F# interface data +// Pickle/unpickle F# interface data //--------------------------------------------------------------------------- let pickleModuleOrNamespace mspec st = p_entity_spec mspec st -let pickleCcuInfo (minfo: PickledCcuInfo) st = - p_tup4 pickleModuleOrNamespace p_string p_bool (p_space 3) (minfo.mspec, minfo.compileTimeWorkingDir, minfo.usesQuotations,()) st +let pickleCcuInfo (minfo: PickledCcuInfo) st = + p_tup4 pickleModuleOrNamespace p_string p_bool (p_space 3) (minfo.mspec, minfo.compileTimeWorkingDir, minfo.usesQuotations, ()) st + +let unpickleModuleOrNamespace st = u_entity_spec st -let unpickleModuleOrNamespace st = u_entity_spec st - -let unpickleCcuInfo st = - let a,b,c,_space = u_tup4 unpickleModuleOrNamespace u_string u_bool (u_space 3) st +let unpickleCcuInfo st = + let a, b, c, _space = u_tup4 unpickleModuleOrNamespace u_string u_bool (u_space 3) st { mspec=a; compileTimeWorkingDir=b; usesQuotations=c } diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 5649c0025e50538ccd808ba86e3078598620254a..9364dbb638a82396c6ee8a47d4c3a0f5afd85a41 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -2861,7 +2861,7 @@ let LightweightTcValForUsingInBuildMethodCall g (vref:ValRef) vrefFlags (vrefTyp let tau = // If we have got an explicit instantiation then use that let _, tps, tptys, tau = FreshenPossibleForallTy g m TyparRigidity.Flexible vty - if tptys.Length <> vrefTypeInst.Length then error(Error(FSComp.SR.tcTypeParameterArityMismatch(tps.Length, vrefTypeInst.Length), m)); + if tptys.Length <> vrefTypeInst.Length then error(Error(FSComp.SR.tcTypeParameterArityMismatch(tps.Length, vrefTypeInst.Length), m)) instType (mkTyparInst tps vrefTypeInst) tau let exprForVal = Expr.Val (vref, vrefFlags, m) @@ -2959,7 +2959,7 @@ let MakeApplicableExprWithFlex cenv (env: TcEnv) expr = then actualType else let flexibleType = NewInferenceType () - AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace actualType flexibleType; + AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace actualType flexibleType flexibleType) // Create a coercion to represent the expansion of the application @@ -6048,32 +6048,8 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = UnifyTypes cenv env m overallTy cenv.g.unit_ty TcStmtThatCantBeCtorBody cenv env tpenv synInnerExpr - | SynExpr.IfThenElse (synBoolExpr, synThenExpr, synElseExprOpt, spIfToThen, isRecovery, mIfToThen, m) -> - let boolExpr, tpenv = TcExprThatCantBeCtorBody cenv cenv.g.bool_ty env tpenv synBoolExpr - let thenExpr, tpenv = - let env = - match env.eContextInfo with - | ContextInfo.ElseBranchResult _ -> { env with eContextInfo = ContextInfo.ElseBranchResult synThenExpr.Range } - | _ -> - match synElseExprOpt with - | None -> { env with eContextInfo = ContextInfo.OmittedElseBranch synThenExpr.Range } - | _ -> { env with eContextInfo = ContextInfo.IfExpression synThenExpr.Range } - - if not isRecovery && Option.isNone synElseExprOpt then - UnifyTypes cenv env m cenv.g.unit_ty overallTy - - TcExprThatCanBeCtorBody cenv overallTy env tpenv synThenExpr - - let elseExpr, spElse, tpenv = - match synElseExprOpt with - | None -> - mkUnit cenv.g mIfToThen, SuppressSequencePointAtTarget, tpenv // the fake 'unit' value gets exactly the same range as spIfToThen - | Some synElseExpr -> - let env = { env with eContextInfo = ContextInfo.ElseBranchResult synElseExpr.Range } - let elseExpr, tpenv = TcExprThatCanBeCtorBody cenv overallTy env tpenv synElseExpr - elseExpr, SequencePointAtTarget, tpenv - - primMkCond spIfToThen SequencePointAtTarget spElse m overallTy boolExpr thenExpr elseExpr, tpenv + | SynExpr.IfThenElse _ -> + TcLinearExprs (TcExprThatCanBeCtorBody cenv) cenv env overallTy tpenv false synExpr (fun x -> x) // This is for internal use in the libraries only | SynExpr.LibraryOnlyStaticOptimization (constraints, e2, e3, m) -> @@ -10446,6 +10422,7 @@ and TcLinearExprs bodyChecker cenv env overallTy tpenv isCompExpr expr cont = let e1', _ = TcStmtThatCantBeCtorBody cenv env tpenv e1 // tailcall let env = ShrinkContext env m e2.Range + // tailcall TcLinearExprs bodyChecker cenv env overallTy tpenv isCompExpr e2 (fun (e2', tpenv) -> cont (Expr.Sequential(e1', e2', NormalSeq, sp, m), tpenv)) @@ -10463,8 +10440,40 @@ and TcLinearExprs bodyChecker cenv env overallTy tpenv isCompExpr expr cont = // TcLinearExprs processes multiple 'let' bindings in a tail recursive way let mkf, envinner, tpenv = TcLetBinding cenv isUse env ExprContainerInfo ExpressionBinding tpenv (binds, m, body.Range) let envinner = ShrinkContext envinner m body.Range + // tailcall TcLinearExprs bodyChecker cenv envinner overallTy tpenv isCompExpr body (fun (x, tpenv) -> cont (fst (mkf (x, overallTy)), tpenv)) + + | SynExpr.IfThenElse (synBoolExpr, synThenExpr, synElseExprOpt, spIfToThen, isRecovery, mIfToThen, m) when not isCompExpr -> + let boolExpr, tpenv = TcExprThatCantBeCtorBody cenv cenv.g.bool_ty env tpenv synBoolExpr + let thenExpr, tpenv = + let env = + match env.eContextInfo with + | ContextInfo.ElseBranchResult _ -> { env with eContextInfo = ContextInfo.ElseBranchResult synThenExpr.Range } + | _ -> + match synElseExprOpt with + | None -> { env with eContextInfo = ContextInfo.OmittedElseBranch synThenExpr.Range } + | _ -> { env with eContextInfo = ContextInfo.IfExpression synThenExpr.Range } + + if not isRecovery && Option.isNone synElseExprOpt then + UnifyTypes cenv env m cenv.g.unit_ty overallTy + + TcExprThatCanBeCtorBody cenv overallTy env tpenv synThenExpr + + match synElseExprOpt with + | None -> + let elseExpr = mkUnit cenv.g mIfToThen + let spElse = SuppressSequencePointAtTarget // the fake 'unit' value gets exactly the same range as spIfToThen + let overallExpr = primMkCond spIfToThen SequencePointAtTarget spElse m overallTy boolExpr thenExpr elseExpr + cont (overallExpr, tpenv) + + | Some synElseExpr -> + let env = { env with eContextInfo = ContextInfo.ElseBranchResult synElseExpr.Range } + // tailcall + TcLinearExprs bodyChecker cenv env overallTy tpenv isCompExpr synElseExpr (fun (elseExpr, tpenv) -> + let resExpr = primMkCond spIfToThen SequencePointAtTarget SequencePointAtTarget m overallTy boolExpr thenExpr elseExpr + cont (resExpr, tpenv)) + | _ -> cont (bodyChecker overallTy env tpenv expr) diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index dec27798565bbc22086e218456458ca591289e41..0e0f7ca0d97c4a1db9fa2a22e370e07abf10e59d 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -45,7 +45,7 @@ type XmlDocCollector() = lazy (savedGrabPoints.ToArray() |> Array.sortWith posCompare) let savedLinesAsArray = - lazy (savedLines.ToArray() |> Array.sortWith (fun (_,p1) (_,p2) -> posCompare p1 p2)) + lazy (savedLines.ToArray() |> Array.sortWith (fun (_, p1) (_, p2) -> posCompare p1 p2)) let check() = assert (not savedLinesAsArray.IsValueCreated && "can't add more XmlDoc elements to XmlDocCollector after extracting first XmlDoc from the overall results" <> "") @@ -54,15 +54,15 @@ type XmlDocCollector() = check() savedGrabPoints.Add pos - member x.AddXmlDocLine(line,pos) = + member x.AddXmlDocLine(line, pos) = check() - savedLines.Add(line,pos) + savedLines.Add(line, pos) - member x.LinesBefore(grabPointPos) = + member x.LinesBefore(grabPointPos) = try let lines = savedLinesAsArray.Force() let grabPoints = savedGrabPointsAsArray.Force() - let firstLineIndexAfterGrabPoint = Array.findFirstIndexWhereTrue lines (fun (_,pos) -> posGeq pos grabPointPos) + let firstLineIndexAfterGrabPoint = Array.findFirstIndexWhereTrue lines (fun (_, pos) -> posGeq pos grabPointPos) let grabPointIndex = Array.findFirstIndexWhereTrue grabPoints (fun pos -> posGeq pos grabPointPos) assert (posEq grabPoints.[grabPointIndex] grabPointPos) let firstLineIndexAfterPrevGrabPoint = @@ -70,20 +70,20 @@ type XmlDocCollector() = 0 else let prevGrabPointPos = grabPoints.[grabPointIndex-1] - Array.findFirstIndexWhereTrue lines (fun (_,pos) -> posGeq pos prevGrabPointPos) + Array.findFirstIndexWhereTrue lines (fun (_, pos) -> posGeq pos prevGrabPointPos) //printfn "#lines = %d, firstLineIndexAfterPrevGrabPoint = %d, firstLineIndexAfterGrabPoint = %d" lines.Length firstLineIndexAfterPrevGrabPoint firstLineIndexAfterGrabPoint let lines = lines.[firstLineIndexAfterPrevGrabPoint..firstLineIndexAfterGrabPoint-1] |> Array.rev - if lines.Length = 0 then + if lines.Length = 0 then [| |] else let firstLineNumber = (snd lines.[0]).Line - lines + lines |> Array.mapi (fun i x -> firstLineNumber - i, x) |> Array.takeWhile (fun (sequencedLineNumber, (_, pos)) -> sequencedLineNumber = pos.Line) |> Array.map (fun (_, (lineStr, _)) -> lineStr) |> Array.rev - with e -> + with e -> //printfn "unexpected error in LinesBefore:\n%s" (e.ToString()) [| |] @@ -121,19 +121,19 @@ type PreXmlDoc = member x.ToXmlDoc() = match x with - | PreXmlMerge(a,b) -> XmlDoc.Merge (a.ToXmlDoc()) (b.ToXmlDoc()) + | PreXmlMerge(a, b) -> XmlDoc.Merge (a.ToXmlDoc()) (b.ToXmlDoc()) | PreXmlDocEmpty -> XmlDoc.Empty - | PreXmlDoc (pos,collector) -> + | PreXmlDoc (pos, collector) -> let lines = collector.LinesBefore pos if lines.Length = 0 then XmlDoc.Empty else XmlDoc lines - static member CreateFromGrabPoint(collector:XmlDocCollector,grabPointPos) = + static member CreateFromGrabPoint(collector:XmlDocCollector, grabPointPos) = collector.AddGrabPoint grabPointPos - PreXmlDoc(grabPointPos,collector) + PreXmlDoc(grabPointPos, collector) static member Empty = PreXmlDocEmpty - static member Merge a b = PreXmlMerge (a,b) + static member Merge a b = PreXmlMerge (a, b) type ParserDetail = | Ok @@ -165,21 +165,21 @@ type LongIdentWithDots = member this.Range = match this with - | LongIdentWithDots([],_) -> failwith "rangeOfLidwd" - | LongIdentWithDots([id],[]) -> id.idRange - | LongIdentWithDots([id],[m]) -> unionRanges id.idRange m - | LongIdentWithDots(h::t,[]) -> unionRanges h.idRange (List.last t).idRange - | LongIdentWithDots(h::t,dotms) -> unionRanges h.idRange (List.last t).idRange |> unionRanges (List.last dotms) + | LongIdentWithDots([], _) -> failwith "rangeOfLidwd" + | LongIdentWithDots([id], []) -> id.idRange + | LongIdentWithDots([id], [m]) -> unionRanges id.idRange m + | LongIdentWithDots(h::t, []) -> unionRanges h.idRange (List.last t).idRange + | LongIdentWithDots(h::t, dotms) -> unionRanges h.idRange (List.last t).idRange |> unionRanges (List.last dotms) - member this.Lid = match this with LongIdentWithDots(lid,_) -> lid + member this.Lid = match this with LongIdentWithDots(lid, _) -> lid - member this.ThereIsAnExtraDotAtTheEnd = match this with LongIdentWithDots(lid,dots) -> lid.Length = dots.Length + member this.ThereIsAnExtraDotAtTheEnd = match this with LongIdentWithDots(lid, dots) -> lid.Length = dots.Length member this.RangeSansAnyExtraDot = match this with - | LongIdentWithDots([],_) -> failwith "rangeOfLidwd" - | LongIdentWithDots([id],_) -> id.idRange - | LongIdentWithDots(h::t,dotms) -> + | LongIdentWithDots([], _) -> failwith "rangeOfLidwd" + | LongIdentWithDots([id], _) -> id.idRange + | LongIdentWithDots(h::t, dotms) -> let nonExtraDots = if dotms.Length = t.Length then dotms else List.truncate t.Length dotms unionRanges h.idRange (List.last t).idRange |> unionRanges (List.last nonExtraDots) @@ -197,7 +197,7 @@ type SynTypar = with member this.Range = match this with - | Typar(id,_,_) -> + | Typar(id, _, _) -> id.idRange //------------------------------------------------------------------------ @@ -280,7 +280,7 @@ type member c.Range dflt = match c with - | SynConst.String (_,m0) | SynConst.Bytes (_,m0) -> m0 + | SynConst.String (_, m0) | SynConst.Bytes (_, m0) -> m0 | _ -> dflt and @@ -366,7 +366,7 @@ type SequencePointInfoForBinding = // Indicates the omission of a sequence point for a binding for a 'do expr' | NoSequencePointAtDoBinding - // Indicates the omission of a sequence point for a binding for a 'let e = expr' where + // Indicates the omission of a sequence point for a binding for a 'let e = expr' where // 'expr' has immediate control flow | NoSequencePointAtLetBinding @@ -386,7 +386,7 @@ type SequencePointInfoForBinding = // Don't drop sequence points when combining sequence points member x.Combine(y:SequencePointInfoForBinding) = - match x,y with + match x, y with | SequencePointAtBinding _ as g, _ -> g | _, (SequencePointAtBinding _ as g) -> g | _ -> x @@ -464,7 +464,7 @@ and /// F# syntax is 'typar : enum<'UnderlyingType> | WhereTyparIsEnum of genericName:SynTypar * SynType list * range:range - /// F# syntax is 'typar : delegate<'Args,unit> + /// F# syntax is 'typar : delegate<'Args, unit> | WhereTyparIsDelegate of genericName:SynTypar * SynType list * range:range and @@ -475,8 +475,8 @@ and | LongIdent of longDotId:LongIdentWithDots /// App(typeName, LESSm, typeArgs, commasm, GREATERm, isPostfix, m) /// - /// F# syntax : type or type type or (type,...,type) type - /// isPostfix: indicates a postfix type application e.g. "int list" or "(int,string) dict" + /// F# syntax : type or type type or (type, ..., type) type + /// isPostfix: indicates a postfix type application e.g. "int list" or "(int, string) dict" /// commasm: ranges for interstitial commas, these only matter for parsing/design-time tooling, the typechecker may munge/discard them | App of typeName:SynType * LESSrange:range option * typeArgs:SynType list * commaRanges:range list * GREATERrange:range option * isPostfix:bool * range:range /// LongIdentApp(typeName, longId, LESSm, tyArgs, commasm, GREATERm, wholem) @@ -556,13 +556,13 @@ and /// /// Paren(expr, leftParenRange, rightParenRange, wholeRangeIncludingParentheses) /// - /// Parenthesized expressions. Kept in AST to distinguish A.M((x,y)) - /// from A.M(x,y), among other things. + /// Parenthesized expressions. Kept in AST to distinguish A.M((x, y)) + /// from A.M(x, y), among other things. | Paren of expr:SynExpr * leftParenRange:range * rightParenRange:range option * range:range /// F# syntax: <@ expr @>, <@@ expr @@> /// - /// Quote(operator,isRaw,quotedSynExpr,isFromQueryExpression,m) + /// Quote(operator, isRaw, quotedSynExpr, isFromQueryExpression, m) | Quote of operator:SynExpr * isRaw:bool * quotedSynExpr:SynExpr * isFromQueryExpression:bool * range:range /// F# syntax: 1, 1.3, () etc. @@ -592,7 +592,7 @@ and /// The flag is true if known to be 'family' ('protected') scope | New of isProtected:bool * typeName:SynType * expr:SynExpr * range:range - /// SynExpr.ObjExpr(objTy,argOpt,binds,extraImpls,mNewExpr,mWholeExpr) + /// SynExpr.ObjExpr(objTy, argOpt, binds, extraImpls, mNewExpr, mWholeExpr) /// /// F# syntax: { new ... with ... } | ObjExpr of objType:SynType * argOptions:(SynExpr * Ident option) option * bindings:SynBinding list * extraImpls:SynInterfaceImpl list * newExprRange:range * range:range @@ -636,8 +636,8 @@ and /// App(exprAtomicFlag, isInfix, funcExpr, argExpr, m) /// - exprAtomicFlag: indicates if the application is syntactically atomic, e.g. f.[1] is atomic, but 'f x' is not - /// - isInfix is true for the first app of an infix operator, e.g. 1+2 becomes App(App(+,1),2), where the inner node is marked isInfix - /// (or more generally, for higher operator fixities, if App(x,y) is such that y comes before x in the source code, then the node is marked isInfix=true) + /// - isInfix is true for the first app of an infix operator, e.g. 1+2 becomes App(App(+, 1), 2), where the inner node is marked isInfix + /// (or more generally, for higher operator fixities, if App(x, y) is such that y comes before x in the source code, then the node is marked isInfix=true) /// /// F# syntax: f x | App of ExprAtomicFlag * isInfix:bool * funcExpr:SynExpr * argExpr:SynExpr * range:range @@ -645,7 +645,7 @@ and /// TypeApp(expr, mLessThan, types, mCommas, mGreaterThan, mTypeArgs, mWholeExpr) /// "mCommas" are the ranges for interstitial commas, these only matter for parsing/design-time tooling, the typechecker may munge/discard them /// - /// F# syntax: expr + /// F# syntax: expr | TypeApp of expr:SynExpr * LESSrange:range * typeNames:SynType list * commaRanges:range list * GREATERrange:range option * typeArgsRange:range * range:range /// LetOrUse(isRecursive, isUse, bindings, body, wholeRange) @@ -671,14 +671,14 @@ and /// F# syntax: expr; expr | Sequential of seqPoint:SequencePointInfoForSeq * isTrueSeq:bool * expr1:SynExpr * expr2:SynExpr * range:range - /// IfThenElse(exprGuard,exprThen,optionalExprElse,spIfToThen,isFromErrorRecovery,mIfToThen,mIfToEndOfLastBranch) + /// IfThenElse(exprGuard, exprThen, optionalExprElse, spIfToThen, isFromErrorRecovery, mIfToThen, mIfToEndOfLastBranch) /// /// F# syntax: if expr then expr /// F# syntax: if expr then expr else expr | IfThenElse of ifExpr:SynExpr * thenExpr:SynExpr * elseExpr:SynExpr option * spIfToThen:SequencePointInfoForBinding * isFromErrorRecovery:bool * ifToThenRange:range * range:range /// F# syntax: ident - /// Optimized representation, = SynExpr.LongIdent(false,[id],id.idRange) + /// Optimized representation, = SynExpr.LongIdent(false, [id], id.idRange) | Ident of Ident /// F# syntax: ident.ident...ident @@ -701,12 +701,12 @@ and /// F# syntax: expr <- expr | Set of SynExpr * SynExpr * range:range - /// F# syntax: expr.[expr,...,expr] + /// F# syntax: expr.[expr, ..., expr] | DotIndexedGet of SynExpr * SynIndexerArg list * range * range:range /// DotIndexedSet (objectExpr, indexExprs, valueExpr, rangeOfLeftOfSet, rangeOfDot, rangeOfWholeExpr) /// - /// F# syntax: expr.[expr,...,expr] <- expr + /// F# syntax: expr.[expr, ..., expr] <- expr | DotIndexedSet of objectExpr:SynExpr * indexExprs:SynIndexerArg list * valueExpr:SynExpr * leftOfSetRange:range * dotRange:range * range:range /// F# syntax: Type.Items(e1) <- e2 , rarely used named-property-setter notation, e.g. Foo.Bar.Chars(3) <- 'a' @@ -919,10 +919,10 @@ and | SynExpr.LetOrUseBang (range=m) | SynExpr.MatchBang (range=m) | SynExpr.DoBang (range=m) -> m - | SynExpr.DotGet (expr,_,lidwd,m) -> if lidwd.ThereIsAnExtraDotAtTheEnd then unionRanges expr.Range lidwd.RangeSansAnyExtraDot else m - | SynExpr.LongIdent (_,lidwd,_,_) -> lidwd.RangeSansAnyExtraDot - | SynExpr.DiscardAfterMissingQualificationAfterDot (expr,_) -> expr.Range - | SynExpr.Fixed (_,m) -> m + | SynExpr.DotGet (expr, _, lidwd, m) -> if lidwd.ThereIsAnExtraDotAtTheEnd then unionRanges expr.Range lidwd.RangeSansAnyExtraDot else m + | SynExpr.LongIdent (_, lidwd, _, _) -> lidwd.RangeSansAnyExtraDot + | SynExpr.DiscardAfterMissingQualificationAfterDot (expr, _) -> expr.Range + | SynExpr.Fixed (_, m) -> m | SynExpr.Ident id -> id.idRange /// Attempt to get the range of the first token or initial portion only - this is extremely ad-hoc, just a cheap way to improve a certain 'query custom operation' error range @@ -985,16 +985,16 @@ and | SynExpr.MatchBang (range=m) | SynExpr.DoBang (range=m) -> m // these are better than just .Range, and also commonly applicable inside queries - | SynExpr.Paren(_,m,_,_) -> m - | SynExpr.Sequential (_,_,e1,_,_) - | SynExpr.App (_,_,e1,_,_) -> + | SynExpr.Paren(_, m, _, _) -> m + | SynExpr.Sequential (_, _, e1, _, _) + | SynExpr.App (_, _, e1, _, _) -> e1.RangeOfFirstPortion - | SynExpr.ForEach (_,_,_,pat,_,_,r) -> + | SynExpr.ForEach (_, _, _, pat, _, _, r) -> let start = r.Start let e = (pat.Range : range).Start mkRange r.FileName start e | SynExpr.Ident id -> id.idRange - | SynExpr.Fixed (_,m) -> m + | SynExpr.Fixed (_, m) -> m and [] @@ -1004,9 +1004,9 @@ and | One of SynExpr - member x.Range = match x with Two (e1,e2) -> unionRanges e1.Range e2.Range | One e -> e.Range + member x.Range = match x with Two (e1, e2) -> unionRanges e1.Range e2.Range | One e -> e.Range - member x.Exprs = match x with Two (e1,e2) -> [e1;e2] | One e -> [e] + member x.Exprs = match x with Two (e1, e2) -> [e1;e2] | One e -> [e] and [] @@ -1049,7 +1049,7 @@ and and [] - /// Represents a simple set of variable bindings a, (a,b) or (a:Type,b:Type) at a lambda, + /// Represents a simple set of variable bindings a, (a, b) or (a:Type, b:Type) at a lambda, /// function definition or other binding point, after the elimination of pattern matching /// from the construct, e.g. after changing a "function pat1 -> rule1 | ..." to a /// "fun v -> match v with ..." @@ -1080,12 +1080,12 @@ and | Ands of SynPat list * range:range - | LongIdent of - longDotId:LongIdentWithDots * - Ident option * // holds additional ident for tooling + | LongIdent of + longDotId:LongIdentWithDots * + Ident option * // holds additional ident for tooling SynValTyparDecls option * // usually None: temporary used to parse "f<'a> x = x"*) - SynConstructorArgs * - accessibility:SynAccess option * + SynConstructorArgs * + accessibility:SynAccess option * range:range | Tuple of isStruct: bool * SynPat list * range:range @@ -1147,18 +1147,18 @@ and and [] SynMatchClause = - | Clause of SynPat * SynExpr option * SynExpr * range:range * SequencePointInfoForTarget + | Clause of SynPat * whenExpr: SynExpr option * SynExpr * range:range * SequencePointInfoForTarget member this.RangeOfGuardAndRhs = match this with - | Clause(_,eo,e,_,_) -> + | Clause(_, eo, e, _, _) -> match eo with | None -> e.Range | Some x -> unionRanges e.Range x.Range member this.Range = match this with - | Clause(_,eo,e,m,_) -> + | Clause(_, eo, e, m, _) -> match eo with | None -> unionRanges e.Range m | Some x -> unionRanges (unionRanges e.Range m) x.Range @@ -1172,7 +1172,7 @@ and ArgExpr: SynExpr - /// Target specifier, e.g. "assembly","module",etc. + /// Target specifier, e.g. "assembly", "module", etc. Target: Ident option /// Is this attribute being applied to a property getter or setter? @@ -1395,7 +1395,7 @@ and [] /// The untyped, unchecked syntax tree for a field declaration in a record or class SynField = - | Field of attrs:SynAttributes * isStatic:bool * Ident option * SynType * bool * xmlDoc:PreXmlDoc * accessibility:SynAccess option * range:range + | Field of attrs:SynAttributes * isStatic:bool * Ident option * SynType * isMutable: bool * xmlDoc:PreXmlDoc * accessibility:SynAccess option * range:range and [] @@ -1442,7 +1442,7 @@ and /// SynValInfo(curriedArgInfos, returnInfo) | SynValInfo of SynArgInfo list list * SynArgInfo - member x.ArgInfos = (let (SynValInfo(args,_)) = x in args) + member x.ArgInfos = (let (SynValInfo(args, _)) = x in args) /// The argument names and other metadata for a parameter for a member or function and @@ -1531,20 +1531,20 @@ and /// A feature that is not implemented | NestedType of typeDefn:SynTypeDefn * accessibility:SynAccess option * range:range - /// SynMemberDefn.AutoProperty (attribs,isStatic,id,tyOpt,propKind,memberFlags,xmlDoc,access,synExpr,mGetSet,mWholeAutoProp). + /// SynMemberDefn.AutoProperty (attribs, isStatic, id, tyOpt, propKind, memberFlags, xmlDoc, access, synExpr, mGetSet, mWholeAutoProp). /// /// F# syntax: 'member val X = expr' - | AutoProperty of - attribs:SynAttributes * - isStatic:bool * - ident:Ident * - typeOpt:SynType option * - propKind:MemberKind * - memberFlags:(MemberKind -> MemberFlags) * - xmlDoc:PreXmlDoc * - accessiblity:SynAccess option * - synExpr:SynExpr * - getSetRange:range option * + | AutoProperty of + attribs:SynAttributes * + isStatic:bool * + ident:Ident * + typeOpt:SynType option * + propKind:MemberKind * + memberFlags:(MemberKind -> MemberFlags) * + xmlDoc:PreXmlDoc * + accessiblity:SynAccess option * + synExpr:SynExpr * + getSetRange:range option * range:range member d.Range = @@ -1680,7 +1680,7 @@ type ParsedSigFile = // AST and parsing utilities. //---------------------------------------------------------------------- -let ident (s,r) = new Ident(s,r) +let ident (s, r) = new Ident(s, r) let textOfId (id:Ident) = id.idText let pathOfLid lid = List.map textOfId lid let arrPathOfLid lid = Array.ofList (pathOfLid lid) @@ -1699,7 +1699,7 @@ type ScopedPragma = // Note: this type may be extended in the future with optimization on/off switches etc. // These are the results of parsing + folding in the implicit file name -/// ImplFile(modname,isScript,qualName,hashDirectives,modules,isLastCompiland) +/// ImplFile(modname, isScript, qualName, hashDirectives, modules, isLastCompiland) /// QualifiedNameOfFile acts to fully-qualify module specifications and implementations, /// most importantly the ones that simply contribute fragments to a namespace (i.e. the ParsedSigFileFragment.NamespaceFragment case) @@ -1715,22 +1715,22 @@ type QualifiedNameOfFile = [] type ParsedImplFileInput = - | ParsedImplFileInput of - fileName : string * - isScript : bool * - qualifiedNameOfFile : QualifiedNameOfFile * - scopedPragmas : ScopedPragma list * - hashDirectives : ParsedHashDirective list * - modules : SynModuleOrNamespace list * + | ParsedImplFileInput of + fileName : string * + isScript : bool * + qualifiedNameOfFile : QualifiedNameOfFile * + scopedPragmas : ScopedPragma list * + hashDirectives : ParsedHashDirective list * + modules : SynModuleOrNamespace list * isLastCompiland: (bool * bool) [] type ParsedSigFileInput = - | ParsedSigFileInput of - fileName : string * - qualifiedNameOfFile : QualifiedNameOfFile * - scopedPragmas : ScopedPragma list * - hashDirectives : ParsedHashDirective list * + | ParsedSigFileInput of + fileName : string * + qualifiedNameOfFile : QualifiedNameOfFile * + scopedPragmas : ScopedPragma list * + hashDirectives : ParsedHashDirective list * modules : SynModuleOrNamespaceSig list [] @@ -1767,31 +1767,31 @@ type SynArgNameGenerator() = //----------------------------------------------------------------------- -let mkSynId m s = Ident(s,m) +let mkSynId m s = Ident(s, m) let pathToSynLid m p = List.map (mkSynId m) p let mkSynIdGet m n = SynExpr.Ident(mkSynId m n) let mkSynLidGet m path n = let lid = pathToSynLid m path @ [mkSynId m n] let dots = List.replicate (lid.Length - 1) m - SynExpr.LongIdent(false,LongIdentWithDots(lid,dots),None,m) + SynExpr.LongIdent(false, LongIdentWithDots(lid, dots), None, m) let mkSynIdGetWithAlt m id altInfo = match altInfo with | None -> SynExpr.Ident id - | _ -> SynExpr.LongIdent(false,LongIdentWithDots([id],[]),altInfo,m) + | _ -> SynExpr.LongIdent(false, LongIdentWithDots([id], []), altInfo, m) -let mkSynSimplePatVar isOpt id = SynSimplePat.Id (id,None,false,false,isOpt,id.idRange) -let mkSynCompGenSimplePatVar id = SynSimplePat.Id (id,None,true,false,false,id.idRange) +let mkSynSimplePatVar isOpt id = SynSimplePat.Id (id, None, false, false, isOpt, id.idRange) +let mkSynCompGenSimplePatVar id = SynSimplePat.Id (id, None, true, false, false, id.idRange) /// Match a long identifier, including the case for single identifiers which gets a more optimized node in the syntax tree. let (|LongOrSingleIdent|_|) inp = match inp with - | SynExpr.LongIdent(isOpt,lidwd,altId,_m) -> Some (isOpt,lidwd,altId,lidwd.RangeSansAnyExtraDot) - | SynExpr.Ident id -> Some (false,LongIdentWithDots([id],[]),None,id.idRange) + | SynExpr.LongIdent(isOpt, lidwd, altId, _m) -> Some (isOpt, lidwd, altId, lidwd.RangeSansAnyExtraDot) + | SynExpr.Ident id -> Some (false, LongIdentWithDots([id], []), None, id.idRange) | _ -> None let (|SingleIdent|_|) inp = match inp with - | SynExpr.LongIdent(false,LongIdentWithDots([id],_),None,_) -> Some id + | SynExpr.LongIdent(false, LongIdentWithDots([id], _), None, _) -> Some id | SynExpr.Ident id -> Some id | _ -> None @@ -1803,7 +1803,7 @@ let rec IsControlFlowExpression e = | SynExpr.LetOrUse _ | SynExpr.Sequential _ // Treat "ident { ... }" as a control flow expression - | SynExpr.App (_, _, SynExpr.Ident _, SynExpr.CompExpr _,_) + | SynExpr.App (_, _, SynExpr.Ident _, SynExpr.CompExpr _, _) | SynExpr.IfThenElse _ | SynExpr.LetOrUseBang _ | SynExpr.Match _ @@ -1812,121 +1812,121 @@ let rec IsControlFlowExpression e = | SynExpr.For _ | SynExpr.ForEach _ | SynExpr.While _ -> true - | SynExpr.Typed(e,_,_) -> IsControlFlowExpression e + | SynExpr.Typed(e, _, _) -> IsControlFlowExpression e | _ -> false -let mkAnonField (ty: SynType) = Field([],false,None,ty,false,PreXmlDoc.Empty,None,ty.Range) -let mkNamedField (ident, ty: SynType) = Field([],false,Some ident,ty,false,PreXmlDoc.Empty,None,ty.Range) +let mkAnonField (ty: SynType) = Field([], false, None, ty, false, PreXmlDoc.Empty, None, ty.Range) +let mkNamedField (ident, ty: SynType) = Field([], false, Some ident, ty, false, PreXmlDoc.Empty, None, ty.Range) -let mkSynPatVar vis (id:Ident) = SynPat.Named (SynPat.Wild id.idRange,id,false,vis,id.idRange) -let mkSynThisPatVar (id:Ident) = SynPat.Named (SynPat.Wild id.idRange,id,true,None,id.idRange) -let mkSynPatMaybeVar lidwd vis m = SynPat.LongIdent (lidwd,None,None,SynConstructorArgs.Pats [],vis,m) +let mkSynPatVar vis (id:Ident) = SynPat.Named (SynPat.Wild id.idRange, id, false, vis, id.idRange) +let mkSynThisPatVar (id:Ident) = SynPat.Named (SynPat.Wild id.idRange, id, true, None, id.idRange) +let mkSynPatMaybeVar lidwd vis m = SynPat.LongIdent (lidwd, None, None, SynConstructorArgs.Pats [], vis, m) /// Extract the argument for patterns corresponding to the declaration of 'new ... = ...' let (|SynPatForConstructorDecl|_|) x = match x with - | SynPat.LongIdent (LongIdentWithDots([_],_),_,_, SynConstructorArgs.Pats [arg],_,_) -> Some arg + | SynPat.LongIdent (LongIdentWithDots([_], _), _, _, SynConstructorArgs.Pats [arg], _, _) -> Some arg | _ -> None /// Recognize the '()' in 'new()' let (|SynPatForNullaryArgs|_|) x = match x with - | SynPat.Paren(SynPat.Const(SynConst.Unit,_),_) -> Some() + | SynPat.Paren(SynPat.Const(SynConst.Unit, _), _) -> Some() | _ -> None let (|SynExprErrorSkip|) (p:SynExpr) = match p with - | SynExpr.FromParseError(p,_) -> p + | SynExpr.FromParseError(p, _) -> p | _ -> p let (|SynExprParen|_|) (e:SynExpr) = match e with - | SynExpr.Paren(SynExprErrorSkip e,a,b,c) -> Some (e,a,b,c) + | SynExpr.Paren(SynExprErrorSkip e, a, b, c) -> Some (e, a, b, c) | _ -> None let (|SynPatErrorSkip|) (p:SynPat) = match p with - | SynPat.FromParseError(p,_) -> p + | SynPat.FromParseError(p, _) -> p | _ -> p /// Push non-simple parts of a patten match over onto the r.h.s. of a lambda. /// Return a simple pattern and a function to build a match on the r.h.s. if the pattern is complex let rec SimplePatOfPat (synArgNameGenerator: SynArgNameGenerator) p = match p with - | SynPat.Typed(p',ty,m) -> - let p2,laterf = SimplePatOfPat synArgNameGenerator p' - SynSimplePat.Typed(p2,ty,m), + | SynPat.Typed(p', ty, m) -> + let p2, laterf = SimplePatOfPat synArgNameGenerator p' + SynSimplePat.Typed(p2, ty, m), laterf - | SynPat.Attrib(p',attribs,m) -> - let p2,laterf = SimplePatOfPat synArgNameGenerator p' - SynSimplePat.Attrib(p2,attribs,m), + | SynPat.Attrib(p', attribs, m) -> + let p2, laterf = SimplePatOfPat synArgNameGenerator p' + SynSimplePat.Attrib(p2, attribs, m), laterf - | SynPat.Named (SynPat.Wild _, v,thisv,_,m) -> - SynSimplePat.Id (v,None,false,thisv,false,m), + | SynPat.Named (SynPat.Wild _, v, thisv, _, m) -> + SynSimplePat.Id (v, None, false, thisv, false, m), None - | SynPat.OptionalVal (v,m) -> - SynSimplePat.Id (v,None,false,false,true,m), + | SynPat.OptionalVal (v, m) -> + SynSimplePat.Id (v, None, false, false, true, m), None - | SynPat.Paren (p,_) -> SimplePatOfPat synArgNameGenerator p - | SynPat.FromParseError (p,_) -> SimplePatOfPat synArgNameGenerator p + | SynPat.Paren (p, _) -> SimplePatOfPat synArgNameGenerator p + | SynPat.FromParseError (p, _) -> SimplePatOfPat synArgNameGenerator p | _ -> let m = p.Range - let isCompGen,altNameRefCell,id,item = + let isCompGen, altNameRefCell, id, item = match p with - | SynPat.LongIdent(LongIdentWithDots([id],_),_,None, SynConstructorArgs.Pats [],None,_) -> + | SynPat.LongIdent(LongIdentWithDots([id], _), _, None, SynConstructorArgs.Pats [], None, _) -> // The pattern is 'V' or some other capitalized identifier. // It may be a real variable, in which case we want to maintain its name. // But it may also be a nullary union case or some other identifier. // In this case, we want to use an alternate compiler generated name for the hidden variable. let altNameRefCell = Some (ref (Undecided (mkSynId m (synArgNameGenerator.New())))) let item = mkSynIdGetWithAlt m id altNameRefCell - false,altNameRefCell,id,item + false, altNameRefCell, id, item | _ -> let nm = synArgNameGenerator.New() let id = mkSynId m nm let item = mkSynIdGet m nm - true,None,id,item - SynSimplePat.Id (id,altNameRefCell,isCompGen,false,false,id.idRange), + true, None, id, item + SynSimplePat.Id (id, altNameRefCell, isCompGen, false, false, id.idRange), Some (fun e -> - let clause = Clause(p,None,e,m,SuppressSequencePointAtTarget) - SynExpr.Match(NoSequencePointAtInvisibleBinding,item,[clause],clause.Range)) + let clause = Clause(p, None, e, m, SuppressSequencePointAtTarget) + SynExpr.Match(NoSequencePointAtInvisibleBinding, item, [clause], clause.Range)) let appFunOpt funOpt x = match funOpt with None -> x | Some f -> f x let composeFunOpt funOpt1 funOpt2 = match funOpt2 with None -> funOpt1 | Some f -> Some (fun x -> appFunOpt funOpt1 (f x)) let rec SimplePatsOfPat synArgNameGenerator p = match p with - | SynPat.FromParseError (p,_) -> SimplePatsOfPat synArgNameGenerator p - | SynPat.Typed(p',ty,m) -> - let p2,laterf = SimplePatsOfPat synArgNameGenerator p' - SynSimplePats.Typed(p2,ty,m), + | SynPat.FromParseError (p, _) -> SimplePatsOfPat synArgNameGenerator p + | SynPat.Typed(p', ty, m) -> + let p2, laterf = SimplePatsOfPat synArgNameGenerator p' + SynSimplePats.Typed(p2, ty, m), laterf -// | SynPat.Paren (p,m) -> SimplePatsOfPat synArgNameGenerator p - | SynPat.Tuple (false,ps,m) - | SynPat.Paren(SynPat.Tuple (false,ps,m),_) -> - let ps2,laterf = +// | SynPat.Paren (p, m) -> SimplePatsOfPat synArgNameGenerator p + | SynPat.Tuple (false, ps, m) + | SynPat.Paren(SynPat.Tuple (false, ps, m), _) -> + let ps2, laterf = List.foldBack - (fun (p',rhsf) (ps',rhsf') -> + (fun (p', rhsf) (ps', rhsf') -> p'::ps', (composeFunOpt rhsf rhsf')) (List.map (SimplePatOfPat synArgNameGenerator) ps) ([], None) - SynSimplePats.SimplePats (ps2,m), + SynSimplePats.SimplePats (ps2, m), laterf - | SynPat.Paren(SynPat.Const (SynConst.Unit,m),_) - | SynPat.Const (SynConst.Unit,m) -> - SynSimplePats.SimplePats ([],m), + | SynPat.Paren(SynPat.Const (SynConst.Unit, m), _) + | SynPat.Const (SynConst.Unit, m) -> + SynSimplePats.SimplePats ([], m), None | _ -> let m = p.Range - let sp,laterf = SimplePatOfPat synArgNameGenerator p - SynSimplePats.SimplePats ([sp],m),laterf + let sp, laterf = SimplePatOfPat synArgNameGenerator p + SynSimplePats.SimplePats ([sp], m), laterf let PushPatternToExpr synArgNameGenerator isMember pat (rhs: SynExpr) = - let nowpats,laterf = SimplePatsOfPat synArgNameGenerator pat - nowpats, SynExpr.Lambda (isMember,false,nowpats, appFunOpt laterf rhs,rhs.Range) + let nowpats, laterf = SimplePatsOfPat synArgNameGenerator pat + nowpats, SynExpr.Lambda (isMember, false, nowpats, appFunOpt laterf rhs, rhs.Range) let private isSimplePattern pat = - let _nowpats,laterf = SimplePatsOfPat (SynArgNameGenerator()) pat + let _nowpats, laterf = SimplePatsOfPat (SynArgNameGenerator()) pat Option.isNone laterf /// "fun (UnionCase x) (UnionCase y) -> body" @@ -1938,29 +1938,29 @@ let private isSimplePattern pat = let PushCurriedPatternsToExpr synArgNameGenerator wholem isMember pats rhs = // Two phases // First phase: Fold back, from right to left, pushing patterns into r.h.s. expr - let spatsl,rhs = - (pats, ([],rhs)) - ||> List.foldBack (fun arg (spatsl,body) -> - let spats,bodyf = SimplePatsOfPat synArgNameGenerator arg + let spatsl, rhs = + (pats, ([], rhs)) + ||> List.foldBack (fun arg (spatsl, body) -> + let spats, bodyf = SimplePatsOfPat synArgNameGenerator arg // accumulate the body. This builds "let (UnionCase y) = tmp2 in body" let body = appFunOpt bodyf body // accumulate the patterns let spatsl = spats::spatsl - (spatsl,body)) + (spatsl, body)) // Second phase: build lambdas. Mark subsequent ones with "true" indicating they are part of an iterated sequence of lambdas let expr = match spatsl with | [] -> rhs | h::t -> - let expr = List.foldBack (fun spats e -> SynExpr.Lambda (isMember,true,spats, e,wholem)) t rhs - let expr = SynExpr.Lambda (isMember,false,h, expr,wholem) + let expr = List.foldBack (fun spats e -> SynExpr.Lambda (isMember, true, spats, e, wholem)) t rhs + let expr = SynExpr.Lambda (isMember, false, h, expr, wholem) expr - spatsl,expr + spatsl, expr /// Helper for parsing the inline IL fragments. #if NO_INLINE_IL_PARSER let ParseAssemblyCodeInstructions _s m = - errorR(Error((193,"Inline IL not valid in a hosted environment"),m)) + errorR(Error((193, "Inline IL not valid in a hosted environment"), m)) [| |] #else let ParseAssemblyCodeInstructions s m = @@ -1975,7 +1975,7 @@ let ParseAssemblyCodeInstructions s m = /// Helper for parsing the inline IL fragments. #if NO_INLINE_IL_PARSER let ParseAssemblyCodeType _s m = - errorR(Error((193,"Inline IL not valid in a hosted environment"),m)) + errorR(Error((193, "Inline IL not valid in a hosted environment"), m)) IL.EcmaMscorlibILGlobals.typ_Object #else let ParseAssemblyCodeType s m = @@ -1983,7 +1983,7 @@ let ParseAssemblyCodeType s m = FSharp.Compiler.AbstractIL.Internal.AsciiLexer.token (UnicodeLexing.StringAsLexbuf s) with RecoverableParseError -> - errorR(Error(FSComp.SR.astParseEmbeddedILTypeError(),m)); + errorR(Error(FSComp.SR.astParseEmbeddedILTypeError(), m)); IL.EcmaMscorlibILGlobals.typ_Object #endif @@ -2000,34 +2000,34 @@ let mkSynInfix opm (l:SynExpr) oper (r:SynExpr) = let wholeRange = unionRanges l.Range r.Range SynExpr.App (ExprAtomicFlag.NonAtomic, false, SynExpr.App (ExprAtomicFlag.NonAtomic, true, mkSynOperator opm oper, l, firstTwoRange), r, wholeRange) -let mkSynBifix m oper x1 x2 = - SynExpr.App (ExprAtomicFlag.NonAtomic, false, SynExpr.App (ExprAtomicFlag.NonAtomic, true, mkSynOperator m oper,x1,m), x2,m) +let mkSynBifix m oper x1 x2 = + SynExpr.App (ExprAtomicFlag.NonAtomic, false, SynExpr.App (ExprAtomicFlag.NonAtomic, true, mkSynOperator m oper, x1, m), x2, m) -let mkSynTrifix m oper x1 x2 x3 = - SynExpr.App (ExprAtomicFlag.NonAtomic, false, SynExpr.App (ExprAtomicFlag.NonAtomic, false, SynExpr.App (ExprAtomicFlag.NonAtomic, true, mkSynOperator m oper,x1,m), x2,m), x3,m) +let mkSynTrifix m oper x1 x2 x3 = + SynExpr.App (ExprAtomicFlag.NonAtomic, false, SynExpr.App (ExprAtomicFlag.NonAtomic, false, SynExpr.App (ExprAtomicFlag.NonAtomic, true, mkSynOperator m oper, x1, m), x2, m), x3, m) -let mkSynPrefixPrim opm m oper x = - SynExpr.App (ExprAtomicFlag.NonAtomic, false, mkSynOperator opm oper, x,m) +let mkSynPrefixPrim opm m oper x = + SynExpr.App (ExprAtomicFlag.NonAtomic, false, mkSynOperator opm oper, x, m) -let mkSynPrefix opm m oper x = - if oper = "~&" then - SynExpr.AddressOf(true,x,opm,m) - elif oper = "~&&" then - SynExpr.AddressOf(false,x,opm,m) +let mkSynPrefix opm m oper x = + if oper = "~&" then + SynExpr.AddressOf(true, x, opm, m) + elif oper = "~&&" then + SynExpr.AddressOf(false, x, opm, m) else mkSynPrefixPrim opm m oper x let mkSynCaseName m n = [mkSynId m (CompileOpName n)] -let mkSynApp1 f x1 m = SynExpr.App(ExprAtomicFlag.NonAtomic,false,f,x1,m) +let mkSynApp1 f x1 m = SynExpr.App(ExprAtomicFlag.NonAtomic, false, f, x1, m) let mkSynApp2 f x1 x2 m = mkSynApp1 (mkSynApp1 f x1 m) x2 m let mkSynApp3 f x1 x2 x3 m = mkSynApp1 (mkSynApp2 f x1 x2 m) x3 m let mkSynApp4 f x1 x2 x3 x4 m = mkSynApp1 (mkSynApp3 f x1 x2 x3 m) x4 m let mkSynApp5 f x1 x2 x3 x4 x5 m = mkSynApp1 (mkSynApp4 f x1 x2 x3 x4 m) x5 m let mkSynDotParenSet m a b c = mkSynTrifix m parenSet a b c -let mkSynDotBrackGet m mDot a b = SynExpr.DotIndexedGet(a,[SynIndexerArg.One b],mDot,m) +let mkSynDotBrackGet m mDot a b = SynExpr.DotIndexedGet(a, [SynIndexerArg.One b], mDot, m) let mkSynQMarkSet m a b c = mkSynTrifix m qmarkSet a b c -let mkSynDotBrackSliceGet m mDot arr sliceArg = SynExpr.DotIndexedGet(arr,[sliceArg],mDot,m) +let mkSynDotBrackSliceGet m mDot arr sliceArg = SynExpr.DotIndexedGet(arr, [sliceArg], mDot, m) let mkSynDotBrackSeqSliceGet m mDot arr (argslist:list) = let notsliced=[ for arg in argslist do @@ -2035,67 +2035,67 @@ let mkSynDotBrackSeqSliceGet m mDot arr (argslist:list) = | SynIndexerArg.One x -> yield x | _ -> () ] if notsliced.Length = argslist.Length then - SynExpr.DotIndexedGet(arr,[SynIndexerArg.One (SynExpr.Tuple(false,notsliced,[],unionRanges (List.head notsliced).Range (List.last notsliced).Range))],mDot,m) + SynExpr.DotIndexedGet(arr, [SynIndexerArg.One (SynExpr.Tuple(false, notsliced, [], unionRanges (List.head notsliced).Range (List.last notsliced).Range))], mDot, m) else - SynExpr.DotIndexedGet(arr,argslist,mDot,m) + SynExpr.DotIndexedGet(arr, argslist, mDot, m) let mkSynDotParenGet lhsm dotm a b = match b with - | SynExpr.Tuple (false,[_;_],_,_) -> errorR(Deprecated(FSComp.SR.astDeprecatedIndexerNotation(),lhsm)) ; SynExpr.Const(SynConst.Unit,lhsm) - | SynExpr.Tuple (false,[_;_;_],_,_) -> errorR(Deprecated(FSComp.SR.astDeprecatedIndexerNotation(),lhsm)) ; SynExpr.Const(SynConst.Unit,lhsm) + | SynExpr.Tuple (false, [_;_], _, _) -> errorR(Deprecated(FSComp.SR.astDeprecatedIndexerNotation(), lhsm)) ; SynExpr.Const(SynConst.Unit, lhsm) + | SynExpr.Tuple (false, [_;_;_], _, _) -> errorR(Deprecated(FSComp.SR.astDeprecatedIndexerNotation(), lhsm)) ; SynExpr.Const(SynConst.Unit, lhsm) | _ -> mkSynInfix dotm a parenGet b -let mkSynUnit m = SynExpr.Const(SynConst.Unit,m) -let mkSynUnitPat m = SynPat.Const(SynConst.Unit,m) -let mkSynDelay m e = SynExpr.Lambda (false,false,SynSimplePats.SimplePats ([mkSynCompGenSimplePatVar (mkSynId m "unitVar")],m), e, m) +let mkSynUnit m = SynExpr.Const(SynConst.Unit, m) +let mkSynUnitPat m = SynPat.Const(SynConst.Unit, m) +let mkSynDelay m e = SynExpr.Lambda (false, false, SynSimplePats.SimplePats ([mkSynCompGenSimplePatVar (mkSynId m "unitVar")], m), e, m) let mkSynAssign (l: SynExpr) (r: SynExpr) = let m = unionRanges l.Range r.Range match l with - //| SynExpr.Paren(l2,m2) -> mkSynAssign m l2 r - | LongOrSingleIdent(false,v,None,_) -> SynExpr.LongIdentSet (v,r,m) - | SynExpr.DotGet(e,_,v,_) -> SynExpr.DotSet (e,v,r,m) - | SynExpr.DotIndexedGet(e1,e2,mDot,mLeft) -> SynExpr.DotIndexedSet (e1,e2,r,mLeft,mDot,m) - | SynExpr.LibraryOnlyUnionCaseFieldGet (x,y,z,_) -> SynExpr.LibraryOnlyUnionCaseFieldSet (x,y,z,r,m) - | SynExpr.App (_, _, SynExpr.App(_, _, SingleIdent(nm), a, _),b,_) when nm.idText = opNameQMark -> + //| SynExpr.Paren(l2, m2) -> mkSynAssign m l2 r + | LongOrSingleIdent(false, v, None, _) -> SynExpr.LongIdentSet (v, r, m) + | SynExpr.DotGet(e, _, v, _) -> SynExpr.DotSet (e, v, r, m) + | SynExpr.DotIndexedGet(e1, e2, mDot, mLeft) -> SynExpr.DotIndexedSet (e1, e2, r, mLeft, mDot, m) + | SynExpr.LibraryOnlyUnionCaseFieldGet (x, y, z, _) -> SynExpr.LibraryOnlyUnionCaseFieldSet (x, y, z, r, m) + | SynExpr.App (_, _, SynExpr.App(_, _, SingleIdent(nm), a, _), b, _) when nm.idText = opNameQMark -> mkSynQMarkSet m a b r - | SynExpr.App (_, _, SynExpr.App(_, _, SingleIdent(nm), a, _),b,_) when nm.idText = opNameParenGet -> + | SynExpr.App (_, _, SynExpr.App(_, _, SingleIdent(nm), a, _), b, _) when nm.idText = opNameParenGet -> mkSynDotParenSet m a b r - | SynExpr.App (_, _, SynExpr.LongIdent(false,v,None,_),x,_) -> SynExpr.NamedIndexedPropertySet (v,x,r,m) - | SynExpr.App (_, _, SynExpr.DotGet(e,_,v,_),x,_) -> SynExpr.DotNamedIndexedPropertySet (e,v,x,r,m) - | l -> SynExpr.Set (l,r,m) + | SynExpr.App (_, _, SynExpr.LongIdent(false, v, None, _), x, _) -> SynExpr.NamedIndexedPropertySet (v, x, r, m) + | SynExpr.App (_, _, SynExpr.DotGet(e, _, v, _), x, _) -> SynExpr.DotNamedIndexedPropertySet (e, v, x, r, m) + | l -> SynExpr.Set (l, r, m) //| _ -> errorR(Error(FSComp.SR.astInvalidExprLeftHandOfAssignment(), m)); l // return just the LHS, so the typechecker can see it and capture expression typings that may be useful for dot lookups let rec mkSynDot dotm m l r = match l with - | SynExpr.LongIdent(isOpt,LongIdentWithDots(lid,dots),None,_) -> - SynExpr.LongIdent(isOpt,LongIdentWithDots(lid@[r],dots@[dotm]),None,m) // REVIEW: MEMORY PERFORMANCE: This list operation is memory intensive (we create a lot of these list nodes) - an ImmutableArray would be better here + | SynExpr.LongIdent(isOpt, LongIdentWithDots(lid, dots), None, _) -> + SynExpr.LongIdent(isOpt, LongIdentWithDots(lid@[r], dots@[dotm]), None, m) // REVIEW: MEMORY PERFORMANCE: This list operation is memory intensive (we create a lot of these list nodes) - an ImmutableArray would be better here | SynExpr.Ident id -> - SynExpr.LongIdent(false,LongIdentWithDots([id;r],[dotm]),None,m) - | SynExpr.DotGet(e,dm,LongIdentWithDots(lid,dots),_) -> - SynExpr.DotGet(e,dm,LongIdentWithDots(lid@[r],dots@[dotm]),m)// REVIEW: MEMORY PERFORMANCE: This is memory intensive (we create a lot of these list nodes) - an ImmutableArray would be better here + SynExpr.LongIdent(false, LongIdentWithDots([id;r], [dotm]), None, m) + | SynExpr.DotGet(e, dm, LongIdentWithDots(lid, dots), _) -> + SynExpr.DotGet(e, dm, LongIdentWithDots(lid@[r], dots@[dotm]), m)// REVIEW: MEMORY PERFORMANCE: This is memory intensive (we create a lot of these list nodes) - an ImmutableArray would be better here | expr -> - SynExpr.DotGet(expr,dotm,LongIdentWithDots([r],[]),m) + SynExpr.DotGet(expr, dotm, LongIdentWithDots([r], []), m) let rec mkSynDotMissing dotm m l = match l with - | SynExpr.LongIdent(isOpt,LongIdentWithDots(lid,dots),None,_) -> - SynExpr.LongIdent(isOpt,LongIdentWithDots(lid,dots@[dotm]),None,m) // REVIEW: MEMORY PERFORMANCE: This list operation is memory intensive (we create a lot of these list nodes) - an ImmutableArray would be better here + | SynExpr.LongIdent(isOpt, LongIdentWithDots(lid, dots), None, _) -> + SynExpr.LongIdent(isOpt, LongIdentWithDots(lid, dots@[dotm]), None, m) // REVIEW: MEMORY PERFORMANCE: This list operation is memory intensive (we create a lot of these list nodes) - an ImmutableArray would be better here | SynExpr.Ident id -> - SynExpr.LongIdent(false,LongIdentWithDots([id],[dotm]),None,m) - | SynExpr.DotGet(e,dm,LongIdentWithDots(lid,dots),_) -> - SynExpr.DotGet(e,dm,LongIdentWithDots(lid,dots@[dotm]),m)// REVIEW: MEMORY PERFORMANCE: This is memory intensive (we create a lot of these list nodes) - an ImmutableArray would be better here + SynExpr.LongIdent(false, LongIdentWithDots([id], [dotm]), None, m) + | SynExpr.DotGet(e, dm, LongIdentWithDots(lid, dots), _) -> + SynExpr.DotGet(e, dm, LongIdentWithDots(lid, dots@[dotm]), m)// REVIEW: MEMORY PERFORMANCE: This is memory intensive (we create a lot of these list nodes) - an ImmutableArray would be better here | expr -> - SynExpr.DiscardAfterMissingQualificationAfterDot(expr,m) + SynExpr.DiscardAfterMissingQualificationAfterDot(expr, m) let mkSynFunMatchLambdas synArgNameGenerator isMember wholem ps e = - let _,e = PushCurriedPatternsToExpr synArgNameGenerator wholem isMember ps e + let _, e = PushCurriedPatternsToExpr synArgNameGenerator wholem isMember ps e e // error recovery - the contract is that these expressions can only be produced if an error has already been reported // (as a result, future checking may choose not to report errors involving these, to prevent noisy cascade errors) -let arbExpr(debugStr,range:range) = SynExpr.ArbitraryAfterError(debugStr,range.MakeSynthetic()) +let arbExpr(debugStr, range:range) = SynExpr.ArbitraryAfterError(debugStr, range.MakeSynthetic()) type SynExpr with member this.IsArbExprAndThusAlreadyReportedError = match this with @@ -2130,7 +2130,7 @@ type SynReturnInfo = SynReturnInfo of (SynType * SynArgInfo) * range:range /// StaticProperty with set(v) --> [1] module SynInfo = /// The argument information for an argument without a name - let unnamedTopArg1 = SynArgInfo([],false,None) + let unnamedTopArg1 = SynArgInfo([], false, None) /// The argument information for a curried argument without a name let unnamedTopArg = [unnamedTopArg1] @@ -2139,64 +2139,64 @@ module SynInfo = let unitArgData = unnamedTopArg /// The 'argument' information for a return value where no attributes are given for the return value (the normal case) - let unnamedRetVal = SynArgInfo([],false,None) + let unnamedRetVal = SynArgInfo([], false, None) /// The 'argument' information for the 'this'/'self' parameter in the cases where it is not given explicitly let selfMetadata = unnamedTopArg /// Determine if a syntactic information represents a member without arguments (which is implicitly a property getter) - let HasNoArgs (SynValInfo(args,_)) = isNil args + let HasNoArgs (SynValInfo(args, _)) = isNil args /// Check if one particular argument is an optional argument. Used when adjusting the /// types of optional arguments for function and member signatures. - let IsOptionalArg (SynArgInfo(_,isOpt,_)) = isOpt + let IsOptionalArg (SynArgInfo(_, isOpt, _)) = isOpt /// Check if there are any optional arguments in the syntactic argument information. Used when adjusting the /// types of optional arguments for function and member signatures. - let HasOptionalArgs (SynValInfo(args,_)) = List.exists (List.exists IsOptionalArg) args + let HasOptionalArgs (SynValInfo(args, _)) = List.exists (List.exists IsOptionalArg) args /// Add a parameter entry to the syntactic value information to represent the '()' argument to a property getter. This is /// used for the implicit '()' argument in property getter signature specifications. - let IncorporateEmptyTupledArgForPropertyGetter (SynValInfo(args,retInfo)) = SynValInfo([]::args,retInfo) + let IncorporateEmptyTupledArgForPropertyGetter (SynValInfo(args, retInfo)) = SynValInfo([]::args, retInfo) /// Add a parameter entry to the syntactic value information to represent the 'this' argument. This is /// used for the implicit 'this' argument in member signature specifications. - let IncorporateSelfArg (SynValInfo(args,retInfo)) = SynValInfo(selfMetadata::args,retInfo) + let IncorporateSelfArg (SynValInfo(args, retInfo)) = SynValInfo(selfMetadata::args, retInfo) /// Add a parameter entry to the syntactic value information to represent the value argument for a property setter. This is /// used for the implicit value argument in property setter signature specifications. - let IncorporateSetterArg (SynValInfo(args,retInfo)) = + let IncorporateSetterArg (SynValInfo(args, retInfo)) = let args = match args with | [] -> [unnamedTopArg] | [arg] -> [arg@[unnamedTopArg1]] | _ -> failwith "invalid setter type" - SynValInfo(args,retInfo) + SynValInfo(args, retInfo) /// Get the argument counts for each curried argument group. Used in some adhoc places in tc.fs. - let AritiesOfArgs (SynValInfo(args,_)) = List.map List.length args + let AritiesOfArgs (SynValInfo(args, _)) = List.map List.length args /// Get the argument attributes from the syntactic information for an argument. - let AttribsOfArgData (SynArgInfo(attribs,_,_)) = attribs + let AttribsOfArgData (SynArgInfo(attribs, _, _)) = attribs /// Infer the syntactic argument info for a single argument from a simple pattern. let rec InferSynArgInfoFromSimplePat attribs p = match p with - | SynSimplePat.Id(nm,_,isCompGen,_,isOpt,_) -> + | SynSimplePat.Id(nm, _, isCompGen, _, isOpt, _) -> SynArgInfo(attribs, isOpt, (if isCompGen then None else Some nm)) - | SynSimplePat.Typed(a,_,_) -> InferSynArgInfoFromSimplePat attribs a - | SynSimplePat.Attrib(a,attribs2,_) -> InferSynArgInfoFromSimplePat (attribs @ attribs2) a + | SynSimplePat.Typed(a, _, _) -> InferSynArgInfoFromSimplePat attribs a + | SynSimplePat.Attrib(a, attribs2, _) -> InferSynArgInfoFromSimplePat (attribs @ attribs2) a /// Infer the syntactic argument info for one or more arguments one or more simple patterns. let rec InferSynArgInfoFromSimplePats x = match x with - | SynSimplePats.SimplePats(ps,_) -> List.map (InferSynArgInfoFromSimplePat []) ps - | SynSimplePats.Typed(ps,_,_) -> InferSynArgInfoFromSimplePats ps + | SynSimplePats.SimplePats(ps, _) -> List.map (InferSynArgInfoFromSimplePat []) ps + | SynSimplePats.Typed(ps, _, _) -> InferSynArgInfoFromSimplePats ps /// Infer the syntactic argument info for one or more arguments a pattern. let InferSynArgInfoFromPat p = // It is ok to use a fresh SynArgNameGenerator here, because compiler generated names are filtered from SynArgInfo, see InferSynArgInfoFromSimplePat above - let sp,_ = SimplePatsOfPat (SynArgNameGenerator()) p + let sp, _ = SimplePatsOfPat (SynArgNameGenerator()) p InferSynArgInfoFromSimplePats sp /// Make sure only a solitary unit argument has unit elimination @@ -2219,7 +2219,7 @@ module SynInfo = let InferLambdaArgs origRhsExpr = let rec loop e = match e with - | SynExpr.Lambda(false,_,spats,rest,_) -> + | SynExpr.Lambda(false, _, spats, rest, _) -> InferSynArgInfoFromSimplePats spats :: loop rest | _ -> [] loop origRhsExpr @@ -2227,11 +2227,11 @@ module SynInfo = let InferSynReturnData (retInfo: SynReturnInfo option) = match retInfo with | None -> unnamedRetVal - | Some(SynReturnInfo((_,retInfo),_)) -> retInfo + | Some(SynReturnInfo((_, retInfo), _)) -> retInfo - let private emptySynValInfo = SynValInfo([],unnamedRetVal) + let private emptySynValInfo = SynValInfo([], unnamedRetVal) - let emptySynValData = SynValData(None,emptySynValInfo,None) + let emptySynValData = SynValData(None, emptySynValInfo, None) /// Infer the syntactic information for a 'let' or 'member' definition, based on the argument pattern, /// any declared return information (e.g. .NET attributes on the return element), and the r.h.s. expression @@ -2240,12 +2240,12 @@ module SynInfo = let infosForExplicitArgs = match pat with - | Some(SynPat.LongIdent(_,_,_, SynConstructorArgs.Pats curriedArgs,_,_)) -> List.map InferSynArgInfoFromPat curriedArgs + | Some(SynPat.LongIdent(_, _, _, SynConstructorArgs.Pats curriedArgs, _, _)) -> List.map InferSynArgInfoFromPat curriedArgs | _ -> [] let explicitArgsAreSimple = match pat with - | Some(SynPat.LongIdent(_,_,_, SynConstructorArgs.Pats curriedArgs,_,_)) -> List.forall isSimplePattern curriedArgs + | Some(SynPat.LongIdent(_, _, _, SynConstructorArgs.Pats curriedArgs, _, _)) -> List.forall isSimplePattern curriedArgs | _ -> true let retInfo = InferSynReturnData retInfo @@ -2255,7 +2255,7 @@ module SynInfo = let infosForLambdaArgs = InferLambdaArgs origRhsExpr let infosForArgs = infosForExplicitArgs @ (if explicitArgsAreSimple then infosForLambdaArgs else []) let infosForArgs = AdjustArgsForUnitElimination infosForArgs - SynValData(None,SynValInfo(infosForArgs,retInfo),None) + SynValData(None, SynValInfo(infosForArgs, retInfo), None) | Some memFlags -> let infosForObjArgs = @@ -2265,22 +2265,22 @@ module SynInfo = let infosForArgs = AdjustArgsForUnitElimination infosForArgs let argInfos = infosForObjArgs @ infosForArgs - SynValData(Some(memFlags),SynValInfo(argInfos,retInfo),None) + SynValData(Some(memFlags), SynValInfo(argInfos, retInfo), None) let mkSynBindingRhs staticOptimizations rhsExpr mRhs retInfo = - let rhsExpr = List.foldBack (fun (c,e1) e2 -> SynExpr.LibraryOnlyStaticOptimization (c,e1,e2,mRhs)) staticOptimizations rhsExpr - let rhsExpr,retTyOpt = + let rhsExpr = List.foldBack (fun (c, e1) e2 -> SynExpr.LibraryOnlyStaticOptimization (c, e1, e2, mRhs)) staticOptimizations rhsExpr + let rhsExpr, retTyOpt = match retInfo with - | Some (SynReturnInfo((ty,SynArgInfo(rattribs,_,_)),tym)) -> SynExpr.Typed(rhsExpr,ty,rhsExpr.Range), Some(SynBindingReturnInfo(ty,tym,rattribs) ) - | None -> rhsExpr,None - rhsExpr,retTyOpt + | Some (SynReturnInfo((ty, SynArgInfo(rattribs, _, _)), tym)) -> SynExpr.Typed(rhsExpr, ty, rhsExpr.Range), Some(SynBindingReturnInfo(ty, tym, rattribs) ) + | None -> rhsExpr, None + rhsExpr, retTyOpt -let mkSynBinding (xmlDoc,headPat) (vis,isInline,isMutable,mBind,spBind,retInfo,origRhsExpr,mRhs,staticOptimizations,attrs,memberFlagsOpt) = +let mkSynBinding (xmlDoc, headPat) (vis, isInline, isMutable, mBind, spBind, retInfo, origRhsExpr, mRhs, staticOptimizations, attrs, memberFlagsOpt) = let info = SynInfo.InferSynValData (memberFlagsOpt, Some headPat, retInfo, origRhsExpr) - let rhsExpr,retTyOpt = mkSynBindingRhs staticOptimizations origRhsExpr mRhs retInfo - Binding (vis,NormalBinding,isInline,isMutable,attrs,xmlDoc,info,headPat,retTyOpt,rhsExpr,mBind,spBind) + let rhsExpr, retTyOpt = mkSynBindingRhs staticOptimizations origRhsExpr mRhs retInfo + Binding (vis, NormalBinding, isInline, isMutable, attrs, xmlDoc, info, headPat, retTyOpt, rhsExpr, mBind, spBind) let NonVirtualMemberFlags k = { MemberKind=k; IsInstance=true; IsDispatchSlot=false; IsOverrideOrExplicitImpl=false; IsFinal=false } let CtorMemberFlags = { MemberKind=MemberKind.Constructor; IsInstance=false; IsDispatchSlot=false; IsOverrideOrExplicitImpl=false; IsFinal=false } @@ -2289,8 +2289,8 @@ let OverrideMemberFlags k = { MemberKind=k; IsInstan let AbstractMemberFlags k = { MemberKind=k; IsInstance=true; IsDispatchSlot=true; IsOverrideOrExplicitImpl=false; IsFinal=false } let StaticMemberFlags k = { MemberKind=k; IsInstance=false; IsDispatchSlot=false; IsOverrideOrExplicitImpl=false; IsFinal=false } -let inferredTyparDecls = SynValTyparDecls([],true,[]) -let noInferredTypars = SynValTyparDecls([],false,[]) +let inferredTyparDecls = SynValTyparDecls([], true, []) +let noInferredTypars = SynValTyparDecls([], false, []) //------------------------------------------------------------------------ // Lexer args: status of #if/#endif processing. @@ -2318,8 +2318,8 @@ type LexerIfdefExpression = | IfdefId of string let rec LexerIfdefEval (lookup : string -> bool) = function - | IfdefAnd (l,r) -> (LexerIfdefEval lookup l) && (LexerIfdefEval lookup r) - | IfdefOr (l,r) -> (LexerIfdefEval lookup l) || (LexerIfdefEval lookup r) + | IfdefAnd (l, r) -> (LexerIfdefEval lookup l) && (LexerIfdefEval lookup r) + | IfdefOr (l, r) -> (LexerIfdefEval lookup l) || (LexerIfdefEval lookup r) | IfdefNot e -> not (LexerIfdefEval lookup e) | IfdefId id -> lookup id @@ -2389,18 +2389,18 @@ let internal lhs (parseState: IParseState) = mkSynRange p1 p2 /// Get the range covering two of the r.h.s. symbols of a grammar rule while it is being reduced -let internal rhs2 (parseState: IParseState) i j = +let internal rhs2 (parseState: IParseState) i j = let p1 = parseState.InputStartPosition i let p2 = parseState.InputEndPosition j mkSynRange p1 p2 /// Get the range corresponding to one of the r.h.s. symbols of a grammar rule while it is being reduced -let internal rhs parseState i = rhs2 parseState i i +let internal rhs parseState i = rhs2 parseState i i type IParseState with /// Get the generator used for compiler-generated argument names. - member internal x.SynArgNameGenerator = + member internal x.SynArgNameGenerator = let key = "SynArgNameGenerator" let bls = x.LexBuffer.BufferLocalStore let gen = @@ -2422,7 +2422,7 @@ module LexbufLocalXmlDocStore = // The key into the BufferLocalStore used to hold the current accumulated XmlDoc lines let private xmlDocKey = "XmlDoc" - let internal ClearXmlDoc (lexbuf:Lexbuf) = + let internal ClearXmlDoc (lexbuf:Lexbuf) = lexbuf.BufferLocalStore.[xmlDocKey] <- box (XmlDocCollector()) /// Called from the lexer to save a single line of XML doc comment. @@ -2459,10 +2459,10 @@ module LexbufLocalXmlDocStore = type NiceNameGenerator() = let lockObj = obj() - let basicNameCounts = new Dictionary(100) + let basicNameCounts = new Dictionary(100) - member x.FreshCompilerGeneratedName (name,m:range) = - lock lockObj (fun () -> + member x.FreshCompilerGeneratedName (name, m:range) = + lock lockObj (fun () -> let basicName = GetBasicNameOfPossibleCompilerGeneratedName name let n = match basicNameCounts.TryGetValue(basicName) with @@ -2472,8 +2472,8 @@ type NiceNameGenerator() = basicNameCounts.[basicName] <- n + 1 nm) - member x.Reset () = - lock lockObj (fun () -> + member x.Reset () = + lock lockObj (fun () -> basicNameCounts.Clear() ) @@ -2489,11 +2489,11 @@ type StableNiceNameGenerator() = let lockObj = obj() - let names = new Dictionary<(string * int64),string>(100) - let basicNameCounts = new Dictionary(100) + let names = new Dictionary<(string * int64), string>(100) + let basicNameCounts = new Dictionary(100) - member x.GetUniqueCompilerGeneratedName (name,m:range,uniq) = - lock lockObj (fun () -> + member x.GetUniqueCompilerGeneratedName (name, m:range, uniq) = + lock lockObj (fun () -> let basicName = GetBasicNameOfPossibleCompilerGeneratedName name let key = basicName, uniq match names.TryGetValue(key) with @@ -2510,7 +2510,7 @@ type StableNiceNameGenerator() = ) member x.Reset () = - lock lockObj (fun () -> + lock lockObj (fun () -> basicNameCounts.Clear() names.Clear() ) @@ -2519,7 +2519,7 @@ let rec synExprContainsError inpExpr = let rec walkBind (Binding(_, _, _, _, _, _, _, _, _, synExpr, _, _)) = walkExpr synExpr and walkExprs es = es |> List.exists walkExpr and walkBinds es = es |> List.exists walkBind - and walkMatchClauses cl = cl |> List.exists (fun (Clause(_,whenExpr,e,_,_)) -> walkExprOpt whenExpr || walkExpr e) + and walkMatchClauses cl = cl |> List.exists (fun (Clause(_, whenExpr, e, _, _)) -> walkExprOpt whenExpr || walkExpr e) and walkExprOpt eOpt = eOpt |> Option.exists walkExpr and walkExpr e = match e with @@ -2535,88 +2535,88 @@ let rec synExprContainsError inpExpr = | SynExpr.ImplicitZero _ | SynExpr.Const _ -> false - | SynExpr.TypeTest (e,_,_) - | SynExpr.Upcast (e,_,_) - | SynExpr.AddressOf (_,e,_,_) - | SynExpr.CompExpr (_,_,e,_) - | SynExpr.ArrayOrListOfSeqExpr (_,e,_) - | SynExpr.Typed (e,_,_) - | SynExpr.FromParseError (e,_) - | SynExpr.Do (e,_) - | SynExpr.Assert (e,_) - | SynExpr.DotGet (e,_,_,_) - | SynExpr.LongIdentSet (_,e,_) - | SynExpr.New (_,_,e,_) - | SynExpr.TypeApp (e,_,_,_,_,_,_) - | SynExpr.LibraryOnlyUnionCaseFieldGet (e,_,_,_) - | SynExpr.Downcast (e,_,_) - | SynExpr.InferredUpcast (e,_) - | SynExpr.InferredDowncast (e,_) + | SynExpr.TypeTest (e, _, _) + | SynExpr.Upcast (e, _, _) + | SynExpr.AddressOf (_, e, _, _) + | SynExpr.CompExpr (_, _, e, _) + | SynExpr.ArrayOrListOfSeqExpr (_, e, _) + | SynExpr.Typed (e, _, _) + | SynExpr.FromParseError (e, _) + | SynExpr.Do (e, _) + | SynExpr.Assert (e, _) + | SynExpr.DotGet (e, _, _, _) + | SynExpr.LongIdentSet (_, e, _) + | SynExpr.New (_, _, e, _) + | SynExpr.TypeApp (e, _, _, _, _, _, _) + | SynExpr.LibraryOnlyUnionCaseFieldGet (e, _, _, _) + | SynExpr.Downcast (e, _, _) + | SynExpr.InferredUpcast (e, _) + | SynExpr.InferredDowncast (e, _) | SynExpr.Lazy (e, _) - | SynExpr.TraitCall(_,_,e,_) - | SynExpr.YieldOrReturn (_,e,_) - | SynExpr.YieldOrReturnFrom (_,e,_) - | SynExpr.DoBang (e,_) - | SynExpr.Fixed (e,_) - | SynExpr.Paren (e,_,_,_) -> + | SynExpr.TraitCall(_, _, e, _) + | SynExpr.YieldOrReturn (_, e, _) + | SynExpr.YieldOrReturnFrom (_, e, _) + | SynExpr.DoBang (e, _) + | SynExpr.Fixed (e, _) + | SynExpr.Paren (e, _, _, _) -> walkExpr e - | SynExpr.NamedIndexedPropertySet (_,e1,e2,_) - | SynExpr.DotSet (e1,_,e2,_) - | SynExpr.Set (e1,e2,_) - | SynExpr.LibraryOnlyUnionCaseFieldSet (e1,_,_,e2,_) - | SynExpr.JoinIn (e1,_,e2,_) - | SynExpr.App (_,_,e1,e2,_) -> + | SynExpr.NamedIndexedPropertySet (_, e1, e2, _) + | SynExpr.DotSet (e1, _, e2, _) + | SynExpr.Set (e1, e2, _) + | SynExpr.LibraryOnlyUnionCaseFieldSet (e1, _, _, e2, _) + | SynExpr.JoinIn (e1, _, e2, _) + | SynExpr.App (_, _, e1, e2, _) -> walkExpr e1 || walkExpr e2 - | SynExpr.ArrayOrList (_,es,_) - | SynExpr.Tuple (_,es,_,_) -> + | SynExpr.ArrayOrList (_, es, _) + | SynExpr.Tuple (_, es, _, _) -> walkExprs es - | SynExpr.AnonRecd (_,origExpr,flds,_) -> - (match origExpr with Some (e,_) -> walkExpr e | None -> false) || + | SynExpr.AnonRecd (_, origExpr, flds, _) -> + (match origExpr with Some (e, _) -> walkExpr e | None -> false) || walkExprs (List.map snd flds) - | SynExpr.Record (_,origExpr,fs,_) -> - (match origExpr with Some (e,_) -> walkExpr e | None -> false) || + | SynExpr.Record (_, origExpr, fs, _) -> + (match origExpr with Some (e, _) -> walkExpr e | None -> false) || let flds = fs |> List.choose (fun (_, v, _) -> v) walkExprs (flds) - | SynExpr.ObjExpr (_,_,bs,is,_,_) -> - walkBinds bs || walkBinds [ for (InterfaceImpl(_,bs,_)) in is do yield! bs ] - | SynExpr.ForEach (_,_,_,_,e1,e2,_) - | SynExpr.While (_,e1,e2,_) -> + | SynExpr.ObjExpr (_, _, bs, is, _, _) -> + walkBinds bs || walkBinds [ for (InterfaceImpl(_, bs, _)) in is do yield! bs ] + | SynExpr.ForEach (_, _, _, _, e1, e2, _) + | SynExpr.While (_, e1, e2, _) -> walkExpr e1 || walkExpr e2 - | SynExpr.For (_,_,e1,_,e2,e3,_) -> + | SynExpr.For (_, _, e1, _, e2, e3, _) -> walkExpr e1 || walkExpr e2 || walkExpr e3 - | SynExpr.MatchLambda(_,_,cl,_,_) -> + | SynExpr.MatchLambda(_, _, cl, _, _) -> walkMatchClauses cl - | SynExpr.Lambda (_,_,_,e,_) -> + | SynExpr.Lambda (_, _, _, e, _) -> walkExpr e - | SynExpr.Match (_,e,cl,_) -> + | SynExpr.Match (_, e, cl, _) -> walkExpr e || walkMatchClauses cl - | SynExpr.LetOrUse (_,_,bs,e,_) -> + | SynExpr.LetOrUse (_, _, bs, e, _) -> walkBinds bs || walkExpr e - | SynExpr.TryWith (e,_,cl,_,_,_,_) -> + | SynExpr.TryWith (e, _, cl, _, _, _, _) -> walkExpr e || walkMatchClauses cl - | SynExpr.TryFinally (e1,e2,_,_,_) -> + | SynExpr.TryFinally (e1, e2, _, _, _) -> walkExpr e1 || walkExpr e2 - | SynExpr.Sequential (_,_,e1,e2,_) -> + | SynExpr.Sequential (_, _, e1, e2, _) -> walkExpr e1 || walkExpr e2 - | SynExpr.IfThenElse (e1,e2,e3opt,_,_,_,_) -> + | SynExpr.IfThenElse (e1, e2, e3opt, _, _, _, _) -> walkExpr e1 || walkExpr e2 || walkExprOpt e3opt - | SynExpr.DotIndexedGet (e1,es,_,_) -> + | SynExpr.DotIndexedGet (e1, es, _, _) -> walkExpr e1 || walkExprs [ for e in es do yield! e.Exprs ] - | SynExpr.DotIndexedSet (e1,es,e2,_,_,_) -> + | SynExpr.DotIndexedSet (e1, es, e2, _, _, _) -> walkExpr e1 || walkExprs [ for e in es do yield! e.Exprs ] || walkExpr e2 - | SynExpr.DotNamedIndexedPropertySet (e1,_,e2,e3,_) -> + | SynExpr.DotNamedIndexedPropertySet (e1, _, e2, e3, _) -> walkExpr e1 || walkExpr e2 || walkExpr e3 - | SynExpr.MatchBang (_,e,cl,_) -> + | SynExpr.MatchBang (_, e, cl, _) -> walkExpr e || walkMatchClauses cl - | SynExpr.LetOrUseBang (_,_,_,_,e1,e2,_) -> + | SynExpr.LetOrUseBang (_, _, _, _, e1, e2, _) -> walkExpr e1 || walkExpr e2 walkExpr inpExpr diff --git a/src/fsharp/autobox.fs b/src/fsharp/autobox.fs index 22e9409a69dd18a51f577497b21835ae100773c6..dd76156619a639e6ee04dc1d06e61679e2754278 100644 --- a/src/fsharp/autobox.fs +++ b/src/fsharp/autobox.fs @@ -44,41 +44,39 @@ let DecideLambda exprF cenv topValInfo expr ety z = | _ -> z ///Special cases where representation uses Lambda. -let DecideExprOp exprF z (op, tyargs, args) = - (* Special cases *) +/// Handle these as special cases since mutables are allowed inside their bodies +let DecideExprOp exprF noInterceptF (z: Zset) (expr: Expr) (op, tyargs, args) = + match op, tyargs, args with - // Handle these as special cases since mutables are allowed inside their bodies | TOp.While _, _, [Expr.Lambda(_, _, _, [_], e1, _, _);Expr.Lambda(_, _, _, [_], e2, _, _)] -> - Some (exprF (exprF z e1) e2) + exprF (exprF z e1) e2 | TOp.TryFinally _, [_], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)] -> - Some (exprF (exprF z e1) e2) + exprF (exprF z e1) e2 | TOp.For(_), _, [Expr.Lambda(_, _, _, [_], e1, _, _);Expr.Lambda(_, _, _, [_], e2, _, _);Expr.Lambda(_, _, _, [_], e3, _, _)] -> - Some (exprF (exprF (exprF z e1) e2) e3) + exprF (exprF (exprF z e1) e2) e3 | TOp.TryCatch _, [_], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], _e2, _, _); Expr.Lambda(_, _, _, [_], e3, _, _)] -> - Some (exprF (exprF (exprF z e1) _e2) e3) + exprF (exprF (exprF z e1) _e2) e3 // In Check code it said // e2; -- don't check filter body - duplicates logic in 'catch' body // Is that true for this code too? - | _ -> None - + | _ -> + noInterceptF z expr /// Find all the mutable locals that escape a lambda expression or object expression -let DecideExpr cenv exprF z expr = +let DecideExpr cenv exprF noInterceptF z expr = match expr with | Expr.Lambda(_, _ctorThisValOpt, _baseValOpt, argvs, _, m, rty) -> let topValInfo = ValReprInfo ([], [argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)], ValReprInfo.unnamedRetVal) let ty = mkMultiLambdaTy m argvs rty - let z = DecideLambda (Some exprF) cenv topValInfo expr ty z - Some z + DecideLambda (Some exprF) cenv topValInfo expr ty z | Expr.TyLambda(_, tps, _, _m, rty) -> let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps, [], ValReprInfo.unnamedRetVal) let ty = mkForallTyIfNeeded tps rty - let z = DecideLambda (Some exprF) cenv topValInfo expr ty z - Some z + DecideLambda (Some exprF) cenv topValInfo expr ty z | Expr.Obj (_, _, baseValOpt, superInitCall, overrides, iimpls, _m) -> let CheckMethod z (TObjExprMethod(_, _attribs, _tps, vs, body, _m)) = @@ -94,12 +92,13 @@ let DecideExpr cenv exprF z expr = let z = exprF z superInitCall let z = CheckMethods z overrides let z = (z, iimpls) ||> List.fold CheckInterfaceImpl - Some z + z | Expr.Op (c, tyargs, args, _m) -> - DecideExprOp exprF z (c, tyargs, args) + DecideExprOp exprF noInterceptF z expr (c, tyargs, args) - | _ -> None + | _ -> + noInterceptF z expr /// Find all the mutable locals that escape a binding let DecideBinding cenv z (TBind(v, expr, _m) as bind) = diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 65ba75efd446ea98683e4f79eea5f02e5c114ebf..29701c86e8a52b334345d532bd49512cbeb580a2 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -1665,10 +1665,6 @@ let GetStrongNameSigner signingInfo = // CopyFSharpCore //---------------------------------------------------------------------------- -#if FX_RESHAPED_REFLECTION -type private TypeInThisAssembly (_dummy:obj) = class end -#endif - // If the --nocopyfsharpcore switch is not specified, this will: // 1) Look into the referenced assemblies, if FSharp.Core.dll is specified, it will copy it to output directory. // 2) If not, but FSharp.Core.dll exists beside the compiler binaries, it will copy it to output directory. @@ -1685,11 +1681,7 @@ let CopyFSharpCore(outFile: string, referencedDlls: AssemblyReference list) = | Some referencedFsharpCoreDll -> copyFileIfDifferent referencedFsharpCoreDll.Text fsharpCoreDestinationPath | None -> let executionLocation = -#if FX_RESHAPED_REFLECTION - TypeInThisAssembly(null).GetType().GetTypeInfo().Assembly.Location -#else Assembly.GetExecutingAssembly().Location -#endif let compilerLocation = Path.GetDirectoryName(executionLocation) let compilerFsharpCoreDllPath = Path.Combine(compilerLocation, fsharpCoreAssemblyName) if File.Exists(compilerFsharpCoreDllPath) then diff --git a/src/fsharp/fsc/fsc.fsproj b/src/fsharp/fsc/fsc.fsproj index 0671b75257fefdc0f151854d8ea0a8523ea1e215..cefdfea783be43b7cf9c17a959c402da0c30b6db 100644 --- a/src/fsharp/fsc/fsc.fsproj +++ b/src/fsharp/fsc/fsc.fsproj @@ -15,7 +15,7 @@ true - + x86 diff --git a/src/fsharp/fscmain.fs b/src/fsharp/fscmain.fs index 2a19cd0d6c9e602a5b9eb0cd0cfbb27d7172abb6..f74c47e0da6b1321c1576a80c76fe956700d1b0d 100644 --- a/src/fsharp/fscmain.fs +++ b/src/fsharp/fscmain.fs @@ -20,13 +20,7 @@ open FSharp.Compiler.CompileOps open FSharp.Compiler.AbstractIL.Internal.Library open Internal.Utilities -#if FX_RESHAPED_REFLECTION -open Microsoft.FSharp.Core.ReflectionAdapters -#endif - -#if !FX_NO_DEFAULT_DEPENDENCY_TYPE [] -#endif do () @@ -83,10 +77,8 @@ let main(argv) = System.Runtime.GCSettings.LatencyMode <- System.Runtime.GCLatencyMode.Batch use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter -#if !FX_NO_HEAPTERMINATION if not runningOnMono then Lib.UnmanagedProcessExecutionOptions.EnableHeapTerminationOnCorruption() (* SDL recommendation *) Lib.UnmanagedProcessExecutionOptions.EnableHeapTerminationOnCorruption() (* SDL recommendation *) -#endif try Driver.main(Array.append [| "fsc.exe" |] argv) diff --git a/src/fsharp/fsi/console.fs b/src/fsharp/fsi/console.fs index 78f6edef349bef72a9e35d0cfd8f090586811ef5..83ec0c5a6e420025903dcb4f94d8debf0292593e 100644 --- a/src/fsharp/fsi/console.fs +++ b/src/fsharp/fsi/console.fs @@ -13,18 +13,9 @@ open Internal.Utilities /// Fixes to System.Console.ReadKey may break this code around, hence the option here. module internal ConsoleOptions = -#if FX_NO_WIN_REGISTRY - let fixupRequired = false -#else - // Bug 4254 was fixed in Dev11 (Net4.5), so this flag tracks making this fix up version specific. - let fixupRequired = not FSharpEnvironment.IsRunningOnNetFx45OrAbove -#endif - - let fixNonUnicodeSystemConsoleReadKey = ref fixupRequired let readKeyFixup (c:char) = #if FX_NO_SERVERCODEPAGES #else - if !fixNonUnicodeSystemConsoleReadKey then // Assumes the c:char is actually a byte in the System.Console.InputEncoding. // Convert it to a Unicode char through the encoding. if 0 <= int c && int c <= 255 then @@ -36,10 +27,8 @@ module internal ConsoleOptions = c // no fix up else assert("readKeyFixHook: given char is outside the 0..255 byte range" = "") - c // no fix up - else #endif - c + c type internal Style = Prompt | Out | Error diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 91f65323e4bcddb6d07aa08e0ea6fb325356e3df..1652eb079f10dc045e8887c5bfc8b941733e16b1 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -56,11 +56,6 @@ open Internal.Utilities open Internal.Utilities.Collections open Internal.Utilities.StructuredFormat -#if FX_RESHAPED_REFLECTION -open Microsoft.FSharp.Core.ReflectionAdapters -#endif - - //---------------------------------------------------------------------------- // For the FSI as a service methods... //---------------------------------------------------------------------------- @@ -92,11 +87,7 @@ module internal Utilities = let ignoreAllErrors f = try f() with _ -> () // TODO: this dotnet/core polyfill can be removed when it surfaces in Type -#if FX_RESHAPED_REFLECTION - let getMember (name: string) (memberType: MemberTypes) (attr: System.Reflection.BindingFlags) (declaringType: Type) = -#else let getMember (name: string) (memberType: MemberTypes) (attr: BindingFlags) (declaringType: Type) = -#endif let memberType = if memberType &&& MemberTypes.NestedType = MemberTypes.NestedType then memberType ||| MemberTypes.TypeInfo @@ -105,11 +96,7 @@ module internal Utilities = declaringType.GetMembers(attr) |> Array.filter(fun m -> 0 <> (int(m.MemberType &&& memberType)) && m.Name = name) let rec tryFindMember (name: string) (memberType: MemberTypes) (declaringType: Type) = -#if FX_RESHAPED_REFLECTION - let bindingFlags = System.Reflection.BindingFlags.Instance ||| System.Reflection.BindingFlags.Public ||| System.Reflection.BindingFlags.NonPublic -#else let bindingFlags = BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic -#endif match declaringType |> getMember name memberType bindingFlags with | [||] -> declaringType.GetInterfaces() |> Array.tryPick (tryFindMember name memberType) | [|m|] -> Some m @@ -185,11 +172,6 @@ module internal Utilities = outWriter.WriteLine() -#if FX_RESHAPED_REFLECTION -// restore type alias -type BindingFlags = System.Reflection.BindingFlags -#endif - //---------------------------------------------------------------------------- // Timing support //---------------------------------------------------------------------------- @@ -1589,23 +1571,17 @@ type internal FsiInterruptController(fsiOptions : FsiCommandLineOptions, module internal MagicAssemblyResolution = // FxCop identifies Assembly.LoadFrom. - [] - let private assemblyLoadFrom (path:string) = - // See bug 5501 for details on decision to use UnsafeLoadFrom here. // Summary: // It is an explicit user trust decision to load an assembly with #r. Scripts are not run automatically (for example, by double-clicking in explorer). // We considered setting loadFromRemoteSources in fsi.exe.config but this would transitively confer unsafe loading to the code in the referenced // assemblies. Better to let those assemblies decide for themselves which is safer. -#if NETSTANDARD1_6 || NETSTANDARD2_0 - Assembly.LoadFrom(path) -#else - Assembly.UnsafeLoadFrom(path) -#endif + [] + let private assemblyLoadFrom (path:string) = Assembly.UnsafeLoadFrom(path) let Install(tcConfigB, tcImports: TcImports, fsiDynamicCompiler: FsiDynamicCompiler, fsiConsoleOutput: FsiConsoleOutput) = -#if NETSTANDARD1_6 || NETSTANDARD2_0 +#if NETSTANDARD ignore tcConfigB ignore tcImports ignore fsiDynamicCompiler @@ -2411,9 +2387,7 @@ let internal DriveFsiEventLoop (fsi: FsiEvaluationSessionHostConfig, fsiConsoleO /// text input, writing to the given text output and error writers. type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], inReader:TextReader, outWriter:TextWriter, errorWriter: TextWriter, fsiCollectible: bool, legacyReferenceResolver: ReferenceResolver.Resolver option) = -#if !FX_NO_HEAPTERMINATION do if not runningOnMono then Lib.UnmanagedProcessExecutionOptions.EnableHeapTerminationOnCorruption() (* SDL recommendation *) -#endif // Explanation: When FsiEvaluationSession.Create is called we do a bunch of processing. For fsi.exe // and fsiAnyCpu.exe there are no other active threads at this point, so we can assume this is the @@ -2464,7 +2438,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i do tcConfigB.resolutionEnvironment <- ResolutionEnvironment.CompilationAndEvaluation // See Bug 3608 do tcConfigB.useFsiAuxLib <- fsi.UseFsiAuxLib -#if NETSTANDARD1_6 || NETSTANDARD2_0 +#if NETSTANDARD do tcConfigB.useSimpleResolution <- true do SetTargetProfile tcConfigB "netcore" // always assume System.Runtime codegen #endif @@ -2474,7 +2448,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i do SetDebugSwitch tcConfigB (Some "pdbonly") OptionSwitch.On do SetTailcallSwitch tcConfigB OptionSwitch.On -#if NETSTANDARD1_6 || NETSTANDARD2_0 +#if NETSTANDARD // set platform depending on whether the current process is a 64-bit process. // BUG 429882 : FsiAnyCPU.exe issues warnings (x64 v MSIL) when referencing 64-bit assemblies do tcConfigB.platform <- if IntPtr.Size = 8 then Some AMD64 else Some X86 diff --git a/src/fsharp/fsi/fsi.fsproj b/src/fsharp/fsi/fsi.fsproj index 7d02c79e1d8e6c0edd16a5c65bff30245a2a6a2a..5c2dba8f939a410e84ee8860b86a14bfcd651d0b 100644 --- a/src/fsharp/fsi/fsi.fsproj +++ b/src/fsharp/fsi/fsi.fsproj @@ -35,7 +35,7 @@ - + diff --git a/src/fsharp/fsi/fsimain.fs b/src/fsharp/fsi/fsimain.fs index 90bf78b650874849dc137a6cb4759ddb9308193e..8bb27f1c63e71c540b244371d4d7aeeba8c0d9c3 100644 --- a/src/fsharp/fsi/fsimain.fs +++ b/src/fsharp/fsi/fsimain.fs @@ -28,21 +28,13 @@ open FSharp.Compiler.Interactive.Shell open FSharp.Compiler.Interactive open FSharp.Compiler.Interactive.Shell.Settings -#if FX_RESHAPED_REFLECTION -open Microsoft.FSharp.Core.ReflectionAdapters -#endif - #nowarn "55" #nowarn "40" // let rec on value 'fsiConfig' - // Hardbinding dependencies should we NGEN fsi.exe -#if !FX_NO_DEFAULT_DEPENDENCY_TYPE [] do () [] do () -#endif - // Standard attributes [] [] @@ -202,7 +194,7 @@ let evaluateSession(argv: string[]) = //#if USE_FSharp_Compiler_Interactive_Settings let fsiObjOpt = let defaultFSharpBinariesDir = -#if FX_RESHAPED_REFLECTION +#if FX_NO_APP_DOMAINS System.AppContext.BaseDirectory #else System.AppDomain.CurrentDomain.BaseDirectory @@ -324,9 +316,7 @@ let evaluateSession(argv: string[]) = // Mark the main thread as STAThread since it is a GUI thread [] [] -#if !FX_NO_LOADER_OPTIMIZATION [] -#endif let MainMain argv = ignore argv let argv = System.Environment.GetCommandLineArgs() diff --git a/src/fsharp/import.fs b/src/fsharp/import.fs index c8cb751cca38cb2af4f73cc9cb0bb3ccd9ff2562..e6709a3d0077eac1ec64ee4d4cd8f40ab9fc2f82 100644 --- a/src/fsharp/import.fs +++ b/src/fsharp/import.fs @@ -52,8 +52,8 @@ type AssemblyLoader = /// using tcImports.GetImportMap() if needed, and it is not harmful if multiple instances are used. The object /// serves as an interface through to the tables stored in the primary TcImports structures defined in CompileOps.fs. [] -type ImportMap(g:TcGlobals,assemblyLoader:AssemblyLoader) = - let typeRefToTyconRefCache = ConcurrentDictionary() +type ImportMap(g:TcGlobals, assemblyLoader:AssemblyLoader) = + let typeRefToTyconRefCache = ConcurrentDictionary() member this.g = g member this.assemblyLoader = assemblyLoader member this.ILTypeRefToTyconRefCache = typeRefToTyconRefCache @@ -74,7 +74,7 @@ let CanImportILScopeRef (env:ImportMap) m scoref = /// Import a reference to a type definition, given the AbstractIL data for the type reference -let ImportTypeRefData (env:ImportMap) m (scoref,path,typeName) = +let ImportTypeRefData (env:ImportMap) m (scoref, path, typeName) = // Explanation: This represents an unchecked invariant in the hosted compiler: that any operations // which import types (and resolve assemblies from the tcImports tables) happen on the compilation thread. @@ -82,8 +82,8 @@ let ImportTypeRefData (env:ImportMap) m (scoref,path,typeName) = let ccu = match scoref with - | ILScopeRef.Local -> error(InternalError("ImportILTypeRef: unexpected local scope",m)) - | ILScopeRef.Module _ -> error(InternalError("ImportILTypeRef: reference found to a type in an auxiliary module",m)) + | ILScopeRef.Local -> error(InternalError("ImportILTypeRef: unexpected local scope", m)) + | ILScopeRef.Module _ -> error(InternalError("ImportILTypeRef: reference found to a type in an auxiliary module", m)) | ILScopeRef.Assembly assemblyRef -> env.assemblyLoader.FindCcuFromAssemblyRef (ctok, m, assemblyRef) // NOTE: only assemblyLoader callsite // Do a dereference of a fake tcref for the type just to check it exists in the target assembly and to find @@ -92,44 +92,44 @@ let ImportTypeRefData (env:ImportMap) m (scoref,path,typeName) = match ccu with | ResolvedCcu ccu->ccu | UnresolvedCcu ccuName -> - error (Error(FSComp.SR.impTypeRequiredUnavailable(typeName, ccuName),m)) + error (Error(FSComp.SR.impTypeRequiredUnavailable(typeName, ccuName), m)) let fakeTyconRef = mkNonLocalTyconRef (mkNonLocalEntityRef ccu path) typeName let tycon = try fakeTyconRef.Deref with _ -> - error (Error(FSComp.SR.impReferencedTypeCouldNotBeFoundInAssembly(String.concat "." (Array.append path [| typeName |]), ccu.AssemblyName),m)) + error (Error(FSComp.SR.impReferencedTypeCouldNotBeFoundInAssembly(String.concat "." (Array.append path [| typeName |]), ccu.AssemblyName), m)) #if !NO_EXTENSIONTYPING // Validate (once because of caching) match tycon.TypeReprInfo with | TProvidedTypeExtensionPoint info -> //printfn "ImportTypeRefData: validating type: typeLogicalName = %A" typeName - ExtensionTyping.ValidateProvidedTypeAfterStaticInstantiation(m,info.ProvidedType,path,typeName) + ExtensionTyping.ValidateProvidedTypeAfterStaticInstantiation(m, info.ProvidedType, path, typeName) | _ -> () #endif match tryRescopeEntity ccu tycon with - | ValueNone -> error (Error(FSComp.SR.impImportedAssemblyUsesNotPublicType(String.concat "." (Array.toList path@[typeName])),m)) + | ValueNone -> error (Error(FSComp.SR.impImportedAssemblyUsesNotPublicType(String.concat "." (Array.toList path@[typeName])), m)) | ValueSome tcref -> tcref /// Import a reference to a type definition, given an AbstractIL ILTypeRef, without caching // // Note, the type names that flow to the point include the "mangled" type names used for static parameters for provided types. -// For example, +// For example, // Foo.Bar,"1.0" // This is because ImportProvidedType goes via Abstract IL type references. let ImportILTypeRefUncached (env:ImportMap) m (tref:ILTypeRef) = - let path,typeName = + let path, typeName = match tref.Enclosing with | [] -> splitILTypeNameWithPossibleStaticArguments tref.Name | h :: t -> - let nsp,tname = splitILTypeNameWithPossibleStaticArguments h + let nsp, tname = splitILTypeNameWithPossibleStaticArguments h // Note, subsequent type names do not need to be split, only the first [| yield! nsp; yield tname; yield! t |], tref.Name - ImportTypeRefData (env:ImportMap) m (tref.Scope,path,typeName) + ImportTypeRefData (env:ImportMap) m (tref.Scope, path, typeName) /// Import a reference to a type definition, given an AbstractIL ILTypeRef, with caching @@ -158,7 +158,7 @@ let rec ImportILType (env:ImportMap) m tinst ty = | ILType.Void -> env.g.unit_ty - | ILType.Array(bounds,ty) -> + | ILType.Array(bounds, ty) -> let n = bounds.Rank let elementType = ImportILType env m tinst ty mkArrayTy env.g n elementType m @@ -172,13 +172,13 @@ let rec ImportILType (env:ImportMap) m tinst ty = | ILType.Ptr ILType.Void when env.g.voidptr_tcr.CanDeref -> mkVoidPtrTy env.g | ILType.Ptr ty -> mkNativePtrTy env.g (ImportILType env m tinst ty) | ILType.FunctionPointer _ -> env.g.nativeint_ty (* failwith "cannot import this kind of type (ptr, fptr)" *) - | ILType.Modified(_,_,ty) -> + | ILType.Modified(_, _, ty) -> // All custom modifiers are ignored ImportILType env m tinst ty | ILType.TypeVar u16 -> try List.item (int u16) tinst with _ -> - error(Error(FSComp.SR.impNotEnoughTypeParamsInScopeWhileImporting(),m)) + error(Error(FSComp.SR.impNotEnoughTypeParamsInScopeWhileImporting(), m)) let rec CanImportILType (env:ImportMap) m ty = match ty with @@ -190,7 +190,7 @@ let rec CanImportILType (env:ImportMap) m ty = | ILType.Byref ety -> CanImportILType env m ety | ILType.Ptr ety -> CanImportILType env m ety | ILType.FunctionPointer _ -> true - | ILType.Modified(_,_,ety) -> CanImportILType env m ety + | ILType.Modified(_, _, ety) -> CanImportILType env m ety | ILType.TypeVar _u16 -> true #if !NO_EXTENSIONTYPING @@ -198,44 +198,44 @@ let rec CanImportILType (env:ImportMap) m ty = /// Import a provided type reference as an F# type TyconRef let ImportProvidedNamedType (env:ImportMap) (m:range) (st:Tainted) = // See if a reverse-mapping exists for a generated/relocated System.Type - match st.PUntaint((fun st -> st.TryGetTyconRef()),m) with + match st.PUntaint((fun st -> st.TryGetTyconRef()), m) with | Some x -> (x :?> TyconRef) | None -> - let tref = ExtensionTyping.GetILTypeRefOfProvidedType (st,m) + let tref = ExtensionTyping.GetILTypeRefOfProvidedType (st, m) ImportILTypeRef env m tref /// Import a provided type as an AbstractIL type let rec ImportProvidedTypeAsILType (env:ImportMap) (m:range) (st:Tainted) = - if st.PUntaint ((fun x -> x.IsVoid),m) then ILType.Void - elif st.PUntaint((fun st -> st.IsGenericParameter),m) then - mkILTyvarTy (uint16 (st.PUntaint((fun st -> st.GenericParameterPosition),m))) - elif st.PUntaint((fun st -> st.IsArray),m) then - let et = ImportProvidedTypeAsILType env m (st.PApply((fun st -> st.GetElementType()),m)) - ILType.Array(ILArrayShape.FromRank (st.PUntaint((fun st -> st.GetArrayRank()),m)), et) - elif st.PUntaint((fun st -> st.IsByRef),m) then - let et = ImportProvidedTypeAsILType env m (st.PApply((fun st -> st.GetElementType()),m)) + if st.PUntaint ((fun x -> x.IsVoid), m) then ILType.Void + elif st.PUntaint((fun st -> st.IsGenericParameter), m) then + mkILTyvarTy (uint16 (st.PUntaint((fun st -> st.GenericParameterPosition), m))) + elif st.PUntaint((fun st -> st.IsArray), m) then + let et = ImportProvidedTypeAsILType env m (st.PApply((fun st -> st.GetElementType()), m)) + ILType.Array(ILArrayShape.FromRank (st.PUntaint((fun st -> st.GetArrayRank()), m)), et) + elif st.PUntaint((fun st -> st.IsByRef), m) then + let et = ImportProvidedTypeAsILType env m (st.PApply((fun st -> st.GetElementType()), m)) ILType.Byref et - elif st.PUntaint((fun st -> st.IsPointer),m) then - let et = ImportProvidedTypeAsILType env m (st.PApply((fun st -> st.GetElementType()),m)) + elif st.PUntaint((fun st -> st.IsPointer), m) then + let et = ImportProvidedTypeAsILType env m (st.PApply((fun st -> st.GetElementType()), m)) ILType.Ptr et else let gst, genericArgs = - if st.PUntaint((fun st -> st.IsGenericType),m) then - let args = st.PApplyArray((fun st -> st.GetGenericArguments()),"GetGenericArguments",m) |> Array.map (ImportProvidedTypeAsILType env m) |> List.ofArray - let gst = st.PApply((fun st -> st.GetGenericTypeDefinition()),m) + if st.PUntaint((fun st -> st.IsGenericType), m) then + let args = st.PApplyArray((fun st -> st.GetGenericArguments()), "GetGenericArguments", m) |> Array.map (ImportProvidedTypeAsILType env m) |> List.ofArray + let gst = st.PApply((fun st -> st.GetGenericTypeDefinition()), m) gst, args else st, [] - let tref = ExtensionTyping.GetILTypeRefOfProvidedType (gst,m) + let tref = ExtensionTyping.GetILTypeRefOfProvidedType (gst, m) let tcref = ImportProvidedNamedType env m gst let tps = tcref.Typars m if tps.Length <> genericArgs.Length then - error(Error(FSComp.SR.impInvalidNumberOfGenericArguments(tcref.CompiledName, tps.Length, genericArgs.Length),m)) + error(Error(FSComp.SR.impInvalidNumberOfGenericArguments(tcref.CompiledName, tps.Length, genericArgs.Length), m)) // We're converting to an IL type, where generic arguments are erased - let genericArgs = List.zip tps genericArgs |> List.filter (fun (tp,_) -> not tp.IsErased) |> List.map snd + let genericArgs = List.zip tps genericArgs |> List.filter (fun (tp, _) -> not tp.IsErased) |> List.map snd - let tspec = mkILTySpec(tref,genericArgs) - if st.PUntaint((fun st -> st.IsValueType),m) then + let tspec = mkILTySpec(tref, genericArgs) + if st.PUntaint((fun st -> st.IsValueType), m) then ILType.Value tspec else mkILBoxedType tspec @@ -253,14 +253,14 @@ let rec ImportProvidedType (env:ImportMap) (m:range) (* (tinst:TypeInst) *) (st: RequireCompilationThread ctok let g = env.g - if st.PUntaint((fun st -> st.IsArray),m) then - let elemTy = (ImportProvidedType env m (* tinst *) (st.PApply((fun st -> st.GetElementType()),m))) - mkArrayTy g (st.PUntaint((fun st -> st.GetArrayRank()),m)) elemTy m - elif st.PUntaint((fun st -> st.IsByRef),m) then - let elemTy = (ImportProvidedType env m (* tinst *) (st.PApply((fun st -> st.GetElementType()),m))) + if st.PUntaint((fun st -> st.IsArray), m) then + let elemTy = (ImportProvidedType env m (* tinst *) (st.PApply((fun st -> st.GetElementType()), m))) + mkArrayTy g (st.PUntaint((fun st -> st.GetArrayRank()), m)) elemTy m + elif st.PUntaint((fun st -> st.IsByRef), m) then + let elemTy = (ImportProvidedType env m (* tinst *) (st.PApply((fun st -> st.GetElementType()), m))) mkByrefTy g elemTy - elif st.PUntaint((fun st -> st.IsPointer),m) then - let elemTy = (ImportProvidedType env m (* tinst *) (st.PApply((fun st -> st.GetElementType()),m))) + elif st.PUntaint((fun st -> st.IsPointer), m) then + let elemTy = (ImportProvidedType env m (* tinst *) (st.PApply((fun st -> st.GetElementType()), m))) if isUnitTy g elemTy || isVoidTy g elemTy && g.voidptr_tcr.CanDeref then mkVoidPtrTy g else @@ -269,10 +269,10 @@ let rec ImportProvidedType (env:ImportMap) (m:range) (* (tinst:TypeInst) *) (st: // REVIEW: Extension type could try to be its own generic arg (or there could be a type loop) let tcref, genericArgs = - if st.PUntaint((fun st -> st.IsGenericType),m) then - let tcref = ImportProvidedNamedType env m (st.PApply((fun st -> st.GetGenericTypeDefinition()),m)) - let args = st.PApplyArray((fun st -> st.GetGenericArguments()),"GetGenericArguments",m) |> Array.map (ImportProvidedType env m (* tinst *) ) |> List.ofArray - tcref,args + if st.PUntaint((fun st -> st.IsGenericType), m) then + let tcref = ImportProvidedNamedType env m (st.PApply((fun st -> st.GetGenericTypeDefinition()), m)) + let args = st.PApplyArray((fun st -> st.GetGenericArguments()), "GetGenericArguments", m) |> Array.map (ImportProvidedType env m (* tinst *) ) |> List.ofArray + tcref, args else let tcref = ImportProvidedNamedType env m st tcref, [] @@ -290,22 +290,22 @@ let rec ImportProvidedType (env:ImportMap) (m:range) (* (tinst:TypeInst) *) (st: let tps = tcref.Typars m if tps.Length <> genericArgs.Length then - error(Error(FSComp.SR.impInvalidNumberOfGenericArguments(tcref.CompiledName, tps.Length, genericArgs.Length),m)) + error(Error(FSComp.SR.impInvalidNumberOfGenericArguments(tcref.CompiledName, tps.Length, genericArgs.Length), m)) let genericArgs = - (tps,genericArgs) ||> List.map2 (fun tp genericArg -> + (tps, genericArgs) ||> List.map2 (fun tp genericArg -> if tp.Kind = TyparKind.Measure then let rec conv ty = match ty with - | TType_app (tcref,[t1;t2]) when tyconRefEq g tcref g.measureproduct_tcr -> Measure.Prod (conv t1, conv t2) - | TType_app (tcref,[t1]) when tyconRefEq g tcref g.measureinverse_tcr -> Measure.Inv (conv t1) - | TType_app (tcref,[]) when tyconRefEq g tcref g.measureone_tcr -> Measure.One - | TType_app (tcref,[]) when tcref.TypeOrMeasureKind = TyparKind.Measure -> Measure.Con tcref - | TType_app (tcref,_) -> - errorR(Error(FSComp.SR.impInvalidMeasureArgument1(tcref.CompiledName, tp.Name),m)) + | TType_app (tcref, [t1;t2]) when tyconRefEq g tcref g.measureproduct_tcr -> Measure.Prod (conv t1, conv t2) + | TType_app (tcref, [t1]) when tyconRefEq g tcref g.measureinverse_tcr -> Measure.Inv (conv t1) + | TType_app (tcref, []) when tyconRefEq g tcref g.measureone_tcr -> Measure.One + | TType_app (tcref, []) when tcref.TypeOrMeasureKind = TyparKind.Measure -> Measure.Con tcref + | TType_app (tcref, _) -> + errorR(Error(FSComp.SR.impInvalidMeasureArgument1(tcref.CompiledName, tp.Name), m)) Measure.One | _ -> - errorR(Error(FSComp.SR.impInvalidMeasureArgument2(tp.Name),m)) + errorR(Error(FSComp.SR.impInvalidMeasureArgument2(tp.Name), m)) Measure.One TType_measure (conv genericArg) @@ -317,72 +317,72 @@ let rec ImportProvidedType (env:ImportMap) (m:range) (* (tinst:TypeInst) *) (st: /// Import a provided method reference as an Abstract IL method reference let ImportProvidedMethodBaseAsILMethodRef (env:ImportMap) (m:range) (mbase: Tainted) = - let tref = ExtensionTyping.GetILTypeRefOfProvidedType (mbase.PApply((fun mbase -> mbase.DeclaringType),m), m) + let tref = ExtensionTyping.GetILTypeRefOfProvidedType (mbase.PApply((fun mbase -> mbase.DeclaringType), m), m) let mbase = // Find the formal member corresponding to the called member match mbase.OfType() with | Some minfo when - minfo.PUntaint((fun minfo -> minfo.IsGenericMethod|| minfo.DeclaringType.IsGenericType),m) -> - let declaringType = minfo.PApply((fun minfo -> minfo.DeclaringType),m) + minfo.PUntaint((fun minfo -> minfo.IsGenericMethod|| minfo.DeclaringType.IsGenericType), m) -> + let declaringType = minfo.PApply((fun minfo -> minfo.DeclaringType), m) let declaringGenericTypeDefn = - if declaringType.PUntaint((fun t -> t.IsGenericType),m) then - declaringType.PApply((fun declaringType -> declaringType.GetGenericTypeDefinition()),m) + if declaringType.PUntaint((fun t -> t.IsGenericType), m) then + declaringType.PApply((fun declaringType -> declaringType.GetGenericTypeDefinition()), m) else declaringType - let methods = declaringGenericTypeDefn.PApplyArray((fun x -> x.GetMethods()),"GetMethods",m) - let metadataToken = minfo.PUntaint((fun minfo -> minfo.MetadataToken),m) - let found = methods |> Array.tryFind (fun x -> x.PUntaint((fun x -> x.MetadataToken),m) = metadataToken) + let methods = declaringGenericTypeDefn.PApplyArray((fun x -> x.GetMethods()), "GetMethods", m) + let metadataToken = minfo.PUntaint((fun minfo -> minfo.MetadataToken), m) + let found = methods |> Array.tryFind (fun x -> x.PUntaint((fun x -> x.MetadataToken), m) = metadataToken) match found with | Some found -> found.Coerce(m) | None -> - let methodName = minfo.PUntaint((fun minfo -> minfo.Name),m) - let typeName = declaringGenericTypeDefn.PUntaint((fun declaringGenericTypeDefn -> declaringGenericTypeDefn.FullName),m) - error(NumberedError(FSComp.SR.etIncorrectProvidedMethod(ExtensionTyping.DisplayNameOfTypeProvider(minfo.TypeProvider, m),methodName,metadataToken,typeName), m)) + let methodName = minfo.PUntaint((fun minfo -> minfo.Name), m) + let typeName = declaringGenericTypeDefn.PUntaint((fun declaringGenericTypeDefn -> declaringGenericTypeDefn.FullName), m) + error(NumberedError(FSComp.SR.etIncorrectProvidedMethod(ExtensionTyping.DisplayNameOfTypeProvider(minfo.TypeProvider, m), methodName, metadataToken, typeName), m)) | _ -> match mbase.OfType() with - | Some cinfo when cinfo.PUntaint((fun x -> x.DeclaringType.IsGenericType),m) -> - let declaringType = cinfo.PApply((fun x -> x.DeclaringType),m) - let declaringGenericTypeDefn = declaringType.PApply((fun x -> x.GetGenericTypeDefinition()),m) + | Some cinfo when cinfo.PUntaint((fun x -> x.DeclaringType.IsGenericType), m) -> + let declaringType = cinfo.PApply((fun x -> x.DeclaringType), m) + let declaringGenericTypeDefn = declaringType.PApply((fun x -> x.GetGenericTypeDefinition()), m) // We have to find the uninstantiated formal signature corresponding to this instantiated constructor. // Annoyingly System.Reflection doesn't give us a MetadataToken to compare on, so we have to look by doing // the instantiation and comparing.. let found = - let ctors = declaringGenericTypeDefn.PApplyArray((fun x -> x.GetConstructors()),"GetConstructors",m) + let ctors = declaringGenericTypeDefn.PApplyArray((fun x -> x.GetConstructors()), "GetConstructors", m) let actualParameterTypes = - [ for p in cinfo.PApplyArray((fun x -> x.GetParameters()), "GetParameters",m) do - yield ImportProvidedType env m (p.PApply((fun p -> p.ParameterType),m)) ] + [ for p in cinfo.PApplyArray((fun x -> x.GetParameters()), "GetParameters", m) do + yield ImportProvidedType env m (p.PApply((fun p -> p.ParameterType), m)) ] let actualGenericArgs = argsOfAppTy env.g (ImportProvidedType env m declaringType) ctors |> Array.tryFind (fun ctor -> let formalParameterTypesAfterInstantiation = - [ for p in ctor.PApplyArray((fun x -> x.GetParameters()), "GetParameters",m) do - let ilFormalTy = ImportProvidedTypeAsILType env m (p.PApply((fun p -> p.ParameterType),m)) + [ for p in ctor.PApplyArray((fun x -> x.GetParameters()), "GetParameters", m) do + let ilFormalTy = ImportProvidedTypeAsILType env m (p.PApply((fun p -> p.ParameterType), m)) yield ImportILType env m actualGenericArgs ilFormalTy ] - (formalParameterTypesAfterInstantiation,actualParameterTypes) ||> List.lengthsEqAndForall2 (typeEquiv env.g)) + (formalParameterTypesAfterInstantiation, actualParameterTypes) ||> List.lengthsEqAndForall2 (typeEquiv env.g)) match found with | Some found -> found.Coerce(m) | None -> - let typeName = declaringGenericTypeDefn.PUntaint((fun x -> x.FullName),m) - error(NumberedError(FSComp.SR.etIncorrectProvidedConstructor(ExtensionTyping.DisplayNameOfTypeProvider(cinfo.TypeProvider, m),typeName), m)) + let typeName = declaringGenericTypeDefn.PUntaint((fun x -> x.FullName), m) + error(NumberedError(FSComp.SR.etIncorrectProvidedConstructor(ExtensionTyping.DisplayNameOfTypeProvider(cinfo.TypeProvider, m), typeName), m)) | _ -> mbase let rty = match mbase.OfType() with - | Some minfo -> minfo.PApply((fun minfo -> minfo.ReturnType),m) + | Some minfo -> minfo.PApply((fun minfo -> minfo.ReturnType), m) | None -> match mbase.OfType() with - | Some _ -> mbase.PApply((fun _ -> ProvidedType.Void),m) + | Some _ -> mbase.PApply((fun _ -> ProvidedType.Void), m) | _ -> failwith "unexpected" let genericArity = - if mbase.PUntaint((fun x -> x.IsGenericMethod),m) then - mbase.PUntaint((fun x -> x.GetGenericArguments().Length),m) + if mbase.PUntaint((fun x -> x.IsGenericMethod), m) then + mbase.PUntaint((fun x -> x.GetGenericArguments().Length), m) else 0 - let callingConv = (if mbase.PUntaint((fun x -> x.IsStatic),m) then ILCallingConv.Static else ILCallingConv.Instance) + let callingConv = (if mbase.PUntaint((fun x -> x.IsStatic), m) then ILCallingConv.Static else ILCallingConv.Instance) let parameters = - [ for p in mbase.PApplyArray((fun x -> x.GetParameters()), "GetParameters",m) do - yield ImportProvidedTypeAsILType env m (p.PApply((fun p -> p.ParameterType),m)) ] - mkILMethRef (tref, callingConv, mbase.PUntaint((fun x -> x.Name),m), genericArity, parameters, ImportProvidedTypeAsILType env m rty ) + [ for p in mbase.PApplyArray((fun x -> x.GetParameters()), "GetParameters", m) do + yield ImportProvidedTypeAsILType env m (p.PApply((fun p -> p.ParameterType), m)) ] + mkILMethRef (tref, callingConv, mbase.PUntaint((fun x -> x.Name), m), genericArity, parameters, ImportProvidedTypeAsILType env m rty ) #endif //------------------------------------------------------------------------- @@ -406,8 +406,8 @@ let ImportILGenericParameters amap m scoref tinst (gps: ILGenericParameterDefs) let tptys = tps |> List.map mkTyparTy let importInst = tinst@tptys - (tps,gps) ||> List.iter2 (fun tp gp -> - let constraints = gp.Constraints |> List.map (fun ilty -> TyparConstraint.CoercesTo(ImportILType amap m importInst (rescopeILType scoref ilty),m) ) + (tps, gps) ||> List.iter2 (fun tp gp -> + let constraints = gp.Constraints |> List.map (fun ilty -> TyparConstraint.CoercesTo(ImportILType amap m importInst (rescopeILType scoref ilty), m) ) let constraints = if gp.HasReferenceTypeConstraint then (TyparConstraint.IsReferenceType(m)::constraints) else constraints let constraints = if gp.HasNotNullableValueTypeConstraint then (TyparConstraint.IsNonNullableStruct(m)::constraints) else constraints let constraints = if gp.HasDefaultConstructorConstraint then (TyparConstraint.RequiresDefaultConstructor(m)::constraints) else constraints @@ -422,7 +422,7 @@ let ImportILGenericParameters amap m scoref tinst (gps: ILGenericParameterDefs) let multisetDiscriminateAndMap nodef tipf (items: ('Key list * 'Value) list) = // Find all the items with an empty key list and call 'tipf' let tips = - [ for (keylist,v) in items do + [ for (keylist, v) in items do match keylist with | [] -> yield tipf v | _ -> () ] @@ -430,17 +430,17 @@ let multisetDiscriminateAndMap nodef tipf (items: ('Key list * 'Value) list) = // Find all the items with a non-empty key list. Bucket them together by // the first key. For each bucket, call 'nodef' on that head key and the bucket. let nodes = - let buckets = new Dictionary<_,_>(10) - for (keylist,v) in items do + let buckets = new Dictionary<_, _>(10) + for (keylist, v) in items do match keylist with | [] -> () | key :: rest -> buckets.[key] <- match buckets.TryGetValue(key) with - | true, b -> (rest,v) :: b - | _ -> (rest,v) :: [] + | true, b -> (rest, v) :: b + | _ -> (rest, v) :: [] - [ for (KeyValue(key,items)) in buckets -> nodef key items ] + [ for (KeyValue(key, items)) in buckets -> nodef key items ] tips @ nodes @@ -454,11 +454,11 @@ let rec ImportILTypeDef amap m scoref (cpath:CompilationPath) enc nm (tdef:ILTyp // Add the type itself. NewILTycon (Some cpath) - (nm,m) + (nm, m) // The read of the type parameters may fail to resolve types. We pick up a new range from the point where that read is forced // Make sure we reraise the original exception one occurs - see findOriginalException. (LazyWithContext.Create((fun m -> ImportILGenericParameters amap m scoref [] tdef.GenericParams), ErrorLogger.findOriginalException)) - (scoref,enc,tdef) + (scoref, enc, tdef) (MaybeLazy.Lazy lazyModuleOrNamespaceTypeForNestedTypes) @@ -479,8 +479,8 @@ and ImportILTypeDefList amap m (cpath:CompilationPath) enc items = (fun n tgs -> let modty = lazy (ImportILTypeDefList amap m (cpath.NestedCompPath n Namespace) enc tgs) NewModuleOrNamespace (Some cpath) taccessPublic (mkSynId m n) XmlDoc.Empty [] (MaybeLazy.Lazy modty)) - (fun (n,info:Lazy<_>) -> - let (scoref2,_,lazyTypeDef:ILPreTypeDef) = info.Force() + (fun (n, info:Lazy<_>) -> + let (scoref2, _, lazyTypeDef:ILPreTypeDef) = info.Force() ImportILTypeDef amap m scoref2 cpath enc n (lazyTypeDef.GetTypeDef())) let kind = match enc with [] -> Namespace | _ -> ModuleOrType @@ -491,7 +491,7 @@ and ImportILTypeDefList amap m (cpath:CompilationPath) enc items = and ImportILTypeDefs amap m scoref cpath enc (tdefs: ILTypeDefs) = // We be very careful not to force a read of the type defs here tdefs.AsArrayOfPreTypeDefs - |> Array.map (fun pre -> (pre.Namespace,(pre.Name,notlazy(scoref,pre.MetadataIndex,pre)))) + |> Array.map (fun pre -> (pre.Namespace, (pre.Name, notlazy(scoref, pre.MetadataIndex, pre)))) |> Array.toList |> ImportILTypeDefList amap m cpath enc @@ -501,7 +501,7 @@ and ImportILTypeDefs amap m scoref cpath enc (tdefs: ILTypeDefs) = /// the return ModuleOrNamespaceType will contain namespace entities for "System" and "Library", which in turn contain /// type definition entities for ["Char"; "Int32"] and ["C"] respectively. let ImportILAssemblyMainTypeDefs amap m scoref modul = - modul.TypeDefs |> ImportILTypeDefs amap m scoref (CompPath(scoref,[])) [] + modul.TypeDefs |> ImportILTypeDefs amap m scoref (CompPath(scoref, [])) [] /// Import the "exported types" table for multi-module assemblies. let ImportILAssemblyExportedType amap m auxModLoader (scoref:ILScopeRef) (exportedType:ILExportedTypeOrForwarder) = @@ -509,7 +509,7 @@ let ImportILAssemblyExportedType amap m auxModLoader (scoref:ILScopeRef) (export if exportedType.IsForwarder then [] else - let ns,n = splitILTypeName exportedType.Name + let ns, n = splitILTypeName exportedType.Name let info = lazy (match (try @@ -519,11 +519,11 @@ let ImportILAssemblyExportedType amap m auxModLoader (scoref:ILScopeRef) (export with :? KeyNotFoundException -> None) with | None -> - error(Error(FSComp.SR.impReferenceToDllRequiredByAssembly(exportedType.ScopeRef.QualifiedName, scoref.QualifiedName, exportedType.Name),m)) + error(Error(FSComp.SR.impReferenceToDllRequiredByAssembly(exportedType.ScopeRef.QualifiedName, scoref.QualifiedName, exportedType.Name), m)) | Some preTypeDef -> - scoref,-1,preTypeDef) + scoref, -1, preTypeDef) - [ ImportILTypeDefList amap m (CompPath(scoref,[])) [] [(ns,(n,info))] ] + [ ImportILTypeDefList amap m (CompPath(scoref, [])) [] [(ns, (n, info))] ] /// Import the "exported types" table for multi-module assemblies. let ImportILAssemblyExportedTypes amap m auxModLoader scoref (exportedTypes: ILExportedTypesAndForwarders) = @@ -544,16 +544,16 @@ let ImportILAssemblyTypeForwarders (amap, m, exportedTypes:ILExportedTypesAndFor // Note: it is very important that we call auxModLoader lazily [ //printfn "reading forwarders..." for exportedType in exportedTypes.AsList do - let ns,n = splitILTypeName exportedType.Name + let ns, n = splitILTypeName exportedType.Name //printfn "found forwarder for %s..." n - let tcref = lazy ImportILTypeRefUncached (amap()) m (ILTypeRef.Create(exportedType.ScopeRef,[],exportedType.Name)) - yield (Array.ofList ns,n),tcref + let tcref = lazy ImportILTypeRefUncached (amap()) m (ILTypeRef.Create(exportedType.ScopeRef, [], exportedType.Name)) + yield (Array.ofList ns, n), tcref let rec nested (nets:ILNestedExportedTypes) enc = [ for net in nets.AsList do //printfn "found nested forwarder for %s..." net.Name - let tcref = lazy ImportILTypeRefUncached (amap()) m (ILTypeRef.Create (exportedType.ScopeRef,enc,net.Name)) - yield (Array.ofList enc,exportedType.Name),tcref + let tcref = lazy ImportILTypeRefUncached (amap()) m (ILTypeRef.Create (exportedType.ScopeRef, enc, net.Name)) + yield (Array.ofList enc, exportedType.Name), tcref yield! nested net.Nested (enc @ [ net.Name ]) ] yield! nested exportedType.Nested (ns@[n]) ] |> Map.ofList @@ -565,9 +565,9 @@ let ImportILAssembly(amap:(unit -> ImportMap), m, auxModuleLoader, ilScopeRef, s let aref = match ilScopeRef with | ILScopeRef.Assembly aref -> aref - | _ -> error(InternalError("ImportILAssembly: cannot reference .NET netmodules directly, reference the containing assembly instead",m)) + | _ -> error(InternalError("ImportILAssembly: cannot reference .NET netmodules directly, reference the containing assembly instead", m)) let nm = aref.Name - let mty = ImportILAssemblyTypeDefs(amap,m,auxModuleLoader,aref,ilModule) + let mty = ImportILAssemblyTypeDefs(amap, m, auxModuleLoader, aref, ilModule) let ccuData : CcuData = { IsFSharp=false UsesFSharp20PlusQuotations=false @@ -587,6 +587,6 @@ let ImportILAssembly(amap:(unit -> ImportMap), m, auxModuleLoader, ilScopeRef, s TypeForwarders = (match ilModule.Manifest with | None -> Map.empty - | Some manifest -> ImportILAssemblyTypeForwarders(amap,m,manifest.ExportedTypes)) } + | Some manifest -> ImportILAssemblyTypeForwarders(amap, m, manifest.ExportedTypes)) } - CcuThunk.Create(nm,ccuData) + CcuThunk.Create(nm, ccuData) diff --git a/src/fsharp/infos.fs b/src/fsharp/infos.fs index d8b2cc37f416c31d837101446f684c46f42759a3..642d0d46bc752c5e22c532375d288cc4cca49bec 100755 --- a/src/fsharp/infos.fs +++ b/src/fsharp/infos.fs @@ -1,15 +1,11 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -/// tinfos, minfos, finfos, pinfos - summaries of information for references -/// to .NET and F# constructs. - - module internal FSharp.Compiler.Infos -open FSharp.Compiler.AbstractIL -open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AbstractIL +open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Internal.Library -open FSharp.Compiler +open FSharp.Compiler open FSharp.Compiler.Range open FSharp.Compiler.Ast open FSharp.Compiler.ErrorLogger @@ -24,78 +20,74 @@ open Microsoft.FSharp.Core.Printf open FSharp.Compiler.ExtensionTyping #endif -#if FX_RESHAPED_REFLECTION -open Microsoft.FSharp.Core.ReflectionAdapters -#endif - //------------------------------------------------------------------------- // From IL types to F# types -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- /// Import an IL type as an F# type. importInst gives the context for interpreting type variables. -let ImportILType scoref amap m importInst ilty = - ilty |> rescopeILType scoref |> Import.ImportILType amap m importInst +let ImportILType scoref amap m importInst ilty = + ilty |> rescopeILType scoref |> Import.ImportILType amap m importInst -let CanImportILType scoref amap m ilty = - ilty |> rescopeILType scoref |> Import.CanImportILType amap m +let CanImportILType scoref amap m ilty = + ilty |> rescopeILType scoref |> Import.CanImportILType amap m //------------------------------------------------------------------------- -// Fold the hierarchy. +// Fold the hierarchy. // REVIEW: this code generalizes the iteration used below for member lookup. -//------------------------------------------------------------------------- +//------------------------------------------------------------------------- /// Indicates if an F# type is the type associated with an F# exception declaration -let isExnDeclTy g ty = +let isExnDeclTy g ty = isAppTy g ty && (tcrefOfAppTy g ty).IsExceptionDecl - + /// Get the base type of a type, taking into account type instantiations. Return None if the /// type has no base type. -let GetSuperTypeOfType g amap m ty = +let GetSuperTypeOfType g amap m ty = #if !NO_EXTENSIONTYPING let ty = (if isAppTy g ty && (tcrefOfAppTy g ty).IsProvided then stripTyEqns g ty else stripTyEqnsAndMeasureEqns g ty) #else - let ty = stripTyEqnsAndMeasureEqns g ty + let ty = stripTyEqnsAndMeasureEqns g ty #endif - match metadataOfTy g ty with + match metadataOfTy g ty with #if !NO_EXTENSIONTYPING - | ProvidedTypeMetadata info -> + | ProvidedTypeMetadata info -> let st = info.ProvidedType - let superOpt = st.PApplyOption((fun st -> match st.BaseType with null -> None | t -> Some t),m) - match superOpt with + let superOpt = st.PApplyOption((fun st -> match st.BaseType with null -> None | t -> Some t), m) + match superOpt with | None -> None | Some super -> Some(Import.ImportProvidedType amap m super) #endif - | ILTypeMetadata (TILObjectReprData(scoref,_,tdef)) -> + | ILTypeMetadata (TILObjectReprData(scoref, _, tdef)) -> let tinst = argsOfAppTy g ty - match tdef.Extends with + match tdef.Extends with | None -> None | Some ilty -> Some (ImportILType scoref amap m tinst ilty) - | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> - if isFSharpObjModelTy g ty || isExnDeclTy g ty then + | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> + if isFSharpObjModelTy g ty || isExnDeclTy g ty then let tcref = tcrefOfAppTy g ty Some (instType (mkInstForAppTy g ty) (superOfTycon g tcref.Deref)) elif isArrayTy g ty then Some g.system_Array_ty - elif isRefTy g ty && not (isObjTy g ty) then + elif isRefTy g ty && not (isObjTy g ty) then Some g.obj_ty - elif isStructTupleTy g ty then + elif isStructTupleTy g ty then Some g.obj_ty elif isFSharpStructOrEnumTy g ty then if isFSharpEnumTy g ty then Some(g.system_Enum_ty) else Some (g.system_Value_ty) - elif isAnonRecdTy g ty then + elif isAnonRecdTy g ty then Some g.obj_ty elif isRecdTy g ty || isUnionTy g ty then Some g.obj_ty - else + else None /// Make a type for System.Collections.Generic.IList -let mkSystemCollectionsGenericIListTy (g: TcGlobals) ty = TType_app(g.tcref_System_Collections_Generic_IList,[ty]) +let mkSystemCollectionsGenericIListTy (g: TcGlobals) ty = TType_app(g.tcref_System_Collections_Generic_IList, [ty]) [] /// Indicates whether we can skip interface types that lie outside the reference set @@ -104,65 +96,65 @@ type SkipUnrefInterfaces = Yes | No /// Collect the set of immediate declared interface types for an F# type, but do not /// traverse the type hierarchy to collect further interfaces. -let rec GetImmediateInterfacesOfType skipUnref g amap m ty = - let itys = +let rec GetImmediateInterfacesOfType skipUnref g amap m ty = + let itys = match tryAppTy g ty with - | ValueSome(tcref,tinst) -> - if tcref.IsMeasureableReprTycon then - [ match tcref.TypeReprInfo with - | TMeasureableRepr reprTy -> - for ity in GetImmediateInterfacesOfType skipUnref g amap m reprTy do - if isAppTy g ity then + | ValueSome(tcref, tinst) -> + if tcref.IsMeasureableReprTycon then + [ match tcref.TypeReprInfo with + | TMeasureableRepr reprTy -> + for ity in GetImmediateInterfacesOfType skipUnref g amap m reprTy do + if isAppTy g ity then let itcref = tcrefOfAppTy g ity - if not (tyconRefEq g itcref g.system_GenericIComparable_tcref) && - not (tyconRefEq g itcref g.system_GenericIEquatable_tcref) then + if not (tyconRefEq g itcref g.system_GenericIComparable_tcref) && + not (tyconRefEq g itcref g.system_GenericIEquatable_tcref) then yield ity | _ -> () - yield mkAppTy g.system_GenericIComparable_tcref [ty] + yield mkAppTy g.system_GenericIComparable_tcref [ty] yield mkAppTy g.system_GenericIEquatable_tcref [ty]] else - match metadataOfTy g ty with + match metadataOfTy g ty with #if !NO_EXTENSIONTYPING - | ProvidedTypeMetadata info -> + | ProvidedTypeMetadata info -> [ for ity in info.ProvidedType.PApplyArray((fun st -> st.GetInterfaces()), "GetInterfaces", m) do yield Import.ImportProvidedType amap m ity ] #endif - | ILTypeMetadata (TILObjectReprData(scoref,_,tdef)) -> + | ILTypeMetadata (TILObjectReprData(scoref, _, tdef)) -> // ImportILType may fail for an interface if the assembly load set is incomplete and the interface // comes from another assembly. In this case we simply skip the interface: // if we don't skip it, then compilation will just fail here, and if type checking - // succeeds with fewer non-dereferencable interfaces reported then it would have - // succeeded with more reported. There are pathological corner cases where this - // doesn't apply: e.g. for mscorlib interfaces like IComparable, but we can always - // assume those are present. - tdef.Implements |> List.choose (fun ity -> - if skipUnref = SkipUnrefInterfaces.No || CanImportILType scoref amap m ity then + // succeeds with fewer non-dereferencable interfaces reported then it would have + // succeeded with more reported. There are pathological corner cases where this + // doesn't apply: e.g. for mscorlib interfaces like IComparable, but we can always + // assume those are present. + tdef.Implements |> List.choose (fun ity -> + if skipUnref = SkipUnrefInterfaces.No || CanImportILType scoref amap m ity then Some (ImportILType scoref amap m tinst ity) else None) - | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> - tcref.ImmediateInterfaceTypesOfFSharpTycon |> List.map (instType (mkInstForAppTy g ty)) + | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> + tcref.ImmediateInterfaceTypesOfFSharpTycon |> List.map (instType (mkInstForAppTy g ty)) | _ -> [] - + // .NET array types are considered to implement IList let itys = - if isArray1DTy g ty then + if isArray1DTy g ty then mkSystemCollectionsGenericIListTy g (destArrayTy g ty) :: itys - else + else itys itys - + [] /// Indicates whether we should visit multiple instantiations of the same generic interface or not type AllowMultiIntfInstantiations = Yes | No -/// Traverse the type hierarchy, e.g. f D (f C (f System.Object acc)). +/// Traverse the type hierarchy, e.g. f D (f C (f System.Object acc)). /// Visit base types and interfaces first. -let private FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref visitor g amap m ty acc = - let rec loop ndeep ty ((visitedTycon,visited:TyconRefMultiMap<_>,acc) as state) = +let private FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref visitor g amap m ty acc = + let rec loop ndeep ty ((visitedTycon, visited:TyconRefMultiMap<_>, acc) as state) = - let seenThisTycon = isAppTy g ty && Set.contains (tcrefOfAppTy g ty).Stamp visitedTycon + let seenThisTycon = isAppTy g ty && Set.contains (tcrefOfAppTy g ty).Stamp visitedTycon // Do not visit the same type twice. Could only be doing this if we've seen this tycon if seenThisTycon && List.exists (typeEquiv g ty) (visited.Find (tcrefOfAppTy g ty)) then state else @@ -170,28 +162,28 @@ let private FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref // Do not visit the same tycon twice, e.g. I and I, collect I only, unless directed to allow this if seenThisTycon && allowMultiIntfInst = AllowMultiIntfInstantiations.No then state else - let state = - if isAppTy g ty then + let state = + if isAppTy g ty then let tcref = tcrefOfAppTy g ty - let visitedTycon = Set.add tcref.Stamp visitedTycon - visitedTycon, visited.Add (tcref,ty), acc + let visitedTycon = Set.add tcref.Stamp visitedTycon + visitedTycon, visited.Add (tcref, ty), acc else state - if ndeep > 100 then (errorR(Error((FSComp.SR.recursiveClassHierarchy (showType ty)),m)); (visitedTycon,visited,acc)) else - let visitedTycon,visited,acc = - if isInterfaceTy g ty then - List.foldBack - (loop (ndeep+1)) - (GetImmediateInterfacesOfType skipUnref g amap m ty) + if ndeep > 100 then (errorR(Error((FSComp.SR.recursiveClassHierarchy (showType ty)), m)); (visitedTycon, visited, acc)) else + let visitedTycon, visited, acc = + if isInterfaceTy g ty then + List.foldBack + (loop (ndeep+1)) + (GetImmediateInterfacesOfType skipUnref g amap m ty) (loop ndeep g.obj_ty state) else match tryDestTyparTy g ty with | ValueSome tp -> - let state = loop (ndeep+1) g.obj_ty state - List.foldBack - (fun x vacc -> - match x with + let state = loop (ndeep+1) g.obj_ty state + List.foldBack + (fun x vacc -> + match x with | TyparConstraint.MayResolveMember _ | TyparConstraint.DefaultsTo _ | TyparConstraint.SupportsComparison _ @@ -199,89 +191,89 @@ let private FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref | TyparConstraint.IsEnum _ | TyparConstraint.IsDelegate _ | TyparConstraint.SupportsNull _ - | TyparConstraint.IsNonNullableStruct _ - | TyparConstraint.IsUnmanaged _ - | TyparConstraint.IsReferenceType _ - | TyparConstraint.SimpleChoice _ + | TyparConstraint.IsNonNullableStruct _ + | TyparConstraint.IsUnmanaged _ + | TyparConstraint.IsReferenceType _ + | TyparConstraint.SimpleChoice _ | TyparConstraint.RequiresDefaultConstructor _ -> vacc - | TyparConstraint.CoercesTo(cty,_) -> - loop (ndeep + 1) cty vacc) - tp.Constraints + | TyparConstraint.CoercesTo(cty, _) -> + loop (ndeep + 1) cty vacc) + tp.Constraints state - | _ -> - let state = - if followInterfaces then - List.foldBack - (loop (ndeep+1)) - (GetImmediateInterfacesOfType skipUnref g amap m ty) - state - else + | _ -> + let state = + if followInterfaces then + List.foldBack + (loop (ndeep+1)) + (GetImmediateInterfacesOfType skipUnref g amap m ty) + state + else state - let state = - Option.foldBack - (loop (ndeep+1)) - (GetSuperTypeOfType g amap m ty) + let state = + Option.foldBack + (loop (ndeep+1)) + (GetSuperTypeOfType g amap m ty) state state let acc = visitor ty acc - (visitedTycon,visited,acc) - loop 0 ty (Set.empty,TyconRefMultiMap<_>.Empty,acc) |> p33 + (visitedTycon, visited, acc) + loop 0 ty (Set.empty, TyconRefMultiMap<_>.Empty, acc) |> p33 /// Fold, do not follow interfaces (unless the type is itself an interface) -let FoldPrimaryHierarchyOfType f g amap m allowMultiIntfInst ty acc = - FoldHierarchyOfTypeAux false allowMultiIntfInst SkipUnrefInterfaces.No f g amap m ty acc +let FoldPrimaryHierarchyOfType f g amap m allowMultiIntfInst ty acc = + FoldHierarchyOfTypeAux false allowMultiIntfInst SkipUnrefInterfaces.No f g amap m ty acc /// Fold, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. -let FoldEntireHierarchyOfType f g amap m allowMultiIntfInst ty acc = +let FoldEntireHierarchyOfType f g amap m allowMultiIntfInst ty acc = FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes f g amap m ty acc /// Iterate, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. -let IterateEntireHierarchyOfType f g amap m allowMultiIntfInst ty = - FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes (fun ty () -> f ty) g amap m ty () +let IterateEntireHierarchyOfType f g amap m allowMultiIntfInst ty = + FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes (fun ty () -> f ty) g amap m ty () /// Search for one element satisfying a predicate, following interfaces -let ExistsInEntireHierarchyOfType f g amap m allowMultiIntfInst ty = - FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes (fun ty acc -> acc || f ty ) g amap m ty false +let ExistsInEntireHierarchyOfType f g amap m allowMultiIntfInst ty = + FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes (fun ty acc -> acc || f ty ) g amap m ty false /// Search for one element where a function returns a 'Some' result, following interfaces -let SearchEntireHierarchyOfType f g amap m ty = +let SearchEntireHierarchyOfType f g amap m ty = FoldHierarchyOfTypeAux true AllowMultiIntfInstantiations.Yes SkipUnrefInterfaces.Yes - (fun ty acc -> - match acc with - | None -> if f ty then Some(ty) else None - | Some _ -> acc) + (fun ty acc -> + match acc with + | None -> if f ty then Some(ty) else None + | Some _ -> acc) g amap m ty None /// Get all super types of the type, including the type itself -let AllSuperTypesOfType g amap m allowMultiIntfInst ty = - FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.No (ListSet.insert (typeEquiv g)) g amap m ty [] +let AllSuperTypesOfType g amap m allowMultiIntfInst ty = + FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.No (ListSet.insert (typeEquiv g)) g amap m ty [] /// Get all interfaces of a type, including the type itself if it is an interface -let AllInterfacesOfType g amap m allowMultiIntfInst ty = +let AllInterfacesOfType g amap m allowMultiIntfInst ty = AllSuperTypesOfType g amap m allowMultiIntfInst ty |> List.filter (isInterfaceTy g) /// Check if two types have the same nominal head type -let HaveSameHeadType g ty1 ty2 = +let HaveSameHeadType g ty1 ty2 = isAppTy g ty1 && isAppTy g ty2 && tyconRefEq g (tcrefOfAppTy g ty1) (tcrefOfAppTy g ty2) /// Check if a type has a particular head type -let HasHeadType g tcref ty2 = +let HasHeadType g tcref ty2 = isAppTy g ty2 && tyconRefEq g tcref (tcrefOfAppTy g ty2) - + /// Check if a type exists somewhere in the hierarchy which has the same head type as the given type (note, the given type need not have a head type at all) -let ExistsSameHeadTypeInHierarchy g amap m typeToSearchFrom typeToLookFor = +let ExistsSameHeadTypeInHierarchy g amap m typeToSearchFrom typeToLookFor = ExistsInEntireHierarchyOfType (HaveSameHeadType g typeToLookFor) g amap m AllowMultiIntfInstantiations.Yes typeToSearchFrom - + /// Check if a type exists somewhere in the hierarchy which has the given head type. -let ExistsHeadTypeInEntireHierarchy g amap m typeToSearchFrom tcrefToLookFor = +let ExistsHeadTypeInEntireHierarchy g amap m typeToSearchFrom tcrefToLookFor = ExistsInEntireHierarchyOfType (HasHeadType g tcrefToLookFor) g amap m AllowMultiIntfInstantiations.Yes typeToSearchFrom - + /// Read an Abstract IL type from metadata and convert to an F# type. -let ImportILTypeFromMetadata amap m scoref tinst minst ilty = +let ImportILTypeFromMetadata amap m scoref tinst minst ilty = ImportILType scoref amap m (tinst@minst) ilty /// Read an Abstract IL type from metadata, including any attributes that may affect the type itself, and convert to an F# type. @@ -293,14 +285,14 @@ let ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst ilty cattrs else ty -/// Get the parameter type of an IL method. +/// Get the parameter type of an IL method. let ImportParameterTypeFromMetadata amap m ilty cattrs scoref tinst mist = ImportILTypeFromMetadataWithAttributes amap m scoref tinst mist ilty cattrs - + /// Get the return type of an IL method, taking into account instantiations for type, return attributes and method generic parameters, and /// translating 'void' to 'None'. let ImportReturnTypeFromMetadata amap m ilty cattrs scoref tinst minst = - match ilty with + match ilty with | ILType.Void -> None | retTy -> Some(ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst retTy cattrs) @@ -308,93 +300,93 @@ let ImportReturnTypeFromMetadata amap m ilty cattrs scoref tinst minst = /// Copy constraints. If the constraint comes from a type parameter associated /// with a type constructor then we are simply renaming type variables. If it comes /// from a generic method in a generic class (e.g. ty.M<_>) then we may be both substituting the -/// instantiation associated with 'ty' as well as copying the type parameters associated with +/// instantiation associated with 'ty' as well as copying the type parameters associated with /// M and instantiating their constraints /// /// Note: this now looks identical to constraint instantiation. let CopyTyparConstraints m tprefInst (tporig:Typar) = - tporig.Constraints - |> List.map (fun tpc -> - match tpc with - | TyparConstraint.CoercesTo(ty,_) -> - TyparConstraint.CoercesTo (instType tprefInst ty,m) - | TyparConstraint.DefaultsTo(priority,ty,_) -> - TyparConstraint.DefaultsTo (priority,instType tprefInst ty,m) - | TyparConstraint.SupportsNull _ -> + tporig.Constraints + |> List.map (fun tpc -> + match tpc with + | TyparConstraint.CoercesTo(ty, _) -> + TyparConstraint.CoercesTo (instType tprefInst ty, m) + | TyparConstraint.DefaultsTo(priority, ty, _) -> + TyparConstraint.DefaultsTo (priority, instType tprefInst ty, m) + | TyparConstraint.SupportsNull _ -> TyparConstraint.SupportsNull m - | TyparConstraint.IsEnum (uty,_) -> - TyparConstraint.IsEnum (instType tprefInst uty,m) - | TyparConstraint.SupportsComparison _ -> + | TyparConstraint.IsEnum (uty, _) -> + TyparConstraint.IsEnum (instType tprefInst uty, m) + | TyparConstraint.SupportsComparison _ -> TyparConstraint.SupportsComparison m - | TyparConstraint.SupportsEquality _ -> + | TyparConstraint.SupportsEquality _ -> TyparConstraint.SupportsEquality m - | TyparConstraint.IsDelegate(aty, bty,_) -> - TyparConstraint.IsDelegate (instType tprefInst aty,instType tprefInst bty,m) - | TyparConstraint.IsNonNullableStruct _ -> + | TyparConstraint.IsDelegate(aty, bty, _) -> + TyparConstraint.IsDelegate (instType tprefInst aty, instType tprefInst bty, m) + | TyparConstraint.IsNonNullableStruct _ -> TyparConstraint.IsNonNullableStruct m | TyparConstraint.IsUnmanaged _ -> TyparConstraint.IsUnmanaged m - | TyparConstraint.IsReferenceType _ -> + | TyparConstraint.IsReferenceType _ -> TyparConstraint.IsReferenceType m - | TyparConstraint.SimpleChoice (tys,_) -> - TyparConstraint.SimpleChoice (List.map (instType tprefInst) tys,m) - | TyparConstraint.RequiresDefaultConstructor _ -> + | TyparConstraint.SimpleChoice (tys, _) -> + TyparConstraint.SimpleChoice (List.map (instType tprefInst) tys, m) + | TyparConstraint.RequiresDefaultConstructor _ -> TyparConstraint.RequiresDefaultConstructor m - | TyparConstraint.MayResolveMember(traitInfo,_) -> - TyparConstraint.MayResolveMember (instTrait tprefInst traitInfo,m)) + | TyparConstraint.MayResolveMember(traitInfo, _) -> + TyparConstraint.MayResolveMember (instTrait tprefInst traitInfo, m)) -/// The constraints for each typar copied from another typar can only be fixed up once -/// we have generated all the new constraints, e.g. f List, B :> List> ... +/// The constraints for each typar copied from another typar can only be fixed up once +/// we have generated all the new constraints, e.g. f List, B :> List> ... let FixupNewTypars m (formalEnclosingTypars:Typars) (tinst: TType list) (tpsorig: Typars) (tps: Typars) = // Checks.. These are defensive programming against early reported errors. let n0 = formalEnclosingTypars.Length let n1 = tinst.Length let n2 = tpsorig.Length let n3 = tps.Length - if n0 <> n1 then error(Error((FSComp.SR.tcInvalidTypeArgumentCount(n0,n1)),m)) - if n2 <> n3 then error(Error((FSComp.SR.tcInvalidTypeArgumentCount(n2,n3)),m)) + if n0 <> n1 then error(Error((FSComp.SR.tcInvalidTypeArgumentCount(n0, n1)), m)) + if n2 <> n3 then error(Error((FSComp.SR.tcInvalidTypeArgumentCount(n2, n3)), m)) - // The real code.. - let renaming,tptys = mkTyparToTyparRenaming tpsorig tps + // The real code.. + let renaming, tptys = mkTyparToTyparRenaming tpsorig tps let tprefInst = mkTyparInst formalEnclosingTypars tinst @ renaming - (tpsorig,tps) ||> List.iter2 (fun tporig tp -> tp.SetConstraints (CopyTyparConstraints m tprefInst tporig)) - renaming,tptys + (tpsorig, tps) ||> List.iter2 (fun tporig tp -> tp.SetConstraints (CopyTyparConstraints m tprefInst tporig)) + renaming, tptys //------------------------------------------------------------------------- // Predicates and properties on values and members - -type ValRef with + +type ValRef with /// Indicates if an F#-declared function or member value is a CLIEvent property compiled as a .NET event - member x.IsFSharpEventProperty g = + member x.IsFSharpEventProperty g = x.IsMember && CompileAsEvent g x.Attribs && not x.IsExtensionMember /// Check if an F#-declared member value is a virtual method - member vref.IsVirtualMember = + member vref.IsVirtualMember = let flags = vref.MemberInfo.Value.MemberFlags flags.IsDispatchSlot || flags.IsOverrideOrExplicitImpl /// Check if an F#-declared member value is a dispatch slot - member vref.IsDispatchSlotMember = + member vref.IsDispatchSlotMember = let membInfo = vref.MemberInfo.Value - membInfo.MemberFlags.IsDispatchSlot + membInfo.MemberFlags.IsDispatchSlot /// Check if an F#-declared member value is an 'override' or explicit member implementation - member vref.IsDefiniteFSharpOverrideMember = - let membInfo = vref.MemberInfo.Value + member vref.IsDefiniteFSharpOverrideMember = + let membInfo = vref.MemberInfo.Value let flags = membInfo.MemberFlags not flags.IsDispatchSlot && (flags.IsOverrideOrExplicitImpl || not (isNil membInfo.ImplementedSlotSigs)) /// Check if an F#-declared member value is an explicit interface member implementation - member vref.IsFSharpExplicitInterfaceImplementation g = - match vref.MemberInfo with + member vref.IsFSharpExplicitInterfaceImplementation g = + match vref.MemberInfo with | None -> false | Some membInfo -> - not membInfo.MemberFlags.IsDispatchSlot && - (match membInfo.ImplementedSlotSigs with - | TSlotSig(_,oty,_,_,_,_) :: _ -> isInterfaceTy g oty + not membInfo.MemberFlags.IsDispatchSlot && + (match membInfo.ImplementedSlotSigs with + | TSlotSig(_, oty, _, _, _, _) :: _ -> isInterfaceTy g oty | [] -> false) member vref.ImplementedSlotSignatures = @@ -403,90 +395,90 @@ type ValRef with | Some membInfo -> membInfo.ImplementedSlotSigs //------------------------------------------------------------------------- -// Helper methods associated with using TAST metadata (F# members, values etc.) +// Helper methods associated with using TAST metadata (F# members, values etc.) // as backing data for MethInfo, PropInfo etc. #if !NO_EXTENSIONTYPING /// Get the return type of a provided method, where 'void' is returned as 'None' let GetCompiledReturnTyOfProvidedMethodInfo amap m (mi:Tainted) = - let returnType = - if mi.PUntaint((fun mi -> mi.IsConstructor),m) then - mi.PApply((fun mi -> mi.DeclaringType),m) - else mi.Coerce(m).PApply((fun mi -> mi.ReturnType),m) + let returnType = + if mi.PUntaint((fun mi -> mi.IsConstructor), m) then + mi.PApply((fun mi -> mi.DeclaringType), m) + else mi.Coerce(m).PApply((fun mi -> mi.ReturnType), m) let ty = Import.ImportProvidedType amap m returnType if isVoidTy amap.g ty then None else Some ty #endif /// The slotsig returned by methInfo.GetSlotSig is in terms of the type parameters on the parent type of the overriding method. -/// Reverse-map the slotsig so it is in terms of the type parameters for the overriding method -let ReparentSlotSigToUseMethodTypars g m ovByMethValRef slotsig = +/// Reverse-map the slotsig so it is in terms of the type parameters for the overriding method +let ReparentSlotSigToUseMethodTypars g m ovByMethValRef slotsig = match PartitionValRefTypars g ovByMethValRef with - | Some(_,enclosingTypars,_,_,_) -> - let parentToMemberInst,_ = mkTyparToTyparRenaming (ovByMethValRef.MemberApparentEntity.Typars(m)) enclosingTypars + | Some(_, enclosingTypars, _, _, _) -> + let parentToMemberInst, _ = mkTyparToTyparRenaming (ovByMethValRef.MemberApparentEntity.Typars(m)) enclosingTypars let res = instSlotSig parentToMemberInst slotsig res - | None -> - // Note: it appears PartitionValRefTypars should never return 'None' + | None -> + // Note: it appears PartitionValRefTypars should never return 'None' slotsig /// Construct the data representing a parameter in the signature of an abstract method slot -let MakeSlotParam (ty,argInfo:ArgReprInfo) = TSlotParam(Option.map textOfId argInfo.Name, ty, false,false,false,argInfo.Attribs) +let MakeSlotParam (ty, argInfo:ArgReprInfo) = TSlotParam(Option.map textOfId argInfo.Name, ty, false, false, false, argInfo.Attribs) /// Construct the data representing the signature of an abstract method slot -let MakeSlotSig (nm,ty,ctps,mtps,paraml,retTy) = copySlotSig (TSlotSig(nm,ty,ctps,mtps,paraml,retTy)) +let MakeSlotSig (nm, ty, ctps, mtps, paraml, retTy) = copySlotSig (TSlotSig(nm, ty, ctps, mtps, paraml, retTy)) -/// Split the type of an F# member value into +/// Split the type of an F# member value into /// - the type parameters associated with method but matching those of the enclosing type /// - the type parameters associated with a generic method /// - the return type of the method /// - the actual type arguments of the enclosing type. -let private AnalyzeTypeOfMemberVal isCSharpExt g (ty,vref:ValRef) = - let memberAllTypars,_,retTy,_ = GetTypeOfMemberInMemberForm g vref - if isCSharpExt || vref.IsExtensionMember then - [],memberAllTypars,retTy,[] +let private AnalyzeTypeOfMemberVal isCSharpExt g (ty, vref:ValRef) = + let memberAllTypars, _, retTy, _ = GetTypeOfMemberInMemberForm g vref + if isCSharpExt || vref.IsExtensionMember then + [], memberAllTypars, retTy, [] else let parentTyArgs = argsOfAppTy g ty - let memberParentTypars,memberMethodTypars = List.splitAt parentTyArgs.Length memberAllTypars - memberParentTypars,memberMethodTypars,retTy,parentTyArgs + let memberParentTypars, memberMethodTypars = List.splitAt parentTyArgs.Length memberAllTypars + memberParentTypars, memberMethodTypars, retTy, parentTyArgs /// Get the object type for a member value which is an extension method (C#-style or F#-style) -let private GetObjTypeOfInstanceExtensionMethod g (vref:ValRef) = - let _,curriedArgInfos,_,_ = GetTopValTypeInCompiledForm g vref.ValReprInfo.Value vref.Type vref.Range +let private GetObjTypeOfInstanceExtensionMethod g (vref:ValRef) = + let _, curriedArgInfos, _, _ = GetTopValTypeInCompiledForm g vref.ValReprInfo.Value vref.Type vref.Range curriedArgInfos.Head.Head |> fst -/// Get the object type for a member value which is a C#-style extension method -let private GetArgInfosOfMember isCSharpExt g (vref:ValRef) = - if isCSharpExt then - let _,curriedArgInfos,_,_ = GetTopValTypeInCompiledForm g vref.ValReprInfo.Value vref.Type vref.Range +/// Get the object type for a member value which is a C#-style extension method +let private GetArgInfosOfMember isCSharpExt g (vref:ValRef) = + if isCSharpExt then + let _, curriedArgInfos, _, _ = GetTopValTypeInCompiledForm g vref.ValReprInfo.Value vref.Type vref.Range [ curriedArgInfos.Head.Tail ] else ArgInfosOfMember g vref /// Combine the type instantiation and generic method instantiation -let private CombineMethInsts ttps mtps tinst minst = (mkTyparInst ttps tinst @ mkTyparInst mtps minst) +let private CombineMethInsts ttps mtps tinst minst = (mkTyparInst ttps tinst @ mkTyparInst mtps minst) /// Work out the instantiation relevant to interpret the backing metadata for a member. /// /// The 'methTyArgs' is the instantiation of any generic method type parameters (this instantiation is -/// not included in the MethInfo objects, but carried separately). -let private GetInstantiationForMemberVal g isCSharpExt (ty, vref, methTyArgs: TypeInst) = - let memberParentTypars,memberMethodTypars,_retTy,parentTyArgs = AnalyzeTypeOfMemberVal isCSharpExt g (ty,vref) - /// In some recursive inference cases involving constraints this may need to be - /// fixed up - we allow uniform generic recursion but nothing else. +/// not included in the MethInfo objects, but carried separately). +let private GetInstantiationForMemberVal g isCSharpExt (ty, vref, methTyArgs: TypeInst) = + let memberParentTypars, memberMethodTypars, _retTy, parentTyArgs = AnalyzeTypeOfMemberVal isCSharpExt g (ty, vref) + /// In some recursive inference cases involving constraints this may need to be + /// fixed up - we allow uniform generic recursion but nothing else. /// See https://github.com/Microsoft/visualfsharp/issues/3038#issuecomment-309429410 - let methTyArgsFixedUp = + let methTyArgsFixedUp = if methTyArgs.Length < memberMethodTypars.Length then methTyArgs @ (List.skip methTyArgs.Length memberMethodTypars |> generalizeTypars) - else + else methTyArgs CombineMethInsts memberParentTypars memberMethodTypars parentTyArgs methTyArgsFixedUp /// Work out the instantiation relevant to interpret the backing metadata for a property. -let private GetInstantiationForPropertyVal g (ty,vref) = - let memberParentTypars,memberMethodTypars,_retTy,parentTyArgs = AnalyzeTypeOfMemberVal false g (ty,vref) +let private GetInstantiationForPropertyVal g (ty, vref) = + let memberParentTypars, memberMethodTypars, _retTy, parentTyArgs = AnalyzeTypeOfMemberVal false g (ty, vref) CombineMethInsts memberParentTypars memberMethodTypars parentTyArgs (generalizeTypars memberMethodTypars) /// Describes the sequence order of the introduction of an extension method. Extension methods that are introduced @@ -496,63 +488,63 @@ type ExtensionMethodPriority = uint64 //------------------------------------------------------------------------- // OptionalArgCallerSideValue, OptionalArgInfo -/// The caller-side value for the optional arg, if any -type OptionalArgCallerSideValue = +/// The caller-side value for the optional arg, if any +type OptionalArgCallerSideValue = | Constant of IL.ILFieldInit | DefaultValue | MissingValue - | WrapperForIDispatch + | WrapperForIDispatch | WrapperForIUnknown | PassByRef of TType * OptionalArgCallerSideValue - + /// Represents information about a parameter indicating if it is optional. -type OptionalArgInfo = +type OptionalArgInfo = /// The argument is not optional | NotOptional - /// The argument is optional, and is an F# callee-side optional arg + /// The argument is optional, and is an F# callee-side optional arg | CalleeSide /// The argument is optional, and is a caller-side .NET optional or default arg. /// Note this is correctly termed caller side, even though the default value is optically specified on the callee: /// in fact the default value is read from the metadata and passed explicitly to the callee on the caller side. - | CallerSide of OptionalArgCallerSideValue - member x.IsOptional = match x with CalleeSide | CallerSide _ -> true | NotOptional -> false + | CallerSide of OptionalArgCallerSideValue + member x.IsOptional = match x with CalleeSide | CallerSide _ -> true | NotOptional -> false /// Compute the OptionalArgInfo for an IL parameter /// /// This includes the Visual Basic rules for IDispatchConstant and IUnknownConstant and optional arguments. - static member FromILParameter g amap m ilScope ilTypeInst (ilParam: ILParameter) = - if ilParam.IsOptional then - match ilParam.Default with - | None -> + static member FromILParameter g amap m ilScope ilTypeInst (ilParam: ILParameter) = + if ilParam.IsOptional then + match ilParam.Default with + | None -> // Do a type-directed analysis of the IL type to determine the default value to pass. // The same rules as Visual Basic are applied here. - let rec analyze ty = - if isByrefTy g ty then + let rec analyze ty = + if isByrefTy g ty then let ty = destByrefTy g ty PassByRef (ty, analyze ty) elif isObjTy g ty then match ilParam.Marshal with | Some(ILNativeType.IUnknown | ILNativeType.IDispatch | ILNativeType.Interface) -> Constant(ILFieldInit.Null) - | _ -> + | _ -> if TryFindILAttributeOpt g.attrib_IUnknownConstantAttribute ilParam.CustomAttrs then WrapperForIUnknown elif TryFindILAttributeOpt g.attrib_IDispatchConstantAttribute ilParam.CustomAttrs then WrapperForIDispatch else MissingValue - else + else DefaultValue CallerSide (analyze (ImportILTypeFromMetadata amap m ilScope ilTypeInst [] ilParam.Type)) - | Some v -> + | Some v -> CallerSide (Constant v) - else + else NotOptional - - static member ValueOfDefaultParameterValueAttrib (Attrib (_,_,exprs,_,_,_,_)) = - let (AttribExpr (_,defaultValueExpr)) = List.head exprs + + static member ValueOfDefaultParameterValueAttrib (Attrib (_, _, exprs, _, _, _, _)) = + let (AttribExpr (_, defaultValueExpr)) = List.head exprs match defaultValueExpr with - | Expr.Const (_,_,_) -> Some defaultValueExpr + | Expr.Const (_, _, _) -> Some defaultValueExpr | _ -> None static member FieldInitForDefaultParameterValueAttrib attrib = match OptionalArgInfo.ValueOfDefaultParameterValueAttrib attrib with - | Some (Expr.Const (ConstToILFieldInit fi,_,_)) -> Some fi + | Some (Expr.Const (ConstToILFieldInit fi, _, _)) -> Some fi | _ -> None type CallerInfo = @@ -564,9 +556,9 @@ type CallerInfo = override x.ToString() = sprintf "%+A" x [] -type ReflectedArgInfo = - | None - | Quote of bool +type ReflectedArgInfo = + | None + | Quote of bool member x.AutoQuote = match x with None -> false | Quote _ -> true //------------------------------------------------------------------------- @@ -574,17 +566,17 @@ type ReflectedArgInfo = [] /// Partial information about a parameter returned for use by the Language Service -type ParamNameAndType = +type ParamNameAndType = | ParamNameAndType of Ident option * TType - static member FromArgInfo (ty,argInfo : ArgReprInfo) = ParamNameAndType(argInfo.Name, ty) + static member FromArgInfo (ty, argInfo : ArgReprInfo) = ParamNameAndType(argInfo.Name, ty) static member FromMember isCSharpExtMem g vref = GetArgInfosOfMember isCSharpExtMem g vref |> List.mapSquared ParamNameAndType.FromArgInfo - static member Instantiate inst p = let (ParamNameAndType(nm,ty)) = p in ParamNameAndType(nm, instType inst ty) + static member Instantiate inst p = let (ParamNameAndType(nm, ty)) = p in ParamNameAndType(nm, instType inst ty) static member InstantiateCurried inst paramTypes = paramTypes |> List.mapSquared (ParamNameAndType.Instantiate inst) [] /// Full information about a parameter returned for use by the type checker and language service. -type ParamData = +type ParamData = /// ParamData(isParamArray, isOut, optArgInfo, callerInfo, nameOpt, reflArgInfo, ttype) ParamData of bool * bool * bool * OptionalArgInfo * CallerInfo * Ident option * ReflectedArgInfo * TType @@ -594,15 +586,15 @@ type ParamData = #if !NO_EXTENSIONTYPING -type ILFieldInit with +type ILFieldInit with /// Compute the ILFieldInit for the given provided constant value for a provided enum type. - static member FromProvidedObj m (v:obj) = + static member FromProvidedObj m (v:obj) = match v with | null -> ILFieldInit.Null | _ -> let objTy = v.GetType() let v = if objTy.IsEnum then objTy.GetField("value__").GetValue(v) else v - match v with + match v with | :? single as i -> ILFieldInit.Single i | :? double as i -> ILFieldInit.Double i | :? bool as i -> ILFieldInit.Bool i @@ -616,49 +608,49 @@ type ILFieldInit with | :? uint32 as i -> ILFieldInit.UInt32 i | :? int64 as i -> ILFieldInit.Int64 i | :? uint64 as i -> ILFieldInit.UInt64 i - | _ -> error(Error(FSComp.SR.infosInvalidProvidedLiteralValue(try v.ToString() with _ -> "?"),m)) + | _ -> error(Error(FSComp.SR.infosInvalidProvidedLiteralValue(try v.ToString() with _ -> "?"), m)) -/// Compute the OptionalArgInfo for a provided parameter. +/// Compute the OptionalArgInfo for a provided parameter. /// -/// This is the same logic as OptionalArgInfoOfILParameter except we do not apply the -/// Visual Basic rules for IDispatchConstant and IUnknownConstant to optional +/// This is the same logic as OptionalArgInfoOfILParameter except we do not apply the +/// Visual Basic rules for IDispatchConstant and IUnknownConstant to optional /// provided parameters. -let OptionalArgInfoOfProvidedParameter (amap:Import.ImportMap) m (provParam : Tainted) = +let OptionalArgInfoOfProvidedParameter (amap:Import.ImportMap) m (provParam : Tainted) = let g = amap.g - if provParam.PUntaint((fun p -> p.IsOptional),m) then - match provParam.PUntaint((fun p -> p.HasDefaultValue),m) with - | false -> + if provParam.PUntaint((fun p -> p.IsOptional), m) then + match provParam.PUntaint((fun p -> p.HasDefaultValue), m) with + | false -> // Do a type-directed analysis of the IL type to determine the default value to pass. - let rec analyze ty = - if isByrefTy g ty then + let rec analyze ty = + if isByrefTy g ty then let ty = destByrefTy g ty PassByRef (ty, analyze ty) elif isObjTy g ty then MissingValue else DefaultValue - let pty = Import.ImportProvidedType amap m (provParam.PApply((fun p -> p.ParameterType),m)) + let pty = Import.ImportProvidedType amap m (provParam.PApply((fun p -> p.ParameterType), m)) CallerSide (analyze pty) - | _ -> - let v = provParam.PUntaint((fun p -> p.RawDefaultValue),m) + | _ -> + let v = provParam.PUntaint((fun p -> p.RawDefaultValue), m) CallerSide (Constant (ILFieldInit.FromProvidedObj m v)) - else + else NotOptional /// Compute the ILFieldInit for the given provided constant value for a provided enum type. -let GetAndSanityCheckProviderMethod m (mi: Tainted<'T :> ProvidedMemberInfo>) (get : 'T -> ProvidedMethodInfo) err = - match mi.PApply((fun mi -> (get mi :> ProvidedMethodBase)),m) with - | Tainted.Null -> error(Error(err(mi.PUntaint((fun mi -> mi.Name),m),mi.PUntaint((fun mi -> mi.DeclaringType.Name),m)),m)) +let GetAndSanityCheckProviderMethod m (mi: Tainted<'T :> ProvidedMemberInfo>) (get : 'T -> ProvidedMethodInfo) err = + match mi.PApply((fun mi -> (get mi :> ProvidedMethodBase)), m) with + | Tainted.Null -> error(Error(err(mi.PUntaint((fun mi -> mi.Name), m), mi.PUntaint((fun mi -> mi.DeclaringType.Name), m)), m)) | meth -> meth /// Try to get an arbitrary ProvidedMethodInfo associated with a property. let ArbitraryMethodInfoOfPropertyInfo (pi:Tainted) m = - if pi.PUntaint((fun pi -> pi.CanRead), m) then + if pi.PUntaint((fun pi -> pi.CanRead), m) then GetAndSanityCheckProviderMethod m pi (fun pi -> pi.GetGetMethod()) FSComp.SR.etPropertyCanReadButHasNoGetter - elif pi.PUntaint((fun pi -> pi.CanWrite), m) then + elif pi.PUntaint((fun pi -> pi.CanWrite), m) then GetAndSanityCheckProviderMethod m pi (fun pi -> pi.GetSetMethod()) FSComp.SR.etPropertyCanWriteButHasNoSetter - else - error(Error(FSComp.SR.etPropertyNeedsCanWriteOrCanRead(pi.PUntaint((fun mi -> mi.Name),m),pi.PUntaint((fun mi -> mi.DeclaringType.Name),m)),m)) + else + error(Error(FSComp.SR.etPropertyNeedsCanWriteOrCanRead(pi.PUntaint((fun mi -> mi.Name), m), pi.PUntaint((fun mi -> mi.DeclaringType.Name), m)), m)) #endif @@ -670,17 +662,17 @@ let ArbitraryMethodInfoOfPropertyInfo (pi:Tainted) m = /// /// This is really just 1:1 with the subset ot TType which result from building types using IL type definitions. [] -type ILTypeInfo = +type ILTypeInfo = /// ILTypeInfo (tyconRef, ilTypeRef, typeArgs, ilTypeDef). | ILTypeInfo of TcGlobals * TType * ILTypeRef * ILTypeDef - member x.TcGlobals = let (ILTypeInfo(g,_,_,_)) = x in g + member x.TcGlobals = let (ILTypeInfo(g, _, _, _)) = x in g - member x.ILTypeRef = let (ILTypeInfo(_,_,tref,_)) = x in tref + member x.ILTypeRef = let (ILTypeInfo(_, _, tref, _)) = x in tref - member x.RawMetadata = let (ILTypeInfo(_,_,_,tdef)) = x in tdef + member x.RawMetadata = let (ILTypeInfo(_, _, _, tdef)) = x in tdef - member x.ToType = let (ILTypeInfo(_,ty,_,_)) = x in ty + member x.ToType = let (ILTypeInfo(_, ty, _, _)) = x in ty /// Get the compiled nominal type. In the case of tuple types, this is a .NET tuple type member x.ToAppType = convertToTypeWithMetadataIfPossible x.TcGlobals x.ToType @@ -695,26 +687,26 @@ type ILTypeInfo = member x.IsValueType = x.RawMetadata.IsStructOrEnum - member x.Instantiate inst = - let (ILTypeInfo(g,ty,tref,tdef)) = x - ILTypeInfo(g,instType inst ty,tref,tdef) + member x.Instantiate inst = + let (ILTypeInfo(g, ty, tref, tdef)) = x + ILTypeInfo(g, instType inst ty, tref, tdef) - static member FromType g ty = - if isAnyTupleTy g ty then + static member FromType g ty = + if isAnyTupleTy g ty then // When getting .NET metadata for the properties and methods // of an F# tuple type, use the compiled nominal type, which is a .NET tuple type let metadataTy = convertToTypeWithMetadataIfPossible g ty assert (isILAppTy g metadataTy) let metadataTyconRef = tcrefOfAppTy g metadataTy let (TILObjectReprData(scoref, enc, tdef)) = metadataTyconRef.ILTyconInfo - let metadataILTypeRef = mkRefForNestedILTypeDef scoref (enc,tdef) + let metadataILTypeRef = mkRefForNestedILTypeDef scoref (enc, tdef) ILTypeInfo(g, ty, metadataILTypeRef, tdef) - elif isILAppTy g ty then + elif isILAppTy g ty then let tcref = tcrefOfAppTy g ty let (TILObjectReprData(scoref, enc, tdef)) = tcref.ILTyconInfo - let tref = mkRefForNestedILTypeDef scoref (enc,tdef) + let tref = mkRefForNestedILTypeDef scoref (enc, tdef) ILTypeInfo(g, ty, tref, tdef) - else + else failwith "ILTypeInfo.FromType - no IL metadata for type" //------------------------------------------------------------------------- @@ -726,30 +718,30 @@ type ILTypeInfo = type ILMethInfo = /// ILMethInfo(g, ilApparentType, ilDeclaringTyconRefOpt, ilMethodDef, ilGenericMethodTyArgs) /// - /// Describes an F# use of an IL method. + /// Describes an F# use of an IL method. /// /// If ilDeclaringTyconRefOpt is 'Some' then this is an F# use of an C#-style extension method. /// If ilDeclaringTyconRefOpt is 'None' then ilApparentType is an IL type definition. - | ILMethInfo of TcGlobals * TType * TyconRef option * ILMethodDef * Typars + | ILMethInfo of TcGlobals * TType * TyconRef option * ILMethodDef * Typars - member x.TcGlobals = match x with ILMethInfo(g,_,_,_,_) -> g + member x.TcGlobals = match x with ILMethInfo(g, _, _, _, _) -> g - /// Get the apparent declaring type of the method as an F# type. - /// If this is a C#-style extension method then this is the type which the method + /// Get the apparent declaring type of the method as an F# type. + /// If this is a C#-style extension method then this is the type which the method /// appears to extend. This may be a variable type. - member x.ApparentEnclosingType = match x with ILMethInfo(_,ty,_,_,_) -> ty + member x.ApparentEnclosingType = match x with ILMethInfo(_, ty, _, _, _) -> ty /// Like ApparentEnclosingType but use the compiled nominal type if this is a method on a tuple type member x.ApparentEnclosingAppType = convertToTypeWithMetadataIfPossible x.TcGlobals x.ApparentEnclosingType /// Get the declaring type associated with an extension member, if any. - member x.ILExtensionMethodDeclaringTyconRef = match x with ILMethInfo(_,_,tcrefOpt,_,_) -> tcrefOpt + member x.ILExtensionMethodDeclaringTyconRef = match x with ILMethInfo(_, _, tcrefOpt, _, _) -> tcrefOpt /// Get the Abstract IL metadata associated with the method. - member x.RawMetadata = match x with ILMethInfo(_,_,_,md,_) -> md + member x.RawMetadata = match x with ILMethInfo(_, _, _, md, _) -> md /// Get the formal method type parameters associated with a method. - member x.FormalMethodTypars = match x with ILMethInfo(_,_,_,_,fmtps) -> fmtps + member x.FormalMethodTypars = match x with ILMethInfo(_, _, _, _, fmtps) -> fmtps /// Get the IL name of the method member x.ILName = x.RawMetadata.Name @@ -759,39 +751,39 @@ type ILMethInfo = /// Get the declaring type of the method. If this is an C#-style extension method then this is the IL type /// holding the static member that is the extension method. - member x.DeclaringTyconRef = - match x.ILExtensionMethodDeclaringTyconRef with - | Some tcref -> tcref + member x.DeclaringTyconRef = + match x.ILExtensionMethodDeclaringTyconRef with + | Some tcref -> tcref | None -> tcrefOfAppTy x.TcGlobals x.ApparentEnclosingAppType - /// Get the instantiation of the declaring type of the method. + /// Get the instantiation of the declaring type of the method. /// If this is an C#-style extension method then this is empty because extension members /// are never in generic classes. - member x.DeclaringTypeInst = - if x.IsILExtensionMethod then [] + member x.DeclaringTypeInst = + if x.IsILExtensionMethod then [] else argsOfAppTy x.TcGlobals x.ApparentEnclosingAppType /// Get the Abstract IL scope information associated with interpreting the Abstract IL metadata that backs this method. member x.MetadataScope = x.DeclaringTyconRef.CompiledRepresentationForNamedType.Scope - - /// Get the Abstract IL metadata corresponding to the parameters of the method. + + /// Get the Abstract IL metadata corresponding to the parameters of the method. /// If this is an C#-style extension method then drop the object argument. - member x.ParamMetadata = + member x.ParamMetadata = let ps = x.RawMetadata.Parameters if x.IsILExtensionMethod then List.tail ps else ps /// Get the number of parameters of the method member x.NumParams = x.ParamMetadata.Length - + /// Indicates if the method is a constructor - member x.IsConstructor = x.RawMetadata.IsConstructor + member x.IsConstructor = x.RawMetadata.IsConstructor /// Indicates if the method is a class initializer. member x.IsClassConstructor = x.RawMetadata.IsClassInitializer /// Indicates if the method has protected accessibility, - member x.IsProtectedAccessibility = - let md = x.RawMetadata + member x.IsProtectedAccessibility = + let md = x.RawMetadata not md.IsConstructor && not md.IsClassInitializer && (md.Access = ILMemberAccess.Family || md.Access = ILMemberAccess.FamilyOrAssembly) @@ -806,46 +798,46 @@ type ILMethInfo = member x.IsAbstract = x.RawMetadata.IsAbstract /// Does it appear to the user as a static method? - member x.IsStatic = + member x.IsStatic = not x.IsILExtensionMethod && // all C#-declared extension methods are instance x.RawMetadata.CallingConv.IsStatic /// Does it have the .NET IL 'newslot' flag set, and is also a virtual? member x.IsNewSlot = x.RawMetadata.IsNewSlot - + /// Does it appear to the user as an instance method? member x.IsInstance = not x.IsConstructor && not x.IsStatic - /// Get the argument types of the the IL method. If this is an C#-style extension method + /// Get the argument types of the the IL method. If this is an C#-style extension method /// then drop the object argument. - member x.GetParamTypes(amap,m,minst) = - x.ParamMetadata |> List.map (fun p -> ImportParameterTypeFromMetadata amap m p.Type p.CustomAttrs x.MetadataScope x.DeclaringTypeInst minst) + member x.GetParamTypes(amap, m, minst) = + x.ParamMetadata |> List.map (fun p -> ImportParameterTypeFromMetadata amap m p.Type p.CustomAttrs x.MetadataScope x.DeclaringTypeInst minst) - /// Get all the argument types of the IL method. Include the object argument even if this is + /// Get all the argument types of the IL method. Include the object argument even if this is /// an C#-style extension method. - member x.GetRawArgTypes(amap,m,minst) = - x.RawMetadata.Parameters |> List.map (fun p -> ImportParameterTypeFromMetadata amap m p.Type p.CustomAttrs x.MetadataScope x.DeclaringTypeInst minst) + member x.GetRawArgTypes(amap, m, minst) = + x.RawMetadata.Parameters |> List.map (fun p -> ImportParameterTypeFromMetadata amap m p.Type p.CustomAttrs x.MetadataScope x.DeclaringTypeInst minst) - /// Get info about the arguments of the IL method. If this is an C#-style extension method then + /// Get info about the arguments of the IL method. If this is an C#-style extension method then /// drop the object argument. /// /// Any type parameters of the enclosing type are instantiated in the type returned. - member x.GetParamNamesAndTypes(amap,m,minst) = + member x.GetParamNamesAndTypes(amap, m, minst) = x.ParamMetadata |> List.map (fun p -> ParamNameAndType(Option.map (mkSynId m) p.Name, ImportParameterTypeFromMetadata amap m p.Type p.CustomAttrs x.MetadataScope x.DeclaringTypeInst minst) ) /// Get a reference to the method (dropping all generic instantiations), as an Abstract IL ILMethodRef. - member x.ILMethodRef = - let mref = mkRefToILMethod (x.DeclaringTyconRef.CompiledRepresentationForNamedType,x.RawMetadata) - rescopeILMethodRef x.MetadataScope mref + member x.ILMethodRef = + let mref = mkRefToILMethod (x.DeclaringTyconRef.CompiledRepresentationForNamedType, x.RawMetadata) + rescopeILMethodRef x.MetadataScope mref - /// Indicates if the method is marked as a DllImport (a PInvoke). This is done by looking at the IL custom attributes on + /// Indicates if the method is marked as a DllImport (a PInvoke). This is done by looking at the IL custom attributes on /// the method. - member x.IsDllImport (g: TcGlobals) = + member x.IsDllImport (g: TcGlobals) = match g.attrib_DllImportAttribute with | None -> false - | Some (AttribInfo(tref,_)) ->x.RawMetadata.CustomAttrs |> TryDecodeILAttribute g tref |> Option.isSome + | Some (AttribInfo(tref, _)) ->x.RawMetadata.CustomAttrs |> TryDecodeILAttribute g tref |> Option.isSome - /// Get the (zero or one) 'self'/'this'/'object' arguments associated with an IL method. + /// Get the (zero or one) 'self'/'this'/'object' arguments associated with an IL method. /// An instance extension method returns one object argument. member x.GetObjArgTypes(amap, m, minst) = // All C#-style extension methods are instance. We have to re-read the 'obj' type w.r.t. the @@ -853,17 +845,17 @@ type ILMethInfo = if x.IsILExtensionMethod then let p = x.RawMetadata.Parameters.Head [ ImportParameterTypeFromMetadata amap m p.Type p.CustomAttrs x.MetadataScope x.DeclaringTypeInst minst ] - else if x.IsInstance then + else if x.IsInstance then [ x.ApparentEnclosingType ] else [] /// Get the compiled return type of the method, where 'void' is None. member x.GetCompiledReturnTy (amap, m, minst) = - ImportReturnTypeFromMetadata amap m x.RawMetadata.Return.Type x.RawMetadata.Return.CustomAttrs x.MetadataScope x.DeclaringTypeInst minst + ImportReturnTypeFromMetadata amap m x.RawMetadata.Return.Type x.RawMetadata.Return.CustomAttrs x.MetadataScope x.DeclaringTypeInst minst /// Get the F# view of the return type of the method, where 'void' is 'unit'. - member x.GetFSharpReturnTy (amap, m, minst) = + member x.GetFSharpReturnTy (amap, m, minst) = x.GetCompiledReturnTy(amap, m, minst) |> GetFSharpViewOfReturnType amap.g @@ -876,7 +868,7 @@ type ILMethInfo = #endif /// Describes an F# use of a method [] -type MethInfo = +type MethInfo = /// FSMeth(tcGlobals, enclosingType, valRef, extensionMethodPriority). /// /// Describes a use of a method declared in F# code and backed by F# metadata. @@ -895,99 +887,99 @@ type MethInfo = | ProvidedMeth of Import.ImportMap * Tainted * ExtensionMethodPriority option * range #endif - /// Get the enclosing type of the method info. + /// Get the enclosing type of the method info. /// /// If this is an extension member, then this is the apparent parent, i.e. the type the method appears to extend. /// This may be a variable type. - member x.ApparentEnclosingType = + member x.ApparentEnclosingType = match x with - | ILMeth(_,ilminfo,_) -> ilminfo.ApparentEnclosingType - | FSMeth(_,ty,_,_) -> ty - | DefaultStructCtor(_,ty) -> ty + | ILMeth(_, ilminfo, _) -> ilminfo.ApparentEnclosingType + | FSMeth(_, ty, _, _) -> ty + | DefaultStructCtor(_, ty) -> ty #if !NO_EXTENSIONTYPING - | ProvidedMeth(amap,mi,_,m) -> - Import.ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType),m)) + | ProvidedMeth(amap, mi, _, m) -> + Import.ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType), m)) #endif /// Get the enclosing type of the method info, using a nominal type for tuple types - member x.ApparentEnclosingAppType = + member x.ApparentEnclosingAppType = convertToTypeWithMetadataIfPossible x.TcGlobals x.ApparentEnclosingType - member x.ApparentEnclosingTyconRef = + member x.ApparentEnclosingTyconRef = tcrefOfAppTy x.TcGlobals x.ApparentEnclosingAppType /// Get the declaring type or module holding the method. If this is an C#-style extension method then this is the type /// holding the static member that is the extension method. If this is an F#-style extension method it is the logical module /// holding the value for the extension method. - member x.DeclaringTyconRef = - match x with - | ILMeth(_,ilminfo,_) when x.IsExtensionMember -> ilminfo.DeclaringTyconRef - | FSMeth(_,_,vref,_) when x.IsExtensionMember && vref.HasDeclaringEntity -> vref.TopValDeclaringEntity - | _ -> x.ApparentEnclosingTyconRef + member x.DeclaringTyconRef = + match x with + | ILMeth(_, ilminfo, _) when x.IsExtensionMember -> ilminfo.DeclaringTyconRef + | FSMeth(_, _, vref, _) when x.IsExtensionMember && vref.HasDeclaringEntity -> vref.TopValDeclaringEntity + | _ -> x.ApparentEnclosingTyconRef - /// Get the information about provided static parameters, if any - member x.ProvidedStaticParameterInfo = + /// Get the information about provided static parameters, if any + member x.ProvidedStaticParameterInfo = match x with | ILMeth _ -> None | FSMeth _ -> None #if !NO_EXTENSIONTYPING - | ProvidedMeth (_, mb, _, m) -> - let staticParams = mb.PApplyWithProvider((fun (mb,provider) -> mb.GetStaticParametersForMethod(provider)), range=m) + | ProvidedMeth (_, mb, _, m) -> + let staticParams = mb.PApplyWithProvider((fun (mb, provider) -> mb.GetStaticParametersForMethod(provider)), range=m) let staticParams = staticParams.PApplyArray(id, "GetStaticParametersForMethod", m) - match staticParams with + match staticParams with | [| |] -> None - | _ -> Some (mb,staticParams) + | _ -> Some (mb, staticParams) #endif | DefaultStructCtor _ -> None /// Get the extension method priority of the method, if it has one. - member x.ExtensionMemberPriorityOption = + member x.ExtensionMemberPriorityOption = match x with - | ILMeth(_,_,pri) -> pri - | FSMeth(_,_,_,pri) -> pri + | ILMeth(_, _, pri) -> pri + | FSMeth(_, _, _, pri) -> pri #if !NO_EXTENSIONTYPING - | ProvidedMeth(_,_,pri,_) -> pri + | ProvidedMeth(_, _, pri, _) -> pri #endif | DefaultStructCtor _ -> None /// Get the extension method priority of the method. If it is not an extension method /// then use the highest possible value since non-extension methods always take priority /// over extension members. - member x.ExtensionMemberPriority = defaultArg x.ExtensionMemberPriorityOption System.UInt64.MaxValue + member x.ExtensionMemberPriority = defaultArg x.ExtensionMemberPriorityOption System.UInt64.MaxValue #if DEBUG /// Get the method name in DebuggerDisplayForm - member x.DebuggerDisplayName = - match x with - | ILMeth(_,y,_) -> "ILMeth: " + y.ILName - | FSMeth(_,_,vref,_) -> "FSMeth: " + vref.LogicalName + member x.DebuggerDisplayName = + match x with + | ILMeth(_, y, _) -> "ILMeth: " + y.ILName + | FSMeth(_, _, vref, _) -> "FSMeth: " + vref.LogicalName #if !NO_EXTENSIONTYPING - | ProvidedMeth(_,mi,_,m) -> "ProvidedMeth: " + mi.PUntaint((fun mi -> mi.Name),m) + | ProvidedMeth(_, mi, _, m) -> "ProvidedMeth: " + mi.PUntaint((fun mi -> mi.Name), m) #endif | DefaultStructCtor _ -> ".ctor" #endif /// Get the method name in LogicalName form, i.e. the name as it would be stored in .NET metadata - member x.LogicalName = - match x with - | ILMeth(_,y,_) -> y.ILName - | FSMeth(_,_,vref,_) -> vref.LogicalName + member x.LogicalName = + match x with + | ILMeth(_, y, _) -> y.ILName + | FSMeth(_, _, vref, _) -> vref.LogicalName #if !NO_EXTENSIONTYPING - | ProvidedMeth(_,mi,_,m) -> mi.PUntaint((fun mi -> mi.Name),m) + | ProvidedMeth(_, mi, _, m) -> mi.PUntaint((fun mi -> mi.Name), m) #endif | DefaultStructCtor _ -> ".ctor" /// Get the method name in DisplayName form - member x.DisplayName = - match x with - | FSMeth(_,_,vref,_) -> vref.DisplayName + member x.DisplayName = + match x with + | FSMeth(_, _, vref, _) -> vref.DisplayName | _ -> x.LogicalName /// Indicates if this is a method defined in this assembly with an internal XML comment member x.HasDirectXmlComment = match x with - | FSMeth(g,_,vref,_) -> valRefInThisAssembly g.compilingFslib vref + | FSMeth(g, _, vref, _) -> valRefInThisAssembly g.compilingFslib vref #if !NO_EXTENSIONTYPING | ProvidedMeth _ -> true #endif @@ -996,80 +988,80 @@ type MethInfo = override x.ToString() = x.ApparentEnclosingType.ToString() + x.LogicalName /// Get the actual type instantiation of the declaring type associated with this use of the method. - /// - /// For extension members this is empty (the instantiation of the declaring type). - member x.DeclaringTypeInst = + /// + /// For extension members this is empty (the instantiation of the declaring type). + member x.DeclaringTypeInst = if x.IsExtensionMember then [] else argsOfAppTy x.TcGlobals x.ApparentEnclosingAppType /// Get the TcGlobals value that governs the method declaration - member x.TcGlobals = - match x with - | ILMeth(g,_,_) -> g - | FSMeth(g,_,_,_) -> g - | DefaultStructCtor (g,_) -> g + member x.TcGlobals = + match x with + | ILMeth(g, _, _) -> g + | FSMeth(g, _, _, _) -> g + | DefaultStructCtor (g, _) -> g #if !NO_EXTENSIONTYPING - | ProvidedMeth(amap,_,_,_) -> amap.g + | ProvidedMeth(amap, _, _, _) -> amap.g #endif /// Get the formal generic method parameters for the method as a list of type variables. /// /// For an extension method this includes all type parameters, even if it is extending a generic type. - member x.FormalMethodTypars = - match x with - | ILMeth(_,ilmeth,_) -> ilmeth.FormalMethodTypars - | FSMeth(g,_,vref,_) -> + member x.FormalMethodTypars = + match x with + | ILMeth(_, ilmeth, _) -> ilmeth.FormalMethodTypars + | FSMeth(g, _, vref, _) -> let ty = x.ApparentEnclosingAppType - let _,memberMethodTypars,_,_ = AnalyzeTypeOfMemberVal x.IsCSharpStyleExtensionMember g (ty,vref) + let _, memberMethodTypars, _, _ = AnalyzeTypeOfMemberVal x.IsCSharpStyleExtensionMember g (ty, vref) memberMethodTypars | DefaultStructCtor _ -> [] #if !NO_EXTENSIONTYPING | ProvidedMeth _ -> [] // There will already have been an error if there are generic parameters here. #endif - + /// Get the formal generic method parameters for the method as a list of variable types. member x.FormalMethodInst = generalizeTypars x.FormalMethodTypars member x.FormalMethodTyparInst = mkTyparInst x.FormalMethodTypars x.FormalMethodInst /// Get the XML documentation associated with the method - member x.XmlDoc = - match x with - | ILMeth(_,_,_) -> XmlDoc.Empty - | FSMeth(_,_,vref,_) -> vref.XmlDoc + member x.XmlDoc = + match x with + | ILMeth(_, _, _) -> XmlDoc.Empty + | FSMeth(_, _, vref, _) -> vref.XmlDoc | DefaultStructCtor _ -> XmlDoc.Empty #if !NO_EXTENSIONTYPING - | ProvidedMeth(_,mi,_,m)-> - XmlDoc (mi.PUntaint((fun mix -> (mix :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(mi.TypeProvider.PUntaintNoFailure(id))),m)) + | ProvidedMeth(_, mi, _, m)-> + XmlDoc (mi.PUntaint((fun mix -> (mix :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(mi.TypeProvider.PUntaintNoFailure(id))), m)) #endif /// Try to get an arbitrary F# ValRef associated with the member. This is to determine if the member is virtual, amongst other things. - member x.ArbitraryValRef = - match x with - | FSMeth(_g,_,vref,_) -> Some vref + member x.ArbitraryValRef = + match x with + | FSMeth(_g, _, vref, _) -> Some vref | _ -> None /// Get a list of argument-number counts, one count for each set of curried arguments. /// /// For an extension member, drop the 'this' argument. - member x.NumArgs = - match x with - | ILMeth(_,ilminfo,_) -> [ilminfo.NumParams] - | FSMeth(g,_,vref,_) -> GetArgInfosOfMember x.IsCSharpStyleExtensionMember g vref |> List.map List.length + member x.NumArgs = + match x with + | ILMeth(_, ilminfo, _) -> [ilminfo.NumParams] + | FSMeth(g, _, vref, _) -> GetArgInfosOfMember x.IsCSharpStyleExtensionMember g vref |> List.map List.length | DefaultStructCtor _ -> [0] #if !NO_EXTENSIONTYPING - | ProvidedMeth(_,mi,_,m) -> [mi.PUntaint((fun mi -> mi.GetParameters().Length),m)] // Why is this a list? Answer: because the method might be curried + | ProvidedMeth(_, mi, _, m) -> [mi.PUntaint((fun mi -> mi.GetParameters().Length), m)] // Why is this a list? Answer: because the method might be curried #endif member x.IsCurried = x.NumArgs.Length > 1 /// Does the method appear to the user as an instance method? - member x.IsInstance = - match x with - | ILMeth(_,ilmeth,_) -> ilmeth.IsInstance - | FSMeth(_,_,vref,_) -> vref.IsInstanceMember || x.IsCSharpStyleExtensionMember + member x.IsInstance = + match x with + | ILMeth(_, ilmeth, _) -> ilmeth.IsInstance + | FSMeth(_, _, vref, _) -> vref.IsInstanceMember || x.IsCSharpStyleExtensionMember | DefaultStructCtor _ -> false #if !NO_EXTENSIONTYPING - | ProvidedMeth(_,mi,_,m) -> mi.PUntaint((fun mi -> not mi.IsConstructor && not mi.IsStatic),m) + | ProvidedMeth(_, mi, _, m) -> mi.PUntaint((fun mi -> not mi.IsConstructor && not mi.IsStatic), m) #endif @@ -1077,50 +1069,50 @@ type MethInfo = /// For an extension method this includes all type parameters, even if it is extending a generic type. member x.GenericArity = x.FormalMethodTypars.Length - member x.IsProtectedAccessiblity = - match x with - | ILMeth(_,ilmeth,_) -> ilmeth.IsProtectedAccessibility + member x.IsProtectedAccessiblity = + match x with + | ILMeth(_, ilmeth, _) -> ilmeth.IsProtectedAccessibility | FSMeth _ -> false | DefaultStructCtor _ -> false #if !NO_EXTENSIONTYPING - | ProvidedMeth(_,mi,_,m) -> mi.PUntaint((fun mi -> mi.IsFamily), m) + | ProvidedMeth(_, mi, _, m) -> mi.PUntaint((fun mi -> mi.IsFamily), m) #endif member x.IsVirtual = - match x with - | ILMeth(_,ilmeth,_) -> ilmeth.IsVirtual - | FSMeth(_,_,vref,_) -> vref.IsVirtualMember + match x with + | ILMeth(_, ilmeth, _) -> ilmeth.IsVirtual + | FSMeth(_, _, vref, _) -> vref.IsVirtualMember | DefaultStructCtor _ -> false #if !NO_EXTENSIONTYPING - | ProvidedMeth(_,mi,_,m) -> mi.PUntaint((fun mi -> mi.IsVirtual), m) + | ProvidedMeth(_, mi, _, m) -> mi.PUntaint((fun mi -> mi.IsVirtual), m) #endif - member x.IsConstructor = - match x with - | ILMeth(_,ilmeth,_) -> ilmeth.IsConstructor - | FSMeth(_g,_,vref,_) -> (vref.MemberInfo.Value.MemberFlags.MemberKind = MemberKind.Constructor) + member x.IsConstructor = + match x with + | ILMeth(_, ilmeth, _) -> ilmeth.IsConstructor + | FSMeth(_g, _, vref, _) -> (vref.MemberInfo.Value.MemberFlags.MemberKind = MemberKind.Constructor) | DefaultStructCtor _ -> true #if !NO_EXTENSIONTYPING - | ProvidedMeth(_,mi,_,m) -> mi.PUntaint((fun mi -> mi.IsConstructor), m) + | ProvidedMeth(_, mi, _, m) -> mi.PUntaint((fun mi -> mi.IsConstructor), m) #endif member x.IsClassConstructor = - match x with - | ILMeth(_,ilmeth,_) -> ilmeth.IsClassConstructor - | FSMeth(_,_,vref,_) -> + match x with + | ILMeth(_, ilmeth, _) -> ilmeth.IsClassConstructor + | FSMeth(_, _, vref, _) -> match vref.TryDeref with | ValueSome x -> x.IsClassConstructor | _ -> false | DefaultStructCtor _ -> false #if !NO_EXTENSIONTYPING - | ProvidedMeth(_,mi,_,m) -> mi.PUntaint((fun mi -> mi.IsConstructor && mi.IsStatic), m) // Note: these are never public anyway + | ProvidedMeth(_, mi, _, m) -> mi.PUntaint((fun mi -> mi.IsConstructor && mi.IsStatic), m) // Note: these are never public anyway #endif - member x.IsDispatchSlot = - match x with - | ILMeth(_g,ilmeth,_) -> ilmeth.IsVirtual - | FSMeth(g,_,vref,_) as x -> - isInterfaceTy g x.ApparentEnclosingType || + member x.IsDispatchSlot = + match x with + | ILMeth(_g, ilmeth, _) -> ilmeth.IsVirtual + | FSMeth(g, _, vref, _) as x -> + isInterfaceTy g x.ApparentEnclosingType || vref.MemberInfo.Value.MemberFlags.IsDispatchSlot | DefaultStructCtor _ -> false #if !NO_EXTENSIONTYPING @@ -1128,90 +1120,90 @@ type MethInfo = #endif - member x.IsFinal = - not x.IsVirtual || - match x with - | ILMeth(_,ilmeth,_) -> ilmeth.IsFinal - | FSMeth(_g,_,_vref,_) -> false + member x.IsFinal = + not x.IsVirtual || + match x with + | ILMeth(_, ilmeth, _) -> ilmeth.IsFinal + | FSMeth(_g, _, _vref, _) -> false | DefaultStructCtor _ -> true #if !NO_EXTENSIONTYPING - | ProvidedMeth(_,mi,_,m) -> mi.PUntaint((fun mi -> mi.IsFinal), m) + | ProvidedMeth(_, mi, _, m) -> mi.PUntaint((fun mi -> mi.IsFinal), m) #endif // This means 'is this particular MethInfo one that doesn't provide an implementation?'. - // For F# methods, this is 'true' for the MethInfos corresponding to 'abstract' declarations, + // For F# methods, this is 'true' for the MethInfos corresponding to 'abstract' declarations, // and false for the (potentially) matching 'default' implementation MethInfos that eventually // provide an implementation for the dispatch slot. // // For IL methods, this is 'true' for abstract methods, and 'false' for virtual methods - member minfo.IsAbstract = - match minfo with - | ILMeth(_,ilmeth,_) -> ilmeth.IsAbstract - | FSMeth(g,_,vref,_) -> isInterfaceTy g minfo.ApparentEnclosingType || vref.IsDispatchSlotMember + member minfo.IsAbstract = + match minfo with + | ILMeth(_, ilmeth, _) -> ilmeth.IsAbstract + | FSMeth(g, _, vref, _) -> isInterfaceTy g minfo.ApparentEnclosingType || vref.IsDispatchSlotMember | DefaultStructCtor _ -> false #if !NO_EXTENSIONTYPING - | ProvidedMeth(_,mi,_,m) -> mi.PUntaint((fun mi -> mi.IsAbstract), m) + | ProvidedMeth(_, mi, _, m) -> mi.PUntaint((fun mi -> mi.IsAbstract), m) #endif - member x.IsNewSlot = - isInterfaceTy x.TcGlobals x.ApparentEnclosingType || - (x.IsVirtual && - (match x with - | ILMeth(_,x,_) -> x.IsNewSlot - | FSMeth(_,_,vref,_) -> vref.IsDispatchSlotMember + member x.IsNewSlot = + isInterfaceTy x.TcGlobals x.ApparentEnclosingType || + (x.IsVirtual && + (match x with + | ILMeth(_, x, _) -> x.IsNewSlot + | FSMeth(_, _, vref, _) -> vref.IsDispatchSlotMember #if !NO_EXTENSIONTYPING - | ProvidedMeth(_,mi,_,m) -> mi.PUntaint((fun mi -> mi.IsHideBySig), m) // REVIEW: Check this is correct + | ProvidedMeth(_, mi, _, m) -> mi.PUntaint((fun mi -> mi.IsHideBySig), m) // REVIEW: Check this is correct #endif | DefaultStructCtor _ -> false)) /// Check if this method is an explicit implementation of an interface member - member x.IsFSharpExplicitInterfaceImplementation = - match x with + member x.IsFSharpExplicitInterfaceImplementation = + match x with | ILMeth _ -> false - | FSMeth(g,_,vref,_) -> vref.IsFSharpExplicitInterfaceImplementation g + | FSMeth(g, _, vref, _) -> vref.IsFSharpExplicitInterfaceImplementation g | DefaultStructCtor _ -> false #if !NO_EXTENSIONTYPING - | ProvidedMeth _ -> false + | ProvidedMeth _ -> false #endif /// Check if this method is marked 'override' and thus definitely overrides another method. - member x.IsDefiniteFSharpOverride = - match x with + member x.IsDefiniteFSharpOverride = + match x with | ILMeth _ -> false - | FSMeth(_,_,vref,_) -> vref.IsDefiniteFSharpOverrideMember + | FSMeth(_, _, vref, _) -> vref.IsDefiniteFSharpOverrideMember | DefaultStructCtor _ -> false #if !NO_EXTENSIONTYPING - | ProvidedMeth _ -> false + | ProvidedMeth _ -> false #endif member x.ImplementedSlotSignatures = - match x with - | FSMeth(_,_,vref,_) -> vref.ImplementedSlotSignatures + match x with + | FSMeth(_, _, vref, _) -> vref.ImplementedSlotSignatures | _ -> failwith "not supported" - /// Indicates if this is an extension member. + /// Indicates if this is an extension member. member x.IsExtensionMember = match x with - | FSMeth (_,_,vref,pri) -> pri.IsSome || vref.IsExtensionMember - | ILMeth (_,_,Some _) -> true + | FSMeth (_, _, vref, pri) -> pri.IsSome || vref.IsExtensionMember + | ILMeth (_, _, Some _) -> true | _ -> false /// Indicates if this is an extension member (e.g. on a struct) that takes a byref arg member x.ObjArgNeedsAddress (amap: Import.ImportMap, m) = (x.IsStruct && not x.IsExtensionMember) || - match x.GetObjArgTypes (amap, m, x.FormalMethodInst) with + match x.GetObjArgTypes (amap, m, x.FormalMethodInst) with | [h] -> isByrefTy amap.g h | _ -> false - /// Indicates if this is an F# extension member. - member x.IsFSharpStyleExtensionMember = - match x with FSMeth (_,_,vref,_) -> vref.IsExtensionMember | _ -> false + /// Indicates if this is an F# extension member. + member x.IsFSharpStyleExtensionMember = + match x with FSMeth (_, _, vref, _) -> vref.IsExtensionMember | _ -> false - /// Indicates if this is an C#-style extension member. - member x.IsCSharpStyleExtensionMember = + /// Indicates if this is an C#-style extension member. + member x.IsCSharpStyleExtensionMember = match x with - | FSMeth (_,_,vref,Some _) -> not vref.IsExtensionMember - | ILMeth (_,_,Some _) -> true + | FSMeth (_, _, vref, Some _) -> not vref.IsExtensionMember + | ILMeth (_, _, Some _) -> true | _ -> false /// Add the actual type instantiation of the apparent type of an F# extension method. @@ -1219,134 +1211,134 @@ type MethInfo = // When an explicit type instantiation is given for an F# extension members the type // arguments implied by the object type are not given in source code. This means we must // add them explicitly. For example - // type List<'T> with + // type List<'T> with // member xs.Map<'U>(f : 'T -> 'U) = .... // is called as // xs.Map // but is compiled as a generic methods with two type arguments - // Map<'T,'U>(this: List<'T>, f : 'T -> 'U) - member x.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers(tyargs) = - (if x.IsFSharpStyleExtensionMember then argsOfAppTy x.TcGlobals x.ApparentEnclosingAppType else []) @ tyargs + // Map<'T, 'U>(this: List<'T>, f : 'T -> 'U) + member x.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers(tyargs) = + (if x.IsFSharpStyleExtensionMember then argsOfAppTy x.TcGlobals x.ApparentEnclosingAppType else []) @ tyargs /// Indicates if this method is a generated method associated with an F# CLIEvent property compiled as a .NET event - member x.IsFSharpEventPropertyMethod = - match x with - | FSMeth(g,_,vref,_) -> vref.IsFSharpEventProperty(g) + member x.IsFSharpEventPropertyMethod = + match x with + | FSMeth(g, _, vref, _) -> vref.IsFSharpEventProperty(g) #if !NO_EXTENSIONTYPING - | ProvidedMeth _ -> false + | ProvidedMeth _ -> false #endif | _ -> false /// Indicates if this method takes no arguments member x.IsNullary = (x.NumArgs = [0]) - /// Indicates if the enclosing type for the method is a value type. + /// Indicates if the enclosing type for the method is a value type. /// /// For an extension method, this indicates if the method extends a struct type. - member x.IsStruct = + member x.IsStruct = isStructTy x.TcGlobals x.ApparentEnclosingType - /// Build IL method infos. - static member CreateILMeth (amap:Import.ImportMap, m, ty:TType, md: ILMethodDef) = + /// Build IL method infos. + static member CreateILMeth (amap:Import.ImportMap, m, ty:TType, md: ILMethodDef) = let tinfo = ILTypeInfo.FromType amap.g ty let mtps = Import.ImportILGenericParameters (fun () -> amap) m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata md.GenericParams - ILMeth (amap.g,ILMethInfo(amap.g, ty, None, md, mtps),None) + ILMeth (amap.g, ILMethInfo(amap.g, ty, None, md, mtps), None) /// Build IL method infos for a C#-style extension method - static member CreateILExtensionMeth (amap, m, apparentTy:TType, declaringTyconRef:TyconRef, extMethPri, md: ILMethodDef) = + static member CreateILExtensionMeth (amap, m, apparentTy:TType, declaringTyconRef:TyconRef, extMethPri, md: ILMethodDef) = let scoref = declaringTyconRef.CompiledRepresentationForNamedType.Scope let mtps = Import.ImportILGenericParameters (fun () -> amap) m scoref [] md.GenericParams - ILMeth (amap.g,ILMethInfo(amap.g,apparentTy,Some declaringTyconRef,md,mtps),extMethPri) + ILMeth (amap.g, ILMethInfo(amap.g, apparentTy, Some declaringTyconRef, md, mtps), extMethPri) /// Tests whether two method infos have the same underlying definition. /// Used to merge operator overloads collected from left and right of an operator constraint. /// Must be compatible with ItemsAreEffectivelyEqual relation. - static member MethInfosUseIdenticalDefinitions x1 x2 = - match x1,x2 with - | ILMeth(_,x1,_), ILMeth(_,x2,_) -> (x1.RawMetadata === x2.RawMetadata) - | FSMeth(g,_,vref1,_), FSMeth(_,_,vref2,_) -> valRefEq g vref1 vref2 - | DefaultStructCtor _, DefaultStructCtor _ -> tyconRefEq x1.TcGlobals x1.DeclaringTyconRef x2.DeclaringTyconRef + static member MethInfosUseIdenticalDefinitions x1 x2 = + match x1, x2 with + | ILMeth(_, x1, _), ILMeth(_, x2, _) -> (x1.RawMetadata === x2.RawMetadata) + | FSMeth(g, _, vref1, _), FSMeth(_, _, vref2, _) -> valRefEq g vref1 vref2 + | DefaultStructCtor _, DefaultStructCtor _ -> tyconRefEq x1.TcGlobals x1.DeclaringTyconRef x2.DeclaringTyconRef #if !NO_EXTENSIONTYPING - | ProvidedMeth(_,mi1,_,_),ProvidedMeth(_,mi2,_,_) -> ProvidedMethodBase.TaintedEquals (mi1, mi2) + | ProvidedMeth(_, mi1, _, _), ProvidedMeth(_, mi2, _, _) -> ProvidedMethodBase.TaintedEquals (mi1, mi2) #endif | _ -> false /// Calculates a hash code of method info. Must be compatible with ItemsAreEffectivelyEqual relation. - member x.ComputeHashCode() = - match x with - | ILMeth(_,x1,_) -> hash x1.RawMetadata.Name - | FSMeth(_,_,vref,_) -> hash vref.LogicalName - | DefaultStructCtor(_,_ty) -> 34892 // "ty" doesn't support hashing. We could use "hash (tcrefOfAppTy g ty).CompiledName" or + member x.ComputeHashCode() = + match x with + | ILMeth(_, x1, _) -> hash x1.RawMetadata.Name + | FSMeth(_, _, vref, _) -> hash vref.LogicalName + | DefaultStructCtor(_, _ty) -> 34892 // "ty" doesn't support hashing. We could use "hash (tcrefOfAppTy g ty).CompiledName" or // something but we don't have a "g" parameter here yet. But this hash need only be very approximate anyway #if !NO_EXTENSIONTYPING - | ProvidedMeth(_,mi,_,_) -> ProvidedMethodInfo.TaintedGetHashCode(mi) + | ProvidedMeth(_, mi, _, _) -> ProvidedMethodInfo.TaintedGetHashCode(mi) #endif - /// Apply a type instantiation to a method info, i.e. apply the instantiation to the enclosing type. - member x.Instantiate(amap, m, inst) = - match x with - | ILMeth(_g,ilminfo,pri) -> - match ilminfo with - | ILMethInfo(_,ty,None,md,_) -> MethInfo.CreateILMeth(amap, m, instType inst ty, md) - | ILMethInfo(_,ty,Some declaringTyconRef,md,_) -> MethInfo.CreateILExtensionMeth(amap, m, instType inst ty, declaringTyconRef, pri, md) - | FSMeth(g,ty,vref,pri) -> FSMeth(g,instType inst ty,vref,pri) - | DefaultStructCtor(g,ty) -> DefaultStructCtor(g,instType inst ty) -#if !NO_EXTENSIONTYPING - | ProvidedMeth _ -> - match inst with + /// Apply a type instantiation to a method info, i.e. apply the instantiation to the enclosing type. + member x.Instantiate(amap, m, inst) = + match x with + | ILMeth(_g, ilminfo, pri) -> + match ilminfo with + | ILMethInfo(_, ty, None, md, _) -> MethInfo.CreateILMeth(amap, m, instType inst ty, md) + | ILMethInfo(_, ty, Some declaringTyconRef, md, _) -> MethInfo.CreateILExtensionMeth(amap, m, instType inst ty, declaringTyconRef, pri, md) + | FSMeth(g, ty, vref, pri) -> FSMeth(g, instType inst ty, vref, pri) + | DefaultStructCtor(g, ty) -> DefaultStructCtor(g, instType inst ty) +#if !NO_EXTENSIONTYPING + | ProvidedMeth _ -> + match inst with | [] -> x - | _ -> assert false; failwith "Not supported" + | _ -> assert false; failwith "Not supported" #endif /// Get the return type of a method info, where 'void' is returned as 'None' - member x.GetCompiledReturnTy (amap, m, minst) = - match x with - | ILMeth(_g,ilminfo,_) -> + member x.GetCompiledReturnTy (amap, m, minst) = + match x with + | ILMeth(_g, ilminfo, _) -> ilminfo.GetCompiledReturnTy(amap, m, minst) - | FSMeth(g,_,vref,_) -> + | FSMeth(g, _, vref, _) -> let ty = x.ApparentEnclosingAppType - let inst = GetInstantiationForMemberVal g x.IsCSharpStyleExtensionMember (ty,vref,minst) - let _,_,retTy,_ = AnalyzeTypeOfMemberVal x.IsCSharpStyleExtensionMember g (ty,vref) + let inst = GetInstantiationForMemberVal g x.IsCSharpStyleExtensionMember (ty, vref, minst) + let _, _, retTy, _ = AnalyzeTypeOfMemberVal x.IsCSharpStyleExtensionMember g (ty, vref) retTy |> Option.map (instType inst) | DefaultStructCtor _ -> None #if !NO_EXTENSIONTYPING - | ProvidedMeth(amap,mi,_,m) -> + | ProvidedMeth(amap, mi, _, m) -> GetCompiledReturnTyOfProvidedMethodInfo amap m mi #endif /// Get the return type of a method info, where 'void' is returned as 'unit' member x.GetFSharpReturnTy(amap, m, minst) = x.GetCompiledReturnTy(amap, m, minst) |> GetFSharpViewOfReturnType amap.g - + /// Get the parameter types of a method info - member x.GetParamTypes(amap, m, minst) = - match x with - | ILMeth(_g,ilminfo,_) -> + member x.GetParamTypes(amap, m, minst) = + match x with + | ILMeth(_g, ilminfo, _) -> // A single group of tupled arguments - [ ilminfo.GetParamTypes(amap,m,minst) ] - | FSMeth(g,ty,vref,_) -> + [ ilminfo.GetParamTypes(amap, m, minst) ] + | FSMeth(g, ty, vref, _) -> let paramTypes = ParamNameAndType.FromMember x.IsCSharpStyleExtensionMember g vref - let inst = GetInstantiationForMemberVal g x.IsCSharpStyleExtensionMember (ty,vref,minst) - paramTypes |> List.mapSquared (fun (ParamNameAndType(_,ty)) -> instType inst ty) + let inst = GetInstantiationForMemberVal g x.IsCSharpStyleExtensionMember (ty, vref, minst) + paramTypes |> List.mapSquared (fun (ParamNameAndType(_, ty)) -> instType inst ty) | DefaultStructCtor _ -> [] #if !NO_EXTENSIONTYPING - | ProvidedMeth(amap,mi,_,m) -> + | ProvidedMeth(amap, mi, _, m) -> // A single group of tupled arguments - [ [ for p in mi.PApplyArray((fun mi -> mi.GetParameters()), "GetParameters",m) do - yield Import.ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType),m)) ] ] + [ [ for p in mi.PApplyArray((fun mi -> mi.GetParameters()), "GetParameters", m) do + yield Import.ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) ] ] #endif /// Get the (zero or one) 'self'/'this'/'object' arguments associated with a method. /// An instance method returns one object argument. - member x.GetObjArgTypes (amap, m, minst) = - match x with - | ILMeth(_,ilminfo,_) -> ilminfo.GetObjArgTypes(amap, m, minst) - | FSMeth(g,_,vref,_) -> - if x.IsInstance then + member x.GetObjArgTypes (amap, m, minst) = + match x with + | ILMeth(_, ilminfo, _) -> ilminfo.GetObjArgTypes(amap, m, minst) + | FSMeth(g, _, vref, _) -> + if x.IsInstance then let ty = x.ApparentEnclosingAppType // The 'this' pointer of an extension member can depend on the minst - if x.IsExtensionMember then - let inst = GetInstantiationForMemberVal g x.IsCSharpStyleExtensionMember (ty,vref,minst) + if x.IsExtensionMember then + let inst = GetInstantiationForMemberVal g x.IsCSharpStyleExtensionMember (ty, vref, minst) let rawObjTy = GetObjTypeOfInstanceExtensionMethod g vref [ rawObjTy |> instType inst ] else @@ -1354,25 +1346,25 @@ type MethInfo = else [] | DefaultStructCtor _ -> [] #if !NO_EXTENSIONTYPING - | ProvidedMeth(amap,mi,_,m) -> - if x.IsInstance then [ Import.ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType),m)) ] // find the type of the 'this' argument + | ProvidedMeth(amap, mi, _, m) -> + if x.IsInstance then [ Import.ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType), m)) ] // find the type of the 'this' argument else [] #endif /// Get the parameter attributes of a method info, which get combined with the parameter names and types - member x.GetParamAttribs(amap, m) = - match x with - | ILMeth(g,ilMethInfo,_) -> + member x.GetParamAttribs(amap, m) = + match x with + | ILMeth(g, ilMethInfo, _) -> [ [ for p in ilMethInfo.ParamMetadata do let isParamArrayArg = TryFindILAttribute g.attrib_ParamArrayAttribute p.CustomAttrs - let reflArgInfo = - match TryDecodeILAttribute g g.attrib_ReflectedDefinitionAttribute.TypeRef p.CustomAttrs with - | Some ([ILAttribElem.Bool b ],_) -> ReflectedArgInfo.Quote b + let reflArgInfo = + match TryDecodeILAttribute g g.attrib_ReflectedDefinitionAttribute.TypeRef p.CustomAttrs with + | Some ([ILAttribElem.Bool b ], _) -> ReflectedArgInfo.Quote b | Some _ -> ReflectedArgInfo.Quote false | _ -> ReflectedArgInfo.None let isOutArg = (p.IsOut && not p.IsIn) let isInArg = (p.IsIn && not p.IsOut) - // Note: we get default argument values from VB and other .NET language metadata + // Note: we get default argument values from VB and other .NET language metadata let optArgInfo = OptionalArgInfo.FromILParameter g amap m ilMethInfo.MetadataScope ilMethInfo.DeclaringTypeInst p let isCallerLineNumberArg = TryFindILAttribute g.attrib_CallerLineNumberAttribute p.CustomAttrs @@ -1393,43 +1385,43 @@ type MethInfo = yield (isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo) ] ] - | FSMeth(g,_,vref,_) -> - GetArgInfosOfMember x.IsCSharpStyleExtensionMember g vref - |> List.mapSquared (fun (ty,argInfo) -> + | FSMeth(g, _, vref, _) -> + GetArgInfosOfMember x.IsCSharpStyleExtensionMember g vref + |> List.mapSquared (fun (ty, argInfo) -> let isParamArrayArg = HasFSharpAttribute g g.attrib_ParamArrayAttribute argInfo.Attribs - let reflArgInfo = - match TryFindFSharpBoolAttributeAssumeFalse g g.attrib_ReflectedDefinitionAttribute argInfo.Attribs with + let reflArgInfo = + match TryFindFSharpBoolAttributeAssumeFalse g g.attrib_ReflectedDefinitionAttribute argInfo.Attribs with | Some b -> ReflectedArgInfo.Quote b | None -> ReflectedArgInfo.None let isOutArg = (HasFSharpAttribute g g.attrib_OutAttribute argInfo.Attribs && isByrefTy g ty) || isOutByrefTy g ty let isInArg = (HasFSharpAttribute g g.attrib_InAttribute argInfo.Attribs && isByrefTy g ty) || isInByrefTy g ty let isCalleeSideOptArg = HasFSharpAttribute g g.attrib_OptionalArgumentAttribute argInfo.Attribs let isCallerSideOptArg = HasFSharpAttributeOpt g g.attrib_OptionalAttribute argInfo.Attribs - let optArgInfo = - if isCalleeSideOptArg then - CalleeSide + let optArgInfo = + if isCalleeSideOptArg then + CalleeSide elif isCallerSideOptArg then let defaultParameterValueAttribute = TryFindFSharpAttributeOpt g g.attrib_DefaultParameterValueAttribute argInfo.Attribs match defaultParameterValueAttribute with - | None -> + | None -> // Do a type-directed analysis of the type to determine the default value to pass. // Similar rules as OptionalArgInfo.FromILParameter are applied here, except for the COM and byref-related stuff. CallerSide (if isObjTy g ty then MissingValue else DefaultValue) - | Some attr -> + | Some attr -> let defaultValue = OptionalArgInfo.ValueOfDefaultParameterValueAttrib attr match defaultValue with - | Some (Expr.Const (_, m, ty2)) when not (typeEquiv g ty2 ty) -> + | Some (Expr.Const (_, m, ty2)) when not (typeEquiv g ty2 ty) -> // the type of the default value does not match the type of the argument. // Emit a warning, and ignore the DefaultParameterValue argument altogether. warning(Error(FSComp.SR.DefaultParameterValueNotAppropriateForArgument(), m)) NotOptional - | Some (Expr.Const((ConstToILFieldInit fi),_,_)) -> + | Some (Expr.Const((ConstToILFieldInit fi), _, _)) -> // Good case - all is well. CallerSide (Constant fi) - | _ -> + | _ -> // Default value is not appropriate, i.e. not a constant. // Compiler already gives an error in that case, so just ignore here. - NotOptional + NotOptional else NotOptional let isCallerLineNumberArg = HasFSharpAttribute g g.attrib_CallerLineNumberAttribute argInfo.Attribs @@ -1442,10 +1434,12 @@ type MethInfo = | true, false, false -> CallerLineNumber | false, true, false -> CallerFilePath | false, false, true -> CallerMemberName - | false, true, true -> match TryFindFSharpAttribute g g.attrib_CallerMemberNameAttribute argInfo.Attribs with - | Some(Attrib(_,_,_,_,_,_,callerMemberNameAttributeRange)) -> warning(Error(FSComp.SR.CallerMemberNameIsOverriden(argInfo.Name.Value.idText), callerMemberNameAttributeRange)) - CallerFilePath - | _ -> failwith "Impossible" + | false, true, true -> + match TryFindFSharpAttribute g g.attrib_CallerMemberNameAttribute argInfo.Attribs with + | Some(Attrib(_, _, _, _, _, _, callerMemberNameAttributeRange)) -> + warning(Error(FSComp.SR.CallerMemberNameIsOverriden(argInfo.Name.Value.idText), callerMemberNameAttributeRange)) + CallerFilePath + | _ -> failwith "Impossible" | _, _, _ -> // if multiple caller info attributes are specified, pick the "wrong" one here // so that we get an error later @@ -1455,17 +1449,17 @@ type MethInfo = (isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo)) - | DefaultStructCtor _ -> + | DefaultStructCtor _ -> [[]] #if !NO_EXTENSIONTYPING - | ProvidedMeth(amap,mi,_,_) -> + | ProvidedMeth(amap, mi, _, _) -> // A single group of tupled arguments [ [for p in mi.PApplyArray((fun mi -> mi.GetParameters()), "GetParameters", m) do - let isParamArrayArg = p.PUntaint((fun px -> (px :> IProvidedCustomAttributeProvider).GetAttributeConstructorArgs(p.TypeProvider.PUntaintNoFailure(id), typeof.FullName).IsSome),m) - let optArgInfo = OptionalArgInfoOfProvidedParameter amap m p - let reflArgInfo = - match p.PUntaint((fun px -> (px :> IProvidedCustomAttributeProvider).GetAttributeConstructorArgs(p.TypeProvider.PUntaintNoFailure(id), typeof.FullName)),m) with + let isParamArrayArg = p.PUntaint((fun px -> (px :> IProvidedCustomAttributeProvider).GetAttributeConstructorArgs(p.TypeProvider.PUntaintNoFailure(id), typeof.FullName).IsSome), m) + let optArgInfo = OptionalArgInfoOfProvidedParameter amap m p + let reflArgInfo = + match p.PUntaint((fun px -> (px :> IProvidedCustomAttributeProvider).GetAttributeConstructorArgs(p.TypeProvider.PUntaintNoFailure(id), typeof.FullName)), m) with | Some ([ Some (:? bool as b) ], _) -> ReflectedArgInfo.Quote b | Some _ -> ReflectedArgInfo.Quote false | None -> ReflectedArgInfo.None @@ -1481,84 +1475,84 @@ type MethInfo = // This code has grown organically over time. We've managed to unify the ILMeth+ProvidedMeth paths. // The FSMeth, ILMeth+ProvidedMeth paths can probably be unified too. member x.GetSlotSig(amap, m) = - match x with - | FSMeth(g,_,vref,_) -> - match vref.RecursiveValInfo with - | ValInRecScope(false) -> error(Error((FSComp.SR.InvalidRecursiveReferenceToAbstractSlot()),m)) + match x with + | FSMeth(g, _, vref, _) -> + match vref.RecursiveValInfo with + | ValInRecScope(false) -> error(Error((FSComp.SR.InvalidRecursiveReferenceToAbstractSlot()), m)) | _ -> () - let allTyparsFromMethod,_,retTy,_ = GetTypeOfMemberInMemberForm g vref + let allTyparsFromMethod, _, retTy, _ = GetTypeOfMemberInMemberForm g vref // A slot signature is w.r.t. the type variables of the type it is associated with. // So we have to rename from the member type variables to the type variables of the type. let formalEnclosingTypars = x.ApparentEnclosingTyconRef.Typars(m) - let formalEnclosingTyparsFromMethod,formalMethTypars = List.splitAt formalEnclosingTypars.Length allTyparsFromMethod - let methodToParentRenaming,_ = mkTyparToTyparRenaming formalEnclosingTyparsFromMethod formalEnclosingTypars - let formalParams = - GetArgInfosOfMember x.IsCSharpStyleExtensionMember g vref + let formalEnclosingTyparsFromMethod, formalMethTypars = List.splitAt formalEnclosingTypars.Length allTyparsFromMethod + let methodToParentRenaming, _ = mkTyparToTyparRenaming formalEnclosingTyparsFromMethod formalEnclosingTypars + let formalParams = + GetArgInfosOfMember x.IsCSharpStyleExtensionMember g vref |> List.mapSquared (map1Of2 (instType methodToParentRenaming) >> MakeSlotParam ) let formalRetTy = Option.map (instType methodToParentRenaming) retTy MakeSlotSig(x.LogicalName, x.ApparentEnclosingType, formalEnclosingTypars, formalMethTypars, formalParams, formalRetTy) - | DefaultStructCtor _ -> error(InternalError("no slotsig for DefaultStructCtor",m)) - | _ -> + | DefaultStructCtor _ -> error(InternalError("no slotsig for DefaultStructCtor", m)) + | _ -> let g = x.TcGlobals - // slotsigs must contain the formal types for the arguments and return type - // a _formal_ 'void' return type is represented as a 'unit' type. - // slotsigs are independent of instantiation: if an instantiation - // happens to make the return type 'unit' (i.e. it was originally a variable type - // then that does not correspond to a slotsig compiled as a 'void' return type. - // REVIEW: should we copy down attributes to slot params? + // slotsigs must contain the formal types for the arguments and return type + // a _formal_ 'void' return type is represented as a 'unit' type. + // slotsigs are independent of instantiation: if an instantiation + // happens to make the return type 'unit' (i.e. it was originally a variable type + // then that does not correspond to a slotsig compiled as a 'void' return type. + // REVIEW: should we copy down attributes to slot params? let tcref = tcrefOfAppTy g x.ApparentEnclosingAppType let formalEnclosingTyparsOrig = tcref.Typars(m) let formalEnclosingTypars = copyTypars formalEnclosingTyparsOrig - let _,formalEnclosingTyparTys = FixupNewTypars m [] [] formalEnclosingTyparsOrig formalEnclosingTypars + let _, formalEnclosingTyparTys = FixupNewTypars m [] [] formalEnclosingTyparsOrig formalEnclosingTypars let formalMethTypars = copyTypars x.FormalMethodTypars - let _,formalMethTyparTys = FixupNewTypars m formalEnclosingTypars formalEnclosingTyparTys x.FormalMethodTypars formalMethTypars - let formalRetTy, formalParams = + let _, formalMethTyparTys = FixupNewTypars m formalEnclosingTypars formalEnclosingTyparTys x.FormalMethodTypars formalMethTypars + let formalRetTy, formalParams = match x with - | ILMeth(_,ilminfo,_) -> - let ftinfo = ILTypeInfo.FromType g (TType_app(tcref,formalEnclosingTyparTys)) + | ILMeth(_, ilminfo, _) -> + let ftinfo = ILTypeInfo.FromType g (TType_app(tcref, formalEnclosingTyparTys)) let formalRetTy = ImportReturnTypeFromMetadata amap m ilminfo.RawMetadata.Return.Type ilminfo.RawMetadata.Return.CustomAttrs ftinfo.ILScopeRef ftinfo.TypeInstOfRawMetadata formalMethTyparTys - let formalParams = - [ [ for p in ilminfo.RawMetadata.Parameters do + let formalParams = + [ [ for p in ilminfo.RawMetadata.Parameters do let paramType = ImportILTypeFromMetadata amap m ftinfo.ILScopeRef ftinfo.TypeInstOfRawMetadata formalMethTyparTys p.Type yield TSlotParam(p.Name, paramType, p.IsIn, p.IsOut, p.IsOptional, []) ] ] formalRetTy, formalParams #if !NO_EXTENSIONTYPING - | ProvidedMeth (_,mi,_,_) -> + | ProvidedMeth (_, mi, _, _) -> // GENERIC TYPE PROVIDERS: for generics, formal types should be generated here, not the actual types // For non-generic type providers there is no difference let formalRetTy = x.GetCompiledReturnTy(amap, m, formalMethTyparTys) // GENERIC TYPE PROVIDERS: formal types should be generated here, not the actual types // For non-generic type providers there is no difference - let formalParams = - [ [ for p in mi.PApplyArray((fun mi -> mi.GetParameters()), "GetParameters", m) do - let paramName = p.PUntaint((fun p -> match p.Name with null -> None | s -> Some s),m) - let paramType = Import.ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType),m)) - let isIn, isOut,isOptional = p.PUntaint((fun p -> p.IsIn, p.IsOut, p.IsOptional),m) + let formalParams = + [ [ for p in mi.PApplyArray((fun mi -> mi.GetParameters()), "GetParameters", m) do + let paramName = p.PUntaint((fun p -> match p.Name with null -> None | s -> Some s), m) + let paramType = Import.ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) + let isIn, isOut, isOptional = p.PUntaint((fun p -> p.IsIn, p.IsOut, p.IsOptional), m) yield TSlotParam(paramName, paramType, isIn, isOut, isOptional, []) ] ] formalRetTy, formalParams #endif | _ -> failwith "unreachable" - MakeSlotSig(x.LogicalName, x.ApparentEnclosingType, formalEnclosingTypars, formalMethTypars,formalParams, formalRetTy) - + MakeSlotSig(x.LogicalName, x.ApparentEnclosingType, formalEnclosingTypars, formalMethTypars, formalParams, formalRetTy) + /// Get the ParamData objects for the parameters of a MethInfo - member x.GetParamDatas(amap, m, minst) = - let paramNamesAndTypes = - match x with - | ILMeth(_g,ilminfo,_) -> - [ ilminfo.GetParamNamesAndTypes(amap,m,minst) ] - | FSMeth(g,_,vref,_) -> + member x.GetParamDatas(amap, m, minst) = + let paramNamesAndTypes = + match x with + | ILMeth(_g, ilminfo, _) -> + [ ilminfo.GetParamNamesAndTypes(amap, m, minst) ] + | FSMeth(g, _, vref, _) -> let ty = x.ApparentEnclosingAppType - let items = ParamNameAndType.FromMember x.IsCSharpStyleExtensionMember g vref - let inst = GetInstantiationForMemberVal g x.IsCSharpStyleExtensionMember (ty,vref,minst) - items |> ParamNameAndType.InstantiateCurried inst - | DefaultStructCtor _ -> + let items = ParamNameAndType.FromMember x.IsCSharpStyleExtensionMember g vref + let inst = GetInstantiationForMemberVal g x.IsCSharpStyleExtensionMember (ty, vref, minst) + items |> ParamNameAndType.InstantiateCurried inst + | DefaultStructCtor _ -> [[]] #if !NO_EXTENSIONTYPING - | ProvidedMeth(amap,mi,_,_) -> + | ProvidedMeth(amap, mi, _, _) -> // A single set of tupled parameters - [ [for p in mi.PApplyArray((fun mi -> mi.GetParameters()), "GetParameters", m) do - let pname = + [ [for p in mi.PApplyArray((fun mi -> mi.GetParameters()), "GetParameters", m) do + let pname = match p.PUntaint((fun p -> p.Name), m) with | null -> None | name -> Some (mkSynId m name) @@ -1566,33 +1560,33 @@ type MethInfo = match p.PApply((fun p -> p.ParameterType), m) with | Tainted.Null -> amap.g.unit_ty | parameterType -> Import.ImportProvidedType amap m parameterType - yield ParamNameAndType(pname,pty) ] ] + yield ParamNameAndType(pname, pty) ] ] #endif let paramAttribs = x.GetParamAttribs(amap, m) - (paramAttribs,paramNamesAndTypes) ||> List.map2 (List.map2 (fun (isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo) (ParamNameAndType(nmOpt,pty)) -> + (paramAttribs, paramNamesAndTypes) ||> List.map2 (List.map2 (fun (isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo) (ParamNameAndType(nmOpt, pty)) -> ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, nmOpt, reflArgInfo, pty))) /// Get the ParamData objects for the parameters of a MethInfo - member x.HasParamArrayArg(amap, m, minst) = - x.GetParamDatas(amap, m, minst) |> List.existsSquared (fun (ParamData(isParamArrayArg,_,_,_,_,_,_,_)) -> isParamArrayArg) + member x.HasParamArrayArg(amap, m, minst) = + x.GetParamDatas(amap, m, minst) |> List.existsSquared (fun (ParamData(isParamArrayArg, _, _, _, _, _, _, _)) -> isParamArrayArg) - /// Select all the type parameters of the declaring type of a method. + /// Select all the type parameters of the declaring type of a method. /// - /// For extension methods, no type parameters are returned, because all the - /// type parameters are part of the apparent type, rather the + /// For extension methods, no type parameters are returned, because all the + /// type parameters are part of the apparent type, rather the /// declaring type, even for extension methods extending generic types. - member x.GetFormalTyparsOfDeclaringType m = - if x.IsExtensionMember then [] - else + member x.GetFormalTyparsOfDeclaringType m = + if x.IsExtensionMember then [] + else match x with - | FSMeth(g,_,vref,_) -> + | FSMeth(g, _, vref, _) -> let ty = x.ApparentEnclosingAppType - let memberParentTypars,_,_,_ = AnalyzeTypeOfMemberVal false g (ty,vref) + let memberParentTypars, _, _, _ = AnalyzeTypeOfMemberVal false g (ty, vref) memberParentTypars - | _ -> + | _ -> x.DeclaringTyconRef.Typars(m) /// Tries to get the object arg type if it's a byref type. @@ -1609,20 +1603,20 @@ type MethInfo = /// Represents a single use of a IL or provided field from one point in an F# program [] -type ILFieldInfo = +type ILFieldInfo = /// Represents a single use of a field backed by Abstract IL metadata - | ILFieldInfo of ILTypeInfo * ILFieldDef // .NET IL fields + | ILFieldInfo of ILTypeInfo * ILFieldDef // .NET IL fields #if !NO_EXTENSIONTYPING /// Represents a single use of a field backed by provided metadata | ProvidedField of Import.ImportMap * Tainted * range #endif - /// Get the enclosing ("parent"/"declaring") type of the field. - member x.ApparentEnclosingType = - match x with - | ILFieldInfo(tinfo,_) -> tinfo.ToType + /// Get the enclosing ("parent"/"declaring") type of the field. + member x.ApparentEnclosingType = + match x with + | ILFieldInfo(tinfo, _) -> tinfo.ToType #if !NO_EXTENSIONTYPING - | ProvidedField(amap,fi,m) -> (Import.ImportProvidedType amap m (fi.PApply((fun fi -> fi.DeclaringType),m))) + | ProvidedField(amap, fi, m) -> (Import.ImportProvidedType amap m (fi.PApply((fun fi -> fi.DeclaringType), m))) #endif member x.ApparentEnclosingAppType = x.ApparentEnclosingType @@ -1632,110 +1626,110 @@ type ILFieldInfo = member x.DeclaringTyconRef = x.ApparentEnclosingTyconRef member x.TcGlobals = - match x with - | ILFieldInfo(tinfo,_) -> tinfo.TcGlobals + match x with + | ILFieldInfo(tinfo, _) -> tinfo.TcGlobals #if !NO_EXTENSIONTYPING - | ProvidedField(amap,_,_) -> amap.g + | ProvidedField(amap, _, _) -> amap.g #endif /// Get a reference to the declaring type of the field as an ILTypeRef - member x.ILTypeRef = - match x with - | ILFieldInfo(tinfo,_) -> tinfo.ILTypeRef + member x.ILTypeRef = + match x with + | ILFieldInfo(tinfo, _) -> tinfo.ILTypeRef #if !NO_EXTENSIONTYPING - | ProvidedField(amap,fi,m) -> (Import.ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.DeclaringType),m))).TypeRef + | ProvidedField(amap, fi, m) -> (Import.ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.DeclaringType), m))).TypeRef #endif - + /// Get the scope used to interpret IL metadata member x.ScopeRef = x.ILTypeRef.Scope - /// Get the type instantiation of the declaring type of the field - member x.TypeInst = - match x with - | ILFieldInfo(tinfo,_) -> tinfo.TypeInstOfRawMetadata + /// Get the type instantiation of the declaring type of the field + member x.TypeInst = + match x with + | ILFieldInfo(tinfo, _) -> tinfo.TypeInstOfRawMetadata #if !NO_EXTENSIONTYPING | ProvidedField _ -> [] /// GENERIC TYPE PROVIDERS #endif /// Get the name of the field - member x.FieldName = - match x with - | ILFieldInfo(_,pd) -> pd.Name + member x.FieldName = + match x with + | ILFieldInfo(_, pd) -> pd.Name #if !NO_EXTENSIONTYPING - | ProvidedField(_,fi,m) -> fi.PUntaint((fun fi -> fi.Name),m) + | ProvidedField(_, fi, m) -> fi.PUntaint((fun fi -> fi.Name), m) #endif /// Indicates if the field is readonly (in the .NET/C# sense of readonly) - member x.IsInitOnly = - match x with - | ILFieldInfo(_,pd) -> pd.IsInitOnly + member x.IsInitOnly = + match x with + | ILFieldInfo(_, pd) -> pd.IsInitOnly #if !NO_EXTENSIONTYPING - | ProvidedField(_,fi,m) -> fi.PUntaint((fun fi -> fi.IsInitOnly),m) + | ProvidedField(_, fi, m) -> fi.PUntaint((fun fi -> fi.IsInitOnly), m) #endif /// Indicates if the field is a member of a struct or enum type - member x.IsValueType = - match x with - | ILFieldInfo(tinfo,_) -> tinfo.IsValueType + member x.IsValueType = + match x with + | ILFieldInfo(tinfo, _) -> tinfo.IsValueType #if !NO_EXTENSIONTYPING - | ProvidedField(amap,_,_) -> isStructTy amap.g x.ApparentEnclosingType + | ProvidedField(amap, _, _) -> isStructTy amap.g x.ApparentEnclosingType #endif /// Indicates if the field is static - member x.IsStatic = - match x with - | ILFieldInfo(_,pd) -> pd.IsStatic + member x.IsStatic = + match x with + | ILFieldInfo(_, pd) -> pd.IsStatic #if !NO_EXTENSIONTYPING - | ProvidedField(_,fi,m) -> fi.PUntaint((fun fi -> fi.IsStatic),m) + | ProvidedField(_, fi, m) -> fi.PUntaint((fun fi -> fi.IsStatic), m) #endif /// Indicates if the field has the 'specialname' property in the .NET IL - member x.IsSpecialName = - match x with - | ILFieldInfo(_,pd) -> pd.IsSpecialName + member x.IsSpecialName = + match x with + | ILFieldInfo(_, pd) -> pd.IsSpecialName #if !NO_EXTENSIONTYPING - | ProvidedField(_,fi,m) -> fi.PUntaint((fun fi -> fi.IsSpecialName),m) + | ProvidedField(_, fi, m) -> fi.PUntaint((fun fi -> fi.IsSpecialName), m) #endif - + /// Indicates if the field is a literal field with an associated literal value - member x.LiteralValue = - match x with - | ILFieldInfo(_,pd) -> if pd.IsLiteral then pd.LiteralValue else None + member x.LiteralValue = + match x with + | ILFieldInfo(_, pd) -> if pd.IsLiteral then pd.LiteralValue else None #if !NO_EXTENSIONTYPING - | ProvidedField(_,fi,m) -> - if fi.PUntaint((fun fi -> fi.IsLiteral),m) then - Some (ILFieldInit.FromProvidedObj m (fi.PUntaint((fun fi -> fi.GetRawConstantValue()),m))) + | ProvidedField(_, fi, m) -> + if fi.PUntaint((fun fi -> fi.IsLiteral), m) then + Some (ILFieldInit.FromProvidedObj m (fi.PUntaint((fun fi -> fi.GetRawConstantValue()), m))) else None #endif - + /// Get the type of the field as an IL type - member x.ILFieldType = - match x with - | ILFieldInfo (_,fdef) -> fdef.FieldType + member x.ILFieldType = + match x with + | ILFieldInfo (_, fdef) -> fdef.FieldType #if !NO_EXTENSIONTYPING - | ProvidedField(amap,fi,m) -> Import.ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.FieldType),m)) + | ProvidedField(amap, fi, m) -> Import.ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.FieldType), m)) #endif /// Get the type of the field as an F# type - member x.FieldType(amap,m) = - match x with - | ILFieldInfo (tinfo,fdef) -> ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata [] fdef.FieldType + member x.FieldType(amap, m) = + match x with + | ILFieldInfo (tinfo, fdef) -> ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata [] fdef.FieldType #if !NO_EXTENSIONTYPING - | ProvidedField(amap,fi,m) -> Import.ImportProvidedType amap m (fi.PApply((fun fi -> fi.FieldType),m)) + | ProvidedField(amap, fi, m) -> Import.ImportProvidedType amap m (fi.PApply((fun fi -> fi.FieldType), m)) #endif /// Tests whether two infos have the same underlying definition. /// Must be compatible with ItemsAreEffectivelyEqual relation. - static member ILFieldInfosUseIdenticalDefinitions x1 x2 = - match x1,x2 with + static member ILFieldInfosUseIdenticalDefinitions x1 x2 = + match x1, x2 with | ILFieldInfo(_, x1), ILFieldInfo(_, x2) -> (x1 === x2) #if !NO_EXTENSIONTYPING - | ProvidedField(_,fi1,_), ProvidedField(_,fi2,_)-> ProvidedFieldInfo.TaintedEquals (fi1, fi2) + | ProvidedField(_, fi1, _), ProvidedField(_, fi2, _)-> ProvidedFieldInfo.TaintedEquals (fi1, fi2) | _ -> false #endif /// Get an (uninstantiated) reference to the field as an Abstract IL ILFieldRef - member x.ILFieldRef = rescopeILFieldRef x.ScopeRef (mkILFieldRef(x.ILTypeRef,x.FieldName,x.ILFieldType)) + member x.ILFieldRef = rescopeILFieldRef x.ScopeRef (mkILFieldRef(x.ILTypeRef, x.FieldName, x.ILFieldType)) /// Calculates a hash code of field info. Must be compatible with ItemsAreEffectivelyEqual relation. member x.ComputeHashCode() = hash x.FieldName @@ -1743,53 +1737,53 @@ type ILFieldInfo = override x.ToString() = x.FieldName -/// Describes an F# use of a field in an F#-declared record, class or struct type +/// Describes an F# use of a field in an F#-declared record, class or struct type [] -type RecdFieldInfo = - | RecdFieldInfo of TypeInst * Tast.RecdFieldRef +type RecdFieldInfo = + | RecdFieldInfo of TypeInst * Tast.RecdFieldRef /// Get the generic instantiation of the declaring type of the field - member x.TypeInst = let (RecdFieldInfo(tinst,_)) = x in tinst + member x.TypeInst = let (RecdFieldInfo(tinst, _)) = x in tinst /// Get a reference to the F# metadata for the uninstantiated field - member x.RecdFieldRef = let (RecdFieldInfo(_,rfref)) = x in rfref + member x.RecdFieldRef = let (RecdFieldInfo(_, rfref)) = x in rfref /// Get the F# metadata for the uninstantiated field member x.RecdField = x.RecdFieldRef.RecdField - /// Indicate if the field is a static field in an F#-declared record, class or struct type + /// Indicate if the field is a static field in an F#-declared record, class or struct type member x.IsStatic = x.RecdField.IsStatic - /// Indicate if the field is a literal field in an F#-declared record, class or struct type + /// Indicate if the field is a literal field in an F#-declared record, class or struct type member x.LiteralValue = x.RecdField.LiteralValue - /// Get a reference to the F# metadata for the F#-declared record, class or struct type + /// Get a reference to the F# metadata for the F#-declared record, class or struct type member x.TyconRef = x.RecdFieldRef.TyconRef - /// Get the F# metadata for the F#-declared record, class or struct type + /// Get the F# metadata for the F#-declared record, class or struct type member x.Tycon = x.RecdFieldRef.Tycon - /// Get the name of the field in an F#-declared record, class or struct type + /// Get the name of the field in an F#-declared record, class or struct type member x.Name = x.RecdField.Name - /// Get the (instantiated) type of the field in an F#-declared record, class or struct type + /// Get the (instantiated) type of the field in an F#-declared record, class or struct type member x.FieldType = actualTyOfRecdFieldRef x.RecdFieldRef x.TypeInst - /// Get the enclosing (declaring) type of the field in an F#-declared record, class or struct type - member x.DeclaringType = TType_app (x.RecdFieldRef.TyconRef,x.TypeInst) + /// Get the enclosing (declaring) type of the field in an F#-declared record, class or struct type + member x.DeclaringType = TType_app (x.RecdFieldRef.TyconRef, x.TypeInst) override x.ToString() = x.TyconRef.ToString() + "::" + x.Name - + /// Describes an F# use of a union case [] -type UnionCaseInfo = - | UnionCaseInfo of TypeInst * Tast.UnionCaseRef +type UnionCaseInfo = + | UnionCaseInfo of TypeInst * Tast.UnionCaseRef /// Get the list of types for the instantiation of the type parameters of the declaring type of the union case - member x.TypeInst = let (UnionCaseInfo(tinst,_)) = x in tinst + member x.TypeInst = let (UnionCaseInfo(tinst, _)) = x in tinst /// Get a reference to the F# metadata for the uninstantiated union case - member x.UnionCaseRef = let (UnionCaseInfo(_,ucref)) = x in ucref + member x.UnionCaseRef = let (UnionCaseInfo(_, ucref)) = x in ucref /// Get the F# metadata for the uninstantiated union case member x.UnionCase = x.UnionCaseRef.UnionCase @@ -1811,88 +1805,88 @@ type UnionCaseInfo = /// Describes an F# use of a property backed by Abstract IL metadata [] -type ILPropInfo = - | ILPropInfo of ILTypeInfo * ILPropertyDef +type ILPropInfo = + | ILPropInfo of ILTypeInfo * ILPropertyDef /// Get the TcGlobals governing this value - member x.TcGlobals = match x with ILPropInfo(tinfo,_) -> tinfo.TcGlobals + member x.TcGlobals = match x with ILPropInfo(tinfo, _) -> tinfo.TcGlobals /// Get the declaring IL type of the IL property, including any generic instantiation - member x.ILTypeInfo = match x with ILPropInfo(tinfo,_) -> tinfo + member x.ILTypeInfo = match x with ILPropInfo(tinfo, _) -> tinfo - /// Get the apparent declaring type of the method as an F# type. - /// If this is a C#-style extension method then this is the type which the method + /// Get the apparent declaring type of the method as an F# type. + /// If this is a C#-style extension method then this is the type which the method /// appears to extend. This may be a variable type. - member x.ApparentEnclosingType = match x with ILPropInfo(tinfo,_) -> tinfo.ToType + member x.ApparentEnclosingType = match x with ILPropInfo(tinfo, _) -> tinfo.ToType /// Like ApparentEnclosingType but use the compiled nominal type if this is a method on a tuple type member x.ApparentEnclosingAppType = convertToTypeWithMetadataIfPossible x.TcGlobals x.ApparentEnclosingType /// Get the raw Abstract IL metadata for the IL property - member x.RawMetadata = match x with ILPropInfo(_,pd) -> pd + member x.RawMetadata = match x with ILPropInfo(_, pd) -> pd /// Get the name of the IL property member x.PropertyName = x.RawMetadata.Name /// Gets the ILMethInfo of the 'get' method for the IL property - member x.GetterMethod = + member x.GetterMethod = assert x.HasGetter let mdef = resolveILMethodRef x.ILTypeInfo.RawMetadata x.RawMetadata.GetMethod.Value - ILMethInfo(x.TcGlobals,x.ILTypeInfo.ToType,None,mdef,[]) + ILMethInfo(x.TcGlobals, x.ILTypeInfo.ToType, None, mdef, []) /// Gets the ILMethInfo of the 'set' method for the IL property - member x.SetterMethod = + member x.SetterMethod = assert x.HasSetter let mdef = resolveILMethodRef x.ILTypeInfo.RawMetadata x.RawMetadata.SetMethod.Value - ILMethInfo(x.TcGlobals,x.ILTypeInfo.ToType,None,mdef,[]) - + ILMethInfo(x.TcGlobals, x.ILTypeInfo.ToType, None, mdef, []) + /// Indicates if the IL property has a 'get' method - member x.HasGetter = Option.isSome x.RawMetadata.GetMethod + member x.HasGetter = Option.isSome x.RawMetadata.GetMethod /// Indicates if the IL property has a 'set' method - member x.HasSetter = Option.isSome x.RawMetadata.SetMethod + member x.HasSetter = Option.isSome x.RawMetadata.SetMethod /// Indicates if the IL property is static - member x.IsStatic = (x.RawMetadata.CallingConv = ILThisConvention.Static) + member x.IsStatic = (x.RawMetadata.CallingConv = ILThisConvention.Static) /// Indicates if the IL property is virtual - member x.IsVirtual = + member x.IsVirtual = (x.HasGetter && x.GetterMethod.IsVirtual) || - (x.HasSetter && x.SetterMethod.IsVirtual) + (x.HasSetter && x.SetterMethod.IsVirtual) /// Indicates if the IL property is logically a 'newslot', i.e. hides any previous slots of the same name. - member x.IsNewSlot = + member x.IsNewSlot = (x.HasGetter && x.GetterMethod.IsNewSlot) || - (x.HasSetter && x.SetterMethod.IsNewSlot) + (x.HasSetter && x.SetterMethod.IsNewSlot) /// Get the names and types of the indexer arguments associated with the IL property. /// /// Any type parameters of the enclosing type are instantiated in the type returned. - member x.GetParamNamesAndTypes(amap,m) = - let (ILPropInfo (tinfo,pdef)) = x + member x.GetParamNamesAndTypes(amap, m) = + let (ILPropInfo (tinfo, pdef)) = x pdef.Args |> List.map (fun ty -> ParamNameAndType(None, ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata [] ty) ) /// Get the types of the indexer arguments associated with the IL property. /// /// Any type parameters of the enclosing type are instantiated in the type returned. - member x.GetParamTypes(amap,m) = - let (ILPropInfo (tinfo,pdef)) = x - pdef.Args |> List.map (fun ty -> ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata [] ty) + member x.GetParamTypes(amap, m) = + let (ILPropInfo (tinfo, pdef)) = x + pdef.Args |> List.map (fun ty -> ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata [] ty) /// Get the return type of the IL property. /// /// Any type parameters of the enclosing type are instantiated in the type returned. - member x.GetPropertyType (amap,m) = - let (ILPropInfo (tinfo,pdef)) = x + member x.GetPropertyType (amap, m) = + let (ILPropInfo (tinfo, pdef)) = x ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata [] pdef.PropertyType override x.ToString() = x.ILTypeInfo.ToString() + "::" + x.PropertyName -/// Describes an F# use of a property +/// Describes an F# use of a property [] -type PropInfo = +type PropInfo = /// An F# use of a property backed by F#-declared metadata | FSProp of TcGlobals * TType * ValRef option * ValRef option /// An F# use of a property backed by Abstract IL metadata @@ -1902,112 +1896,112 @@ type PropInfo = | ProvidedProp of Import.ImportMap * Tainted * range #endif - /// Get the enclosing type of the property. + /// Get the enclosing type of the property. /// /// If this is an extension member, then this is the apparent parent, i.e. the type the property appears to extend. - member x.ApparentEnclosingType = - match x with + member x.ApparentEnclosingType = + match x with | ILProp ilpinfo -> ilpinfo.ILTypeInfo.ToType - | FSProp(_,ty,_,_) -> ty + | FSProp(_, ty, _, _) -> ty #if !NO_EXTENSIONTYPING - | ProvidedProp(amap,pi,m) -> - Import.ImportProvidedType amap m (pi.PApply((fun pi -> pi.DeclaringType),m)) + | ProvidedProp(amap, pi, m) -> + Import.ImportProvidedType amap m (pi.PApply((fun pi -> pi.DeclaringType), m)) #endif /// Get the enclosing type of the method info, using a nominal type for tuple types - member x.ApparentEnclosingAppType = + member x.ApparentEnclosingAppType = match x with | ILProp ilpinfo -> ilpinfo.ApparentEnclosingAppType | _ -> x.ApparentEnclosingType member x.ApparentEnclosingTyconRef = tcrefOfAppTy x.TcGlobals x.ApparentEnclosingAppType - /// Get the declaring type or module holding the method. + /// Get the declaring type or module holding the method. /// Note that C#-style extension properties don't exist in the C# design as yet. /// If this is an F#-style extension method it is the logical module /// holding the value for the extension method. - member x.DeclaringTyconRef = - match x.ArbitraryValRef with + member x.DeclaringTyconRef = + match x.ArbitraryValRef with | Some vref when x.IsExtensionMember && vref.HasDeclaringEntity -> vref.TopValDeclaringEntity | _ -> x.ApparentEnclosingTyconRef /// Try to get an arbitrary F# ValRef associated with the member. This is to determine if the member is virtual, amongst other things. - member x.ArbitraryValRef : ValRef option = - match x with - | FSProp(_,_,Some vref,_) - | FSProp(_,_,_, Some vref) -> Some vref - | FSProp(_,_,None,None) -> failwith "unreachable" - | _ -> None + member x.ArbitraryValRef : ValRef option = + match x with + | FSProp(_, _, Some vref, _) + | FSProp(_, _, _, Some vref) -> Some vref + | FSProp(_, _, None, None) -> failwith "unreachable" + | _ -> None /// Indicates if this property has an associated XML comment authored in this assembly. member x.HasDirectXmlComment = match x with - | FSProp(g,_,Some vref,_) - | FSProp(g,_,_,Some vref) -> valRefInThisAssembly g.compilingFslib vref + | FSProp(g, _, Some vref, _) + | FSProp(g, _, _, Some vref) -> valRefInThisAssembly g.compilingFslib vref #if !NO_EXTENSIONTYPING | ProvidedProp _ -> true #endif | _ -> false /// Get the logical name of the property. - member x.PropertyName = - match x with + member x.PropertyName = + match x with | ILProp ilpinfo -> ilpinfo.PropertyName - | FSProp(_,_,Some vref,_) - | FSProp(_,_,_, Some vref) -> vref.PropertyName + | FSProp(_, _, Some vref, _) + | FSProp(_, _, _, Some vref) -> vref.PropertyName #if !NO_EXTENSIONTYPING - | ProvidedProp(_,pi,m) -> pi.PUntaint((fun pi -> pi.Name),m) + | ProvidedProp(_, pi, m) -> pi.PUntaint((fun pi -> pi.Name), m) #endif | FSProp _ -> failwith "unreachable" /// Indicates if this property has an associated getter method. - member x.HasGetter = + member x.HasGetter = match x with | ILProp ilpinfo-> ilpinfo.HasGetter - | FSProp(_,_,x,_) -> Option.isSome x + | FSProp(_, _, x, _) -> Option.isSome x #if !NO_EXTENSIONTYPING - | ProvidedProp(_,pi,m) -> pi.PUntaint((fun pi -> pi.CanRead),m) + | ProvidedProp(_, pi, m) -> pi.PUntaint((fun pi -> pi.CanRead), m) #endif /// Indicates if this property has an associated setter method. - member x.HasSetter = + member x.HasSetter = match x with | ILProp ilpinfo -> ilpinfo.HasSetter - | FSProp(_,_,_,x) -> Option.isSome x + | FSProp(_, _, _, x) -> Option.isSome x #if !NO_EXTENSIONTYPING - | ProvidedProp(_,pi,m) -> pi.PUntaint((fun pi -> pi.CanWrite),m) + | ProvidedProp(_, pi, m) -> pi.PUntaint((fun pi -> pi.CanWrite), m) #endif /// Indicates if this is an extension member - member x.IsExtensionMember = - match x.ArbitraryValRef with - | Some vref -> vref.IsExtensionMember + member x.IsExtensionMember = + match x.ArbitraryValRef with + | Some vref -> vref.IsExtensionMember | _ -> false /// True if the getter (or, if absent, the setter) is a virtual method // REVIEW: for IL properties this is getter OR setter. For F# properties it is getter ELSE setter - member x.IsVirtualProperty = - match x with + member x.IsVirtualProperty = + match x with | ILProp ilpinfo -> ilpinfo.IsVirtual - | FSProp(_,_,Some vref,_) - | FSProp(_,_,_, Some vref) -> vref.IsVirtualMember + | FSProp(_, _, Some vref, _) + | FSProp(_, _, _, Some vref) -> vref.IsVirtualMember | FSProp _-> failwith "unreachable" #if !NO_EXTENSIONTYPING - | ProvidedProp(_,pi,m) -> + | ProvidedProp(_, pi, m) -> let mi = ArbitraryMethodInfoOfPropertyInfo pi m mi.PUntaint((fun mi -> mi.IsVirtual), m) #endif - + /// Indicates if the property is logically a 'newslot', i.e. hides any previous slots of the same name. - member x.IsNewSlot = - match x with + member x.IsNewSlot = + match x with | ILProp ilpinfo -> ilpinfo.IsNewSlot - | FSProp(_,_,Some vref,_) - | FSProp(_,_,_, Some vref) -> vref.IsDispatchSlotMember - | FSProp(_,_,None,None) -> failwith "unreachable" + | FSProp(_, _, Some vref, _) + | FSProp(_, _, _, Some vref) -> vref.IsDispatchSlotMember + | FSProp(_, _, None, None) -> failwith "unreachable" #if !NO_EXTENSIONTYPING - | ProvidedProp(_,pi,m) -> + | ProvidedProp(_, pi, m) -> let mi = ArbitraryMethodInfoOfPropertyInfo pi m mi.PUntaint((fun mi -> mi.IsHideBySig), m) #endif @@ -2015,71 +2009,71 @@ type PropInfo = /// Indicates if the getter (or, if absent, the setter) for the property is a dispatch slot. // REVIEW: for IL properties this is getter OR setter. For F# properties it is getter ELSE setter - member x.IsDispatchSlot = - match x with + member x.IsDispatchSlot = + match x with | ILProp ilpinfo -> ilpinfo.IsVirtual - | FSProp(g,ty,Some vref,_) - | FSProp(g,ty,_, Some vref) -> + | FSProp(g, ty, Some vref, _) + | FSProp(g, ty, _, Some vref) -> isInterfaceTy g ty || (vref.MemberInfo.Value.MemberFlags.IsDispatchSlot) | FSProp _ -> failwith "unreachable" #if !NO_EXTENSIONTYPING - | ProvidedProp(_,pi,m) -> + | ProvidedProp(_, pi, m) -> let mi = ArbitraryMethodInfoOfPropertyInfo pi m mi.PUntaint((fun mi -> mi.IsVirtual), m) #endif /// Indicates if this property is static. member x.IsStatic = - match x with + match x with | ILProp ilpinfo -> ilpinfo.IsStatic - | FSProp(_,_,Some vref,_) - | FSProp(_,_,_, Some vref) -> not vref.IsInstanceMember - | FSProp(_,_,None,None) -> failwith "unreachable" + | FSProp(_, _, Some vref, _) + | FSProp(_, _, _, Some vref) -> not vref.IsInstanceMember + | FSProp(_, _, None, None) -> failwith "unreachable" #if !NO_EXTENSIONTYPING - | ProvidedProp(_,pi,m) -> + | ProvidedProp(_, pi, m) -> (ArbitraryMethodInfoOfPropertyInfo pi m).PUntaint((fun mi -> mi.IsStatic), m) #endif /// Indicates if this property is marked 'override' and thus definitely overrides another property. - member x.IsDefiniteFSharpOverride = - match x.ArbitraryValRef with + member x.IsDefiniteFSharpOverride = + match x.ArbitraryValRef with | Some vref -> vref.IsDefiniteFSharpOverrideMember | None -> false member x.ImplementedSlotSignatures = - x.ArbitraryValRef.Value.ImplementedSlotSignatures + x.ArbitraryValRef.Value.ImplementedSlotSignatures - member x.IsFSharpExplicitInterfaceImplementation = - match x.ArbitraryValRef with + member x.IsFSharpExplicitInterfaceImplementation = + match x.ArbitraryValRef with | Some vref -> vref.IsFSharpExplicitInterfaceImplementation x.TcGlobals | None -> false /// Indicates if this property is an indexer property, i.e. a property with arguments. - member x.IsIndexer = - match x with - | ILProp(ILPropInfo(_,pdef)) -> pdef.Args.Length <> 0 - | FSProp(g,_,Some vref,_) -> - // A getter has signature { OptionalObjectType } -> Unit -> PropertyType - // A getter indexer has signature { OptionalObjectType } -> TupledIndexerArguments -> PropertyType + member x.IsIndexer = + match x with + | ILProp(ILPropInfo(_, pdef)) -> pdef.Args.Length <> 0 + | FSProp(g, _, Some vref, _) -> + // A getter has signature { OptionalObjectType } -> Unit -> PropertyType + // A getter indexer has signature { OptionalObjectType } -> TupledIndexerArguments -> PropertyType let arginfos = ArgInfosOfMember g vref arginfos.Length = 1 && arginfos.Head.Length >= 1 - | FSProp(g,_,_, Some vref) -> - // A setter has signature { OptionalObjectType } -> PropertyType -> Void - // A setter indexer has signature { OptionalObjectType } -> TupledIndexerArguments -> PropertyType -> Void + | FSProp(g, _, _, Some vref) -> + // A setter has signature { OptionalObjectType } -> PropertyType -> Void + // A setter indexer has signature { OptionalObjectType } -> TupledIndexerArguments -> PropertyType -> Void let arginfos = ArgInfosOfMember g vref arginfos.Length = 1 && arginfos.Head.Length >= 2 - | FSProp(_,_,None,None) -> + | FSProp(_, _, None, None) -> failwith "unreachable" #if !NO_EXTENSIONTYPING - | ProvidedProp(_,pi,m) -> + | ProvidedProp(_, pi, m) -> pi.PUntaint((fun pi -> pi.GetIndexParameters().Length), m)>0 #endif /// Indicates if this is an F# property compiled as a CLI event, e.g. a [] property. - member x.IsFSharpEventProperty = - match x with - | FSProp(g,_,Some vref,None) -> vref.IsFSharpEventProperty(g) + member x.IsFSharpEventProperty = + match x with + | FSProp(g, _, Some vref, None) -> vref.IsFSharpEventProperty(g) #if !NO_EXTENSIONTYPING | ProvidedProp _ -> false #endif @@ -2089,97 +2083,97 @@ type PropInfo = /// /// Property infos can combine getters and setters, assuming they are consistent w.r.t. 'virtual', indexer argument types etc. /// When checking consistency we split these apart - member x.DropSetter = - match x with - | FSProp(g,ty,Some vref,_) -> FSProp(g,ty,Some vref,None) + member x.DropSetter = + match x with + | FSProp(g, ty, Some vref, _) -> FSProp(g, ty, Some vref, None) | _ -> x /// Return a new property info where there is no associated getter, only an associated setter. - member x.DropGetter = - match x with - | FSProp(g,ty,_,Some vref) -> FSProp(g,ty,None,Some vref) + member x.DropGetter = + match x with + | FSProp(g, ty, _, Some vref) -> FSProp(g, ty, None, Some vref) | _ -> x /// Get the intra-assembly XML documentation for the property. - member x.XmlDoc = - match x with + member x.XmlDoc = + match x with | ILProp _ -> XmlDoc.Empty - | FSProp(_,_,Some vref,_) - | FSProp(_,_,_, Some vref) -> vref.XmlDoc - | FSProp(_,_,None,None) -> failwith "unreachable" + | FSProp(_, _, Some vref, _) + | FSProp(_, _, _, Some vref) -> vref.XmlDoc + | FSProp(_, _, None, None) -> failwith "unreachable" #if !NO_EXTENSIONTYPING - | ProvidedProp(_,pi,m) -> + | ProvidedProp(_, pi, m) -> XmlDoc (pi.PUntaint((fun pix -> (pix :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(pi.TypeProvider.PUntaintNoFailure(id))), m)) #endif /// Get the TcGlobals associated with the object - member x.TcGlobals = - match x with - | ILProp ilpinfo -> ilpinfo.TcGlobals - | FSProp(g,_,_,_) -> g + member x.TcGlobals = + match x with + | ILProp ilpinfo -> ilpinfo.TcGlobals + | FSProp(g, _, _, _) -> g #if !NO_EXTENSIONTYPING - | ProvidedProp(amap,_,_) -> amap.g + | ProvidedProp(amap, _, _) -> amap.g #endif - /// Indicates if the enclosing type for the property is a value type. + /// Indicates if the enclosing type for the property is a value type. /// /// For an extension property, this indicates if the property extends a struct type. member x.IsValueType = isStructTy x.TcGlobals x.ApparentEnclosingType /// Get the result type of the property - member x.GetPropertyType (amap,m) = + member x.GetPropertyType (amap, m) = match x with - | ILProp ilpinfo -> ilpinfo.GetPropertyType (amap,m) - | FSProp (g,_,Some vref,_) - | FSProp (g,_,_,Some vref) -> + | ILProp ilpinfo -> ilpinfo.GetPropertyType (amap, m) + | FSProp (g, _, Some vref, _) + | FSProp (g, _, _, Some vref) -> let ty = x.ApparentEnclosingAppType - let inst = GetInstantiationForPropertyVal g (ty,vref) + let inst = GetInstantiationForPropertyVal g (ty, vref) ReturnTypeOfPropertyVal g vref.Deref |> instType inst - + | FSProp _ -> failwith "unreachable" #if !NO_EXTENSIONTYPING - | ProvidedProp(_,pi,m) -> - Import.ImportProvidedType amap m (pi.PApply((fun pi -> pi.PropertyType),m)) + | ProvidedProp(_, pi, m) -> + Import.ImportProvidedType amap m (pi.PApply((fun pi -> pi.PropertyType), m)) #endif /// Get the names and types of the indexer parameters associated with the property /// /// If the property is in a generic type, then the type parameters are instantiated in the types returned. - member x.GetParamNamesAndTypes(amap,m) = - match x with - | ILProp ilpinfo -> ilpinfo.GetParamNamesAndTypes(amap,m) - | FSProp (g,ty,Some vref,_) - | FSProp (g,ty,_,Some vref) -> - let inst = GetInstantiationForPropertyVal g (ty,vref) + member x.GetParamNamesAndTypes(amap, m) = + match x with + | ILProp ilpinfo -> ilpinfo.GetParamNamesAndTypes(amap, m) + | FSProp (g, ty, Some vref, _) + | FSProp (g, ty, _, Some vref) -> + let inst = GetInstantiationForPropertyVal g (ty, vref) ArgInfosOfPropertyVal g vref.Deref |> List.map (ParamNameAndType.FromArgInfo >> ParamNameAndType.Instantiate inst) | FSProp _ -> failwith "unreachable" #if !NO_EXTENSIONTYPING - | ProvidedProp (_,pi,m) -> + | ProvidedProp (_, pi, m) -> [ for p in pi.PApplyArray((fun pi -> pi.GetIndexParameters()), "GetIndexParameters", m) do let paramName = p.PUntaint((fun p -> match p.Name with null -> None | s -> Some (mkSynId m s)), m) let paramType = Import.ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) yield ParamNameAndType(paramName, paramType) ] #endif - + /// Get the details of the indexer parameters associated with the property - member x.GetParamDatas(amap,m) = - x.GetParamNamesAndTypes(amap,m) - |> List.map (fun (ParamNameAndType(nmOpt,pty)) -> ParamData(false, false, false, NotOptional, NoCallerInfo, nmOpt, ReflectedArgInfo.None, pty)) + member x.GetParamDatas(amap, m) = + x.GetParamNamesAndTypes(amap, m) + |> List.map (fun (ParamNameAndType(nmOpt, pty)) -> ParamData(false, false, false, NotOptional, NoCallerInfo, nmOpt, ReflectedArgInfo.None, pty)) /// Get the types of the indexer parameters associated with the property - member x.GetParamTypes(amap,m) = - x.GetParamNamesAndTypes(amap,m) |> List.map (fun (ParamNameAndType(_,ty)) -> ty) + member x.GetParamTypes(amap, m) = + x.GetParamNamesAndTypes(amap, m) |> List.map (fun (ParamNameAndType(_, ty)) -> ty) /// Get a MethInfo for the 'getter' method associated with the property - member x.GetterMethod = + member x.GetterMethod = match x with | ILProp ilpinfo -> ILMeth(x.TcGlobals, ilpinfo.GetterMethod, None) - | FSProp(g,ty,Some vref,_) -> FSMeth(g,ty,vref,None) + | FSProp(g, ty, Some vref, _) -> FSMeth(g, ty, vref, None) #if !NO_EXTENSIONTYPING - | ProvidedProp(amap,pi,m) -> + | ProvidedProp(amap, pi, m) -> let meth = GetAndSanityCheckProviderMethod m pi (fun pi -> pi.GetGetMethod()) FSComp.SR.etPropertyCanReadButHasNoGetter ProvidedMeth(amap, meth, None, m) @@ -2187,12 +2181,12 @@ type PropInfo = | FSProp _ -> failwith "no getter method" /// Get a MethInfo for the 'setter' method associated with the property - member x.SetterMethod = + member x.SetterMethod = match x with | ILProp ilpinfo -> ILMeth(x.TcGlobals, ilpinfo.SetterMethod, None) - | FSProp(g,ty,_,Some vref) -> FSMeth(g,ty,vref,None) + | FSProp(g, ty, _, Some vref) -> FSMeth(g, ty, vref, None) #if !NO_EXTENSIONTYPING - | ProvidedProp(amap,pi,m) -> + | ProvidedProp(amap, pi, m) -> let meth = GetAndSanityCheckProviderMethod m pi (fun pi -> pi.GetSetMethod()) FSComp.SR.etPropertyCanWriteButHasNoSetter ProvidedMeth(amap, meth, None, m) #endif @@ -2201,30 +2195,30 @@ type PropInfo = /// Test whether two property infos have the same underlying definition. /// Uses the same techniques as 'MethInfosUseIdenticalDefinitions'. /// Must be compatible with ItemsAreEffectivelyEqual relation. - static member PropInfosUseIdenticalDefinitions x1 x2 = - let optVrefEq g = function + static member PropInfosUseIdenticalDefinitions x1 x2 = + let optVrefEq g = function | Some(v1), Some(v2) -> valRefEq g v1 v2 | None, None -> true - | _ -> false - match x1,x2 with + | _ -> false + match x1, x2 with | ILProp ilpinfo1, ILProp ilpinfo2 -> (ilpinfo1.RawMetadata === ilpinfo2.RawMetadata) | FSProp(g, _, vrefa1, vrefb1), FSProp(_, _, vrefa2, vrefb2) -> (optVrefEq g (vrefa1, vrefa2)) && (optVrefEq g (vrefb1, vrefb2)) #if !NO_EXTENSIONTYPING - | ProvidedProp(_,pi1,_), ProvidedProp(_,pi2,_) -> ProvidedPropertyInfo.TaintedEquals (pi1, pi2) + | ProvidedProp(_, pi1, _), ProvidedProp(_, pi2, _) -> ProvidedPropertyInfo.TaintedEquals (pi1, pi2) #endif | _ -> false /// Calculates a hash code of property info. Must be compatible with ItemsAreEffectivelyEqual relation. - member pi.ComputeHashCode() = - match pi with + member pi.ComputeHashCode() = + match pi with | ILProp ilpinfo -> hash ilpinfo.RawMetadata.Name - | FSProp(_,_,vrefOpt1, vrefOpt2) -> + | FSProp(_, _, vrefOpt1, vrefOpt2) -> // Hash on option*option let vth = (vrefOpt1 |> Option.map (fun vr -> vr.LogicalName), (vrefOpt2 |> Option.map (fun vr -> vr.LogicalName))) hash vth #if !NO_EXTENSIONTYPING - | ProvidedProp(_,pi,_) -> ProvidedPropertyInfo.TaintedGetHashCode(pi) + | ProvidedProp(_, pi, _) -> ProvidedPropertyInfo.TaintedGetHashCode(pi) #endif //------------------------------------------------------------------------- @@ -2233,11 +2227,11 @@ type PropInfo = /// Describes an F# use of an event backed by Abstract IL metadata [] -type ILEventInfo = +type ILEventInfo = | ILEventInfo of ILTypeInfo * ILEventDef - /// Get the enclosing ("parent"/"declaring") type of the field. - member x.ApparentEnclosingType = match x with ILEventInfo(tinfo,_) -> tinfo.ToType + /// Get the enclosing ("parent"/"declaring") type of the field. + member x.ApparentEnclosingType = match x with ILEventInfo(tinfo, _) -> tinfo.ToType // Note: events are always associated with nominal types member x.ApparentEnclosingAppType = x.ApparentEnclosingType @@ -2245,23 +2239,23 @@ type ILEventInfo = // Note: IL Events are never extension members as C# has no notion of extension events as yet member x.DeclaringTyconRef = tcrefOfAppTy x.TcGlobals x.ApparentEnclosingAppType - member x.TcGlobals = match x with ILEventInfo(tinfo,_) -> tinfo.TcGlobals + member x.TcGlobals = match x with ILEventInfo(tinfo, _) -> tinfo.TcGlobals /// Get the raw Abstract IL metadata for the event - member x.RawMetadata = match x with ILEventInfo(_,ed) -> ed + member x.RawMetadata = match x with ILEventInfo(_, ed) -> ed /// Get the declaring IL type of the event as an ILTypeInfo - member x.ILTypeInfo = match x with ILEventInfo(tinfo,_) -> tinfo + member x.ILTypeInfo = match x with ILEventInfo(tinfo, _) -> tinfo /// Get the ILMethInfo describing the 'add' method associated with the event member x.AddMethod = let mdef = resolveILMethodRef x.ILTypeInfo.RawMetadata x.RawMetadata.AddMethod - ILMethInfo(x.TcGlobals,x.ILTypeInfo.ToType,None,mdef,[]) + ILMethInfo(x.TcGlobals, x.ILTypeInfo.ToType, None, mdef, []) /// Get the ILMethInfo describing the 'remove' method associated with the event member x.RemoveMethod = let mdef = resolveILMethodRef x.ILTypeInfo.RawMetadata x.RawMetadata.RemoveMethod - ILMethInfo(x.TcGlobals,x.ILTypeInfo.ToType,None,mdef,[]) + ILMethInfo(x.TcGlobals, x.ILTypeInfo.ToType, None, mdef, []) /// Get the declaring type of the event as an ILTypeRef member x.TypeRef = x.ILTypeInfo.ILTypeRef @@ -2281,19 +2275,19 @@ type ILEventInfo = /// Error text: "A definition to be compiled as a .NET event does not have the expected form. Only property members can be compiled as .NET events." exception BadEventTransformation of range -/// Properties compatible with type IDelegateEvent and attributed with CLIEvent are special: -/// we generate metadata and add/remove methods -/// to make them into a .NET event, and mangle the name of a property. -/// We don't handle static, indexer or abstract properties correctly. -/// Note the name mangling doesn't affect the name of the get/set methods for the property -/// and so doesn't affect how we compile F# accesses to the property. -let private tyConformsToIDelegateEvent g ty = - isIDelegateEventType g ty && isDelegateTy g (destIDelegateEventType g ty) - +/// Properties compatible with type IDelegateEvent and attributed with CLIEvent are special: +/// we generate metadata and add/remove methods +/// to make them into a .NET event, and mangle the name of a property. +/// We don't handle static, indexer or abstract properties correctly. +/// Note the name mangling doesn't affect the name of the get/set methods for the property +/// and so doesn't affect how we compile F# accesses to the property. +let private tyConformsToIDelegateEvent g ty = + isIDelegateEventType g ty && isDelegateTy g (destIDelegateEventType g ty) + -/// Create an error object to raise should an event not have the shape expected by the .NET idiom described further below -let nonStandardEventError nm m = - Error ((FSComp.SR.eventHasNonStandardType(nm,("add_"+nm),("remove_"+nm))),m) +/// Create an error object to raise should an event not have the shape expected by the .NET idiom described further below +let nonStandardEventError nm m = + Error ((FSComp.SR.eventHasNonStandardType(nm, ("add_"+nm), ("remove_"+nm))), m) /// Find the delegate type that an F# event property implements by looking through the type hierarchy of the type of the property /// for the first instantiation of IDelegateEvent. @@ -2302,13 +2296,13 @@ let FindDelegateTypeOfPropertyEvent g amap nm m ty = | None -> error(nonStandardEventError nm m) | Some ty -> destIDelegateEventType g ty - + //------------------------------------------------------------------------- // EventInfo /// Describes an F# use of an event [] -type EventInfo = +type EventInfo = /// An F# use of an event backed by F#-declared metadata | FSEvent of TcGlobals * PropInfo * ValRef * ValRef /// An F# use of an event backed by .NET metadata @@ -2318,137 +2312,137 @@ type EventInfo = | ProvidedEvent of Import.ImportMap * Tainted * range #endif - /// Get the enclosing type of the event. + /// Get the enclosing type of the event. /// /// If this is an extension member, then this is the apparent parent, i.e. the type the event appears to extend. - member x.ApparentEnclosingType = - match x with - | ILEvent ileinfo -> ileinfo.ApparentEnclosingType - | FSEvent (_,p,_,_) -> p.ApparentEnclosingType + member x.ApparentEnclosingType = + match x with + | ILEvent ileinfo -> ileinfo.ApparentEnclosingType + | FSEvent (_, p, _, _) -> p.ApparentEnclosingType #if !NO_EXTENSIONTYPING - | ProvidedEvent (amap,ei,m) -> Import.ImportProvidedType amap m (ei.PApply((fun ei -> ei.DeclaringType),m)) + | ProvidedEvent (amap, ei, m) -> Import.ImportProvidedType amap m (ei.PApply((fun ei -> ei.DeclaringType), m)) #endif /// Get the enclosing type of the method info, using a nominal type for tuple types - member x.ApparentEnclosingAppType = + member x.ApparentEnclosingAppType = match x with | ILEvent ileinfo -> ileinfo.ApparentEnclosingAppType | _ -> x.ApparentEnclosingType member x.ApparentEnclosingTyconRef = tcrefOfAppTy x.TcGlobals x.ApparentEnclosingAppType - /// Get the declaring type or module holding the method. + /// Get the declaring type or module holding the method. /// Note that C#-style extension properties don't exist in the C# design as yet. /// If this is an F#-style extension method it is the logical module /// holding the value for the extension method. - member x.DeclaringTyconRef = - match x.ArbitraryValRef with + member x.DeclaringTyconRef = + match x.ArbitraryValRef with | Some vref when x.IsExtensionMember && vref.HasDeclaringEntity -> vref.TopValDeclaringEntity - | _ -> x.ApparentEnclosingTyconRef + | _ -> x.ApparentEnclosingTyconRef /// Indicates if this event has an associated XML comment authored in this assembly. member x.HasDirectXmlComment = match x with - | FSEvent (_,p,_,_) -> p.HasDirectXmlComment + | FSEvent (_, p, _, _) -> p.HasDirectXmlComment #if !NO_EXTENSIONTYPING | ProvidedEvent _ -> true #endif | _ -> false /// Get the intra-assembly XML documentation for the property. - member x.XmlDoc = - match x with + member x.XmlDoc = + match x with | ILEvent _ -> XmlDoc.Empty - | FSEvent (_,p,_,_) -> p.XmlDoc + | FSEvent (_, p, _, _) -> p.XmlDoc #if !NO_EXTENSIONTYPING - | ProvidedEvent (_,ei,m) -> + | ProvidedEvent (_, ei, m) -> XmlDoc (ei.PUntaint((fun eix -> (eix :> IProvidedCustomAttributeProvider).GetXmlDocAttributes(ei.TypeProvider.PUntaintNoFailure(id))), m)) #endif /// Get the logical name of the event. - member x.EventName = - match x with - | ILEvent ileinfo -> ileinfo.Name - | FSEvent (_,p,_,_) -> p.PropertyName + member x.EventName = + match x with + | ILEvent ileinfo -> ileinfo.Name + | FSEvent (_, p, _, _) -> p.PropertyName #if !NO_EXTENSIONTYPING - | ProvidedEvent (_,ei,m) -> ei.PUntaint((fun ei -> ei.Name), m) + | ProvidedEvent (_, ei, m) -> ei.PUntaint((fun ei -> ei.Name), m) #endif /// Indicates if this property is static. - member x.IsStatic = - match x with + member x.IsStatic = + match x with | ILEvent ileinfo -> ileinfo.IsStatic - | FSEvent (_,p,_,_) -> p.IsStatic + | FSEvent (_, p, _, _) -> p.IsStatic #if !NO_EXTENSIONTYPING - | ProvidedEvent (_,ei,m) -> + | ProvidedEvent (_, ei, m) -> let meth = GetAndSanityCheckProviderMethod m ei (fun ei -> ei.GetAddMethod()) FSComp.SR.etEventNoAdd meth.PUntaint((fun mi -> mi.IsStatic), m) #endif /// Indicates if this is an extension member - member x.IsExtensionMember = - match x with + member x.IsExtensionMember = + match x with | ILEvent _ -> false - | FSEvent (_,p,_,_) -> p.IsExtensionMember + | FSEvent (_, p, _, _) -> p.IsExtensionMember #if !NO_EXTENSIONTYPING | ProvidedEvent _ -> false #endif /// Get the TcGlobals associated with the object - member x.TcGlobals = - match x with + member x.TcGlobals = + match x with | ILEvent ileinfo -> ileinfo.TcGlobals - | FSEvent(g,_,_,_) -> g + | FSEvent(g, _, _, _) -> g #if !NO_EXTENSIONTYPING - | ProvidedEvent (amap,_,_) -> amap.g + | ProvidedEvent (amap, _, _) -> amap.g #endif - /// Indicates if the enclosing type for the event is a value type. + /// Indicates if the enclosing type for the event is a value type. /// /// For an extension event, this indicates if the event extends a struct type. member x.IsValueType = isStructTy x.TcGlobals x.ApparentEnclosingType /// Get the 'add' method associated with an event - member x.AddMethod = - match x with + member x.AddMethod = + match x with | ILEvent ileinfo -> ILMeth(ileinfo.TcGlobals, ileinfo.AddMethod, None) - | FSEvent(g,p,addValRef,_) -> FSMeth(g,p.ApparentEnclosingType,addValRef,None) + | FSEvent(g, p, addValRef, _) -> FSMeth(g, p.ApparentEnclosingType, addValRef, None) #if !NO_EXTENSIONTYPING - | ProvidedEvent (amap,ei,m) -> + | ProvidedEvent (amap, ei, m) -> let meth = GetAndSanityCheckProviderMethod m ei (fun ei -> ei.GetAddMethod()) FSComp.SR.etEventNoAdd ProvidedMeth(amap, meth, None, m) #endif /// Get the 'remove' method associated with an event - member x.RemoveMethod = - match x with + member x.RemoveMethod = + match x with | ILEvent ileinfo -> ILMeth(x.TcGlobals, ileinfo.RemoveMethod, None) - | FSEvent(g,p,_,removeValRef) -> FSMeth(g,p.ApparentEnclosingType,removeValRef,None) + | FSEvent(g, p, _, removeValRef) -> FSMeth(g, p.ApparentEnclosingType, removeValRef, None) #if !NO_EXTENSIONTYPING - | ProvidedEvent (amap,ei,m) -> + | ProvidedEvent (amap, ei, m) -> let meth = GetAndSanityCheckProviderMethod m ei (fun ei -> ei.GetRemoveMethod()) FSComp.SR.etEventNoRemove ProvidedMeth(amap, meth, None, m) #endif - + /// Try to get an arbitrary F# ValRef associated with the member. This is to determine if the member is virtual, amongst other things. - member x.ArbitraryValRef: ValRef option = - match x with - | FSEvent(_,_,addValRef,_) -> Some addValRef + member x.ArbitraryValRef: ValRef option = + match x with + | FSEvent(_, _, addValRef, _) -> Some addValRef | _ -> None - /// Get the delegate type associated with the event. - member x.GetDelegateType(amap,m) = - match x with - | ILEvent(ILEventInfo(tinfo,edef)) -> + /// Get the delegate type associated with the event. + member x.GetDelegateType(amap, m) = + match x with + | ILEvent(ILEventInfo(tinfo, edef)) -> // Get the delegate type associated with an IL event, taking into account the instantiation of the // declaring type. if Option.isNone edef.EventType then error (nonStandardEventError x.EventName m) ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata [] edef.EventType.Value - | FSEvent(g,p,_,_) -> - FindDelegateTypeOfPropertyEvent g amap x.EventName m (p.GetPropertyType(amap,m)) + | FSEvent(g, p, _, _) -> + FindDelegateTypeOfPropertyEvent g amap x.EventName m (p.GetPropertyType(amap, m)) #if !NO_EXTENSIONTYPING - | ProvidedEvent (_,ei,_) -> + | ProvidedEvent (_, ei, _) -> Import.ImportProvidedType amap m (ei.PApply((fun ei -> ei.EventHandlerType), m)) #endif @@ -2461,18 +2455,18 @@ type EventInfo = PropInfo.PropInfosUseIdenticalDefinitions pi1 pi2 && valRefEq g vrefa1 vrefa2 && valRefEq g vrefb1 vrefb2 | ILEvent ileinfo1, ILEvent ileinfo2 -> (ileinfo1.RawMetadata === ileinfo2.RawMetadata) #if !NO_EXTENSIONTYPING - | ProvidedEvent (_,ei1,_), ProvidedEvent (_,ei2,_) -> ProvidedEventInfo.TaintedEquals (ei1, ei2) + | ProvidedEvent (_, ei1, _), ProvidedEvent (_, ei2, _) -> ProvidedEventInfo.TaintedEquals (ei1, ei2) #endif | _ -> false - + /// Calculates a hash code of event info (similar as previous) /// Must be compatible with ItemsAreEffectivelyEqual relation. - member ei.ComputeHashCode() = - match ei with + member ei.ComputeHashCode() = + match ei with | ILEvent ileinfo -> hash ileinfo.RawMetadata.Name | FSEvent(_, pi, vref1, vref2) -> hash ( pi.ComputeHashCode(), vref1.LogicalName, vref2.LogicalName) #if !NO_EXTENSIONTYPING - | ProvidedEvent (_,ei,_) -> ProvidedEventInfo.TaintedGetHashCode(ei) + | ProvidedEvent (_, ei, _) -> ProvidedEventInfo.TaintedGetHashCode(ei) #endif //------------------------------------------------------------------------- @@ -2485,29 +2479,29 @@ let stripByrefTy g ty = /// Represents the information about the compiled form of a method signature. Used when analyzing implementation /// relations between members and abstract slots. -type CompiledSig = CompiledSig of TType list list * TType option * Typars * TyparInst +type CompiledSig = CompiledSig of TType list list * TType option * Typars * TyparInst /// Get the information about the compiled form of a method signature. Used when analyzing implementation /// relations between members and abstract slots. -let CompiledSigOfMeth g amap m (minfo:MethInfo) = +let CompiledSigOfMeth g amap m (minfo:MethInfo) = let formalMethTypars = minfo.FormalMethodTypars let fminst = generalizeTypars formalMethTypars let vargtys = minfo.GetParamTypes(amap, m, fminst) let vrty = minfo.GetCompiledReturnTy(amap, m, fminst) - // The formal method typars returned are completely formal - they don't take into account the instantiation - // of the enclosing type. For example, they may have constraints involving the _formal_ type parameters - // of the enclosing type. This instantiations can be used to interpret those type parameters - let fmtpinst = + // The formal method typars returned are completely formal - they don't take into account the instantiation + // of the enclosing type. For example, they may have constraints involving the _formal_ type parameters + // of the enclosing type. This instantiations can be used to interpret those type parameters + let fmtpinst = let parentTyArgs = argsOfAppTy g minfo.ApparentEnclosingAppType - let memberParentTypars = minfo.GetFormalTyparsOfDeclaringType m + let memberParentTypars = minfo.GetFormalTyparsOfDeclaringType m mkTyparInst memberParentTypars parentTyArgs - - CompiledSig(vargtys,vrty,formalMethTypars,fmtpinst) + + CompiledSig(vargtys, vrty, formalMethTypars, fmtpinst) /// Used to hide/filter members from super classes based on signature /// Inref and outref parameter types will be treated as a byref type for equivalency. -let MethInfosEquivByNameAndPartialSig erasureFlag ignoreFinal g amap m (minfo:MethInfo) (minfo2:MethInfo) = +let MethInfosEquivByNameAndPartialSig erasureFlag ignoreFinal g amap m (minfo:MethInfo) (minfo2:MethInfo) = (minfo.LogicalName = minfo2.LogicalName) && (minfo.GenericArity = minfo2.GenericArity) && (ignoreFinal || minfo.IsFinal = minfo2.IsFinal) && @@ -2517,33 +2511,33 @@ let MethInfosEquivByNameAndPartialSig erasureFlag ignoreFinal g amap m (minfo:Me let fminst2 = generalizeTypars formalMethTypars2 let argtys = minfo.GetParamTypes(amap, m, fminst) let argtys2 = minfo2.GetParamTypes(amap, m, fminst2) - (argtys,argtys2) ||> List.lengthsEqAndForall2 (List.lengthsEqAndForall2 (fun ty1 ty2 -> + (argtys, argtys2) ||> List.lengthsEqAndForall2 (List.lengthsEqAndForall2 (fun ty1 ty2 -> typeAEquivAux erasureFlag g (TypeEquivEnv.FromEquivTypars formalMethTypars formalMethTypars2) (stripByrefTy g ty1) (stripByrefTy g ty2))) -/// Used to hide/filter members from super classes based on signature -let PropInfosEquivByNameAndPartialSig erasureFlag g amap m (pinfo:PropInfo) (pinfo2:PropInfo) = +/// Used to hide/filter members from super classes based on signature +let PropInfosEquivByNameAndPartialSig erasureFlag g amap m (pinfo:PropInfo) (pinfo2:PropInfo) = pinfo.PropertyName = pinfo2.PropertyName && - let argtys = pinfo.GetParamTypes(amap,m) - let argtys2 = pinfo2.GetParamTypes(amap,m) - List.lengthsEqAndForall2 (typeEquivAux erasureFlag g) argtys argtys2 + let argtys = pinfo.GetParamTypes(amap, m) + let argtys2 = pinfo2.GetParamTypes(amap, m) + List.lengthsEqAndForall2 (typeEquivAux erasureFlag g) argtys argtys2 -/// Used to hide/filter members from super classes based on signature -let MethInfosEquivByNameAndSig erasureFlag ignoreFinal g amap m minfo minfo2 = +/// Used to hide/filter members from super classes based on signature +let MethInfosEquivByNameAndSig erasureFlag ignoreFinal g amap m minfo minfo2 = MethInfosEquivByNameAndPartialSig erasureFlag ignoreFinal g amap m minfo minfo2 && - let (CompiledSig(_,retTy,formalMethTypars,_)) = CompiledSigOfMeth g amap m minfo - let (CompiledSig(_,retTy2,formalMethTypars2,_)) = CompiledSigOfMeth g amap m minfo2 - match retTy,retTy2 with - | None,None -> true - | Some retTy,Some retTy2 -> typeAEquivAux erasureFlag g (TypeEquivEnv.FromEquivTypars formalMethTypars formalMethTypars2) retTy retTy2 + let (CompiledSig(_, retTy, formalMethTypars, _)) = CompiledSigOfMeth g amap m minfo + let (CompiledSig(_, retTy2, formalMethTypars2, _)) = CompiledSigOfMeth g amap m minfo2 + match retTy, retTy2 with + | None, None -> true + | Some retTy, Some retTy2 -> typeAEquivAux erasureFlag g (TypeEquivEnv.FromEquivTypars formalMethTypars formalMethTypars2) retTy retTy2 | _ -> false -/// Used to hide/filter members from super classes based on signature -let PropInfosEquivByNameAndSig erasureFlag g amap m (pinfo:PropInfo) (pinfo2:PropInfo) = +/// Used to hide/filter members from super classes based on signature +let PropInfosEquivByNameAndSig erasureFlag g amap m (pinfo:PropInfo) (pinfo2:PropInfo) = PropInfosEquivByNameAndPartialSig erasureFlag g amap m pinfo pinfo2 && - let retTy = pinfo.GetPropertyType(amap,m) - let retTy2 = pinfo2.GetPropertyType(amap,m) + let retTy = pinfo.GetPropertyType(amap, m) + let retTy2 = pinfo2.GetPropertyType(amap, m) typeEquivAux erasureFlag g retTy retTy2 -let SettersOfPropInfos (pinfos:PropInfo list) = pinfos |> List.choose (fun pinfo -> if pinfo.HasSetter then Some(pinfo.SetterMethod,Some pinfo) else None) -let GettersOfPropInfos (pinfos:PropInfo list) = pinfos |> List.choose (fun pinfo -> if pinfo.HasGetter then Some(pinfo.GetterMethod,Some pinfo) else None) +let SettersOfPropInfos (pinfos:PropInfo list) = pinfos |> List.choose (fun pinfo -> if pinfo.HasSetter then Some(pinfo.SetterMethod, Some pinfo) else None) +let GettersOfPropInfos (pinfos:PropInfo list) = pinfos |> List.choose (fun pinfo -> if pinfo.HasGetter then Some(pinfo.GetterMethod, Some pinfo) else None) diff --git a/src/fsharp/lexhelp.fs b/src/fsharp/lexhelp.fs index 212d7f6c7b55c0bfb35e93d44731733694c6c5d5..615bf736f73ce18d8fe7ae4a918aee088fed5121 100644 --- a/src/fsharp/lexhelp.fs +++ b/src/fsharp/lexhelp.fs @@ -22,10 +22,8 @@ open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.Range open FSharp.Compiler.Parser - - -// The "mock" filename used by fsi.exe when reading from stdin. -// Has special treatment by the lexer, i.e. __SOURCE_DIRECTORY__ becomes GetCurrentDirectory() +/// The "mock" filename used by fsi.exe when reading from stdin. +/// Has special treatment by the lexer, i.e. __SOURCE_DIRECTORY__ becomes GetCurrentDirectory() let stdinMockFilename = "stdin" /// Lexer args: status of #light processing. Mutated when a #light @@ -287,10 +285,10 @@ module Keywords = ] (*------- reserved keywords which are ml-compatibility ids *) @ List.map (fun s -> (FSHARP,s,RESERVED)) - [ "break"; "checked"; "component"; "constraint"; "continue"; - "fori"; "include"; "mixin"; - "parallel"; "params"; "process"; "protected"; "pure"; - "sealed"; "trait"; "tailcall"; "virtual"; ] + [ "break"; "checked"; "component"; "constraint"; "continue" + "fori"; "include"; "mixin" + "parallel"; "params"; "process"; "protected"; "pure" + "sealed"; "trait"; "tailcall"; "virtual" ] let private unreserveWords = keywordList |> List.choose (function (mode, keyword, _) -> if mode = FSHARP then Some keyword else None) diff --git a/src/fsharp/lib.fs b/src/fsharp/lib.fs index ca6d129a6f765a20b3c979070851e4c647340496..118ce038bb5f447d0e0d85ad73c5c132892f8ae8 100755 --- a/src/fsharp/lib.fs +++ b/src/fsharp/lib.fs @@ -526,9 +526,6 @@ module UnmanagedProcessExecutionOptions = [] #endif let EnableHeapTerminationOnCorruption() = -#if FX_NO_HEAPTERMINATION - () -#else if (System.Environment.OSVersion.Version.Major >= 6 && // If OS is Vista or higher System.Environment.Version.Major < 3) then // and CLR not 3.0 or higher // "The flag HeapSetInformation sets is available in Windows XP SP3 and later. @@ -547,5 +544,4 @@ module UnmanagedProcessExecutionOptions = "Unable to enable unmanaged process execution option TerminationOnCorruption. " + "HeapSetInformation() returned FALSE; LastError = 0x" + GetLastError().ToString("X").PadLeft(8,'0') + ".")) -#endif diff --git a/src/fsharp/rational.fs b/src/fsharp/rational.fs index b6c3588cdb020b859b1fd0522c5404599f555490..5b36a9e349e964df39f44b4d23afad6ed7c40456 100644 --- a/src/fsharp/rational.fs +++ b/src/fsharp/rational.fs @@ -6,7 +6,7 @@ module internal FSharp.Compiler.Rational open System.Numerics type Rational = { - numerator: BigInteger; + numerator: BigInteger denominator: BigInteger } @@ -26,7 +26,7 @@ let mkRational p q = if q > BigInteger.Zero then p, q else -p, -q in - { numerator = p; + { numerator = p denominator = q } diff --git a/src/fsharp/service/ServiceLexing.fs b/src/fsharp/service/ServiceLexing.fs index 6954e70fb7e3497895255159eaae4dfb6d0decca..23af633f803f0ee7fc982dbbdb7804291ebf4a7c 100755 --- a/src/fsharp/service/ServiceLexing.fs +++ b/src/fsharp/service/ServiceLexing.fs @@ -690,14 +690,15 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, if isCached then lexcontInitial else LexerStateEncoding.computeNextLexState token lexcontInitial let tokenTag = tagOfToken token let fullMatchedLength = lexbuf.EndPos.AbsoluteOffset - lexbuf.StartPos.AbsoluteOffset - let tokenData = { TokenName = token_to_string token; - LeftColumn=leftc; - RightColumn=rightc; - ColorClass=colorClass; - CharClass=charClass; - FSharpTokenTriggerClass=triggerClass; - Tag=tokenTag; - FullMatchedLength=fullMatchedLength} + let tokenData = + { TokenName = token_to_string token + LeftColumn=leftc + RightColumn=rightc + ColorClass=colorClass + CharClass=charClass + FSharpTokenTriggerClass=triggerClass + Tag=tokenTag + FullMatchedLength=fullMatchedLength} Some(tokenData), lexcontFinal, tokenTag // Get the final lex int and color state diff --git a/src/fsharp/service/ServiceStructure.fs b/src/fsharp/service/ServiceStructure.fs index 8c25bee2a115c9a4ad5b7c81182d8bfd2a31e4ee..e235b90a693b0cac1b62e36a791a7a7b1335cf33 100644 --- a/src/fsharp/service/ServiceStructure.fs +++ b/src/fsharp/service/ServiceStructure.fs @@ -47,14 +47,14 @@ module Structure = | [] -> range0 | head::_ -> Range.startToEnd head.idRange (List.last longId).idRange - /// Caclulate the range of the provided type arguments (<'a,...,'z>) + /// Caclulate the range of the provided type arguments (<'a, ..., 'z>) /// or return the range `other` when `typeArgs` = [] let rangeOfTypeArgsElse other (typeArgs:SynTyparDecl list) = match typeArgs with | [] -> other | ls -> ls - |> List.map (fun (TyparDecl (_,typarg)) -> typarg.Range) + |> List.map (fun (TyparDecl (_, typarg)) -> typarg.Range) |> List.reduce unionRanges let rangeOfSynPatsElse other (synPats:SynSimplePat list) = @@ -218,34 +218,34 @@ module Structure = let rec parseExpr expression = match expression with - | SynExpr.Upcast (e,_,_) - | SynExpr.Downcast (e,_,_) - | SynExpr.AddressOf(_,e,_,_) - | SynExpr.InferredDowncast (e,_) - | SynExpr.InferredUpcast (e,_) - | SynExpr.DotGet (e,_,_,_) - | SynExpr.Do (e,_) - | SynExpr.Typed (e,_,_) - | SynExpr.DotIndexedGet (e,_,_,_) -> + | SynExpr.Upcast (e, _, _) + | SynExpr.Downcast (e, _, _) + | SynExpr.AddressOf(_, e, _, _) + | SynExpr.InferredDowncast (e, _) + | SynExpr.InferredUpcast (e, _) + | SynExpr.DotGet (e, _, _, _) + | SynExpr.Do (e, _) + | SynExpr.Typed (e, _, _) + | SynExpr.DotIndexedGet (e, _, _, _) -> parseExpr e - | SynExpr.Set (e1,e2,_) - | SynExpr.DotSet (e1,_,e2,_) - | SynExpr.DotIndexedSet (e1,_,e2,_,_,_) -> + | SynExpr.Set (e1, e2, _) + | SynExpr.DotSet (e1, _, e2, _) + | SynExpr.DotIndexedSet (e1, _, e2, _, _, _) -> parseExpr e1 parseExpr e2 - | SynExpr.New (_,_,expr,r) -> + | SynExpr.New (_, _, expr, r) -> rcheck Scope.New Collapse.Below r expr.Range parseExpr expr - | SynExpr.YieldOrReturn (_,e,r) -> + | SynExpr.YieldOrReturn (_, e, r) -> rcheck Scope.YieldOrReturn Collapse.Below r r parseExpr e - | SynExpr.YieldOrReturnFrom (_,e,r) -> + | SynExpr.YieldOrReturnFrom (_, e, r) -> rcheck Scope.YieldOrReturnBang Collapse.Below r r parseExpr e - | SynExpr.DoBang (e,r) -> + | SynExpr.DoBang (e, r) -> rcheck Scope.Do Collapse.Below r <| Range.modStart 3 r parseExpr e - | SynExpr.LetOrUseBang (_,_,_,pat,e1,e2,_) -> + | SynExpr.LetOrUseBang (_, _, _, pat, e1, e2, _) -> // for `let!` or `use!` the pattern begins at the end of the keyword so that // this scope can be used without adjustment if there is no `=` on the same line // if there is an `=` the range will be adjusted during the tooltip creation @@ -253,14 +253,14 @@ module Structure = rcheck Scope.LetOrUseBang Collapse.Below r r parseExpr e1 parseExpr e2 - | SynExpr.For (_,_,_,_,_,e,r) - | SynExpr.ForEach (_,_,_,_,_,e,r) -> + | SynExpr.For (_, _, _, _, _, e, r) + | SynExpr.ForEach (_, _, _, _, _, e, r) -> rcheck Scope.For Collapse.Below r r parseExpr e - | SynExpr.LetOrUse (_,_,bindings, body, _) -> + | SynExpr.LetOrUse (_, _, bindings, body, _) -> parseBindings bindings parseExpr body - | SynExpr.Match (seqPointAtBinding,_expr,clauses,r) + | SynExpr.Match (seqPointAtBinding, _expr, clauses, r) | SynExpr.MatchBang (seqPointAtBinding, _expr, clauses, r) -> match seqPointAtBinding with | SequencePointAtBinding sr -> @@ -268,7 +268,7 @@ module Structure = rcheck Scope.Match Collapse.Same r collapse | _ -> () List.iter parseMatchClause clauses - | SynExpr.MatchLambda (_,caseRange,clauses,matchSeqPoint,r) -> + | SynExpr.MatchLambda (_, caseRange, clauses, matchSeqPoint, r) -> let caseRange = match matchSeqPoint with | SequencePointAtBinding r -> r @@ -276,7 +276,7 @@ module Structure = let collapse = Range.endToEnd caseRange r rcheck Scope.MatchLambda Collapse.Same r collapse List.iter parseMatchClause clauses - | SynExpr.App (atomicFlag,isInfix,funcExpr,argExpr,r) -> + | SynExpr.App (atomicFlag, isInfix, funcExpr, argExpr, r) -> // seq exprs, custom operators, etc if ExprAtomicFlag.NonAtomic=atomicFlag && (not isInfix) && (function SynExpr.Ident _ -> true | _ -> false) funcExpr @@ -291,17 +291,17 @@ module Structure = rcheck Scope.CompExpr Collapse.Same r <| Range.modBoth 1 1 collapse parseExpr argExpr parseExpr funcExpr - | SynExpr.Sequential (_,_,e1,e2,_) -> + | SynExpr.Sequential (_, _, e1, e2, _) -> parseExpr e1 parseExpr e2 - | SynExpr.ArrayOrListOfSeqExpr (isArray,e,r) -> + | SynExpr.ArrayOrListOfSeqExpr (isArray, e, r) -> rcheck Scope.ArrayOrList Collapse.Same r <| Range.modBoth (if isArray then 2 else 1) (if isArray then 2 else 1) r parseExpr e - | SynExpr.CompExpr (_arrayOrList,_,e,_r) as _c -> + | SynExpr.CompExpr (_arrayOrList, _, e, _r) as _c -> parseExpr e - | SynExpr.ObjExpr (_,argOpt,bindings,extraImpls,newRange,wholeRange) as _objExpr -> + | SynExpr.ObjExpr (_, argOpt, bindings, extraImpls, newRange, wholeRange) as _objExpr -> match argOpt with - | Some (args,_) -> + | Some (args, _) -> let collapse = Range.endToEnd args.Range wholeRange rcheck Scope.ObjExpr Collapse.Below wholeRange collapse | None -> @@ -309,7 +309,7 @@ module Structure = rcheck Scope.ObjExpr Collapse.Below wholeRange collapse parseBindings bindings parseExprInterfaces extraImpls - | SynExpr.TryWith (e,_,matchClauses,_,wholeRange,tryPoint,withPoint) -> + | SynExpr.TryWith (e, _, matchClauses, _, wholeRange, tryPoint, withPoint) -> match tryPoint, withPoint with | SequencePointAtTry tryRange, SequencePointAtWith withRange -> let fullrange = Range.startToEnd tryRange wholeRange @@ -324,7 +324,7 @@ module Structure = | _ -> () parseExpr e List.iter parseMatchClause matchClauses - | SynExpr.TryFinally (tryExpr,finallyExpr,r,tryPoint,finallyPoint) -> + | SynExpr.TryFinally (tryExpr, finallyExpr, r, tryPoint, finallyPoint) -> match tryPoint, finallyPoint with | SequencePointAtTry tryRange, SequencePointAtFinally finallyRange -> let collapse = Range.endToEnd tryRange finallyExpr.Range @@ -336,7 +336,7 @@ module Structure = | _ -> () parseExpr tryExpr parseExpr finallyExpr - | SynExpr.IfThenElse (ifExpr,thenExpr,elseExprOpt,spIfToThen,_,ifToThenRange,r) -> + | SynExpr.IfThenElse (ifExpr, thenExpr, elseExprOpt, spIfToThen, _, ifToThenRange, r) -> match spIfToThen with | SequencePointAtBinding rt -> // Outline the entire IfThenElse @@ -362,40 +362,40 @@ module Structure = // a suitable approach is determined parseExpr elseExpr | None -> () - | SynExpr.While (_,_,e,r) -> + | SynExpr.While (_, _, e, r) -> rcheck Scope.While Collapse.Below r r parseExpr e - | SynExpr.Lambda (_,_,pats,e,r) -> + | SynExpr.Lambda (_, _, pats, e, r) -> match pats with - | SynSimplePats.SimplePats (_,pr) - | SynSimplePats.Typed (_,_,pr) -> + | SynSimplePats.SimplePats (_, pr) + | SynSimplePats.Typed (_, _, pr) -> rcheck Scope.Lambda Collapse.Below r (Range.endToEnd pr r) parseExpr e - | SynExpr.Lazy (e,r) -> + | SynExpr.Lazy (e, r) -> rcheck Scope.SpecialFunc Collapse.Below r r parseExpr e - | SynExpr.Quote (_,isRaw,e,_,r) -> + | SynExpr.Quote (_, isRaw, e, _, r) -> // subtract columns so the @@> or @> is not collapsed rcheck Scope.Quote Collapse.Same r (Range.modBoth (if isRaw then 3 else 2) (if isRaw then 3 else 2) r) parseExpr e | SynExpr.Tuple (_, es, _, r) -> rcheck Scope.Tuple Collapse.Same r r List.iter parseExpr es - | SynExpr.Paren (e,_,_,_) -> + | SynExpr.Paren (e, _, _, _) -> parseExpr e - | SynExpr.Record (recCtor,recCopy,recordFields,r) -> + | SynExpr.Record (recCtor, recCopy, recordFields, r) -> match recCtor with - | Some (_,ctorArgs,_,_,_) -> parseExpr ctorArgs + | Some (_, ctorArgs, _, _, _) -> parseExpr ctorArgs | _ -> () match recCopy with - | Some (e,_) -> parseExpr e + | Some (e, _) -> parseExpr e | _ -> () - recordFields |> List.choose (fun (_,e,_) -> e) |> List.iter parseExpr + recordFields |> List.choose (fun (_, e, _) -> e) |> List.iter parseExpr // exclude the opening `{` and closing `}` of the record from collapsing rcheck Scope.Record Collapse.Same r <| Range.modBoth 1 1 r | _ -> () - and parseMatchClause (SynMatchClause.Clause(synPat,_,e,_r,_) as clause) = + and parseMatchClause (SynMatchClause.Clause(synPat, _, e, _r, _) as clause) = let rec getLastPat = function | SynPat.Or(_, pat, _) -> getLastPat pat | x -> x @@ -426,7 +426,7 @@ module Structure = for attr in attrs do parseExpr attr.ArgExpr - and parseBinding (SynBinding.Binding (_,kind,_,_,attrs,_,SynValData(memberFlags,_,_),_,_,expr,br,_) as binding) = + and parseBinding (SynBinding.Binding (_, kind, _, _, attrs, _, SynValData(memberFlags, _, _), _, _, expr, br, _) as binding) = match kind with | NormalBinding -> let collapse = Range.endToEnd binding.RangeOfBindingSansRhs binding.RangeOfBindingAndRhs @@ -447,7 +447,7 @@ module Structure = and parseBindings sqs = for bind in sqs do parseBinding bind - and parseExprInterface (InterfaceImpl(synType,bindings,range)) = + and parseExprInterface (InterfaceImpl(synType, bindings, range)) = let collapse = Range.endToEnd synType.Range range |> Range.modEnd -1 rcheck Scope.Interface Collapse.Below range collapse parseBindings bindings @@ -456,12 +456,12 @@ module Structure = and parseSynMemberDefn (objectModelRange: range) d = match d with - | SynMemberDefn.Member(SynBinding.Binding (attrs=attrs; valData=valData; headPat=synPat; range=bindingRange) as binding,_) -> + | SynMemberDefn.Member(SynBinding.Binding (attrs=attrs; valData=valData; headPat=synPat; range=bindingRange) as binding, _) -> match valData with - | SynValData (Some { MemberKind=MemberKind.Constructor },_,_) -> + | SynValData (Some { MemberKind=MemberKind.Constructor }, _, _) -> let collapse = Range.endToEnd synPat.Range d.Range rcheck Scope.New Collapse.Below d.Range collapse - | SynValData (Some { MemberKind=MemberKind.PropertyGet | MemberKind.PropertySet },_,_) -> + | SynValData (Some { MemberKind=MemberKind.PropertyGet | MemberKind.PropertySet }, _, _) -> let range = mkRange d.Range.FileName @@ -480,7 +480,7 @@ module Structure = rcheck Scope.Member Collapse.Below d.Range collapse parseAttributes attrs parseBinding binding - | SynMemberDefn.LetBindings (bindings,_,_,_) -> + | SynMemberDefn.LetBindings (bindings, _, _, _) -> parseBindings bindings | SynMemberDefn.Interface (tp, iMembers, r) -> rcheck Scope.Interface Collapse.Below d.Range (Range.endToEnd tp.Range d.Range) @@ -508,23 +508,23 @@ module Structure = *) and parseSimpleRepr simple = match simple with - | SynTypeDefnSimpleRepr.Enum (cases,_er) -> + | SynTypeDefnSimpleRepr.Enum (cases, _er) -> for EnumCase (attrs, _, _, _, cr) in cases do rcheck Scope.EnumCase Collapse.Below cr cr parseAttributes attrs - | SynTypeDefnSimpleRepr.Record (_,fields,rr) -> + | SynTypeDefnSimpleRepr.Record (_, fields, rr) -> rcheck Scope.RecordDefn Collapse.Same rr rr - for Field (attrs,_,_,_,_,_,_,fr) in fields do + for Field (attrs, _, _, _, _, _, _, fr) in fields do rcheck Scope.RecordField Collapse.Below fr fr parseAttributes attrs - | SynTypeDefnSimpleRepr.Union (_,cases,ur) -> + | SynTypeDefnSimpleRepr.Union (_, cases, ur) -> rcheck Scope.UnionDefn Collapse.Same ur ur - for UnionCase (attrs,_,_,_,_,cr) in cases do + for UnionCase (attrs, _, _, _, _, cr) in cases do rcheck Scope.UnionCase Collapse.Below cr cr parseAttributes attrs | _ -> () - and parseTypeDefn (TypeDefn(ComponentInfo(_,typeArgs,_,_,_,_,_,r), objectModel, members, fullrange)) = + and parseTypeDefn (TypeDefn(ComponentInfo(_, typeArgs, _, _, _, _, _, r), objectModel, members, fullrange)) = let typeArgsRange = rangeOfTypeArgsElse r typeArgs let collapse = Range.endToEnd (Range.modEnd 1 typeArgsRange) fullrange match objectModel with @@ -580,23 +580,23 @@ module Structure = let collectHashDirectives = getConsecutiveModuleDecls( function - | SynModuleDecl.HashDirective (ParsedHashDirective (directive, _, _),r) -> + | SynModuleDecl.HashDirective (ParsedHashDirective (directive, _, _), r) -> let prefixLength = "#".Length + directive.Length + " ".Length Some (mkRange "" (mkPos r.StartLine prefixLength) r.End) | _ -> None) Scope.HashDirective let rec parseDeclaration (decl: SynModuleDecl) = match decl with - | SynModuleDecl.Let (_,bindings,r) -> + | SynModuleDecl.Let (_, bindings, r) -> for binding in bindings do let collapse = Range.endToEnd binding.RangeOfBindingSansRhs r rcheck Scope.LetOrUse Collapse.Below r collapse parseBindings bindings - | SynModuleDecl.Types (types,_r) -> + | SynModuleDecl.Types (types, _r) -> for t in types do parseTypeDefn t // Fold the attributes above a module - | SynModuleDecl.NestedModule (ComponentInfo (attrs,_,_,_,_,_,_,cmpRange),_, decls,_,_) -> + | SynModuleDecl.NestedModule (ComponentInfo (attrs, _, _, _, _, _, _, cmpRange), _, decls, _, _) -> // Outline the full scope of the module let r = Range.endToEnd cmpRange decl.Range rcheck Scope.Module Collapse.Below decl.Range r @@ -604,13 +604,13 @@ module Structure = parseAttributes attrs collectOpens decls List.iter parseDeclaration decls - | SynModuleDecl.DoExpr (_,e,_) -> + | SynModuleDecl.DoExpr (_, e, _) -> parseExpr e - | SynModuleDecl.Attributes (attrs,_) -> + | SynModuleDecl.Attributes (attrs, _) -> parseAttributes attrs | _ -> () - let parseModuleOrNamespace (SynModuleOrNamespace (longId,_,kind,decls,_,attribs,_,r)) = + let parseModuleOrNamespace (SynModuleOrNamespace (longId, _, kind, decls, _, attribs, _, r)) = parseAttributes attribs let idRange = longIdentRange longId let fullrange = Range.startToEnd idRange r @@ -708,7 +708,7 @@ module Structure = match typeSigs with | [] -> range | ls -> - let (TypeDefnSig(_,_,memberSigs,r)) = List.last ls + let (TypeDefnSig(_, _, memberSigs, r)) = List.last ls lastMemberSigRangeElse r memberSigs let lastModuleSigDeclRangeElse range (sigDecls:SynModuleSigDecls) = @@ -716,28 +716,28 @@ module Structure = | [] -> range | ls -> match List.last ls with - | SynModuleSigDecl.Types (typeSigs,r) -> lastTypeDefnSigRangeElse r typeSigs - | SynModuleSigDecl.Val (ValSpfn(range=r),_) -> r - | SynModuleSigDecl.Exception(_,r) -> r - | SynModuleSigDecl.Open(_,r) -> r - | SynModuleSigDecl.ModuleAbbrev(_,_,r) -> r + | SynModuleSigDecl.Types (typeSigs, r) -> lastTypeDefnSigRangeElse r typeSigs + | SynModuleSigDecl.Val (ValSpfn(range=r), _) -> r + | SynModuleSigDecl.Exception(_, r) -> r + | SynModuleSigDecl.Open(_, r) -> r + | SynModuleSigDecl.ModuleAbbrev(_, _, r) -> r | _ -> range let rec parseSynMemberDefnSig = function - | SynMemberSig.Member(valSigs,_,r) -> + | SynMemberSig.Member(valSigs, _, r) -> let collapse = Range.endToEnd valSigs.RangeOfId r rcheck Scope.Member Collapse.Below r collapse - | SynMemberSig.ValField(Field(attrs,_,_,_,_,_,_,fr),fullrange) -> + | SynMemberSig.ValField(Field(attrs, _, _, _, _, _, _, fr), fullrange) -> let collapse = Range.endToEnd fr fullrange rcheck Scope.Val Collapse.Below fullrange collapse parseAttributes attrs - | SynMemberSig.Interface(tp,r) -> + | SynMemberSig.Interface(tp, r) -> rcheck Scope.Interface Collapse.Below r (Range.endToEnd tp.Range r) | SynMemberSig.NestedType (typeDefSig, _r) -> parseTypeDefnSig typeDefSig | _ -> () - and parseTypeDefnSig (TypeDefnSig (ComponentInfo(attribs,typeArgs,_,longId,_,_,_,r) as __, objectModel, memberSigs, _)) = + and parseTypeDefnSig (TypeDefnSig (ComponentInfo(attribs, typeArgs, _, longId, _, _, _, r) as __, objectModel, memberSigs, _)) = parseAttributes attribs let makeRanges memberSigs = @@ -750,23 +750,23 @@ module Structure = List.iter parseSynMemberDefnSig memberSigs match objectModel with - // matches against a type declaration with <'T,...> and (args,...) + // matches against a type declaration with <'T, ...> and (args, ...) | SynTypeDefnSigRepr.ObjectModel (TyconUnspecified, objMembers, _) -> List.iter parseSynMemberDefnSig objMembers - let fullrange,collapse = makeRanges objMembers + let fullrange, collapse = makeRanges objMembers rcheck Scope.Type Collapse.Below fullrange collapse | SynTypeDefnSigRepr.ObjectModel (TyconAugmentation, objMembers, _) -> - let fullrange,collapse = makeRanges objMembers + let fullrange, collapse = makeRanges objMembers rcheck Scope.TypeExtension Collapse.Below fullrange collapse List.iter parseSynMemberDefnSig objMembers | SynTypeDefnSigRepr.ObjectModel (_, objMembers, _) -> - let fullrange,collapse = makeRanges objMembers + let fullrange, collapse = makeRanges objMembers rcheck Scope.Type Collapse.Below fullrange collapse List.iter parseSynMemberDefnSig objMembers // visit the members of a type extension | SynTypeDefnSigRepr.Simple (simpleRepr, _) -> - let fullrange,collapse = makeRanges memberSigs + let fullrange, collapse = makeRanges memberSigs rcheck Scope.Type Collapse.Below fullrange collapse parseSimpleRepr simpleRepr | SynTypeDefnSigRepr.Exception _ -> () @@ -810,18 +810,18 @@ module Structure = Some (mkRange "" (mkPos r.StartLine prefixLength) r.End) | _ -> None) Scope.HashDirective - let collectSigOpens = getConsecutiveSigModuleDecls (function SynModuleSigDecl.Open (_,r) -> Some r | _ -> None) Scope.Open + let collectSigOpens = getConsecutiveSigModuleDecls (function SynModuleSigDecl.Open (_, r) -> Some r | _ -> None) Scope.Open let rec parseModuleSigDeclaration (decl: SynModuleSigDecl) = match decl with - | SynModuleSigDecl.Val ((ValSpfn(attrs,ident,_,_,_,_,_,_,_,_,valrange)),r) -> + | SynModuleSigDecl.Val ((ValSpfn(attrs, ident, _, _, _, _, _, _, _, _, valrange)), r) -> let collapse = Range.endToEnd ident.idRange valrange rcheck Scope.Val Collapse.Below r collapse parseAttributes attrs - | SynModuleSigDecl.Types (typeSigs,_) -> + | SynModuleSigDecl.Types (typeSigs, _) -> List.iter parseTypeDefnSig typeSigs // Fold the attributes above a module - | SynModuleSigDecl.NestedModule (ComponentInfo (attrs,_,_,_,_,_,_,cmpRange),_,decls,moduleRange) -> + | SynModuleSigDecl.NestedModule (ComponentInfo (attrs, _, _, _, _, _, _, cmpRange), _, decls, moduleRange) -> let rangeEnd = lastModuleSigDeclRangeElse moduleRange decls // Outline the full scope of the module let collapse = Range.endToEnd cmpRange rangeEnd @@ -833,7 +833,7 @@ module Structure = List.iter parseModuleSigDeclaration decls | _ -> () - let parseModuleOrNamespaceSigs (SynModuleOrNamespaceSig(longId,_,kind,decls,_,attribs,_,r)) = + let parseModuleOrNamespaceSigs (SynModuleOrNamespaceSig(longId, _, kind, decls, _, attribs, _, r)) = parseAttributes attribs let rangeEnd = lastModuleSigDeclRangeElse r decls let idrange = longIdentRange longId diff --git a/src/fsharp/service/ServiceUntypedParse.fs b/src/fsharp/service/ServiceUntypedParse.fs index 42036bec5822a170c817a47dfaf9eacea64a6778..ab5db3d70e147a076b8ace2bee01c78efb08bf5d 100755 --- a/src/fsharp/service/ServiceUntypedParse.fs +++ b/src/fsharp/service/ServiceUntypedParse.fs @@ -29,16 +29,16 @@ module SourceFile = /// Whether or not this file is compilable let IsCompilable file = let ext = Path.GetExtension(file) - compilableExtensions |> List.exists(fun e->0 = String.Compare(e,ext,StringComparison.OrdinalIgnoreCase)) + compilableExtensions |> List.exists(fun e->0 = String.Compare(e, ext, StringComparison.OrdinalIgnoreCase)) /// Whether or not this file should be a single-file project let MustBeSingleFileProject file = let ext = Path.GetExtension(file) - singleFileProjectExtensions |> List.exists(fun e-> 0 = String.Compare(e,ext,StringComparison.OrdinalIgnoreCase)) + singleFileProjectExtensions |> List.exists(fun e-> 0 = String.Compare(e, ext, StringComparison.OrdinalIgnoreCase)) module SourceFileImpl = let IsInterfaceFile file = let ext = Path.GetExtension(file) - 0 = String.Compare(".fsi",ext,StringComparison.OrdinalIgnoreCase) + 0 = String.Compare(".fsi", ext, StringComparison.OrdinalIgnoreCase) /// Additional #defines that should be in place when editing a file in a file editor such as VS. let AdditionalDefinesForUseInEditor(isInteractive: bool) = @@ -97,7 +97,7 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op member scope.FindNoteworthyParamInfoLocations(pos) = match input with - | Some(input) -> FSharpNoteworthyParamInfoLocations.Find(pos,input) + | Some(input) -> FSharpNoteworthyParamInfoLocations.Find(pos, input) | _ -> None /// Get declared items and the selected item at the specified location @@ -128,12 +128,12 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op let walkWithSeqPt sp = [ match sp with SequencePointAtWith m -> yield! checkRange m | _ -> () ] let walkFinallySeqPt sp = [ match sp with SequencePointAtFinally m -> yield! checkRange m | _ -> () ] - let rec walkBind (Binding(_, _, _, _, _, _, SynValData(memFlagsOpt,_,_), synPat, _, synExpr, _, spInfo)) = + let rec walkBind (Binding(_, _, _, _, _, _, SynValData(memFlagsOpt, _, _), synPat, _, synExpr, _, spInfo)) = [ // Don't yield the binding sequence point if there are any arguments, i.e. we're defining a function or a method let isFunction = Option.isSome memFlagsOpt || match synPat with - | SynPat.LongIdent (_,_,_, SynConstructorArgs.Pats args,_,_) when not (List.isEmpty args) -> true + | SynPat.LongIdent (_, _, _, SynConstructorArgs.Pats args, _, _) when not (List.isEmpty args) -> true | _ -> false if not isFunction then yield! walkBindSeqPt spInfo @@ -143,7 +143,7 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op and walkExprs es = List.collect (walkExpr false) es and walkBinds es = List.collect walkBind es and walkMatchClauses cl = - [ for (Clause(_,whenExpr,e,_,_)) in cl do + [ for (Clause(_, whenExpr, e, _, _)) in cl do match whenExpr with | Some e -> yield! walkExpr false e | _ -> () @@ -179,69 +179,69 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op | SynExpr.Const _ -> () - | SynExpr.Quote(_,_,e,_,_) - | SynExpr.TypeTest (e,_,_) - | SynExpr.Upcast (e,_,_) - | SynExpr.AddressOf (_,e,_,_) - | SynExpr.CompExpr (_,_,e,_) - | SynExpr.ArrayOrListOfSeqExpr (_,e,_) - | SynExpr.Typed (e,_,_) - | SynExpr.FromParseError (e,_) - | SynExpr.DiscardAfterMissingQualificationAfterDot (e,_) - | SynExpr.Do (e,_) - | SynExpr.Assert (e,_) - | SynExpr.Fixed (e,_) - | SynExpr.DotGet (e,_,_,_) - | SynExpr.LongIdentSet (_,e,_) - | SynExpr.New (_,_,e,_) - | SynExpr.TypeApp (e,_,_,_,_,_,_) - | SynExpr.LibraryOnlyUnionCaseFieldGet (e,_,_,_) - | SynExpr.Downcast (e,_,_) - | SynExpr.InferredUpcast (e,_) - | SynExpr.InferredDowncast (e,_) + | SynExpr.Quote(_, _, e, _, _) + | SynExpr.TypeTest (e, _, _) + | SynExpr.Upcast (e, _, _) + | SynExpr.AddressOf (_, e, _, _) + | SynExpr.CompExpr (_, _, e, _) + | SynExpr.ArrayOrListOfSeqExpr (_, e, _) + | SynExpr.Typed (e, _, _) + | SynExpr.FromParseError (e, _) + | SynExpr.DiscardAfterMissingQualificationAfterDot (e, _) + | SynExpr.Do (e, _) + | SynExpr.Assert (e, _) + | SynExpr.Fixed (e, _) + | SynExpr.DotGet (e, _, _, _) + | SynExpr.LongIdentSet (_, e, _) + | SynExpr.New (_, _, e, _) + | SynExpr.TypeApp (e, _, _, _, _, _, _) + | SynExpr.LibraryOnlyUnionCaseFieldGet (e, _, _, _) + | SynExpr.Downcast (e, _, _) + | SynExpr.InferredUpcast (e, _) + | SynExpr.InferredDowncast (e, _) | SynExpr.Lazy (e, _) - | SynExpr.TraitCall(_,_,e,_) - | SynExpr.Paren(e,_,_,_) -> + | SynExpr.TraitCall(_, _, e, _) + | SynExpr.Paren(e, _, _, _) -> yield! walkExpr false e - | SynExpr.YieldOrReturn (_,e,_) - | SynExpr.YieldOrReturnFrom (_,e,_) - | SynExpr.DoBang (e,_) -> + | SynExpr.YieldOrReturn (_, e, _) + | SynExpr.YieldOrReturnFrom (_, e, _) + | SynExpr.DoBang (e, _) -> yield! checkRange e.Range yield! walkExpr false e - | SynExpr.NamedIndexedPropertySet (_,e1,e2,_) - | SynExpr.DotSet (e1,_,e2,_) - | SynExpr.Set (e1,e2,_) - | SynExpr.LibraryOnlyUnionCaseFieldSet (e1,_,_,e2,_) - | SynExpr.App (_,_,e1,e2,_) -> + | SynExpr.NamedIndexedPropertySet (_, e1, e2, _) + | SynExpr.DotSet (e1, _, e2, _) + | SynExpr.Set (e1, e2, _) + | SynExpr.LibraryOnlyUnionCaseFieldSet (e1, _, _, e2, _) + | SynExpr.App (_, _, e1, e2, _) -> yield! walkExpr false e1 yield! walkExpr false e2 - | SynExpr.ArrayOrList (_,es,_) - | SynExpr.Tuple (_,es,_,_) -> + | SynExpr.ArrayOrList (_, es, _) + | SynExpr.Tuple (_, es, _, _) -> yield! walkExprs es - | SynExpr.Record (_,copyExprOpt,fs,_) -> + | SynExpr.Record (_, copyExprOpt, fs, _) -> match copyExprOpt with - | Some (e,_) -> yield! walkExpr true e + | Some (e, _) -> yield! walkExpr true e | None -> () yield! walkExprs (fs |> List.choose p23) | SynExpr.AnonRecd (_isStruct, copyExprOpt, fs, _) -> match copyExprOpt with - | Some (e,_) -> yield! walkExpr true e + | Some (e, _) -> yield! walkExpr true e | None -> () yield! walkExprs (fs |> List.map snd) - | SynExpr.ObjExpr (_,args,bs,is,_,_) -> + | SynExpr.ObjExpr (_, args, bs, is, _, _) -> match args with | None -> () - | Some (arg,_) -> yield! walkExpr false arg + | Some (arg, _) -> yield! walkExpr false arg yield! walkBinds bs - for (InterfaceImpl(_,bs,_)) in is do yield! walkBinds bs + for (InterfaceImpl(_, bs, _)) in is do yield! walkBinds bs - | SynExpr.While (spWhile,e1,e2,_) -> + | SynExpr.While (spWhile, e1, e2, _) -> yield! walkWhileSeqPt spWhile yield! walkExpr false e1 yield! walkExpr true e2 @@ -250,82 +250,82 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op yield! walkExpr false e1 yield! walkExpr false e2 - | SynExpr.For (spFor,_,e1,_,e2,e3,_) -> + | SynExpr.For (spFor, _, e1, _, e2, e3, _) -> yield! walkForSeqPt spFor yield! walkExpr false e1 yield! walkExpr true e2 yield! walkExpr true e3 - | SynExpr.ForEach (spFor,_,_,_,e1,e2,_) -> + | SynExpr.ForEach (spFor, _, _, _, e1, e2, _) -> yield! walkForSeqPt spFor yield! walkExpr false e1 yield! walkExpr true e2 - | SynExpr.MatchLambda(_isExnMatch,_argm,cl,spBind,_wholem) -> + | SynExpr.MatchLambda(_isExnMatch, _argm, cl, spBind, _wholem) -> yield! walkBindSeqPt spBind - for (Clause(_,whenExpr,e,_,_)) in cl do + for (Clause(_, whenExpr, e, _, _)) in cl do yield! walkExprOpt false whenExpr yield! walkExpr true e - | SynExpr.Lambda (_,_,_,e,_) -> + | SynExpr.Lambda (_, _, _, e, _) -> yield! walkExpr true e - | SynExpr.Match (spBind,e,cl,_) -> + | SynExpr.Match (spBind, e, cl, _) -> yield! walkBindSeqPt spBind yield! walkExpr false e - for (Clause(_,whenExpr,e,_,_)) in cl do + for (Clause(_, whenExpr, e, _, _)) in cl do yield! walkExprOpt false whenExpr yield! walkExpr true e - | SynExpr.LetOrUse (_,_,bs,e,_) -> + | SynExpr.LetOrUse (_, _, bs, e, _) -> yield! walkBinds bs yield! walkExpr true e - | SynExpr.TryWith (e,_,cl,_,_,spTry,spWith) -> + | SynExpr.TryWith (e, _, cl, _, _, spTry, spWith) -> yield! walkTrySeqPt spTry yield! walkWithSeqPt spWith yield! walkExpr true e yield! walkMatchClauses cl - | SynExpr.TryFinally (e1,e2,_,spTry,spFinally) -> + | SynExpr.TryFinally (e1, e2, _, spTry, spFinally) -> yield! walkExpr true e1 yield! walkExpr true e2 yield! walkTrySeqPt spTry yield! walkFinallySeqPt spFinally - | SynExpr.Sequential (spSeq,_,e1,e2,_) -> + | SynExpr.Sequential (spSeq, _, e1, e2, _) -> yield! walkExpr (match spSeq with SuppressSequencePointOnStmtOfSequential -> false | _ -> true) e1 yield! walkExpr (match spSeq with SuppressSequencePointOnExprOfSequential -> false | _ -> true) e2 - | SynExpr.IfThenElse (e1,e2,e3opt,spBind,_,_,_) -> + | SynExpr.IfThenElse (e1, e2, e3opt, spBind, _, _, _) -> yield! walkBindSeqPt spBind yield! walkExpr false e1 yield! walkExpr true e2 yield! walkExprOpt true e3opt - | SynExpr.DotIndexedGet (e1,es,_,_) -> + | SynExpr.DotIndexedGet (e1, es, _, _) -> yield! walkExpr false e1 yield! walkExprs [ for e in es do yield! e.Exprs ] - | SynExpr.DotIndexedSet (e1,es,e2,_,_,_) -> + | SynExpr.DotIndexedSet (e1, es, e2, _, _, _) -> yield! walkExpr false e1 yield! walkExprs [ for e in es do yield! e.Exprs ] yield! walkExpr false e2 - | SynExpr.DotNamedIndexedPropertySet (e1,_,e2,e3,_) -> + | SynExpr.DotNamedIndexedPropertySet (e1, _, e2, e3, _) -> yield! walkExpr false e1 yield! walkExpr false e2 yield! walkExpr false e3 - | SynExpr.LetOrUseBang (spBind,_,_,_,e1,e2,_) -> + | SynExpr.LetOrUseBang (spBind, _, _, _, e1, e2, _) -> yield! walkBindSeqPt spBind yield! walkExpr true e1 yield! walkExpr true e2 - | SynExpr.MatchBang (spBind,e,cl,_) -> + | SynExpr.MatchBang (spBind, e, cl, _) -> yield! walkBindSeqPt spBind yield! walkExpr false e - for (Clause(_,whenExpr,e,_,_)) in cl do + for (Clause(_, whenExpr, e, _, _)) in cl do yield! walkExprOpt false whenExpr yield! walkExpr true e ] @@ -344,7 +344,7 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op [ match memb with | SynMemberDefn.LetBindings(binds, _, _, _) -> yield! walkBinds binds | SynMemberDefn.AutoProperty(_attribs, _isStatic, _id, _tyOpt, _propKind, _, _xmlDoc, _access, synExpr, _, _) -> yield! walkExpr true synExpr - | SynMemberDefn.ImplicitCtor(_,_,_,_,m) -> yield! checkRange m + | SynMemberDefn.ImplicitCtor(_, _, _, _, m) -> yield! checkRange m | SynMemberDefn.Member(bind, _) -> yield! walkBind bind | SynMemberDefn.Interface(_synty, Some(membs), _) -> for m in membs do yield! walkMember m | SynMemberDefn.Inherit(_, _, m) -> @@ -362,7 +362,7 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op [ match decl with | SynModuleDecl.Let(_, binds, m) when isMatchRange m -> yield! walkBinds binds - | SynModuleDecl.DoExpr(spExpr,expr, m) when isMatchRange m -> + | SynModuleDecl.DoExpr(spExpr, expr, m) when isMatchRange m -> yield! walkBindSeqPt spExpr yield! walkExpr false expr | SynModuleDecl.ModuleAbbrev _ -> () @@ -376,7 +376,7 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: Ast.ParsedInput op | _ -> () ] // Collect all the items in a module - let walkModule (SynModuleOrNamespace(_,_,_,decls,_,_,_,m)) = + let walkModule (SynModuleOrNamespace(_, _, _, decls, _, _, _, m)) = if isMatchRange m then List.collect walkDecl decls else @@ -449,7 +449,7 @@ module UntypedParseImpl = let emptyStringSet = HashSet() - let GetRangeOfExprLeftOfDot(pos:pos,parseTreeOpt) = + let GetRangeOfExprLeftOfDot(pos:pos, parseTreeOpt) = match parseTreeOpt with | None -> None | Some(parseTree) -> @@ -463,24 +463,24 @@ module UntypedParseImpl = couldBeBeforeFront <- false couldBeBeforeFront, r - AstTraversal.Traverse(pos,parseTree, { new AstTraversal.AstVisitorBase<_>() with + AstTraversal.Traverse(pos, parseTree, { new AstTraversal.AstVisitorBase<_>() with member this.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = let expr = expr // fix debugger locals match expr with - | SynExpr.LongIdent(_, LongIdentWithDots(longIdent,_), _altNameRefCell, _range) -> - let _,r = CheckLongIdent(longIdent) + | SynExpr.LongIdent(_, LongIdentWithDots(longIdent, _), _altNameRefCell, _range) -> + let _, r = CheckLongIdent(longIdent) Some(r) - | SynExpr.LongIdentSet(LongIdentWithDots(longIdent,_), synExpr, _range) -> + | SynExpr.LongIdentSet(LongIdentWithDots(longIdent, _), synExpr, _range) -> if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then traverseSynExpr synExpr else - let _,r = CheckLongIdent(longIdent) + let _, r = CheckLongIdent(longIdent) Some(r) - | SynExpr.DotGet(synExpr, _dotm, LongIdentWithDots(longIdent,_), _range) -> + | SynExpr.DotGet(synExpr, _dotm, LongIdentWithDots(longIdent, _), _range) -> if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then traverseSynExpr synExpr else - let inFront,r = CheckLongIdent(longIdent) + let inFront, r = CheckLongIdent(longIdent) if inFront then Some(synExpr.Range) else @@ -493,13 +493,13 @@ module UntypedParseImpl = traverseSynExpr synExpr2 else Some(range) - | SynExpr.DotSet(synExpr, LongIdentWithDots(longIdent,_), synExpr2, _range) -> + | SynExpr.DotSet(synExpr, LongIdentWithDots(longIdent, _), synExpr2, _range) -> if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then traverseSynExpr synExpr elif AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr2.Range pos then traverseSynExpr synExpr2 else - let inFront,r = CheckLongIdent(longIdent) + let inFront, r = CheckLongIdent(longIdent) if inFront then Some(synExpr.Range) else @@ -509,7 +509,7 @@ module UntypedParseImpl = // ---- synExpr.Range has this value // ------ we want this value Some((unionRanges synExpr.Range r)) - | SynExpr.DotNamedIndexedPropertySet(synExpr, LongIdentWithDots(longIdent,_), synExpr2, synExpr3, _range) -> + | SynExpr.DotNamedIndexedPropertySet(synExpr, LongIdentWithDots(longIdent, _), synExpr2, synExpr3, _range) -> if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then traverseSynExpr synExpr elif AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr2.Range pos then @@ -517,7 +517,7 @@ module UntypedParseImpl = elif AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr3.Range pos then traverseSynExpr synExpr3 else - let inFront,r = CheckLongIdent(longIdent) + let inFront, r = CheckLongIdent(longIdent) if inFront then Some(synExpr.Range) else @@ -546,7 +546,7 @@ module UntypedParseImpl = }) /// searches for the expression island suitable for the evaluation by the debugger - let TryFindExpressionIslandInPosition(pos:pos,parseTreeOpt) = + let TryFindExpressionIslandInPosition(pos:pos, parseTreeOpt) = match parseTreeOpt with | None -> None | Some(parseTree) -> @@ -563,9 +563,9 @@ module UntypedParseImpl = match expr with | SynExpr.Paren(e, _, _, _) when foundCandidate -> TryGetExpression foundCandidate e - | SynExpr.LongIdent(_isOptional, LongIdentWithDots(lid,_), _altNameRefCell, _m) -> + | SynExpr.LongIdent(_isOptional, LongIdentWithDots(lid, _), _altNameRefCell, _m) -> getLidParts lid |> Some - | SynExpr.DotGet(leftPart, _, LongIdentWithDots(lid,_), _) when (rangeContainsPos (rangeOfLid lid) pos) || foundCandidate -> + | SynExpr.DotGet(leftPart, _, LongIdentWithDots(lid, _), _) when (rangeContainsPos (rangeOfLid lid) pos) || foundCandidate -> // requested position is at the lid part of the DotGet // process left part and append result to the result of processing lid let leftPartResult = TryGetExpression true leftPart @@ -602,7 +602,7 @@ module UntypedParseImpl = // ^ // would return None // TODO would be great to unify this with GetRangeOfExprLeftOfDot above, if possible, as they are similar - let TryFindExpressionASTLeftOfDotLeftOfCursor(pos,parseTreeOpt) = + let TryFindExpressionASTLeftOfDotLeftOfCursor(pos, parseTreeOpt) = match parseTreeOpt with | None -> None | Some(parseTree) -> @@ -615,7 +615,7 @@ module UntypedParseImpl = let traverseSynExpr, defaultTraverse, expr = traverseSynExpr, defaultTraverse, expr // for debugging: debugger does not get object expression params as local vars if not(rangeContainsPos expr.Range pos) then match expr with - | SynExpr.DiscardAfterMissingQualificationAfterDot(e,_m) -> + | SynExpr.DiscardAfterMissingQualificationAfterDot(e, _m) -> // This happens with e.g. "f(x) . $" when you bring up a completion list a few spaces after a dot. The cursor is not 'in the parse tree', // but the dive algorithm will dive down into this node, and this is the one case where we do want to give a result despite the cursor // not properly being in a node. @@ -628,14 +628,14 @@ module UntypedParseImpl = // the cursor location. None else - let rec traverseLidOrElse (optExprIfLeftOfLongId : SynExpr option) (LongIdentWithDots(lid,dots) as lidwd) = + let rec traverseLidOrElse (optExprIfLeftOfLongId : SynExpr option) (LongIdentWithDots(lid, dots) as lidwd) = let resultIfLeftOfLongId = match optExprIfLeftOfLongId with | None -> None | Some e -> Some(e.Range.End, posGeq lidwd.Range.Start pos) - match dots |> List.mapi (fun i x -> i,x) |> List.rev |> List.tryFind (fun (_,m) -> posGt pos m.Start) with + match dots |> List.mapi (fun i x -> i, x) |> List.rev |> List.tryFind (fun (_, m) -> posGt pos m.Start) with | None -> resultIfLeftOfLongId - | Some(n,_) -> Some((List.item n lid).idRange.End, (List.length lid = n+1) // foo.$ + | Some(n, _) -> Some((List.item n lid).idRange.End, (List.length lid = n+1) // foo.$ || (posGeq (List.item (n+1) lid).idRange.Start pos)) // foo.$bar match expr with | SynExpr.LongIdent(_isOptional, lidwd, _altNameRefCell, _m) -> @@ -677,7 +677,7 @@ module UntypedParseImpl = else // the cursor is left of the dot None - | SynExpr.DiscardAfterMissingQualificationAfterDot(e,m) -> + | SynExpr.DiscardAfterMissingQualificationAfterDot(e, m) -> match traverseSynExpr(e) with | None -> if posEq m.End pos then @@ -763,7 +763,7 @@ module UntypedParseImpl = List.tryPick walkTyparDecl typars |> Option.orElse (List.tryPick walkTypeConstraint constraints))) |> Option.orElse (List.tryPick walkPat pats) - | SynPat.Tuple(_,pats, _) -> List.tryPick walkPat pats + | SynPat.Tuple(_, pats, _) -> List.tryPick walkPat pats | SynPat.Paren(pat, _) -> walkPat pat | SynPat.ArrayOrList(_, pats, _) -> List.tryPick walkPat pats | SynPat.IsInst(t, _) -> walkType t @@ -796,7 +796,7 @@ module UntypedParseImpl = | SynType.App(ty, _, types, _, _, _, _) -> walkType ty |> Option.orElse (List.tryPick walkType types) | SynType.LongIdentApp(_, _, _, types, _, _, _) -> List.tryPick walkType types - | SynType.Tuple(_,ts, _) -> ts |> List.tryPick (fun (_, t) -> walkType t) + | SynType.Tuple(_, ts, _) -> ts |> List.tryPick (fun (_, t) -> walkType t) | SynType.Array(_, t, _) -> walkType t | SynType.Fun(t1, t2, _) -> walkType t1 |> Option.orElse (walkType t2) | SynType.WithGlobalConstraints(t, _, _) -> walkType t @@ -995,7 +995,7 @@ module UntypedParseImpl = let parseLid (LongIdentWithDots(lid, dots)) = let rec collect plid (parts : Ident list) (dots : range list) = match parts, dots with - | [],_ -> Some (plid, None) + | [], _ -> Some (plid, None) | x::xs, ds -> if rangeContainsPos x.idRange pos then // pos lies with the range of current identifier @@ -1047,7 +1047,7 @@ module UntypedParseImpl = | false, false, true -> Struct | _ -> Invalid - let GetCompletionContextForInheritSynMember ((ComponentInfo(synAttributes, _, _, _,_, _, _, _)), typeDefnKind : SynTypeDefnKind, completionPath) = + let GetCompletionContextForInheritSynMember ((ComponentInfo(synAttributes, _, _, _, _, _, _, _)), typeDefnKind : SynTypeDefnKind, completionPath) = let success k = Some (CompletionContext.Inherit (k, completionPath)) @@ -1198,7 +1198,7 @@ module UntypedParseImpl = | _ -> defaultTraverse expr // new (A$ = 1) - // new (A = 1,$) + // new (A = 1, $) | Setter id when id.idRange.End = pos || rangeBeforePos expr.Range pos -> let precedingArgument = if id.idRange.End = pos then None else Some expr match path with @@ -1257,7 +1257,7 @@ module UntypedParseImpl = | SynPat.LongIdent(longDotId = lidwd) when rangeContainsPos lidwd.Range pos -> // let fo|o x = () Some CompletionContext.Invalid - | SynPat.LongIdent(_,_,_,ctorArgs,_,_) -> + | SynPat.LongIdent(_, _, _, ctorArgs, _, _) -> match ctorArgs with | SynConstructorArgs.Pats(pats) -> pats |> List.tryPick (fun pat -> @@ -1304,7 +1304,7 @@ module UntypedParseImpl = pats |> List.tryPick (fun pat -> match pat with | SynSimplePat.Id(range = range) - | SynSimplePat.Typed(SynSimplePat.Id(range = range),_,_) when rangeContainsPos range pos -> + | SynSimplePat.Typed(SynSimplePat.Id(range = range), _, _) when rangeContainsPos range pos -> Some CompletionContext.Invalid | _ -> None) diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index 522b275c5b3aa92bb485c39b5bf1d380a1ba0ae1..6dbb35f4990a8be354093f5ef33ca5c2dd050e24 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -48,10 +48,6 @@ open Internal.Utilities open Internal.Utilities.Collections open FSharp.Compiler.Layout.TaggedTextOps -#if FX_RESHAPED_REFLECTION -open Microsoft.FSharp.Core.ReflectionAdapters -#endif - type internal Layout = StructuredFormat.Layout [] diff --git a/src/fsharp/sr.fs b/src/fsharp/sr.fs index 7eab19223f89f96c6a91f00974de72b1ddeda421..a59c2419ea4bd0a0d0b1b5a62f4e0492ab11486a 100644 --- a/src/fsharp/sr.fs +++ b/src/fsharp/sr.fs @@ -11,13 +11,7 @@ namespace FSharp.Compiler open System.Reflection module internal SR = -#if FX_RESHAPED_REFLECTION - open System.Reflection - type private TypeInThisAssembly = class end - let private resources = lazy (new System.Resources.ResourceManager("fsstrings", typeof.GetTypeInfo().Assembly)) -#else let private resources = lazy (new System.Resources.ResourceManager("fsstrings", System.Reflection.Assembly.GetExecutingAssembly())) -#endif let GetString(name:string) = let s = resources.Force().GetString(name, System.Globalization.CultureInfo.CurrentUICulture) @@ -34,11 +28,6 @@ namespace FSharp.Compiler open System.Reflection open Internal.Utilities.StructuredFormat -#if FX_RESHAPED_REFLECTION - open PrimReflectionAdapters - open ReflectionAdapters -#endif - let mkFunctionValue (tys: System.Type[]) (impl:obj->obj) = FSharpValue.MakeFunction(FSharpType.MakeFunctionType(tys.[0],tys.[1]), impl) diff --git a/src/fsharp/symbols/Exprs.fs b/src/fsharp/symbols/Exprs.fs index ba9925616c733160aac8d7d58e20324e7ea2c947..6cba7d97db1a0d25442dda5ca20538691d88f830 100644 --- a/src/fsharp/symbols/Exprs.fs +++ b/src/fsharp/symbols/Exprs.fs @@ -20,9 +20,9 @@ module ExprTranslationImpl = type ExprTranslationEnv = { //Map from Val to binding index - vs: ValMap; + vs: ValMap //Map from typar stamps to binding index - tyvs: StampMap; + tyvs: StampMap // Map for values bound by the // 'let v = isinst e in .... if nonnull v then ...v .... ' // construct arising out the compilation of pattern matching. We decode these back to the form @@ -31,7 +31,7 @@ module ExprTranslationImpl = substVals: ValMap } static member Empty = - { vs=ValMap<_>.Empty; + { vs=ValMap<_>.Empty tyvs = Map.empty ; isinstVals = ValMap<_>.Empty substVals = ValMap<_>.Empty } @@ -171,11 +171,11 @@ and [] FSharpExpr (cenv, f: (unit -> FSharpExpr) option, e: E, m:range, | E.ILFieldGet (objOpt, _ty, _fieldName) -> (match objOpt with None -> [] | Some x -> [x]) | E.ILFieldSet (objOpt, _ty, _fieldName, d) -> (match objOpt with None -> [d] | Some x -> [x;d]) | E.ObjectExpr (_ty, basecall, overrides, interfaceImpls) -> - [ yield basecall; + [ yield basecall for m in overrides do yield m.Body for (_, ms) in interfaceImpls do for m in ms do yield m.Body ] | E.DecisionTree (inputExpr, targetCases) -> - [ yield inputExpr; + [ yield inputExpr for (_targetVars, targetExpr) in targetCases do yield targetExpr ] | E.DecisionTreeSuccess (_targetNumber, targetArgs) -> targetArgs | E.UnionCaseSet (obj, _unionType, _unionCase, _unionField, valueExpr) -> [ yield obj; yield valueExpr ] diff --git a/src/fsharp/symbols/SymbolHelpers.fs b/src/fsharp/symbols/SymbolHelpers.fs index 2e9678d1c876db38a6481ea73ad02cf5393fc0c0..0d903f06b85230bfe348b63beab50d8207ae7ebb 100644 --- a/src/fsharp/symbols/SymbolHelpers.fs +++ b/src/fsharp/symbols/SymbolHelpers.fs @@ -637,7 +637,7 @@ module internal SymbolHelpers = | None | Some (XmlDoc [| |]) -> "" | Some (XmlDoc l) -> bufs (fun os -> - bprintf os "\n"; + bprintf os "\n" l |> Array.iter (fun (s:string) -> // Note: this code runs for local/within-project xmldoc tooltips, but not for cross-project or .XML bprintf os "\n%s" s)) @@ -863,11 +863,11 @@ module internal SymbolHelpers = items |> List.filter (fun item -> not (IsExplicitlySuppressed g item.Item)) let SimplerDisplayEnv denv = - { denv with suppressInlineKeyword=true; - shortConstraints=true; - showConstraintTyparAnnotations=false; - abbreviateAdditionalConstraints=false; - suppressNestedTypes=true; + { denv with suppressInlineKeyword=true + shortConstraints=true + showConstraintTyparAnnotations=false + abbreviateAdditionalConstraints=false + suppressNestedTypes=true maxMembers=Some EnvMisc2.maxMembers } let rec FullNameOfItem g item = diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index a5721022392785e61a90b5592b2fd22b2ce10213..a167657b6ba560af3dbd5143ba893909b646bf4a 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -290,6 +290,9 @@ type FSharpSymbol(cenv: SymbolEnv, item: (unit -> Item), access: (FSharpSymbol - | Item.ArgName(id, ty, _) -> FSharpParameter(cenv, ty, {Attribs=[]; Name=Some id}, Some id.idRange, isParamArrayArg=false, isInArg=false, isOutArg=false, isOptionalArg=false) :> _ + | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(_, vref, _)) }) -> + FSharpMemberOrFunctionOrValue(cenv, V vref, item) :> _ + // TODO: the following don't currently return any interesting subtype | Item.ImplicitOp _ | Item.ILField _ @@ -317,7 +320,7 @@ type FSharpSymbol(cenv: SymbolEnv, item: (unit -> Item), access: (FSharpSymbol - and FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = inherit FSharpSymbol(cenv, (fun () -> - checkEntityIsResolved(entity); + checkEntityIsResolved(entity) if entity.IsModuleOrNamespace then Item.ModuleOrNamespaces [entity] else Item.UnqualifiedType [entity]), (fun _this thisCcu2 ad -> @@ -1980,7 +1983,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = member x.IsValCompiledAsMethod = match d with - | V valRef -> IlxGen.IsValCompiledAsMethod cenv.g valRef.Deref + | V valRef -> IlxGen.IsFSharpValCompiledAsMethod cenv.g valRef.Deref | _ -> false member x.IsValue = diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index ea752d9b180baed0a74515c65922bf3fcd2802c0..e02f27bf3994e8d2ebb75a1181999fe47b94e780 100644 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -52,7 +52,7 @@ let globalNng = NiceNameGenerator() // ++GLOBAL MUTABLE STATE (concurrency safe by locking inside StableNiceNameGenerator) let globalStableNameGenerator = StableNiceNameGenerator () -type StampMap<'T> = Map +type StampMap<'T> = Map //------------------------------------------------------------------------- // Flags @@ -410,7 +410,7 @@ type EntityFlags(flags:int64) = /// Indicates the Entity is actually a module or namespace, not a type definition member x.IsModuleOrNamespace = (flags &&& 0b000000000000001L) <> 0x0L - /// Indicates the type prefers the "tycon" syntax for display etc. + /// Indicates the type prefers the "tycon" syntax for display etc. member x.IsPrefixDisplay = (flags &&& 0b000000000000010L) <> 0x0L // This bit is not pickled, only used while establishing a type constructor. It is needed because the type constructor @@ -483,9 +483,9 @@ let KeyTyconByAccessNames nm x = match TryDemangleGenericNameAndPos nm with | ValueSome pos -> let dnm = DemangleGenericTypeNameWithPos pos nm - [| KeyValuePair(nm,x); KeyValuePair(dnm,x) |] + [| KeyValuePair(nm, x); KeyValuePair(dnm, x) |] | _ -> - [| KeyValuePair(nm,x) |] + [| KeyValuePair(nm, x) |] type ModuleOrNamespaceKind = @@ -531,22 +531,22 @@ type PublicPath = type CompilationPath = | CompPath of ILScopeRef * (string * ModuleOrNamespaceKind) list - member x.ILScopeRef = (let (CompPath(scoref,_)) = x in scoref) + member x.ILScopeRef = (let (CompPath(scoref, _)) = x in scoref) - member x.AccessPath = (let (CompPath(_,p)) = x in p) + member x.AccessPath = (let (CompPath(_, p)) = x in p) member x.MangledPath = List.map fst x.AccessPath member x.NestedPublicPath (id:Ident) = PubPath(Array.append (Array.ofList x.MangledPath) [| id.idText |]) member x.ParentCompPath = - let a,_ = List.frontAndBack x.AccessPath - CompPath(x.ILScopeRef,a) + let a, _ = List.frontAndBack x.AccessPath + CompPath(x.ILScopeRef, a) - member x.NestedCompPath n modKind = CompPath(x.ILScopeRef,x.AccessPath@[(n,modKind)]) + member x.NestedCompPath n modKind = CompPath(x.ILScopeRef, x.AccessPath@[(n, modKind)]) member x.DemangledPath = - x.AccessPath |> List.map (fun (nm,k) -> CompilationPath.DemangleEntityName nm k) + x.AccessPath |> List.map (fun (nm, k) -> CompilationPath.DemangleEntityName nm k) /// String 'Module' off an F# module name, if FSharpModuleWithSuffix is used static member DemangleEntityName nm k = @@ -691,7 +691,7 @@ and /// Represents a type definition, exception definition, module definition or /// The display name of the namespace, module or type, e.g. List instead of List`1, and no static parameters member x.DisplayName = x.GetDisplayName(false, false) - /// The display name of the namespace, module or type with <_,_,_> added for generic types, plus static parameters if any + /// The display name of the namespace, module or type with <_, _, _> added for generic types, plus static parameters if any member x.DisplayNameWithStaticParametersAndUnderscoreTypars = x.GetDisplayName(true, true) /// The display name of the namespace, module or type, e.g. List instead of List`1, including static parameters if any @@ -700,7 +700,7 @@ and /// Represents a type definition, exception definition, module definition or #if !NO_EXTENSIONTYPING member x.IsStaticInstantiationTycon = x.IsProvidedErasedTycon && - let _nm,args = PrettyNaming.demangleProvidedTypeName x.LogicalName + let _nm, args = PrettyNaming.demangleProvidedTypeName x.LogicalName args.Length > 0 #endif @@ -718,7 +718,7 @@ and /// Represents a type definition, exception definition, module definition or #if !NO_EXTENSIONTYPING if x.IsProvidedErasedTycon then - let nm,args = PrettyNaming.demangleProvidedTypeName nm + let nm, args = PrettyNaming.demangleProvidedTypeName nm if withStaticParameters && args.Length > 0 then nm + "<" + String.concat "," (Array.map snd args) + ">" else @@ -875,7 +875,7 @@ and /// Represents a type definition, exception definition, module definition or | Some optData -> optData.entity_accessiblity | _ -> TAccess [] - /// Indicates the type prefers the "tycon" syntax for display etc. + /// Indicates the type prefers the "tycon" syntax for display etc. member x.IsPrefixDisplay = x.entity_flags.IsPrefixDisplay /// Indicates the Entity is actually a module or namespace, not a type definition @@ -928,7 +928,7 @@ and /// Represents a type definition, exception definition, module definition or member x.CompilationPath = match x.CompilationPathOpt with | Some cpath -> cpath - | None -> error(Error(FSComp.SR.tastTypeOrModuleNotConcrete(x.LogicalName),x.Range)) + | None -> error(Error(FSComp.SR.tastTypeOrModuleNotConcrete(x.LogicalName), x.Range)) /// Get a table of fields for all the F#-defined record, struct and class fields in this type definition, including /// static fields, 'val' declarations and hidden fields from the compilation of implicit class constructions. @@ -1059,7 +1059,7 @@ and /// Represents a type definition, exception definition, module definition or member x.ILTyconInfo = match x.TypeReprInfo with | TILObjectRepr data -> data | _ -> failwith "not a .NET type definition" /// Get the Abstract IL metadata for this type definition, assuming it is backed by Abstract IL metadata. - member x.ILTyconRawMetadata = let (TILObjectReprData(_,_,td)) = x.ILTyconInfo in td + member x.ILTyconRawMetadata = let (TILObjectReprData(_, _, td)) = x.ILTyconInfo in td /// Indicates if this is an F# type definition whose r.h.s. is known to be a record type definition. member x.IsRecordTycon = match x.TypeReprInfo with | TRecdRepr _ -> true | _ -> false @@ -1092,7 +1092,7 @@ and /// Represents a type definition, exception definition, module definition or /// Indicates if this is an F# type definition whose r.h.s. definition is unknown (i.e. a traditional ML 'abstract' type in a signature, /// which in F# is called a 'unknown representation' type). - member x.IsHiddenReprTycon = match x.TypeAbbrev,x.TypeReprInfo with | None,TNoRepr -> true | _ -> false + member x.IsHiddenReprTycon = match x.TypeAbbrev, x.TypeReprInfo with | None, TNoRepr -> true | _ -> false /// Indicates if this is an F#-defined interface type definition member x.IsFSharpInterfaceTycon = x.IsFSharpObjectModelTycon && match x.FSharpObjectModelTypeInfo.fsobjmodel_kind with TTyconInterface -> true | _ -> false @@ -1152,7 +1152,7 @@ and /// Represents a type definition, exception definition, module definition or /// Gets the immediate interface types of an F# type definition. Further interfaces may be supported through class and interface inheritance. member x.ImmediateInterfaceTypesOfFSharpTycon = - x.ImmediateInterfacesOfFSharpTycon |> List.map (fun (x,_,_) -> x) + x.ImmediateInterfacesOfFSharpTycon |> List.map (fun (x, _, _) -> x) /// Gets the immediate members of an F# type definition, excluding compiler-generated ones. /// Note: result is alphabetically sorted, then for each name the results are in declaration order @@ -1182,16 +1182,16 @@ and /// Represents a type definition, exception definition, module definition or member x.AllGeneratedValues = [ match x.GeneratedCompareToValues with | None -> () - | Some (v1,v2) -> yield v1; yield v2 + | Some (v1, v2) -> yield v1; yield v2 match x.GeneratedCompareToWithComparerValues with | None -> () | Some v -> yield v match x.GeneratedHashAndEqualsValues with | None -> () - | Some (v1,v2) -> yield v1; yield v2 + | Some (v1, v2) -> yield v1; yield v2 match x.GeneratedHashAndEqualsWithComparerValues with | None -> () - | Some (v1,v2,v3) -> yield v1; yield v2; yield v3 ] + | Some (v1, v2, v3) -> yield v1; yield v2; yield v3 ] /// Gets the data indicating the compiled representation of a type or module in terms of Abstract IL data structures. @@ -1213,15 +1213,15 @@ and /// Represents a type definition, exception definition, module definition or | TProvidedNamespaceExtensionPoint _ -> failwith "No compiled representation for provided namespace" | _ -> #endif - let ilTypeRefForCompilationPath (CompPath(sref,p)) item = + let ilTypeRefForCompilationPath (CompPath(sref, p)) item = let rec top racc p = match p with - | [] -> ILTypeRef.Create(sref,[],textOfPath (List.rev (item::racc))) - | (h,istype)::t -> + | [] -> ILTypeRef.Create(sref, [], textOfPath (List.rev (item::racc))) + | (h, istype)::t -> match istype with | FSharpModuleWithSuffix | ModuleOrType -> let outerTypeName = (textOfPath (List.rev (h::racc))) - ILTypeRef.Create(sref, (outerTypeName :: List.map (fun (nm,_) -> nm) t),item) + ILTypeRef.Create(sref, (outerTypeName :: List.map (fun (nm, _) -> nm) t), item) | _ -> top (h::racc) t top [] p @@ -1230,7 +1230,7 @@ and /// Represents a type definition, exception definition, module definition or cached x.CompiledReprCache (fun () -> match x.ExceptionInfo with | TExnAbbrevRepr ecref2 -> ecref2.CompiledRepresentation - | TExnAsmRepr tref -> CompiledTypeRepr.ILAsmNamed(tref, AsObject, Some (mkILTy AsObject (mkILTySpec (tref,[])))) + | TExnAsmRepr tref -> CompiledTypeRepr.ILAsmNamed(tref, AsObject, Some (mkILTy AsObject (mkILTySpec (tref, [])))) | _ -> match x.TypeReprInfo with | TAsmRepr ty -> CompiledTypeRepr.ILAsmOpen ty @@ -1238,12 +1238,12 @@ and /// Represents a type definition, exception definition, module definition or let boxity = if x.IsStructOrEnumTycon then AsValue else AsObject let ilTypeRef = match x.TypeReprInfo with - | TILObjectRepr (TILObjectReprData(ilScopeRef,ilEnclosingTypeDefs,ilTypeDef)) -> IL.mkRefForNestedILTypeDef ilScopeRef (ilEnclosingTypeDefs, ilTypeDef) + | TILObjectRepr (TILObjectReprData(ilScopeRef, ilEnclosingTypeDefs, ilTypeDef)) -> IL.mkRefForNestedILTypeDef ilScopeRef (ilEnclosingTypeDefs, ilTypeDef) | _ -> ilTypeRefForCompilationPath x.CompilationPath x.CompiledName // Pre-allocate a ILType for monomorphic types, to reduce memory usage from Abstract IL nodes let ilTypeOpt = match x.TyparsNoRange with - | [] -> Some (mkILTy boxity (mkILTySpec (ilTypeRef,[]))) + | [] -> Some (mkILTy boxity (mkILTySpec (ilTypeRef, []))) | _ -> None CompiledTypeRepr.ILAsmNamed (ilTypeRef, boxity, ilTypeOpt)) @@ -1478,8 +1478,8 @@ and member info.IsGenerated = not info.IsErased - member info.BaseTypeForErased (m,objTy) = - if info.IsErased then info.LazyBaseType.Force (m,objTy) + member info.BaseTypeForErased (m, objTy) = + if info.IsErased then info.LazyBaseType.Force (m, objTy) else failwith "expect erased type" [] @@ -1623,12 +1623,12 @@ and member uc.DefinitionRange = match uc.OtherRangeOpt with - | Some (m,true) -> m + | Some (m, true) -> m | _ -> uc.Range member uc.SigRange = match uc.OtherRangeOpt with - | Some (m,false) -> m + | Some (m, false) -> m | _ -> uc.Range member uc.DisplayName = uc.Id.idText @@ -1811,7 +1811,7 @@ and [] let modulesByDemangledNameCache : NameMap option ref = ref None let exconsByDemangledNameCache : NameMap option ref = ref None let tyconsByDemangledNameAndArityCache: LayeredMap option ref = ref None - let tyconsByAccessNamesCache : LayeredMultiMap option ref = ref None + let tyconsByAccessNamesCache : LayeredMultiMap option ref = ref None let tyconsByMangledNameCache : NameMap option ref = ref None let allEntitiesByMangledNameCache : NameMap option ref = ref None let allValsAndMembersByPartialLinkageKeyCache : MultiMap option ref = ref None @@ -1870,7 +1870,7 @@ and [] /// Get a table of types defined within this module, namespace or type. The /// table is indexed by both name and generic arity. This means that for generic - /// types "List`1", the entry (List,1) will be present. + /// types "List`1", the entry (List, 1) will be present. member mtyp.TypesByDemangledNameAndArity m = cacheOptRef tyconsByDemangledNameAndArityCache (fun () -> LayeredMap.Empty.AddAndMarkAsCollapsible( mtyp.TypeAndExceptionDefinitions |> List.map (fun (tc:Tycon) -> KeyTyconByDemangledNameAndArity tc.LogicalName (tc.Typars m) tc) |> List.toArray)) @@ -1904,7 +1904,7 @@ and [] let addEntityByMangledName (x:Entity) tab = NameMap.add x.LogicalName x tab QueueList.foldBack addEntityByMangledName entities Map.empty - /// Get a table of values and members indexed by partial linkage key, which includes name, the mangled name of the parent type (if any), + /// Get a table of values and members indexed by partial linkage key, which includes name, the mangled name of the parent type (if any), /// and the method argument count (if any). member mtyp.AllValsAndMembersByPartialLinkageKey = let addValByMangledName (x:Val) tab = @@ -1917,12 +1917,12 @@ and [] QueueList.foldBack addValByMangledName vals MultiMap.empty) /// Try to find the member with the given linkage key in the given module. - member mtyp.TryLinkVal(ccu:CcuThunk,key:ValLinkageFullKey) = + member mtyp.TryLinkVal(ccu:CcuThunk, key:ValLinkageFullKey) = mtyp.AllValsAndMembersByPartialLinkageKey |> MultiMap.find key.PartialKey |> List.tryFind (fun v -> match key.TypeForLinkage with | None -> true - | Some keyTy -> ccu.MemberSignatureEquality(keyTy,v.Type)) + | Some keyTy -> ccu.MemberSignatureEquality(keyTy, v.Type)) |> ValueOptionInternal.ofOption /// Get a table of values indexed by logical name @@ -1980,24 +1980,24 @@ and Construct = #if !NO_EXTENSIONTYPING - static member NewProvidedTyconRepr(resolutionEnvironment,st:Tainted,importProvidedType,isSuppressRelocate,m) = + static member NewProvidedTyconRepr(resolutionEnvironment, st:Tainted, importProvidedType, isSuppressRelocate, m) = - let isErased = st.PUntaint((fun st -> st.IsErased),m) + let isErased = st.PUntaint((fun st -> st.IsErased), m) let lazyBaseTy = LazyWithContext.Create - ((fun (m,objTy) -> + ((fun (m, objTy) -> let baseSystemTy = st.PApplyOption((fun st -> match st.BaseType with null -> None | ty -> Some ty), m) match baseSystemTy with | None -> objTy - | Some t -> importProvidedType t), + | Some t -> importProvidedType t), ErrorLogger.findOriginalException) TProvidedTypeExtensionPoint { ResolutionEnvironment=resolutionEnvironment ProvidedType=st LazyBaseType=lazyBaseTy - UnderlyingTypeOfEnum = (fun () -> importProvidedType (st.PApply((fun st -> st.GetEnumUnderlyingType()),m))) + UnderlyingTypeOfEnum = (fun () -> importProvidedType (st.PApply((fun st -> st.GetEnumUnderlyingType()), m))) IsDelegate = (fun () -> st.PUntaint((fun st -> let baseType = st.BaseType match baseType with @@ -2016,21 +2016,14 @@ and Construct = static member NewProvidedTycon(resolutionEnvironment, st:Tainted, importProvidedType, isSuppressRelocate, m, ?access, ?cpath) = let stamp = newStamp() let name = st.PUntaint((fun st -> st.Name), m) - let id = ident (name,m) + let id = ident (name, m) let kind = let isMeasure = - st.PApplyWithProvider((fun (st,provider) -> + st.PApplyWithProvider((fun (st, provider) -> let findAttrib (ty:System.Type) (a:CustomAttributeData) = (a.Constructor.DeclaringType.FullName = ty.FullName) let ty = st.RawSystemType -#if FX_RESHAPED_REFLECTION - let ty = ty.GetTypeInfo() -#endif -#if FX_NO_CUSTOMATTRIBUTEDATA - provider.GetMemberCustomAttributesData(ty) -#else ignore provider ty.CustomAttributes -#endif |> Seq.exists (findAttrib typeof)), m) .PUntaintNoFailure(fun x -> x) if isMeasure then TyparKind.Measure else TyparKind.Type @@ -2043,8 +2036,8 @@ and Construct = match cpath with | None -> let ilScopeRef = st.TypeProviderAssemblyRef - let enclosingName = ExtensionTyping.GetFSharpPathToProvidedType(st,m) - CompPath(ilScopeRef,enclosingName |> List.map(fun id->id,ModuleOrNamespaceKind.Namespace)) + let enclosingName = ExtensionTyping.GetFSharpPathToProvidedType(st, m) + CompPath(ilScopeRef, enclosingName |> List.map(fun id->id, ModuleOrNamespaceKind.Namespace)) | Some p -> p let pubpath = cpath.NestedPublicPath id @@ -2054,7 +2047,7 @@ and Construct = { entity_stamp=stamp entity_logical_name=name entity_range=m - entity_flags=EntityFlags(usesPrefixDisplay=false, isModuleOrNamespace=false,preEstablishedHasDefaultCtor=false, hasSelfReferentialCtor=false, isStructRecordOrUnionType=false) + entity_flags=EntityFlags(usesPrefixDisplay=false, isModuleOrNamespace=false, preEstablishedHasDefaultCtor=false, hasSelfReferentialCtor=false, isStructRecordOrUnionType=false) entity_attribs=[] // fetched on demand via est.fs API entity_typars= LazyWithContext.NotLazy [] entity_tycon_repr = repr @@ -2078,7 +2071,7 @@ and Construct = entity_range = id.idRange entity_stamp=stamp entity_modul_contents = mtype - entity_flags=EntityFlags(usesPrefixDisplay=false, isModuleOrNamespace=true, preEstablishedHasDefaultCtor=false, hasSelfReferentialCtor=false,isStructRecordOrUnionType=false) + entity_flags=EntityFlags(usesPrefixDisplay=false, isModuleOrNamespace=true, preEstablishedHasDefaultCtor=false, hasSelfReferentialCtor=false, isStructRecordOrUnionType=false) entity_typars=LazyWithContext.NotLazy [] entity_tycon_repr = TNoRepr entity_tycon_tcaug=TyconAugmentation.Create() @@ -2298,13 +2291,13 @@ and member x.SetIdent id = x.typar_id <- id /// Sets the rigidity of a type variable - member x.SetRigidity b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, b, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + member x.SetRigidity b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, b, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) /// Sets whether a type variable is compiler generated - member x.SetCompilerGenerated b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, b, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + member x.SetCompilerGenerated b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, b, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) /// Sets whether a type variable has a static requirement - member x.SetStaticReq b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, b, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + member x.SetStaticReq b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, b, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) /// Sets whether a type variable is required at runtime member x.SetDynamicReq b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, b , flags.EqualityConditionalOn, flags.ComparisonConditionalOn) @@ -2375,22 +2368,22 @@ and [] TraitConstraintInfo = - /// TTrait(tys,nm,memFlags,argtys,rty,colution) + /// TTrait(tys, nm, memFlags, argtys, rty, colution) /// /// Indicates the signature of a member constraint. Contains a mutable solution cell /// to store the inferred solution of the constraint. | TTrait of TTypes * string * MemberFlags * TTypes * TType option * TraitConstraintSln option ref /// Get the member name associated with the member constraint. - member x.MemberName = (let (TTrait(_,nm,_,_,_,_)) = x in nm) + member x.MemberName = (let (TTrait(_, nm, _, _, _, _)) = x in nm) /// Get the return type recorded in the member constraint. - member x.ReturnType = (let (TTrait(_,_,_,_,ty,_)) = x in ty) + member x.ReturnType = (let (TTrait(_, _, _, _, ty, _)) = x in ty) /// Get or set the solution of the member constraint during inference member x.Solution - with get() = (let (TTrait(_,_,_,_,_,sln)) = x in sln.Value) - and set v = (let (TTrait(_,_,_,_,_,sln)) = x in sln.Value <- v) + with get() = (let (TTrait(_, _, _, _, _, sln)) = x in sln.Value) + and set v = (let (TTrait(_, _, _, _, _, sln)) = x in sln.Value <- v) [] member x.DebugText = x.ToString() @@ -2468,7 +2461,7 @@ and [] /// amongst all those in a ModuleOrNamespace. and [< (* NoEquality; NoComparison; *) StructuredFormatDisplay("{DebugText}")>] - ValLinkageFullKey(partialKey: ValLinkagePartialKey, typeForLinkage:TType option) = + ValLinkageFullKey(partialKey: ValLinkagePartialKey, typeForLinkage:TType option) = /// The partial information used to index the value in a ModuleOrNamespace. member x.PartialKey = partialKey @@ -2575,13 +2568,13 @@ and [] /// Range of the definition (implementation) of the value, used by Visual Studio member x.DefinitionRange = match x.val_opt_data with - | Some { val_other_range = Some(m,true) } -> m + | Some { val_other_range = Some(m, true) } -> m | _ -> x.val_range /// Range of the definition (signature) of the value, used by Visual Studio member x.SigRange = match x.val_opt_data with - | Some { val_other_range = Some(m,false) } -> m + | Some { val_other_range = Some(m, false) } -> m | _ -> x.val_range /// The place where the value was defined. @@ -2629,7 +2622,7 @@ and [] | Some optData -> optData.val_repr_info | _ -> None - member x.Id = ident(x.LogicalName,x.Range) + member x.Id = ident(x.LogicalName, x.Range) /// Is this represented as a "top level" static binding (i.e. a static field, static member, /// instance member), rather than an "inner" binding that may result in a closure. @@ -2723,7 +2716,7 @@ and [] /// Indicates if the backing field for a static value is suppressed. member x.IsCompiledAsStaticPropertyWithoutField = - let hasValueAsStaticProperty = x.Attribs |> List.exists(fun (Attrib(tc,_,_,_,_,_,_)) -> tc.CompiledName = "ValueAsStaticPropertyAttribute") + let hasValueAsStaticProperty = x.Attribs |> List.exists(fun (Attrib(tc, _, _, _, _, _, _)) -> tc.CompiledName = "ValueAsStaticPropertyAttribute") x.val_flags.IsCompiledAsStaticPropertyWithoutField || hasValueAsStaticProperty /// Indicates if the value is pinned/fixed @@ -2794,7 +2787,7 @@ and [] member x.TopValDeclaringEntity = match x.DeclaringEntity with | Parent tcref -> tcref - | ParentNone -> error(InternalError("TopValDeclaringEntity: does not have a parent",x.Range)) + | ParentNone -> error(InternalError("TopValDeclaringEntity: does not have a parent", x.Range)) member x.HasDeclaringEntity = match x.DeclaringEntity with @@ -2805,7 +2798,7 @@ and [] member x.MemberApparentEntity : TyconRef = match x.MemberInfo with | Some membInfo -> membInfo.ApparentEnclosingEntity - | None -> error(InternalError("MemberApparentEntity",x.Range)) + | None -> error(InternalError("MemberApparentEntity", x.Range)) /// Get the number of 'this'/'self' object arguments for the member. Instance extension members return '1'. member v.NumObjArgs = @@ -2837,7 +2830,7 @@ and [] | Parent eref -> match eref.PublicPath with | None -> None - | Some p -> Some(ValPubPath(p,x.GetLinkageFullKey())) + | Some p -> Some(ValPubPath(p, x.GetLinkageFullKey())) | ParentNone -> None @@ -2850,19 +2843,19 @@ and [] /// Get the type of the value including any generic type parameters member x.TypeScheme = match x.Type with - | TType_forall(tps,tau) -> tps,tau - | ty -> [],ty + | TType_forall(tps, tau) -> tps, tau + | ty -> [], ty /// Get the type of the value after removing any generic type parameters member x.TauType = match x.Type with - | TType_forall(_,tau) -> tau + | TType_forall(_, tau) -> tau | ty -> ty /// Get the generic type parameters for the value member x.Typars = match x.Type with - | TType_forall(tps,_) -> tps + | TType_forall(tps, _) -> tps | _ -> [] /// The name of the method. @@ -2907,7 +2900,7 @@ and [] // // However we don't need this for CompilerGenerated members such as the implementations of IComparable if x.IsCompiledAsTopLevel && not x.IsMember && (x.IsCompilerGenerated || not x.IsMemberOrModuleBinding) then - globalStableNameGenerator.GetUniqueCompilerGeneratedName(givenName,x.Range,x.Stamp) + globalStableNameGenerator.GetUniqueCompilerGeneratedName(givenName, x.Range, x.Stamp) else givenName @@ -3115,18 +3108,18 @@ and // In this case, we're safely in the realm of types. Just iterate through the nested // types until i = path.Length-1. Create the Tycon's as needed - let rec tryResolveNestedTypeOf(parentEntity:Entity,resolutionEnvironment,st:Tainted,i) = - match st.PApply((fun st -> st.GetNestedType path.[i]),m) with + let rec tryResolveNestedTypeOf(parentEntity:Entity, resolutionEnvironment, st:Tainted, i) = + match st.PApply((fun st -> st.GetNestedType path.[i]), m) with | Tainted.Null -> ValueNone | st -> let newEntity = Construct.NewProvidedTycon(resolutionEnvironment, st, ccu.ImportProvidedType, false, m) parentEntity.ModuleOrNamespaceType.AddProvidedTypeEntity(newEntity) if i = path.Length-1 then ValueSome(newEntity) - else tryResolveNestedTypeOf(newEntity,resolutionEnvironment,st,i+1) + else tryResolveNestedTypeOf(newEntity, resolutionEnvironment, st, i+1) - tryResolveNestedTypeOf(entity,resolutionEnvironment,st,i) + tryResolveNestedTypeOf(entity, resolutionEnvironment, st, i) - | TProvidedNamespaceExtensionPoint(resolutionEnvironment,resolvers) -> + | TProvidedNamespaceExtensionPoint(resolutionEnvironment, resolvers) -> // In this case, we're still in the realm of extensible namespaces. // <----entity--> @@ -3151,12 +3144,12 @@ and [ for resolver in resolvers do let moduleOrNamespace = if j = 0 then null else path.[0..j-1] let typename = path.[j] - let resolution = ExtensionTyping.TryLinkProvidedType(resolver,moduleOrNamespace,typename,m) + let resolution = ExtensionTyping.TryLinkProvidedType(resolver, moduleOrNamespace, typename, m) match resolution with | None | Some (Tainted.Null) -> () - | Some st -> yield (resolver,st) ] + | Some st -> yield (resolver, st) ] match matched with - | [(_,st)] -> + | [(_, st)] -> // 'entity' is at position i in the dereference chain. We resolved to position 'j'. // Inject namespaces until we're an position j, and then inject the type. // Note: this is similar to code in CompileOps.fs @@ -3170,7 +3163,7 @@ and let newEntity = Construct.NewModuleOrNamespace (Some cpath) - (TAccess []) (ident(path.[k],m)) XmlDoc.Empty [] + (TAccess []) (ident(path.[k], m)) XmlDoc.Empty [] (MaybeLazy.Strict (Construct.NewEmptyModuleOrNamespaceType Namespace)) entity.ModuleOrNamespaceType.AddModuleOrNamespaceByMutation(newEntity) injectNamespacesFromIToJ newEntity (k+1) @@ -3195,7 +3188,7 @@ and /// Try to link a non-local entity reference to an actual entity member nleref.TryDeref(canError) = - let (NonLocalEntityRef(ccu,path)) = nleref + let (NonLocalEntityRef(ccu, path)) = nleref if canError then ccu.EnsureDerefable(path) @@ -3208,7 +3201,7 @@ and // Look for a forwarder for each prefix-path let rec tryForwardPrefixPath i = if i < path.Length then - match ccu.TryForward(path.[0..i-1],path.[i]) with + match ccu.TryForward(path.[0..i-1], path.[i]) with // OK, found a forwarder, now continue with the lookup to find the nested type | Some tcref -> NonLocalEntityRef.TryDerefEntityPath(ccu, path, (i+1), tcref.Deref) | None -> tryForwardPrefixPath (i+1) @@ -3218,12 +3211,12 @@ and /// Get the CCU referenced by the nonlocal reference. member nleref.Ccu = - let (NonLocalEntityRef(ccu,_)) = nleref + let (NonLocalEntityRef(ccu, _)) = nleref ccu /// Get the path into the CCU referenced by the nonlocal reference. member nleref.Path = - let (NonLocalEntityRef(_,p)) = nleref + let (NonLocalEntityRef(_, p)) = nleref p member nleref.DisplayName = @@ -3331,7 +3324,7 @@ and /// The display name of the namespace, module or type, e.g. List instead of List`1, not including static parameters member x.DisplayName = x.Deref.DisplayName - /// The display name of the namespace, module or type with <_,_,_> added for generic types, including static parameters + /// The display name of the namespace, module or type with <_, _, _> added for generic types, including static parameters member x.DisplayNameWithStaticParametersAndUnderscoreTypars = x.Deref.DisplayNameWithStaticParametersAndUnderscoreTypars /// The display name of the namespace, module or type, e.g. List instead of List`1, including static parameters @@ -3409,7 +3402,7 @@ and /// Get the value representing the accessibility of an F# type definition or module. member x.Accessibility = x.Deref.Accessibility - /// Indicates the type prefers the "tycon" syntax for display etc. + /// Indicates the type prefers the "tycon" syntax for display etc. member x.IsPrefixDisplay = x.Deref.IsPrefixDisplay /// Indicates the "tycon blob" is actually a module @@ -3844,10 +3837,10 @@ and | UCRef of TyconRef * string /// Get a reference to the type containing this union case - member x.TyconRef = let (UCRef(tcref,_)) = x in tcref + member x.TyconRef = let (UCRef(tcref, _)) = x in tcref /// Get the name of this union case - member x.CaseName = let (UCRef(_,nm)) = x in nm + member x.CaseName = let (UCRef(_, nm)) = x in nm /// Get the Entity for the type containing this union case member x.Tycon = x.TyconRef.Deref @@ -3902,17 +3895,17 @@ and | RFRef of TyconRef * string /// Get a reference to the type containing this union case - member x.TyconRef = let (RFRef(tcref,_)) = x in tcref + member x.TyconRef = let (RFRef(tcref, _)) = x in tcref /// Get the name off the field - member x.FieldName = let (RFRef(_,id)) = x in id + member x.FieldName = let (RFRef(_, id)) = x in id /// Get the Entity for the type containing this union case member x.Tycon = x.TyconRef.Deref /// Dereference the reference member x.RecdField = - let (RFRef(tcref,id)) = x + let (RFRef(tcref, id)) = x match tcref.GetFieldByName id with | Some res -> res | None -> error(InternalError(sprintf "field %s not found in type %s" id tcref.LogicalName, tcref.Range)) @@ -3933,7 +3926,7 @@ and member x.SigRange = x.RecdField.SigRange member x.Index = - let (RFRef(tcref,id)) = x + let (RFRef(tcref, id)) = x try // REVIEW: this could be faster, e.g. by storing the index in the NameMap tcref.AllFieldsArray |> Array.findIndex (fun rfspec -> rfspec.Name = id) @@ -3970,7 +3963,7 @@ and /// Indicates the type is a tuple type. elementTypes must be of length 2 or greater. | TType_tuple of TupInfo * TTypes - /// TType_fun(domainType,rangeType). + /// TType_fun(domainType, rangeType). /// /// Indicates the type is a function type | TType_fun of TType * TType @@ -3996,11 +3989,11 @@ and | TType_app (tcref, _tinst) -> tcref.CompilationPath.ILScopeRef.QualifiedName | TType_tuple (_tupInfo, _tinst) -> "" | TType_anon (anonInfo, _tinst) -> defaultArg anonInfo.Assembly.QualifiedName "" - | TType_fun (_d,_r) -> "" + | TType_fun (_d, _r) -> "" | TType_measure _ms -> "" | TType_var tp -> tp.Solution |> function Some sln -> sln.GetAssemblyName() | None -> "" - | TType_ucase (_uc,_tinst) -> - let (TILObjectReprData(scope,_nesting,_definition)) = _uc.Tycon.ILTyconInfo + | TType_ucase (_uc, _tinst) -> + let (TILObjectReprData(scope, _nesting, _definition)) = _uc.Tycon.ILTyconInfo scope.QualifiedName [] @@ -4008,7 +4001,7 @@ and override x.ToString() = match x with - | TType_forall (_tps,ty) -> "forall ... " + ty.ToString() + | TType_forall (_tps, ty) -> "forall ... " + ty.ToString() | TType_app (tcref, tinst) -> tcref.DisplayName + (match tinst with [] -> "" | tys -> "<" + String.concat "," (List.map string tys) + ">") | TType_tuple (tupInfo, tinst) -> (match tupInfo with @@ -4020,8 +4013,8 @@ and | TupInfo.Const false -> "" | TupInfo.Const true -> "struct ") + "{|" + String.concat "," (Seq.map2 (fun nm ty -> nm + " " + string ty + ";") anonInfo.SortedNames tinst) + ")" + "|}" - | TType_fun (d,r) -> "(" + string d + " -> " + string r + ")" - | TType_ucase (uc,tinst) -> "ucase " + uc.CaseName + (match tinst with [] -> "" | tys -> "<" + String.concat "," (List.map string tys) + ">") + | TType_fun (d, r) -> "(" + string d + " -> " + string r + ")" + | TType_ucase (uc, tinst) -> "ucase " + uc.CaseName + (match tinst with [] -> "" | tys -> "<" + String.concat "," (List.map string tys) + ">") | TType_var tp -> match tp.Solution with | None -> tp.DisplayName @@ -4045,7 +4038,7 @@ and [] AnonRecdTypeInfo = // Hash all the data to form a unique stamp let stamp = sha1HashInt64 - [| for c in ccu.AssemblyName do yield byte c; yield byte (int32 c >>> 8); + [| for c in ccu.AssemblyName do yield byte c; yield byte (int32 c >>> 8) match tupInfo with | TupInfo.Const b -> yield (if b then 0uy else 1uy) for id in sortedIds do @@ -4056,7 +4049,7 @@ and [] AnonRecdTypeInfo = /// Get the ILTypeRef for the generated type implied by the anonymous type member x.ILTypeRef = let ilTypeName = sprintf "<>f__AnonymousType%s%u`%d'" (match x.TupInfo with TupInfo.Const b -> if b then "1000" else "") (uint32 x.Stamp) x.SortedIds.Length - mkILTyRef(x.Assembly.ILScopeRef,ilTypeName) + mkILTyRef(x.Assembly.ILScopeRef, ilTypeName) static member NewUnlinked() : AnonRecdTypeInfo = { Assembly = Unchecked.defaultof<_> @@ -4211,7 +4204,7 @@ and member ccu.EnsureDerefable(requiringPath:string[]) = if ccu.IsUnresolvedReference then let path = System.String.Join(".", requiringPath) - raise(UnresolvedPathReferenceNoRange(ccu.name,path)) + raise(UnresolvedPathReferenceNoRange(ccu.name, path)) /// Indicates that this DLL uses F# 2.0+ quotation literals somewhere. This is used to implement a restriction on static linking. member ccu.UsesFSharp20PlusQuotations @@ -4264,7 +4257,7 @@ and member ccu.RootTypeAndExceptionDefinitions = ccu.Contents.ModuleOrNamespaceType.TypeAndExceptionDefinitions /// Create a CCU with the given name and contents - static member Create(nm,x) = + static member Create(nm, x) = { target = x orphanfixup = false name = nm } @@ -4298,9 +4291,9 @@ and | _ -> errorR(Failure("internal error: FixupOrphaned: the ccu thunk for assembly "+x.AssemblyName+" not delayed!")) /// Try to resolve a path into the CCU by referencing the .NET/CLI type forwarder table of the CCU - member ccu.TryForward(nlpath:string[],item:string) : EntityRef option = + member ccu.TryForward(nlpath:string[], item:string) : EntityRef option = ccu.EnsureDerefable(nlpath) - let key = nlpath,item + let key = nlpath, item match ccu.TypeForwarders.TryGetValue key with | true, entity -> Some(entity.Force()) | _ -> None @@ -4369,7 +4362,7 @@ and override x.ToString() = sprintf "%+A" x -/// Attrib(kind,unnamedArgs,propVal,appliedToAGetterOrSetter,targetsOpt,range) +/// Attrib(kind, unnamedArgs, propVal, appliedToAGetterOrSetter, targetsOpt, range) and [] Attrib = @@ -4396,7 +4389,7 @@ and override x.ToString() = sprintf "AttribExpr(...)" -/// AttribNamedArg(name,type,isField,value) +/// AttribNamedArg(name, type, isField, value) and [] AttribNamedArg = @@ -4477,10 +4470,10 @@ and | TCase of DecisionTreeTest * DecisionTree /// Get the discriminator associated with the case - member x.Discriminator = let (TCase(d,_)) = x in d + member x.Discriminator = let (TCase(d, _)) = x in d /// Get the decision tree or a successful test - member x.CaseTree = let (TCase(_,d)) = x in d + member x.CaseTree = let (TCase(_, d)) = x in d [] member x.DebugText = x.ToString() @@ -4545,13 +4538,13 @@ and | TBind of Val * Expr * SequencePointInfoForBinding /// The value being bound - member x.Var = (let (TBind(v,_,_)) = x in v) + member x.Var = (let (TBind(v, _, _)) = x in v) /// The expression the value is being bound to - member x.Expr = (let (TBind(_,e,_)) = x in e) + member x.Expr = (let (TBind(_, e, _)) = x in e) /// The information about whether to emit a sequence point for the binding - member x.SequencePointInfo = (let (TBind(_,_,sp)) = x in sp) + member x.SequencePointInfo = (let (TBind(_, _, sp)) = x in sp) [] member x.DebugText = x.ToString() @@ -4566,13 +4559,13 @@ and | APElemRef of ActivePatternInfo * ValRef * int /// Get the full information about the active pattern being referred to - member x.ActivePatternInfo = (let (APElemRef(info,_,_)) = x in info) + member x.ActivePatternInfo = (let (APElemRef(info, _, _)) = x in info) /// Get a reference to the value for the active pattern being referred to - member x.ActivePatternVal = (let (APElemRef(_,vref,_)) = x in vref) + member x.ActivePatternVal = (let (APElemRef(_, vref, _)) = x in vref) /// Get the index of the active pattern element within the overall active pattern - member x.CaseIndex = (let (APElemRef(_,_,n)) = x in n) + member x.CaseIndex = (let (APElemRef(_, _, n)) = x in n) [] member x.DebugText = x.ToString() @@ -4588,26 +4581,26 @@ and | ValReprInfo of TyparReprInfo list * ArgReprInfo list list * ArgReprInfo /// Get the extra information about the arguments for the value - member x.ArgInfos = (let (ValReprInfo(_,args,_)) = x in args) + member x.ArgInfos = (let (ValReprInfo(_, args, _)) = x in args) /// Get the number of curried arguments of the value - member x.NumCurriedArgs = (let (ValReprInfo(_,args,_)) = x in args.Length) + member x.NumCurriedArgs = (let (ValReprInfo(_, args, _)) = x in args.Length) /// Get the number of type parameters of the value - member x.NumTypars = (let (ValReprInfo(n,_,_)) = x in n.Length) + member x.NumTypars = (let (ValReprInfo(n, _, _)) = x in n.Length) /// Indicates if the value has no arguments - neither type parameters nor value arguments - member x.HasNoArgs = (let (ValReprInfo(n,args,_)) = x in n.IsEmpty && args.IsEmpty) + member x.HasNoArgs = (let (ValReprInfo(n, args, _)) = x in n.IsEmpty && args.IsEmpty) /// Get the number of tupled arguments in each curried argument position - member x.AritiesOfArgs = (let (ValReprInfo(_,args,_)) = x in List.map List.length args) + member x.AritiesOfArgs = (let (ValReprInfo(_, args, _)) = x in List.map List.length args) /// Get the kind of each type parameter - member x.KindsOfTypars = (let (ValReprInfo(n,_,_)) = x in n |> List.map (fun (TyparReprInfo(_,k)) -> k)) + member x.KindsOfTypars = (let (ValReprInfo(n, _, _)) = x in n |> List.map (fun (TyparReprInfo(_, k)) -> k)) /// Get the total number of arguments member x.TotalArgCount = - let (ValReprInfo(_,args,_)) = x + let (ValReprInfo(_, args, _)) = x // This is List.sumBy List.length args // We write this by hand as it can be a performance bottleneck in LinkagePartialKey let rec loop (args:ArgReprInfo list list) acc = @@ -4847,7 +4840,7 @@ and /// Operation nodes representing C-style operations on byrefs and mutable vals (l-values) | LValueOp of LValueOperation * ValRef - /// ILCall(useCallvirt,isProtected,valu,newobj,valUseFlags,isProp,noTailCall,mref,actualTypeInst,actualMethInst, retTy) + /// ILCall(useCallvirt, isProtected, valu, newobj, valUseFlags, isProp, noTailCall, mref, actualTypeInst, actualMethInst, retTy) /// /// IL method calls. /// value -- is the object a value type? @@ -4947,14 +4940,14 @@ and StaticOptimization = /// A representation of a method in an object expression. /// -/// TObjExprMethod(slotsig,attribs,methTyparsOfOverridingMethod,methodParams,methodBodyExpr,m) +/// TObjExprMethod(slotsig, attribs, methTyparsOfOverridingMethod, methodParams, methodBodyExpr, m) and [] ObjExprMethod = | TObjExprMethod of SlotSig * Attribs * Typars * Val list list * Expr * range - member x.Id = let (TObjExprMethod(slotsig,_,_,_,_,m)) = x in mkSynId m slotsig.Name + member x.Id = let (TObjExprMethod(slotsig, _, _, _, _, m)) = x in mkSynId m slotsig.Name [] member x.DebugText = x.ToString() @@ -4963,24 +4956,24 @@ and /// Represents an abstract method slot, or delegate signature. /// -/// TSlotSig(methodName,declaringType,declaringTypeParameters,methodTypeParameters,slotParameters,returnTy) +/// TSlotSig(methodName, declaringType, declaringTypeParameters, methodTypeParameters, slotParameters, returnTy) and [] SlotSig = | TSlotSig of string * TType * Typars * Typars * SlotParam list list * TType option - member ss.Name = let (TSlotSig(nm,_,_,_,_,_)) = ss in nm + member ss.Name = let (TSlotSig(nm, _, _, _, _, _)) = ss in nm - member ss.ImplementedType = let (TSlotSig(_,ty,_,_,_,_)) = ss in ty + member ss.ImplementedType = let (TSlotSig(_, ty, _, _, _, _)) = ss in ty - member ss.ClassTypars = let (TSlotSig(_,_,ctps,_,_,_)) = ss in ctps + member ss.ClassTypars = let (TSlotSig(_, _, ctps, _, _, _)) = ss in ctps - member ss.MethodTypars = let (TSlotSig(_,_,_,mtps,_,_)) = ss in mtps + member ss.MethodTypars = let (TSlotSig(_, _, _, mtps, _, _)) = ss in mtps - member ss.FormalParams = let (TSlotSig(_,_,_,_,ps,_)) = ss in ps + member ss.FormalParams = let (TSlotSig(_, _, _, _, ps, _)) = ss in ps - member ss.FormalReturnType = let (TSlotSig(_,_,_,_,_,rt)) = ss in rt + member ss.FormalReturnType = let (TSlotSig(_, _, _, _, _, rt)) = ss in rt [] member x.DebugText = x.ToString() @@ -4989,13 +4982,13 @@ and /// Represents a parameter to an abstract method slot. /// -/// TSlotParam(nm,ty,inFlag,outFlag,optionalFlag,attribs) +/// TSlotParam(nm, ty, inFlag, outFlag, optionalFlag, attribs) and [] SlotParam = | TSlotParam of string option * TType * bool (* in *) * bool (* out *) * bool (* optional *) * Attribs - member x.Type = let (TSlotParam(_,ty,_,_,_,_)) = x in ty + member x.Type = let (TSlotParam(_, ty, _, _, _, _)) = x in ty [] member x.DebugText = x.ToString() @@ -5013,7 +5006,7 @@ and * ModuleOrNamespaceExpr * range - member x.Type = let (ModuleOrNamespaceExprWithSig(mtyp,_,_)) = x in mtyp + member x.Type = let (ModuleOrNamespaceExprWithSig(mtyp, _, _)) = x in mtyp [] member x.DebugText = x.ToString() @@ -5066,7 +5059,7 @@ and /// Represents a complete typechecked implementation file, including its typechecked signature if any. /// -/// TImplFile(qualifiedNameOfFile,pragmas,implementationExpressionWithSignature,hasExplicitEntryPoint,isScript) +/// TImplFile(qualifiedNameOfFile, pragmas, implementationExpressionWithSignature, hasExplicitEntryPoint, isScript) and [] TypedImplFile = @@ -5192,8 +5185,8 @@ and /// An AbstractIL type representation that may include type variables // This case is only used for types defined in the F# library by their translation to ILASM types, e.g. // type ``[]``<'T> = (# "!0[]" #) - // type ``[,]``<'T> = (# "!0[0 ...,0 ...]" #) - // type ``[,,]``<'T> = (# "!0[0 ...,0 ...,0 ...]" #) + // type ``[, ]``<'T> = (# "!0[0 ..., 0 ...]" #) + // type ``[, , ]``<'T> = (# "!0[0 ..., 0 ..., 0 ...]" #) // type byref<'T> = (# "!0&" #) // type nativeptr<'T when 'T : unmanaged> = (# "native int" #) // type ilsigptr<'T> = (# "!0*" #) @@ -5223,15 +5216,15 @@ module ValReprInfo = let selfMetadata = unnamedTopArg - let emptyValData = ValReprInfo([],[],unnamedRetVal) + let emptyValData = ValReprInfo([], [], unnamedRetVal) let InferTyparInfo (tps:Typar list) = tps |> List.map (fun tp -> TyparReprInfo(tp.Id, tp.Kind)) let InferArgReprInfo (v:Val) : ArgReprInfo = { Attribs = []; Name= Some v.Id } - let InferArgReprInfos (vs:Val list list) = ValReprInfo([],List.mapSquared InferArgReprInfo vs,unnamedRetVal) + let InferArgReprInfos (vs:Val list list) = ValReprInfo([], List.mapSquared InferArgReprInfo vs, unnamedRetVal) - let HasNoArgs (ValReprInfo(n,args,_)) = n.IsEmpty && args.IsEmpty + let HasNoArgs (ValReprInfo(n, args, _)) = n.IsEmpty && args.IsEmpty //--------------------------------------------------------------------------- // Basic properties via functions (old style) @@ -5254,9 +5247,9 @@ let mkRawStructTupleTy tys = TType_tuple (tupInfoStruct, tys) // make up the entire compilation unit //--------------------------------------------------------------------------- -let mapTImplFile f (TImplFile(fragName,pragmas,moduleExpr,hasExplicitEntryPoint,isScript,anonRecdTypes)) = TImplFile(fragName, pragmas,f moduleExpr,hasExplicitEntryPoint,isScript,anonRecdTypes) -let mapAccImplFile f z (TImplFile(fragName,pragmas,moduleExpr,hasExplicitEntryPoint,isScript,anonRecdTypes)) = let moduleExpr,z = f z moduleExpr in TImplFile(fragName,pragmas,moduleExpr,hasExplicitEntryPoint,isScript,anonRecdTypes), z -let foldTImplFile f z (TImplFile(_,_,moduleExpr,_,_,_)) = f z moduleExpr +let mapTImplFile f (TImplFile(fragName, pragmas, moduleExpr, hasExplicitEntryPoint, isScript, anonRecdTypes)) = TImplFile(fragName, pragmas, f moduleExpr, hasExplicitEntryPoint, isScript, anonRecdTypes) +let mapAccImplFile f z (TImplFile(fragName, pragmas, moduleExpr, hasExplicitEntryPoint, isScript, anonRecdTypes)) = let moduleExpr, z = f z moduleExpr in TImplFile(fragName, pragmas, moduleExpr, hasExplicitEntryPoint, isScript, anonRecdTypes), z +let foldTImplFile f z (TImplFile(_, _, moduleExpr, _, _, _)) = f z moduleExpr //--------------------------------------------------------------------------- // Equality relations on locally defined things @@ -5305,7 +5298,7 @@ let (|ERefLocal|ERefNonLocal|) (x: EntityRef) = let mkLocalTyconRef x = ERefLocal x -let mkNonLocalEntityRef ccu mp = NonLocalEntityRef(ccu,mp) +let mkNonLocalEntityRef ccu mp = NonLocalEntityRef(ccu, mp) let mkNestedNonLocalEntityRef (nleref:NonLocalEntityRef) id = mkNonLocalEntityRef nleref.Ccu (Array.append nleref.Path [| id |]) let mkNonLocalTyconRef nleref id = ERefNonLocal (mkNestedNonLocalEntityRef nleref id) let mkNonLocalTyconRefPreResolved x nleref id = ERefNonLocalPreResolved x (mkNestedNonLocalEntityRef nleref id) @@ -5442,7 +5435,7 @@ let mkNestedValRef (cref:EntityRef) (v:Val) : ValRef = let rescopePubPathToParent viewedCcu (PubPath(p)) = NonLocalEntityRef(viewedCcu, p.[0..p.Length-2]) /// From Ref_private to Ref_nonlocal when exporting data. -let rescopePubPath viewedCcu (PubPath(p)) = NonLocalEntityRef(viewedCcu,p) +let rescopePubPath viewedCcu (PubPath(p)) = NonLocalEntityRef(viewedCcu, p) //--------------------------------------------------------------------------- // Equality between TAST items. @@ -5476,7 +5469,7 @@ let arrayPathEq (y1:string[]) (y2:string[]) = (let rec loop i = (i >= len1) || (y1.[i] = y2.[i] && loop (i+1)) loop 0) -let nonLocalRefEq (NonLocalEntityRef(x1,y1) as smr1) (NonLocalEntityRef(x2,y2) as smr2) = +let nonLocalRefEq (NonLocalEntityRef(x1, y1) as smr1) (NonLocalEntityRef(x2, y2) as smr2) = smr1 === smr2 || (ccuEq x1 x2 && arrayPathEq y1 y2) /// This predicate tests if non-local resolution paths are definitely known to resolve @@ -5484,7 +5477,7 @@ let nonLocalRefEq (NonLocalEntityRef(x1,y1) as smr1) (NonLocalEntityRef(x2,y2) a /// different entities. Two references with the same named paths may resolve to the same /// entities even if they reference through different CCUs, because one reference /// may be forwarded to another via a .NET TypeForwarder. -let nonLocalRefDefinitelyNotEq (NonLocalEntityRef(_,y1)) (NonLocalEntityRef(_,y2)) = +let nonLocalRefDefinitelyNotEq (NonLocalEntityRef(_, y1)) (NonLocalEntityRef(_, y2)) = not (arrayPathEq y1 y2) let pubPathEq (PubPath path1) (PubPath path2) = arrayPathEq path1 path2 @@ -5499,7 +5492,7 @@ let fslibRefEq (nlr1:NonLocalEntityRef) (PubPath(path2)) = // Entity's from signatures rather than Entity's from implementations. This means backup, alternative // equality comparison techniques are needed when compiling fslib itself. let fslibEntityRefEq fslibCcu (eref1:EntityRef) (eref2:EntityRef) = - match eref1,eref2 with + match eref1, eref2 with | (ERefNonLocal nlr1, ERefLocal x2) | (ERefLocal x2, ERefNonLocal nlr1) -> ccuEq nlr1.Ccu fslibCcu && @@ -5525,7 +5518,7 @@ let fslibValRefEq fslibCcu vref1 vref2 = | (VRefLocal x2, VRefNonLocal nlr1) -> ccuEq nlr1.Ccu fslibCcu && match x2.PublicPath with - | Some (ValPubPath(pp2,nm2)) -> + | Some (ValPubPath(pp2, nm2)) -> // Note: this next line is just comparing the values by name, and not even the partial linkage data // This relies on the fact that the compiler doesn't use any references to // entities in fslib that are overloaded, or, if they are overloaded, then value identity @@ -5537,7 +5530,7 @@ let fslibValRefEq fslibCcu vref1 vref2 = // Note: I suspect this private-to-private reference comparison is not needed | (VRefLocal e1, VRefLocal e2) -> match e1.PublicPath, e2.PublicPath with - | Some (ValPubPath(pp1,nm1)), Some (ValPubPath(pp2,nm2)) -> + | Some (ValPubPath(pp1, nm1)), Some (ValPubPath(pp2, nm2)) -> pubPathEq pp1 pp2 && (nm1 = nm2) | _ -> false @@ -5564,7 +5557,7 @@ let primEntityRefEq compilingFslib fslibCcu (x : EntityRef) (y : EntityRef) = compilingFslib && fslibEntityRefEq fslibCcu x y /// Primitive routine to compare two UnionCaseRef's for equality -let primUnionCaseRefEq compilingFslib fslibCcu (UCRef(tcr1,c1) as uc1) (UCRef(tcr2,c2) as uc2) = +let primUnionCaseRefEq compilingFslib fslibCcu (UCRef(tcr1, c1) as uc1) (UCRef(tcr2, c2) as uc2) = uc1 === uc2 || (primEntityRefEq compilingFslib fslibCcu tcr1 tcr2 && c1 = c2) /// Primitive routine to compare two ValRef's for equality. On the whole value identity is not particularly @@ -5592,15 +5585,15 @@ let primValRefEq compilingFslib fslibCcu (x : ValRef) (y : ValRef) = //--------------------------------------------------------------------------- let fullCompPathOfModuleOrNamespace (m:ModuleOrNamespace) = - let (CompPath(scoref,cpath)) = m.CompilationPath - CompPath(scoref,cpath@[(m.LogicalName, m.ModuleOrNamespaceType.ModuleOrNamespaceKind)]) + let (CompPath(scoref, cpath)) = m.CompilationPath + CompPath(scoref, cpath@[(m.LogicalName, m.ModuleOrNamespaceType.ModuleOrNamespaceKind)]) // Can cpath2 be accessed given a right to access cpath1. That is, is cpath2 a nested type or namespace of cpath1. Note order of arguments. -let inline canAccessCompPathFrom (CompPath(scoref1,cpath1)) (CompPath(scoref2,cpath2)) = +let inline canAccessCompPathFrom (CompPath(scoref1, cpath1)) (CompPath(scoref2, cpath2)) = let rec loop p1 p2 = - match p1,p2 with - | (a1,k1)::rest1, (a2,k2)::rest2 -> (a1=a2) && (k1=k2) && loop rest1 rest2 - | [],_ -> true + match p1, p2 with + | (a1, k1)::rest1, (a2, k2)::rest2 -> (a1=a2) && (k1=k2) && loop rest1 rest2 + | [], _ -> true | _ -> false // cpath1 is longer loop cpath1 cpath2 && (scoref1 = scoref2) @@ -5616,15 +5609,15 @@ let canAccessFromSomewhere (TAccess _) = true let isLessAccessible (TAccess aa) (TAccess bb) = not (aa |> List.forall(fun a -> bb |> List.exists (fun b -> canAccessCompPathFrom a b))) -/// Given (newPath,oldPath) replace oldPath by newPath in the TAccess. -let accessSubstPaths (newPath,oldPath) (TAccess paths) = +/// Given (newPath, oldPath) replace oldPath by newPath in the TAccess. +let accessSubstPaths (newPath, oldPath) (TAccess paths) = let subst cpath = if cpath=oldPath then newPath else cpath TAccess (List.map subst paths) -let compPathOfCcu (ccu:CcuThunk) = CompPath(ccu.ILScopeRef,[]) +let compPathOfCcu (ccu:CcuThunk) = CompPath(ccu.ILScopeRef, []) let taccessPublic = TAccess [] let taccessPrivate accessPath = TAccess [accessPath] -let compPathInternal = CompPath(ILScopeRef.Local,[]) +let compPathInternal = CompPath(ILScopeRef.Local, []) let taccessInternal = TAccess [compPathInternal] let combineAccess (TAccess a1) (TAccess a2) = TAccess(a1@a2) @@ -5649,11 +5642,11 @@ let MakeUnionCases ucs : TyconUnionData = let MakeUnionRepr ucs = TUnionRepr (MakeUnionCases ucs) -let NewTypar (kind,rigid,Typar(id,staticReq,isCompGen),isFromError,dynamicReq,attribs,eqDep,compDep) = +let NewTypar (kind, rigid, Typar(id, staticReq, isCompGen), isFromError, dynamicReq, attribs, eqDep, compDep) = Typar.New { typar_id = id typar_stamp = newStamp() - typar_flags= TyparFlags(kind,rigid,isFromError,isCompGen,staticReq,dynamicReq,eqDep,compDep) + typar_flags= TyparFlags(kind, rigid, isFromError, isCompGen, staticReq, dynamicReq, eqDep, compDep) typar_solution = None typar_astype = Unchecked.defaultof<_> typar_opt_data = @@ -5661,7 +5654,7 @@ let NewTypar (kind,rigid,Typar(id,staticReq,isCompGen),isFromError,dynamicReq,at | [] -> None | _ -> Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = attribs } } -let NewRigidTypar nm m = NewTypar (TyparKind.Type,TyparRigidity.Rigid,Typar(mkSynId m nm,NoStaticReq,true),false,TyparDynamicReq.Yes,[],false,false) +let NewRigidTypar nm m = NewTypar (TyparKind.Type, TyparRigidity.Rigid, Typar(mkSynId m nm, NoStaticReq, true), false, TyparDynamicReq.Yes, [], false, false) let NewUnionCase id tys rty attribs docOption access : UnionCase = { Id=id @@ -5722,7 +5715,7 @@ let NewTycon (cpath, nm, m, access, reprAccess, kind, typars, docOption, usesPre { entity_stamp=stamp entity_logical_name=nm entity_range=m - entity_flags=EntityFlags(usesPrefixDisplay=usesPrefixDisplay, isModuleOrNamespace=false,preEstablishedHasDefaultCtor=preEstablishedHasDefaultCtor, hasSelfReferentialCtor=hasSelfReferentialCtor, isStructRecordOrUnionType=false) + entity_flags=EntityFlags(usesPrefixDisplay=usesPrefixDisplay, isModuleOrNamespace=false, preEstablishedHasDefaultCtor=preEstablishedHasDefaultCtor, hasSelfReferentialCtor=hasSelfReferentialCtor, isStructRecordOrUnionType=false) entity_attribs=[] // fixed up after entity_typars=typars entity_tycon_repr = TNoRepr @@ -5737,13 +5730,13 @@ let NewTycon (cpath, nm, m, access, reprAccess, kind, typars, docOption, usesPre | _ -> Some { Entity.NewEmptyEntityOptData() with entity_kind = kind; entity_xmldoc = docOption; entity_tycon_repr_accessibility = reprAccess; entity_accessiblity=access } } -let NewILTycon nlpath (nm,m) tps (scoref:ILScopeRef, enc, tdef:ILTypeDef) mtyp = +let NewILTycon nlpath (nm, m) tps (scoref:ILScopeRef, enc, tdef:ILTypeDef) mtyp = // NOTE: hasSelfReferentialCtor=false is an assumption about mscorlib let hasSelfReferentialCtor = tdef.IsClass && (not scoref.IsAssemblyRef && scoref.AssemblyRef.Name = "mscorlib") let tycon = NewTycon(nlpath, nm, m, taccessPublic, taccessPublic, TyparKind.Type, tps, XmlDoc.Empty, true, false, hasSelfReferentialCtor, mtyp) - tycon.entity_tycon_repr <- TILObjectRepr (TILObjectReprData (scoref,enc,tdef)) + tycon.entity_tycon_repr <- TILObjectRepr (TILObjectReprData (scoref, enc, tdef)) tycon.TypeContents.tcaug_closed <- true tycon @@ -5766,7 +5759,7 @@ let NewVal { val_stamp = stamp val_logical_name = logicalName val_range = m - val_flags = ValFlags(recValInfo,baseOrThis,isCompGen,inlineInfo,isMutable,isModuleOrMemberBinding,isExtensionMember,isIncrClassSpecialMember,isTyFunc,allowTypeInst,isGeneratedEventVal) + val_flags = ValFlags(recValInfo, baseOrThis, isCompGen, inlineInfo, isMutable, isModuleOrMemberBinding, isExtensionMember, isIncrClassSpecialMember, isTyFunc, allowTypeInst, isGeneratedEventVal) val_type = ty val_opt_data = match compiledName, arity, konst, access, doc, specialRepr, actualParent, attribs with @@ -5786,7 +5779,7 @@ let NewVal /// Create the new contents of an overall assembly let NewCcuContents sref m nm mty = - NewModuleOrNamespace (Some(CompPath(sref,[]))) taccessPublic (ident(nm,m)) XmlDoc.Empty [] (MaybeLazy.Strict mty) + NewModuleOrNamespace (Some(CompPath(sref, []))) taccessPublic (ident(nm, m)) XmlDoc.Empty [] (MaybeLazy.Strict mty) //-------------------------------------------------------------------------- @@ -5828,8 +5821,8 @@ let CombineCcuContentFragments m l = /// Combine module types when multiple namespace fragments contribute to the /// same namespace, making new module specs as we go. let rec CombineModuleOrNamespaceTypes path m (mty1:ModuleOrNamespaceType) (mty2:ModuleOrNamespaceType) = - match mty1.ModuleOrNamespaceKind,mty2.ModuleOrNamespaceKind with - | Namespace,Namespace -> + match mty1.ModuleOrNamespaceKind, mty2.ModuleOrNamespaceKind with + | Namespace, Namespace -> let kind = mty1.ModuleOrNamespaceKind let tab1 = mty1.AllEntitiesByLogicalMangledName let tab2 = mty2.AllEntitiesByLogicalMangledName @@ -5847,16 +5840,16 @@ let CombineCcuContentFragments m l = ModuleOrNamespaceType(kind, vals, QueueList.ofList entities) - | Namespace, _ | _,Namespace -> - error(Error(FSComp.SR.tastNamespaceAndModuleWithSameNameInAssembly(textOfPath path),m)) + | Namespace, _ | _, Namespace -> + error(Error(FSComp.SR.tastNamespaceAndModuleWithSameNameInAssembly(textOfPath path), m)) | _-> - error(Error(FSComp.SR.tastTwoModulesWithSameNameInAssembly(textOfPath path),m)) + error(Error(FSComp.SR.tastTwoModulesWithSameNameInAssembly(textOfPath path), m)) and CombineEntites path (entity1:Entity) (entity2:Entity) = match entity1.IsModuleOrNamespace, entity2.IsModuleOrNamespace with - | true,true -> + | true, true -> entity1 |> NewModifiedTycon (fun data1 -> let xml = XmlDoc.Merge entity1.XmlDoc entity2.XmlDoc { data1 with @@ -5866,10 +5859,10 @@ let CombineCcuContentFragments m l = match data1.entity_opt_data with | Some optData -> Some { optData with entity_xmldoc = xml } | _ -> Some { Entity.NewEmptyEntityOptData() with entity_xmldoc = xml } }) - | false,false -> - error(Error(FSComp.SR.tastDuplicateTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path),entity2.Range)) - | _,_ -> - error(Error(FSComp.SR.tastConflictingModuleAndTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path),entity2.Range)) + | false, false -> + error(Error(FSComp.SR.tastDuplicateTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path), entity2.Range)) + | _, _ -> + error(Error(FSComp.SR.tastConflictingModuleAndTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path), entity2.Range)) and CombineModuleOrNamespaceTypeList path m l = match l with diff --git a/src/utils/sformat.fs b/src/utils/sformat.fs index 7620a2c411c0a9668f1952c6aa15eae40aaf8b4b..fbd09fe7f2007a99e489fe6ffa001051f1d35f4f 100644 --- a/src/utils/sformat.fs +++ b/src/utils/sformat.fs @@ -1196,7 +1196,7 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl // massively reign in deep printing of properties let nDepth = depthLim/10 -#if NETSTANDARD1_6 || NETSTANDARD2_0 +#if NETSTANDARD Array.Sort((propsAndFields),{ new IComparer with member this.Compare(p1,p2) = compare (p1.Name) (p2.Name) } ); #else Array.Sort((propsAndFields :> Array),{ new System.Collections.IComparer with member this.Compare(p1,p2) = compare ((p1 :?> MemberInfo).Name) ((p2 :?> MemberInfo).Name) } ); diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs index a14429fe00ae7d999a4562f7382a997a8108541d..5afff678472bf669716d522822265a496022ccf1 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs @@ -278,8 +278,10 @@ type CancellationType() = } |> Async.Start try - let res = t.Wait(1000) - Assert.Fail (sprintf "Excepted TimeoutException wrapped in an AggregateException, but got %A" res) + let res = t.Wait(2000) + let msg = sprintf "Excepted TimeoutException wrapped in an AggregateException, but got %A" res + printfn "failure msg: %s" msg + Assert.Fail (msg) with :? AggregateException as agg -> () [] diff --git a/tests/fsharp/core/large/conditionals/LargeConditionals-200.fs b/tests/fsharp/core/large/conditionals/LargeConditionals-200.fs new file mode 100644 index 0000000000000000000000000000000000000000..d1910edcce485af20d59826911f315339b1a7d69 --- /dev/null +++ b/tests/fsharp/core/large/conditionals/LargeConditionals-200.fs @@ -0,0 +1,210 @@ +module TestData + +let rnd = new System.Random() + +let expectedValues() = + let x = 1 + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + 4 +printfn "expectedValues() = %A" (expectedValues()) +System.IO.File.WriteAllLines("test.ok", ["ok"]) \ No newline at end of file diff --git a/tests/fsharp/core/large/conditionals/LargeConditionals-maxtested.fs b/tests/fsharp/core/large/conditionals/LargeConditionals-maxtested.fs new file mode 100644 index 0000000000000000000000000000000000000000..40840fbdb1307f9906d10f32cbcbc0b59abaf814 --- /dev/null +++ b/tests/fsharp/core/large/conditionals/LargeConditionals-maxtested.fs @@ -0,0 +1,424 @@ +module TestData + +let rnd = new System.Random() + +let expectedValues() = + let x = 1 + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + if rnd.Next(3) = 1 then 1 else + 4 +printfn "expectedValues() = %A" (expectedValues()) +System.IO.File.WriteAllLines("test.ok", ["ok"]) \ No newline at end of file diff --git a/tests/fsharp/core/large/lets/LargeLets-500.fs b/tests/fsharp/core/large/lets/LargeLets-500.fs new file mode 100644 index 0000000000000000000000000000000000000000..5a1aa0697bb86ae62667a09e856fc807dd27d02d --- /dev/null +++ b/tests/fsharp/core/large/lets/LargeLets-500.fs @@ -0,0 +1,509 @@ +module TestData + +let rnd = new System.Random() + +let expectedValues() = + let x = 1 + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + x +printfn "expectedValues() = %A" (expectedValues()) +System.IO.File.WriteAllLines("test.ok", ["ok"]) diff --git a/tests/fsharp/core/large/lets/LargeLets-maxtested.fs b/tests/fsharp/core/large/lets/LargeLets-maxtested.fs new file mode 100644 index 0000000000000000000000000000000000000000..9f220268b6ea9196be6b405a8070e32d1b61850a --- /dev/null +++ b/tests/fsharp/core/large/lets/LargeLets-maxtested.fs @@ -0,0 +1,795 @@ +module TestData + +let rnd = new System.Random() + +let expectedValues() = + let x = 1 + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + let x = x + rnd.Next(3) + x +printfn "expectedValues() = %A" (expectedValues()) +System.IO.File.WriteAllLines("test.ok", ["ok"]) diff --git a/tests/fsharp/core/large/lists/LargeList-500.fs b/tests/fsharp/core/large/lists/LargeList-500.fs new file mode 100644 index 0000000000000000000000000000000000000000..b46244887a7ffe476ff79a14bd1f750808daadfe --- /dev/null +++ b/tests/fsharp/core/large/lists/LargeList-500.fs @@ -0,0 +1,507 @@ +module TestData + +let expectedValues = + [ + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + ] +printfn "length = %d" expectedValues.Length +System.IO.File.WriteAllLines("test.ok", ["ok"]) \ No newline at end of file diff --git a/tests/fsharp/core/large/matches/LargeMatches-200.fs b/tests/fsharp/core/large/matches/LargeMatches-200.fs new file mode 100644 index 0000000000000000000000000000000000000000..4dac865609aa826e5c656a6b6f6518db0a46615c --- /dev/null +++ b/tests/fsharp/core/large/matches/LargeMatches-200.fs @@ -0,0 +1,309 @@ +module TestData + +let rnd = new System.Random() +let r() = if rnd.Next(3) > 1 then Some 4 else None +let expectedValues() = + let x = 1 + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + 4 +printfn "expectedValues() = %A" (expectedValues()) +System.IO.File.WriteAllLines("test.ok", ["ok"]) \ No newline at end of file diff --git a/tests/fsharp/core/large/matches/LargeMatches-maxtested.fs b/tests/fsharp/core/large/matches/LargeMatches-maxtested.fs new file mode 100644 index 0000000000000000000000000000000000000000..a220824334d2b317f59f152f15cc35cb6893a191 --- /dev/null +++ b/tests/fsharp/core/large/matches/LargeMatches-maxtested.fs @@ -0,0 +1,465 @@ +module TestData + +let rnd = new System.Random() +let r() = if rnd.Next(3) > 1 then Some 4 else None +let expectedValues() = + let x = 1 + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + match r() with + | Some x -> x + | None -> + 4 +printfn "expectedValues() = %A" (expectedValues()) +System.IO.File.WriteAllLines("test.ok", ["ok"]) \ No newline at end of file diff --git a/tests/fsharp/core/large/mixed/LargeSequentialLet-500.fs b/tests/fsharp/core/large/mixed/LargeSequentialLet-500.fs new file mode 100644 index 0000000000000000000000000000000000000000..404817e2a4fcf7b9b94eac03625902ccff24d9e8 --- /dev/null +++ b/tests/fsharp/core/large/mixed/LargeSequentialLet-500.fs @@ -0,0 +1,1011 @@ +module TestData + +let rnd = new System.Random() + +let expectedValues() = + let mutable x = 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x +printfn "expectedValues() = %A" (expectedValues()) +System.IO.File.WriteAllLines("test.ok", ["ok"]) \ No newline at end of file diff --git a/tests/fsharp/core/large/mixed/LargeSequentialLet-maxtested.fs b/tests/fsharp/core/large/mixed/LargeSequentialLet-maxtested.fs new file mode 100644 index 0000000000000000000000000000000000000000..404817e2a4fcf7b9b94eac03625902ccff24d9e8 --- /dev/null +++ b/tests/fsharp/core/large/mixed/LargeSequentialLet-maxtested.fs @@ -0,0 +1,1011 @@ +module TestData + +let rnd = new System.Random() + +let expectedValues() = + let mutable x = 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x <- x + rnd.Next(3) + let mutable x = x + 1 + x +printfn "expectedValues() = %A" (expectedValues()) +System.IO.File.WriteAllLines("test.ok", ["ok"]) \ No newline at end of file diff --git a/tests/fsharp/core/large/sequential/LargeSequential-500.fs b/tests/fsharp/core/large/sequential/LargeSequential-500.fs new file mode 100644 index 0000000000000000000000000000000000000000..adfd85723c8b2ed2c925bc3b42f5e99df0e690e1 --- /dev/null +++ b/tests/fsharp/core/large/sequential/LargeSequential-500.fs @@ -0,0 +1,509 @@ +module TestData + +let rnd = new System.Random() + +let expectedValues() = + let mutable x = 1 + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x +printfn "expectedValues() = %A" (expectedValues()) +System.IO.File.WriteAllLines("test.ok", ["ok"]) \ No newline at end of file diff --git a/tests/fsharp/core/large/sequential/LargeSequential-maxtested.fs b/tests/fsharp/core/large/sequential/LargeSequential-maxtested.fs new file mode 100644 index 0000000000000000000000000000000000000000..e28abe4c37916d2bf200676f02e659534901e554 --- /dev/null +++ b/tests/fsharp/core/large/sequential/LargeSequential-maxtested.fs @@ -0,0 +1,6715 @@ +module TestData + +let rnd = new System.Random() + +let expectedValues() = + let mutable x = 1 + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x <- x + rnd.Next(3) + x +printfn "expectedValues() = %A" (expectedValues()) +System.IO.File.WriteAllLines("test.ok", ["ok"]) \ No newline at end of file diff --git a/tests/fsharp/test-framework.fs b/tests/fsharp/test-framework.fs index bb4b134f8d02577bf33b25bb9927adf4aa9c7adb..5ce54f20590759b4a4a61089032fd408f0129ce5 100644 --- a/tests/fsharp/test-framework.fs +++ b/tests/fsharp/test-framework.fs @@ -167,7 +167,7 @@ let config configurationName envVars = let fsiArchitecture = "netcoreapp2.1" let fsharpCoreArchitecture = "netstandard1.6" let fsharpBuildArchitecture = "netstandard2.0" - let fsharpCompilerInteractiveSettingsArchitecture = "netstandard1.6" + let fsharpCompilerInteractiveSettingsArchitecture = "netstandard2.0" #endif let repoRoot = SCRIPT_ROOT ++ ".." ++ ".." let artifactsPath = repoRoot ++ "artifacts" diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index ca19aa3a7faa20b2a95288c6f166407948bdebd5..4c210eaba7f8feebabdb89fc7cc7c43c5cc71aeb 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -273,6 +273,94 @@ module CoreTests = testOkFile.CheckExists() + [] + let ``lots-of-conditionals``() = + let cfg = testConfig "core/large/conditionals" + use testOkFile = fileguard cfg "test.ok" + fsc cfg "%s -o:test.exe " cfg.fsc_flags ["LargeConditionals-200.fs"] + exec cfg ("." ++ "test.exe") "" + testOkFile.CheckExists() + + [] + let ``lots-of-conditionals-maxtested``() = + let cfg = testConfig "core/large/conditionals" + use testOkFile = fileguard cfg "test.ok" + fsc cfg "%s -o:test.exe " cfg.fsc_flags ["LargeConditionals-maxtested.fs"] + exec cfg ("." ++ "test.exe") "" + testOkFile.CheckExists() + + [] + let ``lots-of-lets``() = + let cfg = testConfig "core/large/lets" + use testOkFile = fileguard cfg "test.ok" + fsc cfg "%s -o:test.exe " cfg.fsc_flags ["LargeLets-500.fs"] + exec cfg ("." ++ "test.exe") "" + testOkFile.CheckExists() + + [] + let ``lots-of-lets-maxtested``() = + let cfg = testConfig "core/large/lets" + use testOkFile = fileguard cfg "test.ok" + fsc cfg "%s -o:test.exe " cfg.fsc_flags ["LargeLets-maxtested.fs"] + exec cfg ("." ++ "test.exe") "" + testOkFile.CheckExists() + + [] + let ``lots-of-lists``() = + let cfg = testConfig "core/large/lists" + use testOkFile = fileguard cfg "test.ok" + fsc cfg "%s -o:test-500.exe " cfg.fsc_flags ["LargeList-500.fs"] + exec cfg ("." ++ "test-500.exe") "" + testOkFile.CheckExists() + + [] + let ``lots-of-matches``() = + let cfg = testConfig "core/large/matches" + use testOkFile = fileguard cfg "test.ok" + fsc cfg "%s -o:test.exe " cfg.fsc_flags ["LargeMatches-200.fs"] + exec cfg ("." ++ "test.exe") "" + testOkFile.CheckExists() + + [] + let ``lots-of-matches-maxtested``() = + let cfg = testConfig "core/large/matches" + use testOkFile = fileguard cfg "test.ok" + fsc cfg "%s -o:test.exe " cfg.fsc_flags ["LargeMatches-maxtested.fs"] + exec cfg ("." ++ "test.exe") "" + testOkFile.CheckExists() + + [] + let ``lots-of-sequential-and-let``() = + let cfg = testConfig "core/large/mixed" + use testOkFile = fileguard cfg "test.ok" + fsc cfg "%s -o:test.exe " cfg.fsc_flags ["LargeSequentialLet-500.fs"] + exec cfg ("." ++ "test.exe") "" + testOkFile.CheckExists() + + [] + let ``lots-of-sequential-and-let-maxtested``() = + let cfg = testConfig "core/large/mixed" + use testOkFile = fileguard cfg "test.ok" + fsc cfg "%s -o:test.exe " cfg.fsc_flags ["LargeSequentialLet-maxtested.fs"] + exec cfg ("." ++ "test.exe") "" + testOkFile.CheckExists() + + [] + let ``lots-of-sequential``() = + let cfg = testConfig "core/large/sequential" + use testOkFile = fileguard cfg "test.ok" + fsc cfg "%s -o:test.exe " cfg.fsc_flags ["LargeSequential-500.fs"] + exec cfg ("." ++ "test.exe") "" + testOkFile.CheckExists() + + [] + let ``lots-of-sequential-maxtested``() = + let cfg = testConfig "core/large/sequential" + use testOkFile = fileguard cfg "test.ok" + fsc cfg "%s -o:test.exe " cfg.fsc_flags ["LargeSequential-maxtested.fs"] + exec cfg ("." ++ "test.exe") "" + testOkFile.CheckExists() + #endif [] diff --git a/tests/scripts/longLines.fsx b/tests/scripts/codingConventions.fsx similarity index 65% rename from tests/scripts/longLines.fsx rename to tests/scripts/codingConventions.fsx index f6c8e0c5b83732dde05bbc23b42e6bc7dd974c8f..c8fa69bbe32e772aac7dcc0419bd3f66905d9643 100644 --- a/tests/scripts/longLines.fsx +++ b/tests/scripts/codingConventions.fsx @@ -1,4 +1,4 @@ - +// Print some stats about some very very basic code formatting conventions open System.IO @@ -17,6 +17,8 @@ let lines = yield file, (line+1, lineText) |] + +printfn "------ LINE LENGTH ANALYSIS ----------" let totalLines = lines.Length let buckets = lines |> Array.groupBy (fun (_file, (_line, lineText)) -> lineText.Length / 10) |> Array.sortByDescending (fun (key, vs) -> key) @@ -35,3 +37,33 @@ let numHumungous = lines |> Array.filter (fun (_, (line, lineText)) -> lineText. printfn "%d long lines = %2.2f%%" numLong (double numLong / double totalLines) printfn "%d huge lines = %2.2f%%" numHuge (double numHuge / double totalLines) printfn "%d humungous lines = %2.2f%%" numHumungous (double numHumungous / double totalLines) + +printfn "------ SPACE AFTER COMMA ANALYSIS ----------" + +let commas = + lines + |> Array.groupBy fst + |> Array.map (fun (file, lines) -> + file, + lines + |> Array.sumBy (fun (_,(_,line)) -> + line |> Seq.pairwise |> Seq.filter (fun (c1, c2) -> c1 = ',' && c2 <> ' ') |> Seq.length)) + |> Array.sortByDescending snd + +printfn "Top files that have commas without spaces: %A" (Array.truncate 10 commas) + + +printfn "------DANGLINE SEMICOLONS----------" + +let semis = + lines + |> Array.groupBy fst + |> Array.map (fun (file, lines) -> + file, + lines + |> Array.filter (fun (_,(_,line)) -> line.Trim().EndsWith(";")) + |> Array.length) + |> Array.sortByDescending snd + +printfn "Top files that have semicolon at end of line: %A" (Array.truncate 10 semis) + diff --git a/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/DummyProviderForLanguageServiceTesting.fs b/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/DummyProviderForLanguageServiceTesting.fs index 1e17fda491f27b7d316b4ed62b9562773ea753b9..7c36d8f37e15e5ae1fc6364d81668bb849f46804 100644 --- a/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/DummyProviderForLanguageServiceTesting.fs +++ b/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/DummyProviderForLanguageServiceTesting.fs @@ -113,33 +113,39 @@ module internal TPModule = // Used by unit testing to check that Dispose is being called on the type provider module GlobalCounters = - let mutable creations = 0 - let mutable disposals = 0 - let mutable configs = ([]: TypeProviderConfig list) - let GetTotalCreations() = creations - let GetTotalDisposals() = disposals + let counterLock = obj() + let mutable private creations = 0 + let mutable private disposals = 0 + let mutable private configs = ([]: TypeProviderConfig list) + let GetTotalCreations() = lock counterLock (fun () -> creations) + let GetTotalDisposals() = lock counterLock (fun () -> disposals) + let IncrementCreations() = lock counterLock (fun () -> creations <- creations + 1) + let IncrementDisposals() = lock counterLock (fun () -> disposals <- disposals + 1) + let AddConfig c = lock counterLock (fun () -> configs <- c :: configs) + let GetConfigs() = lock counterLock (fun () -> configs) let CheckAllConfigsDisposed() = - for c in configs do + let cs = GetConfigs() + lock counterLock (fun () -> + configs <- []) + for c in cs do try c.SystemRuntimeContainsType("System.Object") |> ignore failwith "expected configuration object to be disposed" with :? System.ObjectDisposedException -> () - - [] type HelloWorldProvider(config: TypeProviderConfig) = inherit TypeProviderForNamespaces(TPModule.namespaceName,TPModule.types) - do GlobalCounters.creations <- GlobalCounters.creations + 1 + do GlobalCounters.IncrementCreations() let mutable disposed = false - do GlobalCounters.configs <- config :: GlobalCounters.configs + do GlobalCounters.AddConfig config interface System.IDisposable with member x.Dispose() = System.Diagnostics.Debug.Assert(not disposed) disposed <- true - GlobalCounters.disposals <- GlobalCounters.disposals + 1 - if GlobalCounters.disposals % 5 = 0 then failwith "simulate random error during disposal" + do GlobalCounters.IncrementDisposals() + if GlobalCounters.GetTotalDisposals() % 5 = 0 then failwith "simulate random error during disposal" // implementation of a poorly behaving TP that sleeps for various numbers of seconds when traversing into members. diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs index 8744c77910dd5e0dd3e017ca6839d60b05295934..1240e6c73aff5911c5485d878d0d3086a68b4048 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs @@ -1623,26 +1623,44 @@ type UsingMSBuild() as this = let file1 = OpenFile(project,fileName) // The disposals should be at least one less - Assert.IsTrue(countDisposals() < i, "Check1, countDisposals() < i, iteration " + string i) - Assert.IsTrue(countCreations() >= countDisposals(), "Check2, countCreations() >= countDisposals(), iteration " + string i) - Assert.IsTrue(countCreations() = i, "Check3, countCreations() = i, iteration " + string i) + let c = countCreations() + let d = countDisposals() + + // Creations should always be greater or equal to disposals + Assert.IsTrue(c >= d, "Check2, countCreations() >= countDisposals(), iteration " + string i + ", countCreations() = " + string c + ", countDisposals() = " + string d) + + // Creations can run ahead of iterations if the background checker resurrects the builder for a project + // even after we've moved on from it. + Assert.IsTrue((c >= i), "Check3, countCreations() >= i, iteration " + string i + ", countCreations() = " + string c) + if not clearing then // By default we hold 3 build incrementalBuilderCache entries and 5 typeCheckInfo entries, so if we're not clearing // there should be some roots to project builds still present if i >= 3 then - Assert.IsTrue(i >= countDisposals() + 3, "Check4a, i >= countDisposals() + 3, iteration " + string i + ", i = " + string i + ", countDisposals() = " + string (countDisposals())) + Assert.IsTrue(c >= d + 3, "Check4a, c >= countDisposals() + 3, iteration " + string i + ", i = " + string i + ", countDisposals() = " + string d) printfn "Check4a2, i = %d, countInvaldiationHandlersRemoved() = %d" i (countInvaldiationHandlersRemoved()) // If we forcefully clear out caches and force a collection, then we can say much stronger things... if clearing then ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients(this.VS) - Assert.IsTrue((i = countDisposals()), "Check4b, countCreations() = countDisposals(), iteration " + string i) - Assert.IsTrue(countInvaldiationHandlersAdded() - countInvaldiationHandlersRemoved() = 0, "Check4b2, all invlidation handlers removed, iteration " + string i) + let c = countCreations() + let d = countDisposals() + + // Creations should be equal to disposals after a `ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients` + Assert.IsTrue((c = d), "Check4b, countCreations() = countDisposals(), iteration " + string i) + Assert.IsTrue((countInvaldiationHandlersAdded() = countInvaldiationHandlersRemoved()), "Check4b2, all invlidation handlers removed, iteration " + string i) - Assert.IsTrue(countCreations() = 50, "Check5, at end, countCreations() = 50") + let c = countCreations() + let d = countDisposals() + Assert.IsTrue(c >= 50, "Check5, at end, countCreations() >= 50") + ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients(this.VS) - Assert.IsTrue(countDisposals() = 50, "Check6b, at end, countDisposals() = 50 after explicit clearing") - Assert.IsTrue(countInvaldiationHandlersAdded() - countInvaldiationHandlersRemoved() = 0, "Check6b2, at end, all invalidation handlers removed after explicit cleraring") + + let c = countCreations() + let d = countDisposals() + // Creations should be equal to disposals after a `ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients` + Assert.IsTrue((c = d), "Check6b, at end, countCreations() = countDisposals() after explicit clearing") + Assert.IsTrue((countInvaldiationHandlersAdded() = countInvaldiationHandlersRemoved()), "Check6b2, at end, all invalidation handlers removed after explicit cleraring") checkConfigsDisposed() []