From 86686f97d7bd96fabfa4d47e6330c75e30ebbc13 Mon Sep 17 00:00:00 2001 From: Gauthier Segay Date: Sun, 24 Jul 2016 20:07:35 +0200 Subject: [PATCH 01/38] Better error message when specializing generic abstract type with unit --- src/fsharp/CompileOps.fs | 32 +++++++++++++++---- src/fsharp/FSStrings.resx | 3 ++ .../UnitSpecialization.fs | 9 ++++++ .../TypeParameterDefinitions/env.lst | 1 + .../E_UnitGenericAbstractType1.fs | 9 ++++++ .../UnitGenericAbstractType/env.lst | 1 + tests/fsharpqa/Source/test.lst | 1 + 7 files changed, 49 insertions(+), 7 deletions(-) create mode 100644 tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/TypeParameterDefinitions/UnitSpecialization.fs create mode 100644 tests/fsharpqa/Source/ErrorMessages/UnitGenericAbstractType/E_UnitGenericAbstractType1.fs create mode 100644 tests/fsharpqa/Source/ErrorMessages/UnitGenericAbstractType/env.lst diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index ca4f6ebd000..2d852915815 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -524,6 +524,7 @@ let TypeTestUnnecessaryE() = DeclareResourceString("TypeTestUnnecessary","") let OverrideDoesntOverride1E() = DeclareResourceString("OverrideDoesntOverride1","%s") let OverrideDoesntOverride2E() = DeclareResourceString("OverrideDoesntOverride2","%s") let OverrideDoesntOverride3E() = DeclareResourceString("OverrideDoesntOverride3","%s") +let OverrideDoesntOverride4E() = DeclareResourceString("OverrideDoesntOverride4","%s") let UnionCaseWrongArgumentsE() = DeclareResourceString("UnionCaseWrongArguments","%d%d") let UnionPatternsBindDifferentNamesE() = DeclareResourceString("UnionPatternsBindDifferentNames","") let RequiredButNotSpecifiedE() = DeclareResourceString("RequiredButNotSpecified","%s%s%s") @@ -1144,15 +1145,32 @@ let OutputPhasedErrorR (os:System.Text.StringBuilder) (err:PhasedError) = Printf.bprintf os "%s" msg | OverrideDoesntOverride(denv,impl,minfoVirtOpt,g,amap,m) -> let sig1 = DispatchSlotChecking.FormatOverride denv impl - begin match minfoVirtOpt with + match minfoVirtOpt with | None -> os.Append(OverrideDoesntOverride1E().Format sig1) |> ignore - | Some minfoVirt -> - os.Append(OverrideDoesntOverride2E().Format sig1) |> ignore - let sig2 = DispatchSlotChecking.FormatMethInfoSig g amap m denv minfoVirt - if sig1 <> sig2 then - os.Append(OverrideDoesntOverride3E().Format sig2) |> ignore - end + | Some minfoVirt -> + // https://github.com/Microsoft/visualfsharp/issues/35 + // Improve error message when attempting to override generic return type with unit: + // we need to check if unit was used as a type argument + let rec hasUnitTType_app (types: TType list) = + match types with + | TType_app (maybeUnit, []) :: ts -> + match maybeUnit.TypeAbbrev with + | Some ttype when Tastops.isUnitTy g ttype -> true + | _ -> hasUnitTType_app ts + | _ :: ts -> hasUnitTType_app ts + | [] -> false + + match minfoVirt.EnclosingType with + | TType_app (t, types) when t.IsFSharpInterfaceTycon && hasUnitTType_app types -> + // match abstract member with 'unit' passed as generic argument + os.Append(OverrideDoesntOverride4E().Format sig1) |> ignore + | _ -> + os.Append(OverrideDoesntOverride2E().Format sig1) |> ignore + let sig2 = DispatchSlotChecking.FormatMethInfoSig g amap m denv minfoVirt + if sig1 <> sig2 then + os.Append(OverrideDoesntOverride3E().Format sig2) |> ignore + | UnionCaseWrongArguments (_,n1,n2,_) -> os.Append(UnionCaseWrongArgumentsE().Format n2 n1) |> ignore | UnionPatternsBindDifferentNames _ -> diff --git a/src/fsharp/FSStrings.resx b/src/fsharp/FSStrings.resx index f028e00b6f8..04bce992367 100644 --- a/src/fsharp/FSStrings.resx +++ b/src/fsharp/FSStrings.resx @@ -867,6 +867,9 @@ The required signature is '{0}'. + + The member '{0}' is specialized with 'unit' but 'unit' can't be used as return type of an abstract method parameterized on return type. + This constructor is applied to {0} argument(s) but expects {1} diff --git a/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/TypeParameterDefinitions/UnitSpecialization.fs b/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/TypeParameterDefinitions/UnitSpecialization.fs new file mode 100644 index 00000000000..f56675b651d --- /dev/null +++ b/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/TypeParameterDefinitions/UnitSpecialization.fs @@ -0,0 +1,9 @@ +// #UnitGenericAbstractType +// + +type Foo<'t> = + abstract member Bar : 't -> int + +type Bar() = + interface Foo with + member x.Bar _ = 1 \ No newline at end of file diff --git a/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/TypeParameterDefinitions/env.lst b/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/TypeParameterDefinitions/env.lst index d33bde606e7..63e29215be3 100644 --- a/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/TypeParameterDefinitions/env.lst +++ b/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/TypeParameterDefinitions/env.lst @@ -6,3 +6,4 @@ SOURCE=E_LazyInType02.fs SCFLAGS="--test:ErrorRanges" # E_LazyInType02.fs SOURCE=MultipleConstraints01.fs # MultipleConstraints01.fs SOURCE=ValueTypesWithConstraints01.fs # ValueTypesWithConstraints01.fs + SOURCE=UnitSpecialization.fs # UnitSpecialization.fs diff --git a/tests/fsharpqa/Source/ErrorMessages/UnitGenericAbstractType/E_UnitGenericAbstractType1.fs b/tests/fsharpqa/Source/ErrorMessages/UnitGenericAbstractType/E_UnitGenericAbstractType1.fs new file mode 100644 index 00000000000..0b7f1d98a6d --- /dev/null +++ b/tests/fsharpqa/Source/ErrorMessages/UnitGenericAbstractType/E_UnitGenericAbstractType1.fs @@ -0,0 +1,9 @@ +// #ErrorMessages #UnitGenericAbstractType +//The member 'Apply : int -> unit' is specialized with 'unit' but 'unit' can't be used as return type of an abstract method parameterized on return type\. +type EDF<'S> = + abstract member Apply : int -> 'S +type SomeEDF () = + interface EDF with + member this.Apply d = + // [ERROR] The member 'Apply' does not have the correct type to override the corresponding abstract method. + () \ No newline at end of file diff --git a/tests/fsharpqa/Source/ErrorMessages/UnitGenericAbstractType/env.lst b/tests/fsharpqa/Source/ErrorMessages/UnitGenericAbstractType/env.lst new file mode 100644 index 00000000000..26ae602bd6a --- /dev/null +++ b/tests/fsharpqa/Source/ErrorMessages/UnitGenericAbstractType/env.lst @@ -0,0 +1 @@ + SOURCE=E_UnitGenericAbstractType1.fs # E_UnitGenericAbstractType1 \ No newline at end of file diff --git a/tests/fsharpqa/Source/test.lst b/tests/fsharpqa/Source/test.lst index 8b87fc8a031..1eb2476c1a7 100644 --- a/tests/fsharpqa/Source/test.lst +++ b/tests/fsharpqa/Source/test.lst @@ -260,6 +260,7 @@ Misc01 Libraries\Core\Reflection Misc01 Libraries\Core\Unchecked Misc01 Warnings Misc01 ErrorMessages\NameResolution +Misc01 ErrorMessages\UnitGenericAbstractType Misc02 Libraries\Portable Misc02 Misc From fb99fc87240ff6382091cba73712566e314d27ab Mon Sep 17 00:00:00 2001 From: ncave Date: Mon, 22 Aug 2016 08:40:27 -0700 Subject: [PATCH 02/38] Fixed binary reader error message --- src/fsharp/CompileOps.fs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 2d852915815..ee55a308b7a 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -2583,8 +2583,8 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = clrRoot, (int v1, sprintf "v%d.%d" v1 v2), (v1=5us && v2=0us && v3=5us) // SL5 mscorlib is 5.0.5.0 | _ -> failwith (FSComp.SR.buildCouldNotReadVersionInfoFromMscorlib()) - with _ -> - error(Error(FSComp.SR.buildCannotReadAssembly(filename),rangeStartup)) + with e -> + error(Error(FSComp.SR.buildErrorOpeningBinaryFile(filename, e.Message), rangeStartup)) | _ -> #if !ENABLE_MONO_SUPPORT // TODO: we have to get msbuild out of this @@ -2644,8 +2644,8 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = checkFSharpBinaryCompatWithMscorlib filename ilReader.ILAssemblyRefs ilReader.ILModuleDef.ManifestOfAssembly.Version rangeStartup; let fslibRoot = Path.GetDirectoryName(FileSystem.GetFullPathShim(filename)) fslibRoot (* , sprintf "v%d.%d" v1 v2 *) - with _ -> - error(Error(FSComp.SR.buildCannotReadAssembly(filename),rangeStartup)) + with e -> + error(Error(FSComp.SR.buildErrorOpeningBinaryFile(filename, e.Message), rangeStartup)) | _ -> data.defaultFSharpBinariesDir From 5b814f06fbf9fa4710cadcdee146bcb7624d6e7d Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Wed, 17 Aug 2016 05:00:46 -0400 Subject: [PATCH 03/38] added detail to local.fs error messages --- src/fsharp/FSharp.Core/local.fs | 135 +++++++++++++++++++++++++------- 1 file changed, 107 insertions(+), 28 deletions(-) diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index fc178060eb1..a8b5951d5d7 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -14,6 +14,20 @@ open Microsoft.FSharp.Core.ICloneableExtensions #endif +module internal DetailedExceptions = + + /// takes an argument, a formatting string, a param array to splice into the formatting string + let inline internal invalidArgFmt (arg:string) (fmt:string) argArray = + let msg = System.String.Format (fmt,argArray) + raise (new System.ArgumentException (msg,arg)) + + /// takes a formatting string and a param array to splice into the formatting string + let inline internal invalidOpFmt (fmt:string) argArray = + let msg = System.String.Format (fmt,argArray) + raise (new System.InvalidOperationException(msg)) + +open DetailedExceptions + module internal List = let arrayZeroCreate (n:int) = (# "newarr !0" type ('T) n : 'T array #) @@ -32,7 +46,7 @@ module internal List = match list with | [] -> setFreshConsTail cons [] | x::rest -> - if hashSet.Add(x) then + if hashSet.Add x then let cons2 = freshConsNoTail x setFreshConsTail cons cons2 distinctToFreshConsTail cons2 hashSet rest @@ -45,7 +59,7 @@ module internal List = | [h] -> [h] | x::rest -> let hashSet = HashSet<'T>(comparer) - hashSet.Add(x) |> ignore + hashSet.Add x |> ignore let cons = freshConsNoTail x distinctToFreshConsTail cons hashSet rest cons @@ -207,7 +221,14 @@ module internal List = let cons2 = freshConsNoTail (f.Invoke(h1,h2)) setFreshConsTail cons cons2 map2ToFreshConsTail cons2 f t1 t2 - | _ -> invalidArg "xs2" (SR.GetString(SR.listsHadDifferentLengths)) + | [],xs2 -> + invalidArgFmt "list1" + "{0}\nlist1 is {1} elements shorter than list2" + [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] + | xs1,[] -> + invalidArgFmt "list2" + "{0}\nlist2 is {1} elements shorter than list1" + [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] let map2 f xs1 xs2 = match xs1,xs2 with @@ -217,7 +238,14 @@ module internal List = let cons = freshConsNoTail (f.Invoke(h1,h2)) map2ToFreshConsTail cons f t1 t2 cons - | _ -> invalidArg "xs2" (SR.GetString(SR.listsHadDifferentLengths)) + | [],xs2 -> + invalidArgFmt "list1" + "{0}\nlist1 is {1} elements shorter than list2" + [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] + | xs1,[] -> + invalidArgFmt "list2" + "{0}\nlist2 is {1} elements shorter than list1" + [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] let rec map3ToFreshConsTail cons (f:OptimizedClosures.FSharpFunc<_,_,_,_>) xs1 xs2 xs3 = match xs1,xs2,xs3 with @@ -227,7 +255,10 @@ module internal List = let cons2 = freshConsNoTail (f.Invoke(h1,h2,h3)) setFreshConsTail cons cons2 map3ToFreshConsTail cons2 f t1 t2 t3 - | _ -> invalidArg "list3" (SR.GetString(SR.listsHadDifferentLengths)) + | xs1,xs2,xs3 -> + invalidArgFmt "list1, list2, list3" + "{0}\n list1.Length = {1}, list2.Length = {2}, list3.Length = {3}" + [|SR.GetString SR.listsHadDifferentLengths; xs1.Length; xs2.Length; xs3.Length|] let map3 f xs1 xs2 xs3 = match xs1,xs2,xs3 with @@ -237,7 +268,10 @@ module internal List = let cons = freshConsNoTail (f.Invoke(h1,h2,h3)) map3ToFreshConsTail cons f t1 t2 t3 cons - | _ -> invalidArg "list3" (SR.GetString(SR.listsHadDifferentLengths)) + | xs1,xs2,xs3 -> + invalidArgFmt "list1, list2, list3" + "{0}\n list1.Length = {1}, list2.Length = {2}, list3.Length = {3}" + [|SR.GetString SR.listsHadDifferentLengths; xs1.Length; xs2.Length; xs3.Length|] let rec mapi2ToFreshConsTail n cons (f:OptimizedClosures.FSharpFunc<_,_,_,_>) xs1 xs2 = match xs1,xs2 with @@ -247,7 +281,14 @@ module internal List = let cons2 = freshConsNoTail (f.Invoke(n,h1,h2)) setFreshConsTail cons cons2 mapi2ToFreshConsTail (n + 1) cons2 f t1 t2 - | _ -> invalidArg "list2" (SR.GetString(SR.listsHadDifferentLengths)) + | [],xs2 -> + invalidArgFmt "list1" + "{0}\nlist1 is {1} elements shorter than list2" + [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] + | xs1,[] -> + invalidArgFmt "list2" + "{0}\nlist2 is {1} elements shorter than list1" + [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] let mapi2 f xs1 xs2 = match xs1,xs2 with @@ -257,7 +298,14 @@ module internal List = let cons = freshConsNoTail (f.Invoke(0, h1,h2)) mapi2ToFreshConsTail 1 cons f t1 t2 cons - | _ -> invalidArg "list2" (SR.GetString(SR.listsHadDifferentLengths)) + | [],xs2 -> + invalidArgFmt "list1" + "{0}\nlist1 is {1} elements shorter than list2" + [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] + | xs1,[] -> + invalidArgFmt "list2" + "{0}\nlist2 is {1} elements shorter than list1" + [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] let rec scanToFreshConsTail cons xs s (f: OptimizedClosures.FSharpFunc<_,_,_>) = match xs with @@ -501,7 +549,8 @@ module internal List = let init count f = - if count < 0 then invalidArg "count" LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString + if count < 0 then + invalidArgFmt "count" "{0}\ncount = {1}" [|LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString; count|] if count = 0 then [] else let res = freshConsNoTail (f 0) @@ -511,17 +560,23 @@ module internal List = let rec takeFreshConsTail cons n l = if n = 0 then setFreshConsTail cons [] else match l with - | [] -> raise <| System.InvalidOperationException (SR.GetString(SR.notEnoughElements)) + | [] -> + invalidOpFmt + "{0}\nThe list was short by {1} {2}" + [|SR.GetString SR.notEnoughElements; n; (if n=1 then "element" else "elements")|] | x::xs -> let cons2 = freshConsNoTail x setFreshConsTail cons cons2 takeFreshConsTail cons2 (n - 1) xs let take n l = - if n < 0 then invalidArg "count" LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString + if n < 0 then invalidArgFmt "count" "{0}\ncount = {1}" [|LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString; n|] if n = 0 then [] else match l with - | [] -> raise <| System.InvalidOperationException (SR.GetString(SR.notEnoughElements)) + | [] -> + invalidOpFmt + "{0}\nThe list was short by {1} {2}" + [|SR.GetString SR.notEnoughElements; n; (if n=1 then "element" else "elements")|] | x::xs -> let cons = freshConsNoTail x takeFreshConsTail cons (n - 1) xs @@ -533,18 +588,26 @@ module internal List = l else match l with - | [] -> raise <| System.InvalidOperationException (SR.GetString(SR.notEnoughElements)) + | [] -> + invalidOpFmt + "{0}\nThe list was short by {1} {2}" + [|SR.GetString SR.notEnoughElements; index; (if index=1 then "element" else "elements")|] | x :: xs -> let cons2 = freshConsNoTail x setFreshConsTail cons cons2 splitAtFreshConsTail cons2 (index - 1) xs let splitAt index l = - if index < 0 then invalidArg "index" (SR.GetString(SR.inputMustBeNonNegative)) + if index < 0 then invalidArgFmt "index" "{0}\nindex = {1}" [|SR.GetString SR.inputMustBeNonNegative; index|] if index = 0 then [], l else match l with - | [] -> raise <| System.InvalidOperationException (SR.GetString(SR.notEnoughElements)) - | [_] -> if index = 1 then l, [] else raise <| System.InvalidOperationException (SR.GetString(SR.notEnoughElements)) + | [] -> invalidOp (SR.GetString SR.inputListWasEmpty) + | [_] -> + if index = 1 then l, [] else + invalidOpFmt + "{0}\nThe list was {1} {2} shorter than the index" + [|SR.GetString SR.notEnoughElements; index-1; (if index=2 then "element" else "elements")|] + | x::xs -> if index = 1 then [x], xs else let cons = freshConsNoTail x @@ -707,7 +770,7 @@ module internal List = windowedToFreshConsTail cons2 windowSize (i - 1) list.Tail let windowed windowSize (list: 'T list) = - if windowSize <= 0 then invalidArg "windowSize" (SR.GetString(SR.inputMustBePositive)) + if windowSize <= 0 then invalidArgFmt "windowSize" "{0}\nwindowSize = {1}" [|SR.GetString SR.inputMustBePositive; windowSize|] let len = list.Length if windowSize > len then [] @@ -733,7 +796,7 @@ module internal List = chunkBySizeToFreshConsTail cons resCons chunkSize (i+1) t let chunkBySize chunkSize list = - if chunkSize <= 0 then invalidArg "chunkSize" (SR.GetString(SR.inputMustBePositive)) + if chunkSize <= 0 then invalidArgFmt "chunkSize" "{0}\nwindowSize = {1}" [|SR.GetString SR.inputMustBePositive; chunkSize|] match list with | [] -> [] | head::tail -> @@ -759,7 +822,7 @@ module internal List = splitIntoToFreshConsTail cons resCons lenDivCount lenModCount i (j + 1) t let splitInto count (list: _ list) = - if count <= 0 then invalidArg "count" (SR.GetString(SR.inputMustBePositive)) + if count <= 0 then invalidArgFmt "count" "{0}\ncount = {1}" [|SR.GetString SR.inputMustBePositive; count|] match list.Length with | 0 -> [] | len -> @@ -779,8 +842,14 @@ module internal List = let cons2 = freshConsNoTail (h1,h2) setFreshConsTail cons cons2 zipToFreshConsTail cons2 t1 t2 - | _ -> - invalidArg "xs2" (SR.GetString(SR.listsHadDifferentLengths)) + | [],xs2 -> + invalidArgFmt "list1" + "{0}\nlist1 is {1} elements shorter than list2" + [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] + | xs1,[] -> + invalidArgFmt "list2" + "{0}\nlist2 is {1} elements shorter than list1" + [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] // optimized mutation-based implementation. This code is only valid in fslib, where mutation of private // tail cons cells is permitted in carefully written library code. @@ -791,8 +860,14 @@ module internal List = let res = freshConsNoTail (h1,h2) zipToFreshConsTail res t1 t2 res - | _ -> - invalidArg "xs2" (SR.GetString(SR.listsHadDifferentLengths)) + | [],xs2 -> + invalidArgFmt "list1" + "{0}\nlist1 is {1} elements shorter than list2" + [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] + | xs1,[] -> + invalidArgFmt "list2" + "{0}\nlist2 is {1} elements shorter than list1" + [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] // optimized mutation-based implementation. This code is only valid in fslib, where mutation of private // tail cons cells is permitted in carefully written library code. @@ -804,8 +879,10 @@ module internal List = let cons2 = freshConsNoTail (h1,h2,h3) setFreshConsTail cons cons2 zip3ToFreshConsTail cons2 t1 t2 t3 - | _ -> - invalidArg "xs1" (SR.GetString(SR.listsHadDifferentLengths)) + | xs1,xs2,xs3 -> + invalidArgFmt "list1, list2, list3" + "{0}\n list1.Length = {1}, list2.Length = {2}, list3.Length = {3}" + [|SR.GetString SR.listsHadDifferentLengths; xs1.Length; xs2.Length; xs3.Length|] // optimized mutation-based implementation. This code is only valid in fslib, where mutation of private // tail cons cells is permitted in carefully written library code. @@ -817,8 +894,10 @@ module internal List = let res = freshConsNoTail (h1,h2,h3) zip3ToFreshConsTail res t1 t2 t3 res - | _ -> - invalidArg "xs1" (SR.GetString(SR.listsHadDifferentLengths)) + | xs1,xs2,xs3 -> + invalidArgFmt "list1, list2, list3" + "{0}\n list1.Length = {1}, list2.Length = {2}, list3.Length = {3}" + [|SR.GetString SR.listsHadDifferentLengths; xs1.Length; xs2.Length; xs3.Length|] let rec takeWhileFreshConsTail cons p l = match l with @@ -925,7 +1004,7 @@ module internal Array = (# "newarr !0" type ('T) count : 'T array #) let inline init (count:int) (f: int -> 'T) = - if count < 0 then invalidArg "count" LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString + if count < 0 then invalidArgFmt "count" "{0}\ncount = {1}" [|LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString; count|] let arr = (zeroCreateUnchecked count : 'T array) for i = 0 to arr.Length-1 do arr.[i] <- f i From 29d5507e03e060e76136799fd13ee6ffb9716755 Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Wed, 17 Aug 2016 07:45:26 -0400 Subject: [PATCH 04/38] move detailed exceptions into FSharp.Core namespace --- src/fsharp/FSharp.Core/local.fs | 33 ++++++++++++++++++-------------- src/fsharp/FSharp.Core/local.fsi | 7 +++++++ 2 files changed, 26 insertions(+), 14 deletions(-) diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index a8b5951d5d7..03d5a38b781 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -1,8 +1,27 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +namespace Microsoft.FSharp.Core + +module DetailedExceptions = + + /// takes an argument, a formatting string, a param array to splice into the formatting string + let inline internal invalidArgFmt (arg:string) (format:string) paramArray = + let msg = System.String.Format (format,paramArray) + raise (new System.ArgumentException (msg,arg)) + + /// takes a formatting string and a param array to splice into the formatting string + let inline internal invalidOpFmt (format:string) paramArray = + let msg = System.String.Format (format,paramArray) + raise (new System.InvalidOperationException(msg)) + + + + namespace Microsoft.FSharp.Primitives.Basics open Microsoft.FSharp.Core +open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Collections open Microsoft.FSharp.Core.Operators @@ -14,20 +33,6 @@ open Microsoft.FSharp.Core.ICloneableExtensions #endif -module internal DetailedExceptions = - - /// takes an argument, a formatting string, a param array to splice into the formatting string - let inline internal invalidArgFmt (arg:string) (fmt:string) argArray = - let msg = System.String.Format (fmt,argArray) - raise (new System.ArgumentException (msg,arg)) - - /// takes a formatting string and a param array to splice into the formatting string - let inline internal invalidOpFmt (fmt:string) argArray = - let msg = System.String.Format (fmt,argArray) - raise (new System.InvalidOperationException(msg)) - -open DetailedExceptions - module internal List = let arrayZeroCreate (n:int) = (# "newarr !0" type ('T) n : 'T array #) diff --git a/src/fsharp/FSharp.Core/local.fsi b/src/fsharp/FSharp.Core/local.fsi index 342d3ac8852..5d04acf72ec 100644 --- a/src/fsharp/FSharp.Core/local.fsi +++ b/src/fsharp/FSharp.Core/local.fsi @@ -1,5 +1,12 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. +namespace Microsoft.FSharp.Core +open Microsoft.FSharp.Core + +module internal DetailedExceptions = + val inline internal invalidArgFmt: arg:string -> format:string -> paramArray:obj array -> 'a + val inline internal invalidOpFmt: format:string -> paramArray:obj array -> 'a + /// Definitions internal for this library. namespace Microsoft.FSharp.Primitives.Basics From 67d5ab2b07c9cdf27fad1dca123a62c1929de817 Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Wed, 17 Aug 2016 07:45:52 -0400 Subject: [PATCH 05/38] detailed error messages for array2.fs --- src/fsharp/FSharp.Core/array2.fs | 50 +++++++++++++++++++++++++------- 1 file changed, 40 insertions(+), 10 deletions(-) diff --git a/src/fsharp/FSharp.Core/array2.fs b/src/fsharp/FSharp.Core/array2.fs index bcab855a895..3a590b21dc0 100644 --- a/src/fsharp/FSharp.Core/array2.fs +++ b/src/fsharp/FSharp.Core/array2.fs @@ -4,6 +4,7 @@ namespace Microsoft.FSharp.Collections open System open Microsoft.FSharp.Core + open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Core.Operators open Microsoft.FSharp.Core.Operators.Checked @@ -37,8 +38,8 @@ namespace Microsoft.FSharp.Collections [] let zeroCreate (n:int) (m:int) = - if n < 0 then invalidArg "n" (SR.GetString(SR.inputMustBeNonNegative)) - if m < 0 then invalidArg "m" (SR.GetString(SR.inputMustBeNonNegative)) + if n < 0 then invalidArgFmt "length1" "{0}\nlength1 = {0}" [|SR.GetString SR.inputMustBeNonNegative; n|] + if m < 0 then invalidArgFmt "length2" "{0}\nlength2 = {0}" [|SR.GetString SR.inputMustBeNonNegative; m|] (# "newarr.multi 2 !0" type ('T) n m : 'T[,] #) [] @@ -133,14 +134,43 @@ namespace Microsoft.FSharp.Collections let blit (source : 'T[,]) sourceIndex1 sourceIndex2 (target : 'T[,]) targetIndex1 targetIndex2 count1 count2 = checkNonNull "source" source checkNonNull "target" target - if sourceIndex1 < source.GetLowerBound(0) then invalidArg "sourceIndex1" (SR.GetString(SR.outOfRange)) - if sourceIndex2 < source.GetLowerBound(1) then invalidArg "sourceIndex2" (SR.GetString(SR.outOfRange)) - if targetIndex1 < target.GetLowerBound(0) then invalidArg "targetIndex1" (SR.GetString(SR.outOfRange)) - if targetIndex2 < target.GetLowerBound(1) then invalidArg "targetIndex2" (SR.GetString(SR.outOfRange)) - if sourceIndex1 + count1 > (length1 source) + source.GetLowerBound(0) then invalidArg "count1" (SR.GetString(SR.outOfRange)) - if sourceIndex2 + count2 > (length2 source) + source.GetLowerBound(1) then invalidArg "count2" (SR.GetString(SR.outOfRange)) - if targetIndex1 + count1 > (length1 target) + target.GetLowerBound(0) then invalidArg "count1" (SR.GetString(SR.outOfRange)) - if targetIndex2 + count2 > (length2 target) + target.GetLowerBound(1) then invalidArg "count2" (SR.GetString(SR.outOfRange)) + let sourceX0, sourceY0 = source.GetLowerBound 0 , source.GetLowerBound 1 + let sourceXN, sourceYN = (length1 source) + sourceX0, (length2 source) + sourceY0 + let targetX0, targetY0 = target.GetLowerBound 0 , target.GetLowerBound 1 + let targetXN, targetYN = (length1 target) + targetX0, (length2 target) + targetY0 + + if sourceIndex1 < sourceX0 then + invalidArgFmt "sourceIndex1" + "{0}\nsourceIndex1 = {1}, source axis-0 lower bound = {2}" + [|SR.GetString SR.outOfRange; sourceIndex1; sourceX0|] + if sourceIndex2 < sourceY0 then + invalidArgFmt "sourceIndex2" + "{0}\nsourceIndex2 = {1}, source axis-1 lower bound = {2}" + [|SR.GetString SR.outOfRange; sourceIndex2; sourceY0|] + if targetIndex1 < targetX0 then + invalidArgFmt "targetIndex1" + "{0}\ntargetIndex1 = {1}, target axis-0 lower bound = {2}" + [|SR.GetString SR.outOfRange; targetIndex1; targetX0|] + if targetIndex2 < targetY0 then + invalidArgFmt "targetIndex2" + "{0}\ntargetIndex2 = {1}, target axis-1 lower bound = {2}" + [|SR.GetString SR.outOfRange; targetIndex2; targetY0|] + if sourceIndex1 + count1 > sourceXN then + invalidArgFmt "count1" + "{0}\nsource axis-0 end index = {1}, source axis-0 upper bound = {2}" + [|SR.GetString SR.outOfRange; sourceIndex1 + count1; sourceXN|] + if sourceIndex2 + count2 > sourceYN then + invalidArgFmt "count2" + "{0}\nsource axis-1 end index = {1}, source axis-1 upper bound = {2}" + [|SR.GetString SR.outOfRange; sourceIndex2 + count2; sourceYN|] + if targetIndex1 + count1 > targetXN then + invalidArgFmt "count1" + "{0}\ntarget axis-0 end index = {1}, target axis-0 upper bound = {2}" + [|SR.GetString SR.outOfRange; targetIndex1 + count1; targetXN|] + if targetIndex2 + count2 > targetYN then + invalidArgFmt "count2" + "{0}\ntarget axis-1 end index = {1}, target axis-1 upper bound = {2}" + [|SR.GetString SR.outOfRange; targetIndex2 + count2; targetYN|] for i = 0 to count1 - 1 do for j = 0 to count2 - 1 do From 8e1d47c7d9c76138970e1b42c54fa58cfc465b73 Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Wed, 17 Aug 2016 08:27:02 -0400 Subject: [PATCH 06/38] Detailed error messages seq.fs --- src/fsharp/FSharp.Core/seq.fs | 961 +++++++++++++++++----------------- 1 file changed, 486 insertions(+), 475 deletions(-) diff --git a/src/fsharp/FSharp.Core/seq.fs b/src/fsharp/FSharp.Core/seq.fs index 196956dc311..0aaad8403ef 100644 --- a/src/fsharp/FSharp.Core/seq.fs +++ b/src/fsharp/FSharp.Core/seq.fs @@ -8,13 +8,14 @@ namespace Microsoft.FSharp.Collections open System.Collections open System.Collections.Generic open Microsoft.FSharp.Core + open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Core.Operators open Microsoft.FSharp.Control open Microsoft.FSharp.Collections open Microsoft.FSharp.Primitives.Basics - module IEnumerator = + module IEnumerator = let noReset() = raise (new System.NotSupportedException(SR.GetString(SR.resetNotSupported))) @@ -23,39 +24,39 @@ namespace Microsoft.FSharp.Collections let check started = if not started then notStarted() let dispose (r : System.IDisposable) = r.Dispose() - let cast (e : IEnumerator) : IEnumerator<'T> = - { new IEnumerator<'T> with + let cast (e : IEnumerator) : IEnumerator<'T> = + { new IEnumerator<'T> with member x.Current = unbox<'T> e.Current - interface IEnumerator with + interface IEnumerator with member x.Current = unbox<'T> e.Current :> obj member x.MoveNext() = e.MoveNext() member x.Reset() = noReset() - interface System.IDisposable with - member x.Dispose() = - match e with + interface System.IDisposable with + member x.Dispose() = + match e with | :? System.IDisposable as e -> e.Dispose() | _ -> () } - + /// A concrete implementation of an enumerator that returns no values [] - type EmptyEnumerator<'T>() = - let mutable started = false - interface IEnumerator<'T> with - member x.Current = - check started + type EmptyEnumerator<'T>() = + let mutable started = false + interface IEnumerator<'T> with + member x.Current = + check started (alreadyFinished() : 'T) - - interface System.Collections.IEnumerator with - member x.Current = - check started + + interface System.Collections.IEnumerator with + member x.Current = + check started (alreadyFinished() : obj) - member x.MoveNext() = + member x.MoveNext() = if not started then started <- true false member x.Reset() = noReset() - interface System.IDisposable with - member x.Dispose() = () - + interface System.IDisposable with + member x.Dispose() = () + let Empty<'T> () = (new EmptyEnumerator<'T>() :> IEnumerator<'T>) let rec tryItem index (e : IEnumerator<'T>) = @@ -63,15 +64,18 @@ namespace Microsoft.FSharp.Collections elif index = 0 then Some(e.Current) else tryItem (index-1) e - let rec nth index (e : IEnumerator<'T>) = - if not (e.MoveNext()) then invalidArg "index" (SR.GetString(SR.notEnoughElements)) + let rec nth index (e : IEnumerator<'T>) = + if not (e.MoveNext()) then + invalidArgFmt "index" + "{0}\nseq was short by {1} {2}" + [|SR.GetString SR.notEnoughElements; index; (if index=1 then "element" else "elements")|] if index = 0 then e.Current else nth (index-1) e [] - type MapEnumeratorState = - | NotStarted - | InProcess + type MapEnumeratorState = + | NotStarted + | InProcess | Finished [] @@ -79,20 +83,20 @@ namespace Microsoft.FSharp.Collections let mutable state = NotStarted [] val mutable private curr : 'T - + member this.GetCurrent () = match state with | NotStarted -> notStarted() | Finished -> alreadyFinished() | InProcess -> () this.curr - + abstract DoMoveNext : byref<'T> -> bool abstract Dispose : unit -> unit - + interface IEnumerator<'T> with member this.Current = this.GetCurrent() - + interface IEnumerator with member this.Current = box(this.GetCurrent()) member this.MoveNext () = @@ -105,9 +109,9 @@ namespace Microsoft.FSharp.Collections member this.Reset() = noReset() interface System.IDisposable with member this.Dispose() = this.Dispose() - + let map f (e : IEnumerator<_>) : IEnumerator<_>= - upcast + upcast { new MapEnumerator<_>() with member this.DoMoveNext (curr : byref<_>) = if e.MoveNext() then @@ -117,10 +121,10 @@ namespace Microsoft.FSharp.Collections false member this.Dispose() = e.Dispose() } - + let mapi f (e : IEnumerator<_>) : IEnumerator<_> = let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f) - let i = ref (-1) + let i = ref (-1) upcast { new MapEnumerator<_>() with member this.DoMoveNext curr = @@ -132,22 +136,22 @@ namespace Microsoft.FSharp.Collections false member this.Dispose() = e.Dispose() } - + let map2 f (e1 : IEnumerator<_>) (e2 : IEnumerator<_>) : IEnumerator<_>= let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f) - upcast + upcast { new MapEnumerator<_>() with - member this.DoMoveNext curr = + member this.DoMoveNext curr = let n1 = e1.MoveNext() let n2 = e2.MoveNext() if n1 && n2 then curr <- f.Invoke(e1.Current, e2.Current) true - else + else false - member this.Dispose() = - try - e1.Dispose() + member this.Dispose() = + try + e1.Dispose() finally e2.Dispose() } @@ -171,21 +175,21 @@ namespace Microsoft.FSharp.Collections e2.Dispose() } - let map3 f (e1 : IEnumerator<_>) (e2 : IEnumerator<_>) (e3 : IEnumerator<_>) : IEnumerator<_> = + let map3 f (e1 : IEnumerator<_>) (e2 : IEnumerator<_>) (e3 : IEnumerator<_>) : IEnumerator<_> = let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(f) - upcast + upcast { new MapEnumerator<_>() with - member this.DoMoveNext curr = + member this.DoMoveNext curr = let n1 = e1.MoveNext() let n2 = e2.MoveNext() let n3 = e3.MoveNext() - if n1 && n2 && n3 then + if n1 && n2 && n3 then curr <- f.Invoke(e1.Current, e2.Current, e3.Current) true else false - member this.Dispose() = + member this.Dispose() = try e1.Dispose() finally @@ -195,44 +199,44 @@ namespace Microsoft.FSharp.Collections e3.Dispose() } - let choose f (e : IEnumerator<'T>) = - let started = ref false - let curr = ref None - let get() = check !started; (match !curr with None -> alreadyFinished() | Some x -> x) - { new IEnumerator<'U> with + let choose f (e : IEnumerator<'T>) = + let started = ref false + let curr = ref None + let get() = check !started; (match !curr with None -> alreadyFinished() | Some x -> x) + { new IEnumerator<'U> with member x.Current = get() - interface IEnumerator with + interface IEnumerator with member x.Current = box (get()) - member x.MoveNext() = + member x.MoveNext() = if not !started then started := true - curr := None - while ((!curr).IsNone && e.MoveNext()) do + curr := None + while ((!curr).IsNone && e.MoveNext()) do curr := f e.Current Option.isSome !curr member x.Reset() = noReset() - interface System.IDisposable with + interface System.IDisposable with member x.Dispose() = e.Dispose() } - let filter f (e : IEnumerator<'T>) = - let started = ref false - let this = - { new IEnumerator<'T> with + let filter f (e : IEnumerator<'T>) = + let started = ref false + let this = + { new IEnumerator<'T> with member x.Current = check !started; e.Current - interface IEnumerator with + interface IEnumerator with member x.Current = check !started; box e.Current - member x.MoveNext() = + member x.MoveNext() = let rec next() = if not !started then started := true - e.MoveNext() && (f e.Current || next()) + e.MoveNext() && (f e.Current || next()) next() member x.Reset() = noReset() - interface System.IDisposable with - member x.Dispose() = e.Dispose() } + interface System.IDisposable with + member x.Dispose() = e.Dispose() } this - + let unfold f x : IEnumerator<_> = let state = ref x - upcast + upcast { new MapEnumerator<_>() with member this.DoMoveNext curr = match f !state with @@ -247,13 +251,13 @@ namespace Microsoft.FSharp.Collections let upto lastOption f = match lastOption with | Some b when b<0 -> Empty() // a request for -ve length returns empty sequence - | _ -> + | _ -> let unstarted = -1 // index value means unstarted (and no valid index) let completed = -2 // index value means completed (and no valid index) let unreachable = -3 // index is unreachable from 0,1,2,3,... let finalIndex = match lastOption with | Some b -> b // here b>=0, a valid end value. - | None -> unreachable // run "forever", well as far as Int32.MaxValue since indexing with a bounded type. + | None -> unreachable // run "forever", well as far as Int32.MaxValue since indexing with a bounded type. // The Current value for a valid index is "f i". // Lazy<_> values are used as caches, to store either the result or an exception if thrown. // These "Lazy<_>" caches are created only on the first call to current and forced immediately. @@ -264,19 +268,19 @@ namespace Microsoft.FSharp.Collections // a Lazy node to cache the result/exception let current = ref (Unchecked.defaultof<_>) let setIndex i = index := i; current := (Unchecked.defaultof<_>) // cache node unprimed, initialised on demand. - let getCurrent() = + let getCurrent() = if !index = unstarted then notStarted() if !index = completed then alreadyFinished() - match box !current with - | null -> current := Lazy<_>.Create(fun () -> f !index) + match box !current with + | null -> current := Lazy<_>.Create(fun () -> f !index) | _ -> () - // forced or re-forced immediately. - (!current).Force() - { new IEnumerator<'U> with + // forced or re-forced immediately. + (!current).Force() + { new IEnumerator<'U> with member x.Current = getCurrent() - interface IEnumerator with + interface IEnumerator with member x.Current = box (getCurrent()) - member x.MoveNext() = + member x.MoveNext() = if !index = completed then false elif !index = unstarted then @@ -291,67 +295,67 @@ namespace Microsoft.FSharp.Collections true ) member self.Reset() = noReset() - interface System.IDisposable with - member x.Dispose() = () } - - let readAndClear r = + interface System.IDisposable with + member x.Dispose() = () } + + let readAndClear r = lock r (fun () -> match !r with None -> None | Some _ as res -> r := None; res) - - let generateWhileSome openf compute closef : IEnumerator<'U> = - let started = ref false + + let generateWhileSome openf compute closef : IEnumerator<'U> = + let started = ref false let curr = ref None - let state = ref (Some(openf())) - let getCurr() = + let state = ref (Some(openf())) + let getCurr() = check !started - match !curr with None -> alreadyFinished() | Some x -> x - let start() = if not !started then (started := true) + match !curr with None -> alreadyFinished() | Some x -> x + let start() = if not !started then (started := true) let dispose() = readAndClear state |> Option.iter closef - let finish() = (try dispose() finally curr := None) - { new IEnumerator<'U> with + let finish() = (try dispose() finally curr := None) + { new IEnumerator<'U> with member x.Current = getCurr() - interface IEnumerator with + interface IEnumerator with member x.Current = box (getCurr()) - member x.MoveNext() = + member x.MoveNext() = start() - match !state with + match !state with | None -> false (* we started, then reached the end, then got another MoveNext *) - | Some s -> - match (try compute s with e -> finish(); reraise()) with + | Some s -> + match (try compute s with e -> finish(); reraise()) with | None -> finish(); false | Some _ as x -> curr := x; true member x.Reset() = noReset() - interface System.IDisposable with - member x.Dispose() = dispose() } + interface System.IDisposable with + member x.Dispose() = dispose() } [] - type ArrayEnumerator<'T>(arr: 'T array) = + type ArrayEnumerator<'T>(arr: 'T array) = let mutable curr = -1 let mutable len = arr.Length member x.Get() = - if curr >= 0 then + if curr >= 0 then if curr >= len then alreadyFinished() else arr.[curr] - else + else notStarted() - interface IEnumerator<'T> with + interface IEnumerator<'T> with member x.Current = x.Get() - interface System.Collections.IEnumerator with - member x.MoveNext() = + interface System.Collections.IEnumerator with + member x.MoveNext() = if curr >= len then false - else + else curr <- curr + 1 (curr < len) member x.Current = box(x.Get()) member x.Reset() = noReset() - interface System.IDisposable with - member x.Dispose() = () + interface System.IDisposable with + member x.Dispose() = () let ofArray arr = (new ArrayEnumerator<'T>(arr) :> IEnumerator<'T>) - [] - type Singleton<'T>(v:'T) = + [] + type Singleton<'T>(v:'T) = let mutable started = false interface IEnumerator<'T> with member x.Current = v @@ -360,11 +364,11 @@ namespace Microsoft.FSharp.Collections member x.MoveNext() = if started then false else (started <- true; true) member x.Reset() = noReset() interface System.IDisposable with - member x.Dispose() = () + member x.Dispose() = () let Singleton x = (new Singleton<'T>(x) :> IEnumerator<'T>) - let EnumerateThenFinally f (e : IEnumerator<'T>) = + let EnumerateThenFinally f (e : IEnumerator<'T>) = { new IEnumerator<'T> with member x.Current = e.Current interface IEnumerator with @@ -372,79 +376,79 @@ namespace Microsoft.FSharp.Collections member x.MoveNext() = e.MoveNext() member x.Reset() = noReset() interface System.IDisposable with - member x.Dispose() = + member x.Dispose() = try - e.Dispose() + e.Dispose() finally f() } // Use generators for some implementations of IEnumerables. // - module Generator = + module Generator = open System.Collections open System.Collections.Generic - + [] - type Step<'T> = + type Step<'T> = | Stop | Yield of 'T | Goto of Generator<'T> - and Generator<'T> = + and Generator<'T> = abstract Apply: (unit -> Step<'T>) abstract Disposer: (unit -> unit) option - let disposeG (g:Generator<'T>) = - match g.Disposer with - | None -> () + let disposeG (g:Generator<'T>) = + match g.Disposer with + | None -> () | Some f -> f() - + let appG (g:Generator<_>) = //System.Console.WriteLine("{0}.appG", box g) let res = g.Apply() - match res with - | Goto(next) -> + match res with + | Goto(next) -> Goto(next) - | Yield _ -> + | Yield _ -> res - | Stop -> + | Stop -> //System.Console.WriteLine("appG: Stop") disposeG g res - - // Binding. + + // Binding. // - // We use a type definition to apply a local dynamic optimization. + // We use a type definition to apply a local dynamic optimization. // We automatically right-associate binding, i.e. push the continuations to the right. // That is, bindG (bindG G1 cont1) cont2 --> bindG G1 (cont1 o cont2) // This makes constructs such as the following linear rather than quadratic: // - // let rec rwalk n = { if n > 0 then + // let rec rwalk n = { if n > 0 then // yield! rwalk (n-1) // yield n } type GenerateThen<'T>(g:Generator<'T>, cont : unit -> Generator<'T>) = member self.Generator = g member self.Cont = cont - interface Generator<'T> with - member x.Apply = (fun () -> - match appG g with - | Stop -> + interface Generator<'T> with + member x.Apply = (fun () -> + match appG g with + | Stop -> // OK, move onto the generator given by the continuation Goto(cont()) - | Yield _ as res -> + | Yield _ as res -> res - - | Goto next -> + + | Goto next -> Goto(GenerateThen<_>.Bind(next,cont))) - member x.Disposer = + member x.Disposer = g.Disposer - static member Bind (g:Generator<'T>, cont) = + static member Bind (g:Generator<'T>, cont) = match g with | :? GenerateThen<'T> as g -> GenerateThen<_>.Bind(g.Generator,(fun () -> GenerateThen<_>.Bind (g.Cont(), cont))) | g -> (new GenerateThen<'T>(g, cont) :> Generator<'T>) @@ -452,28 +456,28 @@ namespace Microsoft.FSharp.Collections let bindG g cont = GenerateThen<_>.Bind(g,cont) - //let emptyG () = - // { new Generator<_> with + //let emptyG () = + // { new Generator<_> with // member x.Apply = (fun () -> Stop) // member x.Disposer = None } // - //let delayG f = - // { new Generator<_> with + //let delayG f = + // { new Generator<_> with // member x.Apply = fun () -> Goto(f()) // member x.Disposer = None } // - //let useG (v: System.IDisposable) f = - // { new Generator<_> with - // member x.Apply = (fun () -> - // let g = f v in + //let useG (v: System.IDisposable) f = + // { new Generator<_> with + // member x.Apply = (fun () -> + // let g = f v in // // We're leaving this generator but want to maintain the disposal on the target. // // Hence chain it into the disposer of the target // Goto(chainDisposeG v.Dispose g)) // member x.Disposer = Some (fun () -> v.Dispose()) } // - //let yieldG (v:'T) = + //let yieldG (v:'T) = // let yielded = ref false - // { new Generator<_> with + // { new Generator<_> with // member x.Apply = fun () -> if !yielded then Stop else (yielded := true; Yield(v)) // member x.Disposer = None } // @@ -481,24 +485,24 @@ namespace Microsoft.FSharp.Collections // //let yieldThenG x b = bindG (yieldG x) b // - //let forG (v: seq<'T>) f = - // let e = v.GetEnumerator() in + //let forG (v: seq<'T>) f = + // let e = v.GetEnumerator() in // whileG e.MoveNext (fun () -> f e.Current) // Internal type. Drive an underlying generator. Crucially when the generator returns // a new generator we simply update our current generator and continue. Thus the enumerator // effectively acts as a reference cell holding the current generator. This means that - // infinite or large generation chains (e.g. caused by long sequences of append's, including + // infinite or large generation chains (e.g. caused by long sequences of append's, including // possible delay loops) can be referenced via a single enumerator. // // A classic case where this arises in this sort of sequence expression: - // let rec data s = { yield s; + // let rec data s = { yield s; // yield! data (s + random()) } // - // This translates to + // This translates to // let rec data s = Seq.delay (fun () -> Seq.append (Seq.singleton s) (Seq.delay (fun () -> data (s+random())))) // - // When you unwind through all the Seq, IEnumerator and Generator objects created, + // When you unwind through all the Seq, IEnumerator and Generator objects created, // you get (data s).GetEnumerator being an "GenerateFromEnumerator(EnumeratorWrappingLazyGenerator(...))" for the append. // After one element is yielded, we move on to the generator for the inner delay, which in turn // comes back to be a "GenerateFromEnumerator(EnumeratorWrappingLazyGenerator(...))". @@ -520,8 +524,8 @@ namespace Microsoft.FSharp.Collections member x.MoveNext() = not finished && (match appG g with - | Stop -> - curr <- None + | Stop -> + curr <- None finished <- true false | Yield(v) -> @@ -539,28 +543,29 @@ namespace Microsoft.FSharp.Collections type LazyGeneratorWrappingEnumerator<'T>(e:System.Collections.Generic.IEnumerator<'T>) = member g.Enumerator = e interface Generator<'T> with - member g.Apply = (fun () -> - if e.MoveNext() then - Yield(e.Current) - else + member g.Apply = (fun () -> + if e.MoveNext() then + Yield(e.Current) + else Stop) member g.Disposer= Some(e.Dispose) - let EnumerateFromGenerator(g:Generator<'T>) = - match g with + let EnumerateFromGenerator(g:Generator<'T>) = + match g with | :? LazyGeneratorWrappingEnumerator<'T> as g -> g.Enumerator | _ -> (new EnumeratorWrappingLazyGenerator<_>(g) :> System.Collections.Generic.IEnumerator<_>) let GenerateFromEnumerator (e:System.Collections.Generic.IEnumerator<'T>) = - match e with + match e with | :? EnumeratorWrappingLazyGenerator<'T> as e -> e.Generator | _ -> (new LazyGeneratorWrappingEnumerator<'T>(e) :> Generator<'T>) - + namespace Microsoft.FSharp.Core.CompilerServices open System open System.Diagnostics open Microsoft.FSharp.Core + open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Core.Operators open Microsoft.FSharp.Control @@ -570,45 +575,45 @@ namespace Microsoft.FSharp.Core.CompilerServices open System.Collections.Generic module RuntimeHelpers = - + [] - type internal StructBox<'T when 'T : equality>(value:'T) = + type internal StructBox<'T when 'T : equality>(value:'T) = member x.Value = value static member Comparer = let gcomparer = HashIdentity.Structural<'T> - { new IEqualityComparer> with + { new IEqualityComparer> with member __.GetHashCode(v) = gcomparer.GetHashCode(v.Value) member __.Equals(v1,v2) = gcomparer.Equals(v1.Value,v2.Value) } - let inline checkNonNull argName arg = - match box arg with - | null -> nullArg argName + let inline checkNonNull argName arg = + match box arg with + | null -> nullArg argName | _ -> () - let mkSeq f = - { new IEnumerable<'U> with + let mkSeq f = + { new IEnumerable<'U> with member x.GetEnumerator() = f() - interface IEnumerable with + interface IEnumerable with member x.GetEnumerator() = (f() :> IEnumerator) } [] - type EmptyEnumerable<'T> = + type EmptyEnumerable<'T> = | EmptyEnumerable - interface IEnumerable<'T> with + interface IEnumerable<'T> with member x.GetEnumerator() = IEnumerator.Empty<'T>() - interface IEnumerable with - member x.GetEnumerator() = (IEnumerator.Empty<'T>() :> IEnumerator) + interface IEnumerable with + member x.GetEnumerator() = (IEnumerator.Empty<'T>() :> IEnumerator) - let Generate openf compute closef = - mkSeq (fun () -> IEnumerator.generateWhileSome openf compute closef) - - let GenerateUsing (openf : unit -> ('U :> System.IDisposable)) compute = + let Generate openf compute closef = + mkSeq (fun () -> IEnumerator.generateWhileSome openf compute closef) + + let GenerateUsing (openf : unit -> ('U :> System.IDisposable)) compute = Generate openf compute (fun (s:'U) -> s.Dispose()) - let EnumerateFromFunctions opener moveNext current = - Generate - opener - (fun x -> if moveNext x then Some(current x) else None) + let EnumerateFromFunctions opener moveNext current = + Generate + opener + (fun x -> if moveNext x then Some(current x) else None) (fun x -> match box(x) with :? System.IDisposable as id -> id.Dispose() | _ -> ()) // A family of enumerators that can have additional 'finally' actions added to the enumerator through @@ -619,57 +624,57 @@ namespace Microsoft.FSharp.Core.CompilerServices // results in the 'while' loop giving an adjustable enumerator. This is then adjusted by adding the disposal action // from the 'use' into the enumerator. This means that we avoid constructing a two-deep enumerator chain in this // common case. - type IFinallyEnumerator = + type IFinallyEnumerator = abstract AppendFinallyAction : (unit -> unit) -> unit /// A concrete implementation of IEnumerable that adds the given compensation to the "Dispose" chain of any /// enumerators returned by the enumerable. [] - type FinallyEnumerable<'T>(compensation: unit -> unit, restf: unit -> seq<'T>) = - interface IEnumerable<'T> with - member x.GetEnumerator() = - try + type FinallyEnumerable<'T>(compensation: unit -> unit, restf: unit -> seq<'T>) = + interface IEnumerable<'T> with + member x.GetEnumerator() = + try let ie = restf().GetEnumerator() - match ie with - | :? IFinallyEnumerator as a -> + match ie with + | :? IFinallyEnumerator as a -> a.AppendFinallyAction(compensation) ie - | _ -> - IEnumerator.EnumerateThenFinally compensation ie - with e -> + | _ -> + IEnumerator.EnumerateThenFinally compensation ie + with e -> compensation() reraise() - interface IEnumerable with - member x.GetEnumerator() = ((x :> IEnumerable<'T>).GetEnumerator() :> IEnumerator) - + interface IEnumerable with + member x.GetEnumerator() = ((x :> IEnumerable<'T>).GetEnumerator() :> IEnumerator) + /// An optimized object for concatenating a sequence of enumerables [] - type ConcatEnumerator<'T,'U when 'U :> seq<'T>>(sources: seq<'U>) = + type ConcatEnumerator<'T,'U when 'U :> seq<'T>>(sources: seq<'U>) = let mutable outerEnum = sources.GetEnumerator() let mutable currInnerEnum = IEnumerator.Empty() - let mutable started = false - let mutable finished = false + let mutable started = false + let mutable finished = false let mutable compensations = [] - + [] // false = unchecked val mutable private currElement : 'T - member x.Finish() = + member x.Finish() = finished <- true try - match currInnerEnum with + match currInnerEnum with | null -> () - | _ -> + | _ -> try currInnerEnum.Dispose() finally currInnerEnum <- null finally try - match outerEnum with + match outerEnum with | null -> () - | _ -> + | _ -> try outerEnum.Dispose() finally @@ -684,110 +689,110 @@ namespace Microsoft.FSharp.Core.CompilerServices compensations |> List.rev |> iter finally compensations <- [] - - member x.GetCurrent() = + + member x.GetCurrent() = IEnumerator.check started if finished then IEnumerator.alreadyFinished() else x.currElement - - interface IFinallyEnumerator with - member x.AppendFinallyAction(f) = + + interface IFinallyEnumerator with + member x.AppendFinallyAction(f) = compensations <- f :: compensations - - interface IEnumerator<'T> with + + interface IEnumerator<'T> with member x.Current = x.GetCurrent() - interface IEnumerator with + interface IEnumerator with member x.Current = box (x.GetCurrent()) - - member x.MoveNext() = - if not started then (started <- true) + + member x.MoveNext() = + if not started then (started <- true) if finished then false - else - let rec takeInner () = + else + let rec takeInner () = // check the inner list - if currInnerEnum.MoveNext() then + if currInnerEnum.MoveNext() then x.currElement <- currInnerEnum.Current true else // check the outer list - let rec takeOuter() = - if outerEnum.MoveNext() then - let ie = outerEnum.Current + let rec takeOuter() = + if outerEnum.MoveNext() then + let ie = outerEnum.Current // Optimization to detect the statically-allocated empty IEnumerables match box ie with - | :? EmptyEnumerable<'T> -> + | :? EmptyEnumerable<'T> -> // This one is empty, just skip, don't call GetEnumerator, try again takeOuter() - | _ -> + | _ -> // OK, this one may not be empty. // Don't forget to dispose of the enumerator for the inner list now we're done with it currInnerEnum.Dispose() currInnerEnum <- ie.GetEnumerator() takeInner () - else + else // We're done x.Finish() false takeOuter() - takeInner () + takeInner () member x.Reset() = IEnumerator.noReset() - interface System.IDisposable with - member x.Dispose() = - if not finished then - x.Finish() - - let EnumerateUsing (resource : 'T :> System.IDisposable) (rest: 'T -> #seq<'U>) = - (FinallyEnumerable((fun () -> match box resource with null -> () | _ -> resource.Dispose()), + interface System.IDisposable with + member x.Dispose() = + if not finished then + x.Finish() + + let EnumerateUsing (resource : 'T :> System.IDisposable) (rest: 'T -> #seq<'U>) = + (FinallyEnumerable((fun () -> match box resource with null -> () | _ -> resource.Dispose()), (fun () -> rest resource :> seq<_>)) :> seq<_>) - let mkConcatSeq (sources: seq<'U :> seq<'T>>) = + let mkConcatSeq (sources: seq<'U :> seq<'T>>) = mkSeq (fun () -> new ConcatEnumerator<_,_>(sources) :> IEnumerator<'T>) - let EnumerateWhile (g : unit -> bool) (b: seq<'T>) : seq<'T> = - let started = ref false + let EnumerateWhile (g : unit -> bool) (b: seq<'T>) : seq<'T> = + let started = ref false let curr = ref None - let getCurr() = + let getCurr() = IEnumerator.check !started - match !curr with None -> IEnumerator.alreadyFinished() | Some x -> x - let start() = if not !started then (started := true) + match !curr with None -> IEnumerator.alreadyFinished() | Some x -> x + let start() = if not !started then (started := true) - let finish() = (curr := None) - mkConcatSeq - (mkSeq (fun () -> - { new IEnumerator<_> with + let finish() = (curr := None) + mkConcatSeq + (mkSeq (fun () -> + { new IEnumerator<_> with member x.Current = getCurr() - interface IEnumerator with + interface IEnumerator with member x.Current = box (getCurr()) - member x.MoveNext() = + member x.MoveNext() = start() let keepGoing = (try g() with e -> finish (); reraise ()) in - if keepGoing then + if keepGoing then curr := Some(b); true - else + else finish(); false member x.Reset() = IEnumerator.noReset() - interface System.IDisposable with + interface System.IDisposable with member x.Dispose() = () })) let EnumerateThenFinally (rest : seq<'T>) (compensation : unit -> unit) = (FinallyEnumerable(compensation, (fun () -> rest)) :> seq<_>) - let CreateEvent (add : 'Delegate -> unit) (remove : 'Delegate -> unit) (create : (obj -> 'Args -> unit) -> 'Delegate ) :IEvent<'Delegate,'Args> = - // Note, we implement each interface explicitly: this works around a bug in the CLR + let CreateEvent (add : 'Delegate -> unit) (remove : 'Delegate -> unit) (create : (obj -> 'Args -> unit) -> 'Delegate ) :IEvent<'Delegate,'Args> = + // Note, we implement each interface explicitly: this works around a bug in the CLR // implementation on CompactFramework 3.7, used on Windows Phone 7 { new obj() with member x.ToString() = "" - interface IEvent<'Delegate,'Args> - interface IDelegateEvent<'Delegate> with - member x.AddHandler(h) = add h - member x.RemoveHandler(h) = remove h - interface System.IObservable<'Args> with - member x.Subscribe(r:IObserver<'Args>) = + interface IEvent<'Delegate,'Args> + interface IDelegateEvent<'Delegate> with + member x.AddHandler(h) = add h + member x.RemoveHandler(h) = remove h + interface System.IObservable<'Args> with + member x.Subscribe(r:IObserver<'Args>) = let h = create (fun _ args -> r.OnNext(args)) - add h - { new System.IDisposable with + add h + { new System.IDisposable with member x.Dispose() = remove h } } @@ -795,52 +800,52 @@ namespace Microsoft.FSharp.Core.CompilerServices type GeneratedSequenceBase<'T>() = let mutable redirectTo : GeneratedSequenceBase<'T> = Unchecked.defaultof<_> let mutable redirect : bool = false - + abstract GetFreshEnumerator : unit -> IEnumerator<'T> abstract GenerateNext : next:byref> -> int // 0 = Stop, 1 = Yield, 2 = Goto abstract Close: unit -> unit abstract CheckClose: bool abstract LastGenerated : 'T - + //[] - member x.MoveNextImpl() = - let active = + member x.MoveNextImpl() = + let active = if redirect then redirectTo else x let mutable target = null - match active.GenerateNext(&target) with - | 1 -> + match active.GenerateNext(&target) with + | 1 -> true - | 2 -> - match target.GetEnumerator() with - | :? GeneratedSequenceBase<'T> as g when not active.CheckClose -> + | 2 -> + match target.GetEnumerator() with + | :? GeneratedSequenceBase<'T> as g when not active.CheckClose -> redirectTo <- g - | e -> - redirectTo <- - { new GeneratedSequenceBase<'T>() with + | e -> + redirectTo <- + { new GeneratedSequenceBase<'T>() with member x.GetFreshEnumerator() = e - member x.GenerateNext(_) = if e.MoveNext() then 1 else 0 + member x.GenerateNext(_) = if e.MoveNext() then 1 else 0 member x.Close() = try e.Dispose() finally active.Close() member x.CheckClose = true member x.LastGenerated = e.Current } redirect <- true x.MoveNextImpl() - | _ (* 0 *) -> + | _ (* 0 *) -> false - - interface IEnumerable<'T> with + + interface IEnumerable<'T> with member x.GetEnumerator() = x.GetFreshEnumerator() interface IEnumerable with member x.GetEnumerator() = (x.GetFreshEnumerator() :> IEnumerator) - interface IEnumerator<'T> with + interface IEnumerator<'T> with member x.Current = if redirect then redirectTo.LastGenerated else x.LastGenerated member x.Dispose() = if redirect then redirectTo.Close() else x.Close() interface IEnumerator with member x.Current = box (if redirect then redirectTo.LastGenerated else x.LastGenerated) //[] - member x.MoveNext() = x.MoveNextImpl() - + member x.MoveNext() = x.MoveNextImpl() + member x.Reset() = raise <| new System.NotSupportedException() @@ -852,6 +857,7 @@ namespace Microsoft.FSharp.Collections open System.Collections.Generic open System.Reflection open Microsoft.FSharp.Core + open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Core.Operators open Microsoft.FSharp.Core.CompilerServices @@ -861,36 +867,36 @@ namespace Microsoft.FSharp.Collections [] type CachedSeq<'T>(cleanup,res:seq<'T>) = - interface System.IDisposable with + interface System.IDisposable with member x.Dispose() = cleanup() - interface System.Collections.Generic.IEnumerable<'T> with + interface System.Collections.Generic.IEnumerable<'T> with member x.GetEnumerator() = res.GetEnumerator() - interface System.Collections.IEnumerable with + interface System.Collections.IEnumerable with member x.GetEnumerator() = (res :> System.Collections.IEnumerable).GetEnumerator() member obj.Clear() = cleanup() - + [] [] - module Seq = - + module Seq = + #if FX_NO_ICLONEABLE - open Microsoft.FSharp.Core.ICloneableExtensions + open Microsoft.FSharp.Core.ICloneableExtensions #else -#endif +#endif open Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers - + let mkDelayedSeq (f: unit -> IEnumerable<'T>) = mkSeq (fun () -> f().GetEnumerator()) - let mkUnfoldSeq f x = mkSeq (fun () -> IEnumerator.unfold f x) + let mkUnfoldSeq f x = mkSeq (fun () -> IEnumerator.unfold f x) let inline indexNotFound() = raise (new System.Collections.Generic.KeyNotFoundException(SR.GetString(SR.keyNotFoundAlt))) - + [] let delay f = mkDelayedSeq f [] let unfold f x = mkUnfoldSeq f x - + [] let empty<'T> = (EmptyEnumerable :> seq<'T>) @@ -899,11 +905,11 @@ namespace Microsoft.FSharp.Collections [] let init count f = - if count < 0 then invalidArg "count" (SR.GetString(SR.inputMustBeNonNegative)) + if count < 0 then invalidArgFmt "count" "{0}\ncount = {1}" [|SR.GetString SR.inputMustBeNonNegative; count|] mkSeq (fun () -> IEnumerator.upto (Some (count-1)) f) [] - let iter f (source : seq<'T>) = + let iter f (source : seq<'T>) = checkNonNull "source" source use e = source.GetEnumerator() while e.MoveNext() do @@ -912,7 +918,7 @@ namespace Microsoft.FSharp.Collections [] let item i (source : seq<'T>) = checkNonNull "source" source - if i < 0 then invalidArg "index" (SR.GetString(SR.inputMustBeNonNegative)) + if i < 0 then invalidArgFmt "index" "{0}\nindex = {1}" [|SR.GetString SR.inputMustBeNonNegative; i|] use e = source.GetEnumerator() IEnumerator.nth i e @@ -927,24 +933,24 @@ namespace Microsoft.FSharp.Collections let nth i (source : seq<'T>) = item i source [] - let iteri f (source : seq<'T>) = + let iteri f (source : seq<'T>) = checkNonNull "source" source use e = source.GetEnumerator() let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f) - let mutable i = 0 + let mutable i = 0 while e.MoveNext() do f.Invoke(i, e.Current) i <- i + 1 [] - let exists f (source : seq<'T>) = + let exists f (source : seq<'T>) = checkNonNull "source" source use e = source.GetEnumerator() let mutable state = false while (not state && e.MoveNext()) do state <- f e.Current state - + [] let inline contains element (source : seq<'T>) = checkNonNull "source" source @@ -953,19 +959,19 @@ namespace Microsoft.FSharp.Collections while (not state && e.MoveNext()) do state <- element = e.Current state - + [] - let forall f (source : seq<'T>) = + let forall f (source : seq<'T>) = checkNonNull "source" source use e = source.GetEnumerator() - let mutable state = true + let mutable state = true while (state && e.MoveNext()) do state <- f e.Current state - - + + [] - let iter2 f (source1 : seq<_>) (source2 : seq<_>) = + let iter2 f (source1 : seq<_>) (source2 : seq<_>) = checkNonNull "source1" source1 checkNonNull "source2" source2 use e1 = source1.GetEnumerator() @@ -975,26 +981,26 @@ namespace Microsoft.FSharp.Collections f.Invoke(e1.Current, e2.Current) [] - let iteri2 f (source1 : seq<_>) (source2 : seq<_>) = + let iteri2 f (source1 : seq<_>) (source2 : seq<_>) = checkNonNull "source1" source1 checkNonNull "source2" source2 use e1 = source1.GetEnumerator() use e2 = source2.GetEnumerator() let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(f) - let mutable i = 0 + let mutable i = 0 while (e1.MoveNext() && e2.MoveNext()) do f.Invoke(i, e1.Current, e2.Current) i <- i + 1 // Build an IEnumerble by wrapping/transforming iterators as they get generated. let revamp f (ie : seq<_>) = mkSeq (fun () -> f (ie.GetEnumerator())) - let revamp2 f (ie1 : seq<_>) (source2 : seq<_>) = + let revamp2 f (ie1 : seq<_>) (source2 : seq<_>) = mkSeq (fun () -> f (ie1.GetEnumerator()) (source2.GetEnumerator())) - let revamp3 f (ie1 : seq<_>) (source2 : seq<_>) (source3 : seq<_>) = + let revamp3 f (ie1 : seq<_>) (source2 : seq<_>) (source3 : seq<_>) = mkSeq (fun () -> f (ie1.GetEnumerator()) (source2.GetEnumerator()) (source3.GetEnumerator())) [] - let filter f source = + let filter f source = checkNonNull "source" source revamp (IEnumerator.filter f) source @@ -1002,12 +1008,12 @@ namespace Microsoft.FSharp.Collections let where f source = filter f source [] - let map f source = + let map f source = checkNonNull "source" source revamp (IEnumerator.map f) source [] - let mapi f source = + let mapi f source = checkNonNull "source" source revamp (IEnumerator.mapi f) source @@ -1018,20 +1024,20 @@ namespace Microsoft.FSharp.Collections revamp2 (IEnumerator.mapi2 f) source1 source2 [] - let map2 f source1 source2 = + let map2 f source1 source2 = checkNonNull "source1" source1 checkNonNull "source2" source2 revamp2 (IEnumerator.map2 f) source1 source2 [] - let map3 f source1 source2 source3 = + let map3 f source1 source2 source3 = checkNonNull "source1" source1 checkNonNull "source2" source2 checkNonNull "source3" source3 revamp3 (IEnumerator.map3 f) source1 source2 source3 [] - let choose f source = + let choose f source = checkNonNull "source" source revamp (IEnumerator.choose f) source @@ -1041,116 +1047,117 @@ namespace Microsoft.FSharp.Collections mapi (fun i x -> i,x) source [] - let zip source1 source2 = + let zip source1 source2 = checkNonNull "source1" source1 checkNonNull "source2" source2 map2 (fun x y -> x,y) source1 source2 [] - let zip3 source1 source2 source3 = + let zip3 source1 source2 source3 = checkNonNull "source1" source1 checkNonNull "source2" source2 checkNonNull "source3" source3 map2 (fun x (y,z) -> x,y,z) source1 (zip source2 source3) [] - let cast (source: IEnumerable) = + let cast (source: IEnumerable) = checkNonNull "source" source mkSeq (fun () -> IEnumerator.cast (source.GetEnumerator())) [] - let tryPick f (source : seq<'T>) = + let tryPick f (source : seq<'T>) = checkNonNull "source" source use e = source.GetEnumerator() - let mutable res = None + let mutable res = None while (Option.isNone res && e.MoveNext()) do res <- f e.Current res [] - let pick f source = + let pick f source = checkNonNull "source" source - match tryPick f source with + match tryPick f source with | None -> indexNotFound() | Some x -> x - + [] - let tryFind f (source : seq<'T>) = + let tryFind f (source : seq<'T>) = checkNonNull "source" source use e = source.GetEnumerator() - let mutable res = None + let mutable res = None while (Option.isNone res && e.MoveNext()) do - let c = e.Current + let c = e.Current if f c then res <- Some(c) res [] - let find f source = + let find f source = checkNonNull "source" source - match tryFind f source with + match tryFind f source with | None -> indexNotFound() | Some x -> x [] - let take count (source : seq<'T>) = + let take count (source : seq<'T>) = checkNonNull "source" source - if count < 0 then invalidArg "count" (SR.GetString(SR.inputMustBeNonNegative)) + if count < 0 then invalidArgFmt "count" "{0}\ncount = {1}" [|SR.GetString SR.inputMustBeNonNegative; count|] (* Note: don't create or dispose any IEnumerable if n = 0 *) - if count = 0 then empty else - seq { use e = source.GetEnumerator() - for _ in 0 .. count - 1 do + if count = 0 then empty else + seq { use e = source.GetEnumerator() + for x in 0 .. count - 1 do if not (e.MoveNext()) then - raise <| System.InvalidOperationException (SR.GetString(SR.notEnoughElements)) + invalidOpFmt "tried to take {0} {1} past the end of the seq" + [|SR.GetString SR.notEnoughElements; x; (if x=1 then "element" else "elements")|] yield e.Current } [] - let isEmpty (source : seq<'T>) = + let isEmpty (source : seq<'T>) = checkNonNull "source" source - match source with + match source with | :? ('T[]) as a -> a.Length = 0 | :? list<'T> as a -> a.IsEmpty | :? ICollection<'T> as a -> a.Count = 0 - | _ -> + | _ -> use ie = source.GetEnumerator() not (ie.MoveNext()) [] - let concat sources = + let concat sources = checkNonNull "sources" sources mkConcatSeq sources [] - let length (source : seq<'T>) = + let length (source : seq<'T>) = checkNonNull "source" source - match source with + match source with | :? ('T[]) as a -> a.Length | :? ('T list) as a -> a.Length | :? ICollection<'T> as a -> a.Count - | _ -> - use e = source.GetEnumerator() - let mutable state = 0 + | _ -> + use e = source.GetEnumerator() + let mutable state = 0 while e.MoveNext() do state <- state + 1 state [] - let fold<'T,'State> f (x:'State) (source : seq<'T>) = + let fold<'T,'State> f (x:'State) (source : seq<'T>) = checkNonNull "source" source - use e = source.GetEnumerator() + use e = source.GetEnumerator() let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f) - let mutable state = x + let mutable state = x while e.MoveNext() do state <- f.Invoke(state, e.Current) state [] - let fold2<'T1,'T2,'State> f (state:'State) (source1: seq<'T1>) (source2: seq<'T2>) = + let fold2<'T1,'T2,'State> f (state:'State) (source1: seq<'T1>) (source2: seq<'T2>) = checkNonNull "source1" source1 checkNonNull "source2" source2 - use e1 = source1.GetEnumerator() - use e2 = source2.GetEnumerator() + use e1 = source1.GetEnumerator() + use e2 = source2.GetEnumerator() let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(f) @@ -1161,19 +1168,19 @@ namespace Microsoft.FSharp.Collections state [] - let reduce f (source : seq<'T>) = + let reduce f (source : seq<'T>) = checkNonNull "source" source - use e = source.GetEnumerator() + use e = source.GetEnumerator() if not (e.MoveNext()) then invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f) - let mutable state = e.Current + let mutable state = e.Current while e.MoveNext() do state <- f.Invoke(state, e.Current) state let fromGenerator f = mkSeq(fun () -> Generator.EnumerateFromGenerator (f())) let toGenerator (ie : seq<_>) = Generator.GenerateFromEnumerator (ie.GetEnumerator()) - + [] let replicate count x = #if FX_ATLEAST_40 @@ -1182,39 +1189,39 @@ namespace Microsoft.FSharp.Collections if count < 0 then invalidArg "count" (SR.GetString(SR.inputMustBeNonNegative)) seq { for _ in 1 .. count -> x } #endif - + [] - let append (source1: seq<'T>) (source2: seq<'T>) = + let append (source1: seq<'T>) (source2: seq<'T>) = checkNonNull "source1" source1 checkNonNull "source2" source2 fromGenerator(fun () -> Generator.bindG (toGenerator source1) (fun () -> toGenerator source2)) - + [] let collect f sources = map f sources |> concat [] - let compareWith (f:'T -> 'T -> int) (source1 : seq<'T>) (source2: seq<'T>) = + let compareWith (f:'T -> 'T -> int) (source1 : seq<'T>) (source2: seq<'T>) = checkNonNull "source1" source1 checkNonNull "source2" source2 use e1 = source1.GetEnumerator() use e2 = source2.GetEnumerator() let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f) - let rec go () = - let e1ok = e1.MoveNext() - let e2ok = e2.MoveNext() + let rec go () = + let e1ok = e1.MoveNext() + let e2ok = e2.MoveNext() let c = if e1ok = e2ok then 0 else if e1ok then 1 else -1 if c <> 0 then c else - if not e1ok || not e2ok then 0 + if not e1ok || not e2ok then 0 else let c = f.Invoke(e1.Current, e2.Current) if c <> 0 then c else - go () + go () go() [] - let ofList (source : 'T list) = + let ofList (source : 'T list) = (source :> seq<'T>) [] @@ -1222,26 +1229,26 @@ namespace Microsoft.FSharp.Collections checkNonNull "source" source Microsoft.FSharp.Primitives.Basics.List.ofSeq source - // Create a new object to ensure underlying array may not be mutated by a backdoor cast + // Create a new object to ensure underlying array may not be mutated by a backdoor cast [] - let ofArray (source : 'T array) = + let ofArray (source : 'T array) = checkNonNull "source" source - mkSeq (fun () -> IEnumerator.ofArray source) - + mkSeq (fun () -> IEnumerator.ofArray source) + [] - let toArray (source : seq<'T>) = + let toArray (source : seq<'T>) = checkNonNull "source" source - match source with + match source with | :? ('T[]) as res -> (res.Clone() :?> 'T[]) | :? ('T list) as res -> List.toArray res - | :? ICollection<'T> as res -> - // Directly create an array and copy ourselves. + | :? ICollection<'T> as res -> + // Directly create an array and copy ourselves. // This avoids an extra copy if using ResizeArray in fallback below. let arr = Array.zeroCreateUnchecked res.Count res.CopyTo(arr, 0) arr - | _ -> - let res = ResizeArray<_>(source) + | _ -> + let res = ResizeArray<_>(source) res.ToArray() let foldArraySubRight (f:OptimizedClosures.FSharpFunc<'T,_,_>) (arr: 'T[]) start fin acc = @@ -1281,7 +1288,7 @@ namespace Microsoft.FSharp.Collections let truncate n (source: seq<'T>) = checkNonNull "source" source seq { let i = ref 0 - use ie = source.GetEnumerator() + use ie = source.GetEnumerator() while !i < n && ie.MoveNext() do i := !i + 1 yield ie.Current } @@ -1289,21 +1296,21 @@ namespace Microsoft.FSharp.Collections [] let pairwise (source: seq<'T>) = checkNonNull "source" source - seq { use ie = source.GetEnumerator() + seq { use ie = source.GetEnumerator() if ie.MoveNext() then let iref = ref ie.Current while ie.MoveNext() do - let j = ie.Current + let j = ie.Current yield (!iref, j) iref := j } [] - let scan<'T,'State> f (z:'State) (source : seq<'T>) = + let scan<'T,'State> f (z:'State) (source : seq<'T>) = checkNonNull "source" source let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f) seq { let zref = ref z yield !zref - use ie = source.GetEnumerator() + use ie = source.GetEnumerator() while ie.MoveNext() do zref := f.Invoke(!zref, ie.Current) yield !zref } @@ -1327,11 +1334,11 @@ namespace Microsoft.FSharp.Collections res :> seq<_>) [] - let findIndex p (source:seq<_>) = + let findIndex p (source:seq<_>) = checkNonNull "source" source - use ie = source.GetEnumerator() - let rec loop i = - if ie.MoveNext() then + use ie = source.GetEnumerator() + let rec loop i = + if ie.MoveNext() then if p ie.Current then i else loop (i+1) @@ -1340,11 +1347,11 @@ namespace Microsoft.FSharp.Collections loop 0 [] - let tryFindIndex p (source:seq<_>) = + let tryFindIndex p (source:seq<_>) = checkNonNull "source" source - use ie = source.GetEnumerator() - let rec loop i = - if ie.MoveNext() then + use ie = source.GetEnumerator() + let rec loop i = + if ie.MoveNext() then if p ie.Current then Some i else loop (i+1) @@ -1364,10 +1371,11 @@ namespace Microsoft.FSharp.Collections // windowed : int -> seq<'T> -> seq<'T[]> [] - let windowed windowSize (source: seq<_>) = + let windowed windowSize (source: seq<_>) = checkNonNull "source" source - if windowSize <= 0 then invalidArg "windowSize" (SR.GetString(SR.inputMustBePositive)) - seq { + if windowSize <= 0 then invalidArgFmt "windowSize" "{0}\nwindowSize = {1}" + [|SR.GetString SR.inputMustBePositive; windowSize|] + seq { let arr = Array.zeroCreateUnchecked windowSize let r = ref (windowSize - 1) let i = ref 0 @@ -1387,7 +1395,7 @@ namespace Microsoft.FSharp.Collections } [] - let cache (source : seq<'T>) = + let cache (source : seq<'T>) = checkNonNull "source" source // Wrap a seq to ensure that it is enumerated just once and only as far as is necessary. // @@ -1403,12 +1411,12 @@ namespace Microsoft.FSharp.Collections // None = Unstarted. // Some(Some e) = Started. // Some None = Finished. - let oneStepTo i = + let oneStepTo i = // If possible, step the enumeration to prefix length i (at most one step). // Be speculative, since this could have already happened via another thread. if not (i < prefix.Count) then // is a step still required? // If not yet started, start it (create enumerator). - match !enumeratorR with + match !enumeratorR with | None -> enumeratorR := Some (Some (source.GetEnumerator())) | Some _ -> () match (!enumeratorR).Value with @@ -1418,12 +1426,12 @@ namespace Microsoft.FSharp.Collections enumerator.Dispose() // Move failed, dispose enumerator, enumeratorR := Some None // drop it and record finished. | None -> () - let result = - unfold (fun i -> + let result = + unfold (fun i -> // i being the next position to be returned // A lock is needed over the reads to prefix.Count since the list may be being resized // NOTE: we could change to a reader/writer lock here - lock enumeratorR (fun () -> + lock enumeratorR (fun () -> if i < prefix.Count then Some (prefix.[i],i+1) else @@ -1432,10 +1440,10 @@ namespace Microsoft.FSharp.Collections Some (prefix.[i],i+1) else None)) 0 - let cleanup() = - lock enumeratorR (fun () -> + let cleanup() = + lock enumeratorR (fun () -> prefix.Clear() - begin match !enumeratorR with + begin match !enumeratorR with | Some (Some e) -> IEnumerator.dispose e | _ -> () end @@ -1449,9 +1457,9 @@ namespace Microsoft.FSharp.Collections let cached = cache source2 source1 |> collect (fun x -> cached |> map (fun y -> x,y)) - [] + [] [] - let readonly (source:seq<_>) = + let readonly (source:seq<_>) = checkNonNull "source" source mkSeq (fun () -> source.GetEnumerator()) @@ -1466,7 +1474,7 @@ namespace Microsoft.FSharp.Collections let minimumBucketSize = 4 // Build the groupings - seq |> iter (fun v -> + seq |> iter (fun v -> let safeKey = keyf v let mutable prev = Unchecked.defaultof<_> match dict.TryGetValue (safeKey, &prev) with @@ -1476,16 +1484,16 @@ namespace Microsoft.FSharp.Collections dict.[safeKey] <- prev prev.Add v) - // Trim the size of each result group, don't trim very small buckets, as excessive work, and garbage for - // minimal gain + // Trim the size of each result group, don't trim very small buckets, as excessive work, and garbage for + // minimal gain dict |> iter (fun group -> if group.Value.Count > minimumBucketSize then group.Value.TrimExcess()) - - // Return the sequence-of-sequences. Don't reveal the + + // Return the sequence-of-sequences. Don't reveal the // internal collections: just reveal them as sequences dict |> map (fun group -> (getKey group.Key, readonly group.Value)) // We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance - let groupByValueType (keyf:'T->'Key) (seq:seq<'T>) = seq |> groupByImpl HashIdentity.Structural<'Key> keyf id + let groupByValueType (keyf:'T->'Key) (seq:seq<'T>) = seq |> groupByImpl HashIdentity.Structural<'Key> keyf id // Wrap a StructBox around all keys in case the key type is itself a type using null as a representation let groupByRefType (keyf:'T->'Key) (seq:seq<'T>) = seq |> groupByImpl StructBox<'Key>.Comparer (fun t -> StructBox (keyf t)) (fun sb -> sb.Value) @@ -1519,16 +1527,16 @@ namespace Microsoft.FSharp.Collections [] let sortBy keyf source = checkNonNull "source" source - mkDelayedSeq (fun () -> - let array = source |> toArray + mkDelayedSeq (fun () -> + let array = source |> toArray Array.stableSortInPlaceBy keyf array array :> seq<_>) [] let sort source = checkNonNull "source" source - mkDelayedSeq (fun () -> - let array = source |> toArray + mkDelayedSeq (fun () -> + let array = source |> toArray Array.stableSortInPlace array array :> seq<_>) @@ -1558,7 +1566,7 @@ namespace Microsoft.FSharp.Collections let dict = Dictionary comparer // Build the groupings - source |> iter (fun v -> + source |> iter (fun v -> let safeKey = keyf v let mutable prev = Unchecked.defaultof<_> if dict.TryGetValue(safeKey, &prev) @@ -1568,7 +1576,7 @@ namespace Microsoft.FSharp.Collections dict |> map (fun group -> (getKey group.Key, group.Value)) // We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance - let countByValueType (keyf:'T->'Key) (seq:seq<'T>) = seq |> countByImpl HashIdentity.Structural<'Key> keyf id + let countByValueType (keyf:'T->'Key) (seq:seq<'T>) = seq |> countByImpl HashIdentity.Structural<'Key> keyf id // Wrap a StructBox around all keys in case the key type is itself a type using null as a representation let countByRefType (keyf:'T->'Key) (seq:seq<'T>) = seq |> countByImpl StructBox<'Key>.Comparer (fun t -> StructBox (keyf t)) (fun sb -> sb.Value) @@ -1586,65 +1594,65 @@ namespace Microsoft.FSharp.Collections else mkDelayedSeq (fun () -> countByRefType keyf source) [] - let inline sum (source: seq< (^a) >) : ^a = - use e = source.GetEnumerator() - let mutable acc = LanguagePrimitives.GenericZero< (^a) > + let inline sum (source: seq< ^a>) : ^a = + use e = source.GetEnumerator() + let mutable acc = LanguagePrimitives.GenericZero< ^a> while e.MoveNext() do acc <- Checked.(+) acc e.Current acc [] - let inline sumBy (f : 'T -> ^U) (source: seq<'T>) : ^U = - use e = source.GetEnumerator() - let mutable acc = LanguagePrimitives.GenericZero< (^U) > + let inline sumBy (f : 'T -> ^U) (source: seq<'T>) : ^U = + use e = source.GetEnumerator() + let mutable acc = LanguagePrimitives.GenericZero< ^U> while e.MoveNext() do acc <- Checked.(+) acc (f e.Current) acc [] - let inline average (source: seq< (^a) >) : ^a = + let inline average (source: seq< ^a>) : ^a = checkNonNull "source" source - use e = source.GetEnumerator() - let mutable acc = LanguagePrimitives.GenericZero< (^a) > + use e = source.GetEnumerator() + let mutable acc = LanguagePrimitives.GenericZero< ^a> let mutable count = 0 while e.MoveNext() do acc <- Checked.(+) acc e.Current count <- count + 1 - if count = 0 then + if count = 0 then invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - LanguagePrimitives.DivideByInt< (^a) > acc count + LanguagePrimitives.DivideByInt< ^a> acc count [] - let inline averageBy (f : 'T -> ^U) (source: seq< 'T >) : ^U = + let inline averageBy (f : 'T -> ^U) (source: seq< 'T >) : ^U = checkNonNull "source" source - use e = source.GetEnumerator() - let mutable acc = LanguagePrimitives.GenericZero< (^U) > + use e = source.GetEnumerator() + let mutable acc = LanguagePrimitives.GenericZero< ^U> let mutable count = 0 while e.MoveNext() do acc <- Checked.(+) acc (f e.Current) count <- count + 1 - if count = 0 then + if count = 0 then invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - LanguagePrimitives.DivideByInt< (^U) > acc count - + LanguagePrimitives.DivideByInt< ^U> acc count + [] - let inline min (source: seq<_>) = + let inline min (source: seq<_>) = checkNonNull "source" source - use e = source.GetEnumerator() - if not (e.MoveNext()) then + use e = source.GetEnumerator() + if not (e.MoveNext()) then invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString let mutable acc = e.Current while e.MoveNext() do - let curr = e.Current - if curr < acc then + let curr = e.Current + if curr < acc then acc <- curr acc [] - let inline minBy (f : 'T -> 'U) (source: seq<'T>) : 'T = + let inline minBy (f : 'T -> 'U) (source: seq<'T>) : 'T = checkNonNull "source" source - use e = source.GetEnumerator() - if not (e.MoveNext()) then + use e = source.GetEnumerator() + if not (e.MoveNext()) then invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString let first = e.Current let mutable acc = f first @@ -1659,10 +1667,10 @@ namespace Microsoft.FSharp.Collections (* [] - let inline minValBy (f : 'T -> 'U) (source: seq<'T>) : 'U = + let inline minValBy (f : 'T -> 'U) (source: seq<'T>) : 'U = checkNonNull "source" source - use e = source.GetEnumerator() - if not (e.MoveNext()) then + use e = source.GetEnumerator() + if not (e.MoveNext()) then invalidArg "source" InputSequenceEmptyString let first = e.Current let mutable acc = f first @@ -1675,23 +1683,23 @@ namespace Microsoft.FSharp.Collections *) [] - let inline max (source: seq<_>) = + let inline max (source: seq<_>) = checkNonNull "source" source - use e = source.GetEnumerator() - if not (e.MoveNext()) then + use e = source.GetEnumerator() + if not (e.MoveNext()) then invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString let mutable acc = e.Current while e.MoveNext() do - let curr = e.Current - if curr > acc then + let curr = e.Current + if curr > acc then acc <- curr acc [] - let inline maxBy (f : 'T -> 'U) (source: seq<'T>) : 'T = + let inline maxBy (f : 'T -> 'U) (source: seq<'T>) : 'T = checkNonNull "source" source - use e = source.GetEnumerator() - if not (e.MoveNext()) then + use e = source.GetEnumerator() + if not (e.MoveNext()) then invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString let first = e.Current let mutable acc = f first @@ -1707,10 +1715,10 @@ namespace Microsoft.FSharp.Collections (* [] - let inline maxValBy (f : 'T -> 'U) (source: seq<'T>) : 'U = + let inline maxValBy (f : 'T -> 'U) (source: seq<'T>) : 'U = checkNonNull "source" source - use e = source.GetEnumerator() - if not (e.MoveNext()) then + use e = source.GetEnumerator() + if not (e.MoveNext()) then invalidArg "source" InputSequenceEmptyString let first = e.Current let mutable acc = f first @@ -1723,27 +1731,28 @@ namespace Microsoft.FSharp.Collections *) [] - let takeWhile p (source: seq<_>) = + let takeWhile p (source: seq<_>) = checkNonNull "source" source - seq { use e = source.GetEnumerator() + seq { use e = source.GetEnumerator() let latest = ref Unchecked.defaultof<_> - while e.MoveNext() && (latest := e.Current; p !latest) do + while e.MoveNext() && (latest := e.Current; p !latest) do yield !latest } [] let skip count (source: seq<_>) = checkNonNull "source" source - seq { use e = source.GetEnumerator() - for _ in 1 .. count do - if not (e.MoveNext()) then - raise <| System.InvalidOperationException (SR.GetString(SR.notEnoughElements)) + seq { use e = source.GetEnumerator() + for x in 1 .. count do + if not (e.MoveNext()) then + invalidOpFmt "tried to skip {0} {1} past the end of the seq" + [|SR.GetString SR.notEnoughElements; x; (if x=1 then "element" else "elements")|] while e.MoveNext() do yield e.Current } [] - let skipWhile p (source: seq<_>) = + let skipWhile p (source: seq<_>) = checkNonNull "source" source - seq { use e = source.GetEnumerator() + seq { use e = source.GetEnumerator() let latest = ref (Unchecked.defaultof<_>) let ok = ref false while e.MoveNext() do @@ -1753,7 +1762,7 @@ namespace Microsoft.FSharp.Collections [] - let forall2 p (source1: seq<_>) (source2: seq<_>) = + let forall2 p (source1: seq<_>) (source2: seq<_>) = checkNonNull "source1" source1 checkNonNull "source2" source2 use e1 = source1.GetEnumerator() @@ -1764,9 +1773,9 @@ namespace Microsoft.FSharp.Collections ok <- p.Invoke(e1.Current, e2.Current) ok - + [] - let exists2 p (source1: seq<_>) (source2: seq<_>) = + let exists2 p (source1: seq<_>) (source2: seq<_>) = checkNonNull "source1" source1 checkNonNull "source2" source2 use e1 = source1.GetEnumerator() @@ -1780,22 +1789,22 @@ namespace Microsoft.FSharp.Collections [] let head (source : seq<_>) = checkNonNull "source" source - use e = source.GetEnumerator() + use e = source.GetEnumerator() if (e.MoveNext()) then e.Current else invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString [] let tryHead (source : seq<_>) = checkNonNull "source" source - use e = source.GetEnumerator() + use e = source.GetEnumerator() if (e.MoveNext()) then Some e.Current else None [] let tail (source: seq<'T>) = checkNonNull "source" source - seq { use e = source.GetEnumerator() - if not (e.MoveNext()) then + seq { use e = source.GetEnumerator() + if not (e.MoveNext()) then invalidArg "source" (SR.GetString(SR.notEnoughElements)) while e.MoveNext() do yield e.Current } @@ -1803,8 +1812,8 @@ namespace Microsoft.FSharp.Collections [] let last (source : seq<_>) = checkNonNull "source" source - use e = source.GetEnumerator() - if e.MoveNext() then + use e = source.GetEnumerator() + if e.MoveNext() then let mutable res = e.Current while (e.MoveNext()) do res <- e.Current res @@ -1814,8 +1823,8 @@ namespace Microsoft.FSharp.Collections [] let tryLast (source : seq<_>) = checkNonNull "source" source - use e = source.GetEnumerator() - if e.MoveNext() then + use e = source.GetEnumerator() + if e.MoveNext() then let mutable res = e.Current while (e.MoveNext()) do res <- e.Current Some res @@ -1825,10 +1834,10 @@ namespace Microsoft.FSharp.Collections [] let exactlyOne (source : seq<_>) = checkNonNull "source" source - use e = source.GetEnumerator() - if e.MoveNext() then - let v = e.Current - if e.MoveNext() then + use e = source.GetEnumerator() + if e.MoveNext() then + let v = e.Current + if e.MoveNext() then invalidArg "source" (SR.GetString(SR.inputSequenceTooLong)) else v @@ -1880,7 +1889,8 @@ namespace Microsoft.FSharp.Collections [] let chunkBySize chunkSize (source : seq<_>) = checkNonNull "source" source - if chunkSize <= 0 then invalidArg "chunkSize" (SR.GetString(SR.inputMustBePositive)) + if chunkSize <= 0 then invalidArgFmt "chunkSize" "{0}\nchunkSize = {1}" + [|SR.GetString SR.inputMustBePositive; chunkSize|] seq { use e = source.GetEnumerator() let nextChunk() = let res = Array.zeroCreateUnchecked chunkSize @@ -1899,6 +1909,7 @@ namespace Microsoft.FSharp.Collections [] let splitInto count source = checkNonNull "source" source - if count <= 0 then invalidArg "count" (SR.GetString(SR.inputMustBePositive)) + if count <= 0 then invalidArgFmt "count" "{0}\ncount = {1}" + [|SR.GetString SR.inputMustBePositive; count|] mkDelayedSeq (fun () -> source |> toArray |> Array.splitInto count :> seq<_>) From 0ffbf558abce7e059c3bd9cacd4a0f2277d3ace7 Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Wed, 17 Aug 2016 10:03:55 -0400 Subject: [PATCH 07/38] added detail to 2 string errors in string.fs --- src/fsharp/FSharp.Core/string.fs | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/fsharp/FSharp.Core/string.fs b/src/fsharp/FSharp.Core/string.fs index a1848b1a220..7b544a3d166 100644 --- a/src/fsharp/FSharp.Core/string.fs +++ b/src/fsharp/FSharp.Core/string.fs @@ -6,6 +6,7 @@ namespace Microsoft.FSharp.Core open System.Text open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Core.Operators + open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Core.Operators.Checked open Microsoft.FSharp.Collections @@ -38,14 +39,14 @@ namespace Microsoft.FSharp.Core [] let map (f: char -> char) (str:string) = let str = emptyIfNull str - let res = StringBuilder(str.Length) + let res = StringBuilder str.Length str |> iter (fun c -> res.Append(f c) |> ignore) res.ToString() [] let mapi (f: int -> char -> char) (str:string) = let str = emptyIfNull str - let res = StringBuilder(str.Length) + let res = StringBuilder str.Length let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f) str |> iteri (fun i c -> res.Append(f.Invoke(i, c)) |> ignore) res.ToString() @@ -53,32 +54,32 @@ namespace Microsoft.FSharp.Core [] let filter (f: char -> bool) (str:string) = let str = emptyIfNull str - let res = StringBuilder(str.Length) - str |> iter (fun c -> if f c then res.Append(c) |> ignore) + let res = StringBuilder str.Length + str |> iter (fun c -> if f c then res.Append c |> ignore) res.ToString() [] let collect (f: char -> string) (str:string) = let str = emptyIfNull str - let res = StringBuilder(str.Length) + let res = StringBuilder str.Length str |> iter (fun c -> res.Append(f c) |> ignore) res.ToString() [] let init (count:int) (initializer: int-> string) = - if count < 0 then invalidArg "count" (SR.GetString(SR.inputMustBeNonNegative)) - let res = StringBuilder(count) + if count < 0 then invalidArgFmt "count" "{0}\ncount = {1}" [|SR.GetString SR.inputMustBeNonNegative; count|] + let res = StringBuilder count for i = 0 to count - 1 do res.Append(initializer i) |> ignore res.ToString() [] let replicate (count:int) (str:string) = - if count < 0 then invalidArg "count" (SR.GetString(SR.inputMustBeNonNegative)) + if count < 0 then invalidArgFmt "count" "{0}\ncount = {1}" [|SR.GetString SR.inputMustBeNonNegative; count|] let str = emptyIfNull str - let res = StringBuilder(str.Length) + let res = StringBuilder str.Length for i = 0 to count - 1 do - res.Append(str) |> ignore + res.Append str |> ignore res.ToString() [] From 68a0c07d70f9795fb04307ca3fd68d9ddd610c49 Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Wed, 17 Aug 2016 21:14:56 -0400 Subject: [PATCH 08/38] Added more detailed error messages to list.fs --- src/fsharp/FSharp.Core/list.fs | 56 +++++++++++++++++++++++++++++----- 1 file changed, 49 insertions(+), 7 deletions(-) diff --git a/src/fsharp/FSharp.Core/list.fs b/src/fsharp/FSharp.Core/list.fs index dc2b14f1458..b515dfd1348 100644 --- a/src/fsharp/FSharp.Core/list.fs +++ b/src/fsharp/FSharp.Core/list.fs @@ -3,6 +3,7 @@ namespace Microsoft.FSharp.Collections open Microsoft.FSharp.Core + open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Core.Operators open Microsoft.FSharp.Core.LanguagePrimitives open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators @@ -185,7 +186,14 @@ namespace Microsoft.FSharp.Collections match list1,list2 with | [],[] -> () | h1::t1, h2::t2 -> f.Invoke(h1,h2); loop t1 t2 - | _ -> invalidArg "list2" (SR.GetString(SR.listsHadDifferentLengths)) + | [],xs2 -> + invalidArgFmt "list1" + "{0}\nlist1 is {1} elements shorter than list2" + [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] + | xs1,[] -> + invalidArgFmt "list2" + "{0}\nlist2 is {1} elements shorter than list1" + [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] loop list1 list2 [] @@ -195,7 +203,14 @@ namespace Microsoft.FSharp.Collections match list1,list2 with | [],[] -> () | h1::t1, h2::t2 -> f.Invoke(n,h1,h2); loop (n+1) t1 t2 - | _ -> invalidArg "list2" (SR.GetString(SR.listsHadDifferentLengths)) + | [],xs2 -> + invalidArgFmt "list1" + "{0}\nlist1 is {1} elements shorter than list2" + [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] + | xs1,[] -> + invalidArgFmt "list2" + "{0}\nlist2 is {1} elements shorter than list1" + [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] loop 0 list1 list2 [] @@ -245,7 +260,14 @@ namespace Microsoft.FSharp.Collections match list1,list2 with | [],[] -> acc | h1::t1, h2::t2 -> loop (f.Invoke(acc,h1,h2)) t1 t2 - | _ -> invalidArg "list2" (SR.GetString(SR.listsHadDifferentLengths)) + | [],xs2 -> + invalidArgFmt "list1" + "{0}\nlist1 is {1} elements shorter than list2" + [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] + | xs1,[] -> + invalidArgFmt "list2" + "{0}\nlist2 is {1} elements shorter than list1" + [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] loop acc list1 list2 let foldArraySubRight (f:OptimizedClosures.FSharpFunc<'T,_,_>) (arr: 'T[]) start fin acc = @@ -308,7 +330,10 @@ namespace Microsoft.FSharp.Collections let arr2 = toArray list2 let n1 = arr1.Length let n2 = arr2.Length - if n1 <> n2 then invalidArg "list2" (SR.GetString(SR.listsHadDifferentLengths)); + if n1 <> n2 then + invalidArgFmt "list1, list2" + "{0}\nlist1.Length = {1}, list2.Length = {2}" + [|SR.GetString SR.listsHadDifferentLengths; arr1.Length; arr2.Length|] let mutable res = acc for i = n1 - 1 downto 0 do res <- f.Invoke(arr1.[i],arr2.[i],res) @@ -326,13 +351,27 @@ namespace Microsoft.FSharp.Collections | [h2;h3],[k2;k3] -> f.Invoke(h1,k1,f.Invoke(h2,k2,f.Invoke(h3,k3,acc))) | [h2;h3;h4],[k2;k3;k4] -> f.Invoke(h1,k1,f.Invoke(h2,k2,f.Invoke(h3,k3,f.Invoke(h4,k4,acc)))) | _ -> foldBack2UsingArrays f list1 list2 acc - | _ -> invalidArg "list2" (SR.GetString(SR.listsHadDifferentLengths)) + | [],xs2 -> + invalidArgFmt "list1" + "{0}\nlist1 is {1} elements shorter than list2" + [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] + | xs1,[] -> + invalidArgFmt "list2" + "{0}\nlist2 is {1} elements shorter than list1" + [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] let rec forall2aux (f:OptimizedClosures.FSharpFunc<_,_,_>) list1 list2 = match list1,list2 with | [],[] -> true | h1::t1, h2::t2 -> f.Invoke(h1,h2) && forall2aux f t1 t2 - | _ -> invalidArg "list2" (SR.GetString(SR.listsHadDifferentLengths)) + | [],xs2 -> + invalidArgFmt "list1" + "{0}\nlist1 is {1} elements shorter than list2" + [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] + | xs1,[] -> + invalidArgFmt "list2" + "{0}\nlist2 is {1} elements shorter than list1" + [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] [] let forall2 f list1 list2 = @@ -468,7 +507,10 @@ namespace Microsoft.FSharp.Collections match lst with | _ when i = 0 -> lst | _::t -> loop (i-1) t - | [] -> invalidArg "count" (SR.GetString(SR.outOfRange)) + | [] -> + invalidArgFmt "count" + "{0}\ncount of {1} exceeds the length of list by {2}" + [|SR.GetString SR.outOfRange; count; i|] loop count list [] From ec97f1a30f3ffc0ffc55bae9e4d375f197d8d2b1 Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Wed, 17 Aug 2016 23:10:39 -0400 Subject: [PATCH 09/38] cleaned up error messages in local.fs --- src/fsharp/FSharp.Core/local.fs | 151 +++++++++++++------------------- 1 file changed, 60 insertions(+), 91 deletions(-) diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index 03d5a38b781..51de10e2a84 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -4,18 +4,44 @@ namespace Microsoft.FSharp.Core module DetailedExceptions = - + open System + /// takes an argument, a formatting string, a param array to splice into the formatting string let inline internal invalidArgFmt (arg:string) (format:string) paramArray = - let msg = System.String.Format (format,paramArray) - raise (new System.ArgumentException (msg,arg)) + let msg = String.Format (format,paramArray) + raise (new ArgumentException (msg,arg)) /// takes a formatting string and a param array to splice into the formatting string let inline internal invalidOpFmt (format:string) paramArray = - let msg = System.String.Format (format,paramArray) - raise (new System.InvalidOperationException(msg)) - - + let msg = String.Format (format,paramArray) + raise (new InvalidOperationException(msg)) + + /// throws an invalid argument exception and returns the difference between the lists' lengths + let invalidArgDifferentListLength (arg1:string) (arg2:string) (diff:int) = + invalidArgFmt arg1 + "{0}\n{1} is {2} elements shorter than {3}" + [|SR.GetString SR.listsHadDifferentLengths; arg1; diff; arg2|] + + /// throws an invalid argument exception and returns the difference between the lists' lengths + let invalidArg3ListsDifferent arg1 arg2 arg3 len1 len2 len3 = + invalidArgFmt (String.Concat [|arg1; ", "; arg2; ", "; arg3|]) + "{0}\n {1}.Length = {2}, {3}.Length = {4}, {5}.Length = {6}" + [|SR.GetString SR.listsHadDifferentLengths; arg1; len1; arg2; len2; arg3; len3|] + + /// throws an invalid operation exception and returns how many elements the + /// list is shorter than the index + let invalidOpListNotEnoughElements index = + invalidOpFmt + "{0}\nThe list was {1} {2} shorter than the index" + [|SR.GetString SR.notEnoughElements; index; (if index=1 then "element" else "elements")|] + + /// throws an invalid argument exception and returns the arg's value + let invalidArgInputMustBeNonNegative arg count = + invalidArgFmt arg "{0}\n{1} = {2}" [|SR.GetString SR.inputMustBeNonNegative; arg; count|] + + /// throws an invalid argument exception and returns the arg's value + let invalidArgInputMustBePositive arg count = + invalidArgFmt arg "{0}\n{1} = {2}" [|SR.GetString SR.inputMustBePositive; arg; count|] namespace Microsoft.FSharp.Primitives.Basics @@ -226,14 +252,8 @@ module internal List = let cons2 = freshConsNoTail (f.Invoke(h1,h2)) setFreshConsTail cons cons2 map2ToFreshConsTail cons2 f t1 t2 - | [],xs2 -> - invalidArgFmt "list1" - "{0}\nlist1 is {1} elements shorter than list2" - [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] - | xs1,[] -> - invalidArgFmt "list2" - "{0}\nlist2 is {1} elements shorter than list1" - [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] + | [],xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length + | xs1,[] -> invalidArgDifferentListLength "list2" "list1" xs1.Length let map2 f xs1 xs2 = match xs1,xs2 with @@ -243,14 +263,8 @@ module internal List = let cons = freshConsNoTail (f.Invoke(h1,h2)) map2ToFreshConsTail cons f t1 t2 cons - | [],xs2 -> - invalidArgFmt "list1" - "{0}\nlist1 is {1} elements shorter than list2" - [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] - | xs1,[] -> - invalidArgFmt "list2" - "{0}\nlist2 is {1} elements shorter than list1" - [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] + | [],xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length + | xs1,[] -> invalidArgDifferentListLength "list2" "list1" xs1.Length let rec map3ToFreshConsTail cons (f:OptimizedClosures.FSharpFunc<_,_,_,_>) xs1 xs2 xs3 = match xs1,xs2,xs3 with @@ -261,9 +275,7 @@ module internal List = setFreshConsTail cons cons2 map3ToFreshConsTail cons2 f t1 t2 t3 | xs1,xs2,xs3 -> - invalidArgFmt "list1, list2, list3" - "{0}\n list1.Length = {1}, list2.Length = {2}, list3.Length = {3}" - [|SR.GetString SR.listsHadDifferentLengths; xs1.Length; xs2.Length; xs3.Length|] + invalidArg3ListsDifferent "list1" "list2" "list3" xs1.Length xs2.Length xs3.Length let map3 f xs1 xs2 xs3 = match xs1,xs2,xs3 with @@ -274,9 +286,7 @@ module internal List = map3ToFreshConsTail cons f t1 t2 t3 cons | xs1,xs2,xs3 -> - invalidArgFmt "list1, list2, list3" - "{0}\n list1.Length = {1}, list2.Length = {2}, list3.Length = {3}" - [|SR.GetString SR.listsHadDifferentLengths; xs1.Length; xs2.Length; xs3.Length|] + invalidArg3ListsDifferent "list1" "list2" "list3" xs1.Length xs2.Length xs3.Length let rec mapi2ToFreshConsTail n cons (f:OptimizedClosures.FSharpFunc<_,_,_,_>) xs1 xs2 = match xs1,xs2 with @@ -286,14 +296,8 @@ module internal List = let cons2 = freshConsNoTail (f.Invoke(n,h1,h2)) setFreshConsTail cons cons2 mapi2ToFreshConsTail (n + 1) cons2 f t1 t2 - | [],xs2 -> - invalidArgFmt "list1" - "{0}\nlist1 is {1} elements shorter than list2" - [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] - | xs1,[] -> - invalidArgFmt "list2" - "{0}\nlist2 is {1} elements shorter than list1" - [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] + | [],xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length + | xs1,[] -> invalidArgDifferentListLength "list2" "list1" xs1.Length let mapi2 f xs1 xs2 = match xs1,xs2 with @@ -303,14 +307,8 @@ module internal List = let cons = freshConsNoTail (f.Invoke(0, h1,h2)) mapi2ToFreshConsTail 1 cons f t1 t2 cons - | [],xs2 -> - invalidArgFmt "list1" - "{0}\nlist1 is {1} elements shorter than list2" - [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] - | xs1,[] -> - invalidArgFmt "list2" - "{0}\nlist2 is {1} elements shorter than list1" - [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] + | [],xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length + | xs1,[] -> invalidArgDifferentListLength "list2" "list1" xs1.Length let rec scanToFreshConsTail cons xs s (f: OptimizedClosures.FSharpFunc<_,_,_>) = match xs with @@ -554,8 +552,7 @@ module internal List = let init count f = - if count < 0 then - invalidArgFmt "count" "{0}\ncount = {1}" [|LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString; count|] + if count < 0 then invalidArgInputMustBeNonNegative "count" count if count = 0 then [] else let res = freshConsNoTail (f 0) @@ -565,23 +562,17 @@ module internal List = let rec takeFreshConsTail cons n l = if n = 0 then setFreshConsTail cons [] else match l with - | [] -> - invalidOpFmt - "{0}\nThe list was short by {1} {2}" - [|SR.GetString SR.notEnoughElements; n; (if n=1 then "element" else "elements")|] + | [] -> invalidOpListNotEnoughElements n | x::xs -> let cons2 = freshConsNoTail x setFreshConsTail cons cons2 takeFreshConsTail cons2 (n - 1) xs let take n l = - if n < 0 then invalidArgFmt "count" "{0}\ncount = {1}" [|LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString; n|] + if n < 0 then invalidArgInputMustBeNonNegative "count" n if n = 0 then [] else match l with - | [] -> - invalidOpFmt - "{0}\nThe list was short by {1} {2}" - [|SR.GetString SR.notEnoughElements; n; (if n=1 then "element" else "elements")|] + | [] -> invalidOpListNotEnoughElements n | x::xs -> let cons = freshConsNoTail x takeFreshConsTail cons (n - 1) xs @@ -593,26 +584,20 @@ module internal List = l else match l with - | [] -> - invalidOpFmt - "{0}\nThe list was short by {1} {2}" - [|SR.GetString SR.notEnoughElements; index; (if index=1 then "element" else "elements")|] + | [] -> invalidOpListNotEnoughElements index | x :: xs -> let cons2 = freshConsNoTail x setFreshConsTail cons cons2 splitAtFreshConsTail cons2 (index - 1) xs let splitAt index l = - if index < 0 then invalidArgFmt "index" "{0}\nindex = {1}" [|SR.GetString SR.inputMustBeNonNegative; index|] + if index < 0 then invalidArgInputMustBeNonNegative "index" index if index = 0 then [], l else match l with | [] -> invalidOp (SR.GetString SR.inputListWasEmpty) | [_] -> if index = 1 then l, [] else - invalidOpFmt - "{0}\nThe list was {1} {2} shorter than the index" - [|SR.GetString SR.notEnoughElements; index-1; (if index=2 then "element" else "elements")|] - + invalidOpListNotEnoughElements (index-1) | x::xs -> if index = 1 then [x], xs else let cons = freshConsNoTail x @@ -775,7 +760,7 @@ module internal List = windowedToFreshConsTail cons2 windowSize (i - 1) list.Tail let windowed windowSize (list: 'T list) = - if windowSize <= 0 then invalidArgFmt "windowSize" "{0}\nwindowSize = {1}" [|SR.GetString SR.inputMustBePositive; windowSize|] + if windowSize <= 0 then invalidArgInputMustBePositive "windowSize" windowSize let len = list.Length if windowSize > len then [] @@ -801,7 +786,7 @@ module internal List = chunkBySizeToFreshConsTail cons resCons chunkSize (i+1) t let chunkBySize chunkSize list = - if chunkSize <= 0 then invalidArgFmt "chunkSize" "{0}\nwindowSize = {1}" [|SR.GetString SR.inputMustBePositive; chunkSize|] + if chunkSize <= 0 then invalidArgInputMustBePositive "chunkSize" chunkSize match list with | [] -> [] | head::tail -> @@ -827,7 +812,7 @@ module internal List = splitIntoToFreshConsTail cons resCons lenDivCount lenModCount i (j + 1) t let splitInto count (list: _ list) = - if count <= 0 then invalidArgFmt "count" "{0}\ncount = {1}" [|SR.GetString SR.inputMustBePositive; count|] + if count <= 0 then invalidArgInputMustBePositive "count" count match list.Length with | 0 -> [] | len -> @@ -847,14 +832,8 @@ module internal List = let cons2 = freshConsNoTail (h1,h2) setFreshConsTail cons cons2 zipToFreshConsTail cons2 t1 t2 - | [],xs2 -> - invalidArgFmt "list1" - "{0}\nlist1 is {1} elements shorter than list2" - [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] - | xs1,[] -> - invalidArgFmt "list2" - "{0}\nlist2 is {1} elements shorter than list1" - [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] + | [],xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length + | xs1,[] -> invalidArgDifferentListLength "list2" "list1" xs1.Length // optimized mutation-based implementation. This code is only valid in fslib, where mutation of private // tail cons cells is permitted in carefully written library code. @@ -865,14 +844,8 @@ module internal List = let res = freshConsNoTail (h1,h2) zipToFreshConsTail res t1 t2 res - | [],xs2 -> - invalidArgFmt "list1" - "{0}\nlist1 is {1} elements shorter than list2" - [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] - | xs1,[] -> - invalidArgFmt "list2" - "{0}\nlist2 is {1} elements shorter than list1" - [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] + | [],xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length + | xs1,[] -> invalidArgDifferentListLength "list2" "list1" xs1.Length // optimized mutation-based implementation. This code is only valid in fslib, where mutation of private // tail cons cells is permitted in carefully written library code. @@ -885,9 +858,7 @@ module internal List = setFreshConsTail cons cons2 zip3ToFreshConsTail cons2 t1 t2 t3 | xs1,xs2,xs3 -> - invalidArgFmt "list1, list2, list3" - "{0}\n list1.Length = {1}, list2.Length = {2}, list3.Length = {3}" - [|SR.GetString SR.listsHadDifferentLengths; xs1.Length; xs2.Length; xs3.Length|] + invalidArg3ListsDifferent "list1" "list2" "list3" xs1.Length xs2.Length xs3.Length // optimized mutation-based implementation. This code is only valid in fslib, where mutation of private // tail cons cells is permitted in carefully written library code. @@ -900,9 +871,7 @@ module internal List = zip3ToFreshConsTail res t1 t2 t3 res | xs1,xs2,xs3 -> - invalidArgFmt "list1, list2, list3" - "{0}\n list1.Length = {1}, list2.Length = {2}, list3.Length = {3}" - [|SR.GetString SR.listsHadDifferentLengths; xs1.Length; xs2.Length; xs3.Length|] + invalidArg3ListsDifferent "list1" "list2" "list3" xs1.Length xs2.Length xs3.Length let rec takeWhileFreshConsTail cons p l = match l with @@ -1009,7 +978,7 @@ module internal Array = (# "newarr !0" type ('T) count : 'T array #) let inline init (count:int) (f: int -> 'T) = - if count < 0 then invalidArgFmt "count" "{0}\ncount = {1}" [|LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString; count|] + if count < 0 then invalidArgInputMustBeNonNegative "count" count let arr = (zeroCreateUnchecked count : 'T array) for i = 0 to arr.Length-1 do arr.[i] <- f i From 87495e4cb5c4b3a38fc2822915e2520b5b8aaff9 Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Wed, 17 Aug 2016 23:54:48 -0400 Subject: [PATCH 10/38] extend detailed exception signature --- src/fsharp/FSharp.Core/local.fs | 8 ++++++++ src/fsharp/FSharp.Core/local.fsi | 10 ++++++++-- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index 51de10e2a84..eac7cf3e81a 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -43,6 +43,14 @@ module DetailedExceptions = let invalidArgInputMustBePositive arg count = invalidArgFmt arg "{0}\n{1} = {2}" [|SR.GetString SR.inputMustBePositive; arg; count|] + /// throws an invalid argument exception and returns the out of range index, + /// a text description of the range, and the bound of the range + /// e.g. sourceIndex = -4, source axis-0 lower bound = 0" + let invalidArgOutOfRange arg index text bound = + invalidArgFmt arg + "{0}\n{1} = {2}, {3} = {4}" + [|SR.GetString SR.outOfRange; arg; index; text; bound|] + namespace Microsoft.FSharp.Primitives.Basics diff --git a/src/fsharp/FSharp.Core/local.fsi b/src/fsharp/FSharp.Core/local.fsi index 5d04acf72ec..5bfa9a046fa 100644 --- a/src/fsharp/FSharp.Core/local.fsi +++ b/src/fsharp/FSharp.Core/local.fsi @@ -4,8 +4,14 @@ namespace Microsoft.FSharp.Core open Microsoft.FSharp.Core module internal DetailedExceptions = - val inline internal invalidArgFmt: arg:string -> format:string -> paramArray:obj array -> 'a - val inline internal invalidOpFmt: format:string -> paramArray:obj array -> 'a + val inline internal invalidArgFmt: arg:string -> format:string -> paramArray:obj array -> _ + val inline internal invalidOpFmt: format:string -> paramArray:obj array -> _ + val invalidArgDifferentListLength: arg1:string -> arg2:string -> diff:int -> _ + val invalidArg3ListsDifferent: arg1:string -> arg2:string -> arg3:string -> len1:int -> len2:int -> len3:int -> _ + val invalidOpListNotEnoughElements: index:int -> _ + val invalidArgInputMustBeNonNegative: arg:string -> count:int -> _ + val invalidArgInputMustBePositive: arg:string -> count:int -> _ + val invalidArgOutOfRange: arg:string -> index:int -> text:string -> bound:int -> _ /// Definitions internal for this library. namespace Microsoft.FSharp.Primitives.Basics From e79cf3bf331a0f723d4c214e5a60438645ffcb40 Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Wed, 17 Aug 2016 23:55:18 -0400 Subject: [PATCH 11/38] Clean up Array2D error messages --- src/fsharp/FSharp.Core/array2.fs | 43 +++++++++----------------------- 1 file changed, 12 insertions(+), 31 deletions(-) diff --git a/src/fsharp/FSharp.Core/array2.fs b/src/fsharp/FSharp.Core/array2.fs index 3a590b21dc0..d60d30bd9bf 100644 --- a/src/fsharp/FSharp.Core/array2.fs +++ b/src/fsharp/FSharp.Core/array2.fs @@ -38,8 +38,8 @@ namespace Microsoft.FSharp.Collections [] let zeroCreate (n:int) (m:int) = - if n < 0 then invalidArgFmt "length1" "{0}\nlength1 = {0}" [|SR.GetString SR.inputMustBeNonNegative; n|] - if m < 0 then invalidArgFmt "length2" "{0}\nlength2 = {0}" [|SR.GetString SR.inputMustBeNonNegative; m|] + if n < 0 then invalidArgInputMustBeNonNegative "length1" n + if m < 0 then invalidArgInputMustBeNonNegative "length2" m (# "newarr.multi 2 !0" type ('T) n m : 'T[,] #) [] @@ -131,46 +131,27 @@ namespace Microsoft.FSharp.Collections init (length1 array) (length2 array) (fun i j -> array.[b1+i,b2+j]) [] - let blit (source : 'T[,]) sourceIndex1 sourceIndex2 (target : 'T[,]) targetIndex1 targetIndex2 count1 count2 = + let blit (source : 'T[,]) sourceIndex1 sourceIndex2 (target: 'T[,]) targetIndex1 targetIndex2 count1 count2 = checkNonNull "source" source checkNonNull "target" target + let sourceX0, sourceY0 = source.GetLowerBound 0 , source.GetLowerBound 1 let sourceXN, sourceYN = (length1 source) + sourceX0, (length2 source) + sourceY0 let targetX0, targetY0 = target.GetLowerBound 0 , target.GetLowerBound 1 let targetXN, targetYN = (length1 target) + targetX0, (length2 target) + targetY0 - if sourceIndex1 < sourceX0 then - invalidArgFmt "sourceIndex1" - "{0}\nsourceIndex1 = {1}, source axis-0 lower bound = {2}" - [|SR.GetString SR.outOfRange; sourceIndex1; sourceX0|] - if sourceIndex2 < sourceY0 then - invalidArgFmt "sourceIndex2" - "{0}\nsourceIndex2 = {1}, source axis-1 lower bound = {2}" - [|SR.GetString SR.outOfRange; sourceIndex2; sourceY0|] - if targetIndex1 < targetX0 then - invalidArgFmt "targetIndex1" - "{0}\ntargetIndex1 = {1}, target axis-0 lower bound = {2}" - [|SR.GetString SR.outOfRange; targetIndex1; targetX0|] - if targetIndex2 < targetY0 then - invalidArgFmt "targetIndex2" - "{0}\ntargetIndex2 = {1}, target axis-1 lower bound = {2}" - [|SR.GetString SR.outOfRange; targetIndex2; targetY0|] + if sourceIndex1 < sourceX0 then invalidArgOutOfRange "sourceIndex1" sourceIndex1 "source axis-0 lower bound" sourceX0 + if sourceIndex2 < sourceY0 then invalidArgOutOfRange "sourceIndex2" sourceIndex2 "source axis-1 lower bound" sourceY0 + if targetIndex1 < targetX0 then invalidArgOutOfRange "targetIndex1" targetIndex1 "target axis-0 lower bound" targetX0 + if targetIndex2 < targetY0 then invalidArgOutOfRange "targetIndex2" targetIndex2 "target axis-1 lower bound" targetY0 if sourceIndex1 + count1 > sourceXN then - invalidArgFmt "count1" - "{0}\nsource axis-0 end index = {1}, source axis-0 upper bound = {2}" - [|SR.GetString SR.outOfRange; sourceIndex1 + count1; sourceXN|] + invalidArgOutOfRange "count1" count1 ("source axis-0 end index = " + string(sourceIndex1+count1) + " source axis-0 upper bound") sourceXN if sourceIndex2 + count2 > sourceYN then - invalidArgFmt "count2" - "{0}\nsource axis-1 end index = {1}, source axis-1 upper bound = {2}" - [|SR.GetString SR.outOfRange; sourceIndex2 + count2; sourceYN|] + invalidArgOutOfRange "count2" count2 ("source axis-1 end index = " + string(sourceIndex2+count2) + " source axis-1 upper bound") sourceYN if targetIndex1 + count1 > targetXN then - invalidArgFmt "count1" - "{0}\ntarget axis-0 end index = {1}, target axis-0 upper bound = {2}" - [|SR.GetString SR.outOfRange; targetIndex1 + count1; targetXN|] + invalidArgOutOfRange "count1" count1 ("target axis-0 end index = " + string(targetIndex1+count1) + " target axis-0 upper bound") targetXN if targetIndex2 + count2 > targetYN then - invalidArgFmt "count2" - "{0}\ntarget axis-1 end index = {1}, target axis-1 upper bound = {2}" - [|SR.GetString SR.outOfRange; targetIndex2 + count2; targetYN|] + invalidArgOutOfRange "count2" count2 ("target axis-1 end index = " + string(targetIndex2+count2) + " target axis-1 upper bound") targetYN for i = 0 to count1 - 1 do for j = 0 to count2 - 1 do From c1c8851dca96ec54bc7776c507405eab4b63865c Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Thu, 18 Aug 2016 00:47:46 -0400 Subject: [PATCH 12/38] more detailed collections function error messages --- src/fsharp/FSharp.Core/array.fs | 21 ++++++------ src/fsharp/FSharp.Core/array3.fs | 19 +++++------ src/fsharp/FSharp.Core/list.fs | 55 +++++++------------------------- src/fsharp/FSharp.Core/local.fs | 10 +++--- src/fsharp/FSharp.Core/seq.fs | 6 ++-- src/fsharp/FSharp.Core/string.fs | 4 +-- 6 files changed, 42 insertions(+), 73 deletions(-) diff --git a/src/fsharp/FSharp.Core/array.fs b/src/fsharp/FSharp.Core/array.fs index 741d2df0974..7ef664ba346 100644 --- a/src/fsharp/FSharp.Core/array.fs +++ b/src/fsharp/FSharp.Core/array.fs @@ -7,6 +7,7 @@ namespace Microsoft.FSharp.Collections open System.Collections.Generic open Microsoft.FSharp.Primitives.Basics open Microsoft.FSharp.Core + open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Collections open Microsoft.FSharp.Core.Operators open Microsoft.FSharp.Core.CompilerServices @@ -46,16 +47,16 @@ namespace Microsoft.FSharp.Collections else Some array.[array.Length-1] [] - let inline init count f = Array.init count f + let inline init count f = Array.init count f [] let zeroCreate count = - if count < 0 then invalidArg "count" (SR.GetString(SR.inputMustBeNonNegative)) + if count < 0 then invalidArgInputMustBeNonNegative "count" count Array.zeroCreateUnchecked count [] let create (count:int) (x:'T) = - if count < 0 then invalidArg "count" (SR.GetString(SR.inputMustBeNonNegative)) + if count < 0 then invalidArgInputMustBeNonNegative "count" count let array: 'T[] = Array.zeroCreateUnchecked count for i = 0 to Operators.Checked.(-) array.Length 1 do // use checked arithmetic here to satisfy FxCop array.[i] <- x @@ -110,7 +111,7 @@ namespace Microsoft.FSharp.Collections [] let replicate count x = - if count < 0 then invalidArg "count" (SR.GetString(SR.inputMustBeNonNegative)) + if count < 0 then invalidArgInputMustBeNonNegative "count" count let arr : 'T array = Array.zeroCreateUnchecked count for i = 0 to arr.Length-1 do arr.[i] <- x @@ -128,7 +129,7 @@ namespace Microsoft.FSharp.Collections [] let splitAt index (array:'T[]) = checkNonNull "array" array - if index < 0 then invalidArg "index" (SR.GetString(SR.inputMustBeNonNegative)) + if index < 0 then invalidArgInputMustBeNonNegative "index" index if array.Length < index then raise <| InvalidOperationException (SR.GetString(SR.notEnoughElements)) if index = 0 then let right = Array.subUnchecked 0 array.Length array @@ -145,7 +146,7 @@ namespace Microsoft.FSharp.Collections [] let take count (array : 'T[]) = checkNonNull "array" array - if count < 0 then invalidArg "count" (SR.GetString(SR.inputMustBeNonNegative)) + if count < 0 then invalidArgInputMustBeNonNegative "count" count if count = 0 then empty else @@ -1076,8 +1077,8 @@ namespace Microsoft.FSharp.Collections [] let sub (array:'T[]) (startIndex:int) (count:int) = checkNonNull "array" array - if startIndex < 0 then invalidArg "startIndex" (SR.GetString(SR.inputMustBeNonNegative)) - if count < 0 then invalidArg "count" (SR.GetString(SR.inputMustBeNonNegative)) + if startIndex < 0 then invalidArgInputMustBeNonNegative "startIndex" startIndex + if count < 0 then invalidArgInputMustBeNonNegative "count" count if startIndex + count > array.Length then invalidArg "count" (SR.GetString(SR.outOfRange)) Array.subUnchecked startIndex count array @@ -1102,8 +1103,8 @@ namespace Microsoft.FSharp.Collections [] let fill (target:'T[]) (targetIndex:int) (count:int) (x:'T) = checkNonNull "target" target - if targetIndex < 0 then invalidArg "targetIndex" (SR.GetString(SR.inputMustBeNonNegative)) - if count < 0 then invalidArg "count" (SR.GetString(SR.inputMustBeNonNegative)) + if targetIndex < 0 then invalidArgInputMustBeNonNegative "targetIndex" targetIndex + if count < 0 then invalidArgInputMustBeNonNegative "count" count for i = targetIndex to targetIndex + count - 1 do target.[i] <- x diff --git a/src/fsharp/FSharp.Core/array3.fs b/src/fsharp/FSharp.Core/array3.fs index db94d654894..6036ee88725 100644 --- a/src/fsharp/FSharp.Core/array3.fs +++ b/src/fsharp/FSharp.Core/array3.fs @@ -5,6 +5,7 @@ namespace Microsoft.FSharp.Collections open System.Diagnostics open Microsoft.FSharp.Collections open Microsoft.FSharp.Core + open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Core.Operators open Microsoft.FSharp.Core.Operators.Checked @@ -35,9 +36,9 @@ namespace Microsoft.FSharp.Collections [] let zeroCreate (n1:int) (n2:int) (n3:int) = - if n1 < 0 then invalidArg "n1" (SR.GetString(SR.inputMustBeNonNegative)) - if n2 < 0 then invalidArg "n2" (SR.GetString(SR.inputMustBeNonNegative)) - if n3 < 0 then invalidArg "n3" (SR.GetString(SR.inputMustBeNonNegative)) + if n1 < 0 then invalidArgInputMustBeNonNegative "n1" n1 + if n2 < 0 then invalidArgInputMustBeNonNegative "n2" n2 + if n3 < 0 then invalidArgInputMustBeNonNegative "n3" n3 (# "newarr.multi 3 !0" type ('T) n1 n2 n3 : 'T[,,] #) [] @@ -127,10 +128,10 @@ namespace Microsoft.FSharp.Collections [] let zeroCreate (n1:int) (n2:int) (n3:int) (n4:int) = - if n1 < 0 then invalidArg "n1" (SR.GetString(SR.inputMustBeNonNegative)) - if n2 < 0 then invalidArg "n2" (SR.GetString(SR.inputMustBeNonNegative)) - if n3 < 0 then invalidArg "n3" (SR.GetString(SR.inputMustBeNonNegative)) - if n4 < 0 then invalidArg "n4" (SR.GetString(SR.inputMustBeNonNegative)) + if n1 < 0 then invalidArgInputMustBeNonNegative "n1" n1 + if n2 < 0 then invalidArgInputMustBeNonNegative "n2" n2 + if n3 < 0 then invalidArgInputMustBeNonNegative "n3" n3 + if n4 < 0 then invalidArgInputMustBeNonNegative "n4" n4 (# "newarr.multi 4 !0" type ('T) n1 n2 n3 n4 : 'T[,,,] #) [] @@ -156,7 +157,7 @@ namespace Microsoft.FSharp.Collections [] - let get (array: 'T[,,,]) n1 n2 n3 n4 = array.[n1,n2,n3,n4] + let get (array: 'T[,,,]) n1 n2 n3 n4 = array.[n1,n2,n3,n4] [] - let set (array: 'T[,,,]) n1 n2 n3 n4 x = array.[n1,n2,n3,n4] <- x + let set (array: 'T[,,,]) n1 n2 n3 n4 x = array.[n1,n2,n3,n4] <- x diff --git a/src/fsharp/FSharp.Core/list.fs b/src/fsharp/FSharp.Core/list.fs index b515dfd1348..6c8f8caefa1 100644 --- a/src/fsharp/FSharp.Core/list.fs +++ b/src/fsharp/FSharp.Core/list.fs @@ -186,14 +186,8 @@ namespace Microsoft.FSharp.Collections match list1,list2 with | [],[] -> () | h1::t1, h2::t2 -> f.Invoke(h1,h2); loop t1 t2 - | [],xs2 -> - invalidArgFmt "list1" - "{0}\nlist1 is {1} elements shorter than list2" - [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] - | xs1,[] -> - invalidArgFmt "list2" - "{0}\nlist2 is {1} elements shorter than list1" - [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] + | [],xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length + | xs1,[] -> invalidArgDifferentListLength "list2" "list1" xs1.Length loop list1 list2 [] @@ -203,14 +197,8 @@ namespace Microsoft.FSharp.Collections match list1,list2 with | [],[] -> () | h1::t1, h2::t2 -> f.Invoke(n,h1,h2); loop (n+1) t1 t2 - | [],xs2 -> - invalidArgFmt "list1" - "{0}\nlist1 is {1} elements shorter than list2" - [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] - | xs1,[] -> - invalidArgFmt "list2" - "{0}\nlist2 is {1} elements shorter than list1" - [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] + | [],xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length + | xs1,[] -> invalidArgDifferentListLength "list2" "list1" xs1.Length loop 0 list1 list2 [] @@ -260,14 +248,8 @@ namespace Microsoft.FSharp.Collections match list1,list2 with | [],[] -> acc | h1::t1, h2::t2 -> loop (f.Invoke(acc,h1,h2)) t1 t2 - | [],xs2 -> - invalidArgFmt "list1" - "{0}\nlist1 is {1} elements shorter than list2" - [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] - | xs1,[] -> - invalidArgFmt "list2" - "{0}\nlist2 is {1} elements shorter than list1" - [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] + | [],xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length + | xs1,[] -> invalidArgDifferentListLength "list2" "list1" xs1.Length loop acc list1 list2 let foldArraySubRight (f:OptimizedClosures.FSharpFunc<'T,_,_>) (arr: 'T[]) start fin acc = @@ -351,27 +333,15 @@ namespace Microsoft.FSharp.Collections | [h2;h3],[k2;k3] -> f.Invoke(h1,k1,f.Invoke(h2,k2,f.Invoke(h3,k3,acc))) | [h2;h3;h4],[k2;k3;k4] -> f.Invoke(h1,k1,f.Invoke(h2,k2,f.Invoke(h3,k3,f.Invoke(h4,k4,acc)))) | _ -> foldBack2UsingArrays f list1 list2 acc - | [],xs2 -> - invalidArgFmt "list1" - "{0}\nlist1 is {1} elements shorter than list2" - [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] - | xs1,[] -> - invalidArgFmt "list2" - "{0}\nlist2 is {1} elements shorter than list1" - [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] + | [],xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length + | xs1,[] -> invalidArgDifferentListLength "list2" "list1" xs1.Length let rec forall2aux (f:OptimizedClosures.FSharpFunc<_,_,_>) list1 list2 = match list1,list2 with | [],[] -> true | h1::t1, h2::t2 -> f.Invoke(h1,h2) && forall2aux f t1 t2 - | [],xs2 -> - invalidArgFmt "list1" - "{0}\nlist1 is {1} elements shorter than list2" - [|SR.GetString SR.listsHadDifferentLengths; xs2.Length|] - | xs1,[] -> - invalidArgFmt "list2" - "{0}\nlist2 is {1} elements shorter than list1" - [|SR.GetString SR.listsHadDifferentLengths; xs1.Length|] + | [],xs2 -> invalidArgDifferentListLength "list1" "list2" xs2.Length + | xs1,[] -> invalidArgDifferentListLength "list2" "list1" xs1.Length [] let forall2 f list1 list2 = @@ -507,10 +477,7 @@ namespace Microsoft.FSharp.Collections match lst with | _ when i = 0 -> lst | _::t -> loop (i-1) t - | [] -> - invalidArgFmt "count" - "{0}\ncount of {1} exceeds the length of list by {2}" - [|SR.GetString SR.outOfRange; count; i|] + | [] -> invalidArgOutOfRange "count" count "distance past the list" i loop count list [] diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index eac7cf3e81a..4446d3b1bc6 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -23,30 +23,30 @@ module DetailedExceptions = [|SR.GetString SR.listsHadDifferentLengths; arg1; diff; arg2|] /// throws an invalid argument exception and returns the difference between the lists' lengths - let invalidArg3ListsDifferent arg1 arg2 arg3 len1 len2 len3 = + let invalidArg3ListsDifferent (arg1:string) (arg2:string) (arg3:string) (len1:int) (len2:int) (len3:int) = invalidArgFmt (String.Concat [|arg1; ", "; arg2; ", "; arg3|]) "{0}\n {1}.Length = {2}, {3}.Length = {4}, {5}.Length = {6}" [|SR.GetString SR.listsHadDifferentLengths; arg1; len1; arg2; len2; arg3; len3|] /// throws an invalid operation exception and returns how many elements the /// list is shorter than the index - let invalidOpListNotEnoughElements index = + let invalidOpListNotEnoughElements (index:int) = invalidOpFmt "{0}\nThe list was {1} {2} shorter than the index" [|SR.GetString SR.notEnoughElements; index; (if index=1 then "element" else "elements")|] /// throws an invalid argument exception and returns the arg's value - let invalidArgInputMustBeNonNegative arg count = + let invalidArgInputMustBeNonNegative (arg:string) (count:int) = invalidArgFmt arg "{0}\n{1} = {2}" [|SR.GetString SR.inputMustBeNonNegative; arg; count|] /// throws an invalid argument exception and returns the arg's value - let invalidArgInputMustBePositive arg count = + let invalidArgInputMustBePositive (arg:string) (count:int) = invalidArgFmt arg "{0}\n{1} = {2}" [|SR.GetString SR.inputMustBePositive; arg; count|] /// throws an invalid argument exception and returns the out of range index, /// a text description of the range, and the bound of the range /// e.g. sourceIndex = -4, source axis-0 lower bound = 0" - let invalidArgOutOfRange arg index text bound = + let invalidArgOutOfRange (arg:string) (index:int) (text:string) (bound:int) = invalidArgFmt arg "{0}\n{1} = {2}, {3} = {4}" [|SR.GetString SR.outOfRange; arg; index; text; bound|] diff --git a/src/fsharp/FSharp.Core/seq.fs b/src/fsharp/FSharp.Core/seq.fs index 0aaad8403ef..b931bd8ae70 100644 --- a/src/fsharp/FSharp.Core/seq.fs +++ b/src/fsharp/FSharp.Core/seq.fs @@ -905,7 +905,7 @@ namespace Microsoft.FSharp.Collections [] let init count f = - if count < 0 then invalidArgFmt "count" "{0}\ncount = {1}" [|SR.GetString SR.inputMustBeNonNegative; count|] + if count < 0 then invalidArgInputMustBeNonNegative "count" count mkSeq (fun () -> IEnumerator.upto (Some (count-1)) f) [] @@ -918,7 +918,7 @@ namespace Microsoft.FSharp.Collections [] let item i (source : seq<'T>) = checkNonNull "source" source - if i < 0 then invalidArgFmt "index" "{0}\nindex = {1}" [|SR.GetString SR.inputMustBeNonNegative; i|] + if i < 0 then invalidArgInputMustBeNonNegative "index" i use e = source.GetEnumerator() IEnumerator.nth i e @@ -1100,7 +1100,7 @@ namespace Microsoft.FSharp.Collections [] let take count (source : seq<'T>) = checkNonNull "source" source - if count < 0 then invalidArgFmt "count" "{0}\ncount = {1}" [|SR.GetString SR.inputMustBeNonNegative; count|] + if count < 0 then invalidArgInputMustBeNonNegative "count" count (* Note: don't create or dispose any IEnumerable if n = 0 *) if count = 0 then empty else seq { use e = source.GetEnumerator() diff --git a/src/fsharp/FSharp.Core/string.fs b/src/fsharp/FSharp.Core/string.fs index 7b544a3d166..1e77918734a 100644 --- a/src/fsharp/FSharp.Core/string.fs +++ b/src/fsharp/FSharp.Core/string.fs @@ -67,7 +67,7 @@ namespace Microsoft.FSharp.Core [] let init (count:int) (initializer: int-> string) = - if count < 0 then invalidArgFmt "count" "{0}\ncount = {1}" [|SR.GetString SR.inputMustBeNonNegative; count|] + if count < 0 then invalidArgInputMustBeNonNegative "count" count let res = StringBuilder count for i = 0 to count - 1 do res.Append(initializer i) |> ignore @@ -75,7 +75,7 @@ namespace Microsoft.FSharp.Core [] let replicate (count:int) (str:string) = - if count < 0 then invalidArgFmt "count" "{0}\ncount = {1}" [|SR.GetString SR.inputMustBeNonNegative; count|] + if count < 0 then invalidArgInputMustBeNonNegative "count" count let str = emptyIfNull str let res = StringBuilder str.Length for i = 0 to count - 1 do From 38d0a9a7d713739c20274042564317ac68a0fd93 Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Thu, 18 Aug 2016 21:01:19 -0400 Subject: [PATCH 13/38] adjust access modifiers --- src/fsharp/FSharp.Core/local.fs | 13 +++++++------ src/fsharp/FSharp.Core/local.fsi | 8 ++++---- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index 4446d3b1bc6..475c455e528 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -3,16 +3,17 @@ namespace Microsoft.FSharp.Core -module DetailedExceptions = +module internal DetailedExceptions = open System + open Microsoft.FSharp.Core /// takes an argument, a formatting string, a param array to splice into the formatting string - let inline internal invalidArgFmt (arg:string) (format:string) paramArray = + let inline invalidArgFmt (arg:string) (format:string) paramArray = let msg = String.Format (format,paramArray) raise (new ArgumentException (msg,arg)) /// takes a formatting string and a param array to splice into the formatting string - let inline internal invalidOpFmt (format:string) paramArray = + let inline invalidOpFmt (format:string) paramArray = let msg = String.Format (format,paramArray) raise (new InvalidOperationException(msg)) @@ -36,11 +37,11 @@ module DetailedExceptions = [|SR.GetString SR.notEnoughElements; index; (if index=1 then "element" else "elements")|] /// throws an invalid argument exception and returns the arg's value - let invalidArgInputMustBeNonNegative (arg:string) (count:int) = - invalidArgFmt arg "{0}\n{1} = {2}" [|SR.GetString SR.inputMustBeNonNegative; arg; count|] + let inline invalidArgInputMustBeNonNegative (arg:string) (count:int) = + invalidArgFmt arg "{0}\n{1} = {2}" [|LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString ; arg; count|] /// throws an invalid argument exception and returns the arg's value - let invalidArgInputMustBePositive (arg:string) (count:int) = + let inline invalidArgInputMustBePositive (arg:string) (count:int) = invalidArgFmt arg "{0}\n{1} = {2}" [|SR.GetString SR.inputMustBePositive; arg; count|] /// throws an invalid argument exception and returns the out of range index, diff --git a/src/fsharp/FSharp.Core/local.fsi b/src/fsharp/FSharp.Core/local.fsi index 5bfa9a046fa..3c1b42d2703 100644 --- a/src/fsharp/FSharp.Core/local.fsi +++ b/src/fsharp/FSharp.Core/local.fsi @@ -4,13 +4,13 @@ namespace Microsoft.FSharp.Core open Microsoft.FSharp.Core module internal DetailedExceptions = - val inline internal invalidArgFmt: arg:string -> format:string -> paramArray:obj array -> _ - val inline internal invalidOpFmt: format:string -> paramArray:obj array -> _ + val inline invalidArgFmt: arg:string -> format:string -> paramArray:obj array -> _ + val inline invalidOpFmt: format:string -> paramArray:obj array -> _ val invalidArgDifferentListLength: arg1:string -> arg2:string -> diff:int -> _ val invalidArg3ListsDifferent: arg1:string -> arg2:string -> arg3:string -> len1:int -> len2:int -> len3:int -> _ val invalidOpListNotEnoughElements: index:int -> _ - val invalidArgInputMustBeNonNegative: arg:string -> count:int -> _ - val invalidArgInputMustBePositive: arg:string -> count:int -> _ + val inline invalidArgInputMustBeNonNegative: arg:string -> count:int -> _ + val inline invalidArgInputMustBePositive: arg:string -> count:int -> _ val invalidArgOutOfRange: arg:string -> index:int -> text:string -> bound:int -> _ /// Definitions internal for this library. From de95f019f80b7df816dd072e1b013158c9343f01 Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Fri, 19 Aug 2016 00:35:35 -0400 Subject: [PATCH 14/38] fix grammar in error message --- src/fsharp/FSharp.Core/local.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index 475c455e528..1d5170e0418 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -20,8 +20,8 @@ module internal DetailedExceptions = /// throws an invalid argument exception and returns the difference between the lists' lengths let invalidArgDifferentListLength (arg1:string) (arg2:string) (diff:int) = invalidArgFmt arg1 - "{0}\n{1} is {2} elements shorter than {3}" - [|SR.GetString SR.listsHadDifferentLengths; arg1; diff; arg2|] + "{0}\n{1} is {2} {3} shorter than {4}" + [|SR.GetString SR.listsHadDifferentLengths; arg1; diff; (if diff=1 then "element" else "elements"); arg2|] /// throws an invalid argument exception and returns the difference between the lists' lengths let invalidArg3ListsDifferent (arg1:string) (arg2:string) (arg3:string) (len1:int) (len2:int) (len3:int) = From b6245c63c4e93813d309cac375676c6644d9e4e6 Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Fri, 19 Aug 2016 00:35:59 -0400 Subject: [PATCH 15/38] use labeled properties for FsCheck tests --- .../CollectionModulesConsistency.fs | 226 ++++++++++-------- 1 file changed, 120 insertions(+), 106 deletions(-) diff --git a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Collections/CollectionModulesConsistency.fs b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Collections/CollectionModulesConsistency.fs index 1763cb82454..ad4898624dd 100644 --- a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Collections/CollectionModulesConsistency.fs +++ b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Collections/CollectionModulesConsistency.fs @@ -8,11 +8,17 @@ open NUnit.Framework open FsCheck open Utils +/// helper function that creates labeled FsCheck properties for equality comparisons +let consistency name sqs ls arr = + (sqs = arr) |@ (sprintf "Seq.%s = Array.%s" name name) .&. + (ls = arr) |@ (sprintf "List.%s = Array.%s" name name) + + let allPairs<'a when 'a : equality> (xs : list<'a>) (xs2 : list<'a>) = - let s = xs |> Seq.allPairs xs2 - let l = xs |> List.allPairs xs2 - let a = xs |> Seq.toArray |> Array.allPairs (Seq.toArray xs2) - Seq.toArray s = a && List.toArray l = a + let s = xs |> Seq.allPairs xs2 |> Seq.toArray + let l = xs |> List.allPairs xs2 |> List.toArray + let a = xs |> Seq.toArray |> Array.allPairs (Seq.toArray xs2) + consistency "allPairs" s l a [] let ``allPairs is consistent`` () = @@ -21,10 +27,11 @@ let ``allPairs is consistent`` () = Check.QuickThrowOnFailure allPairs let append<'a when 'a : equality> (xs : list<'a>) (xs2 : list<'a>) = - let s = xs |> Seq.append xs2 - let l = xs |> List.append xs2 + let s = xs |> Seq.append xs2 |> Seq.toArray + let l = xs |> List.append xs2 |> List.toArray let a = xs |> Seq.toArray |> Array.append (Seq.toArray xs2) - Seq.toArray s = a && List.toArray l = a + consistency "append" s l a + [] let ``append is consistent`` () = @@ -36,8 +43,8 @@ let averageFloat (xs : NormalFloat []) = let xs = xs |> Array.map float let s = runAndCheckErrorType (fun () -> xs |> Seq.average) let l = runAndCheckErrorType (fun () -> xs |> List.ofArray |> List.average) - let a = runAndCheckErrorType (fun () -> xs |> Array.average) - s = a && l = a + let a = runAndCheckErrorType (fun () -> xs |> Array.average) + consistency "average" s l a [] let ``average is consistent`` () = @@ -49,7 +56,8 @@ let averageBy (xs : float []) f = let s = runAndCheckErrorType (fun () -> xs |> Seq.averageBy f) let l = runAndCheckErrorType (fun () -> xs |> List.ofArray |> List.averageBy f) let a = runAndCheckErrorType (fun () -> xs |> Array.averageBy f) - s = a && l = a + consistency "averageBy" s l a + [] let ``averageBy is consistent`` () = @@ -59,7 +67,8 @@ let contains<'a when 'a : equality> (xs : 'a []) x = let s = xs |> Seq.contains x let l = xs |> List.ofArray |> List.contains x let a = xs |> Array.contains x - s = a && l = a + consistency "contains" s l a + [] let ``contains is consistent`` () = @@ -68,10 +77,10 @@ let ``contains is consistent`` () = Check.QuickThrowOnFailure contains let choose<'a when 'a : equality> (xs : 'a []) f = - let s = xs |> Seq.choose f - let l = xs |> List.ofArray |> List.choose f + let s = xs |> Seq.choose f |> Seq.toArray + let l = xs |> List.ofArray |> List.choose f |> List.toArray let a = xs |> Array.choose f - Seq.toArray s = a && List.toArray l = a + consistency "contains" s l a [] let ``choose is consistent`` () = @@ -83,7 +92,8 @@ let chunkBySize<'a when 'a : equality> (xs : 'a []) size = let s = run (fun () -> xs |> Seq.chunkBySize size |> Seq.map Seq.toArray |> Seq.toArray) let l = run (fun () -> xs |> List.ofArray |> List.chunkBySize size |> Seq.map Seq.toArray |> Seq.toArray) let a = run (fun () -> xs |> Array.chunkBySize size |> Seq.map Seq.toArray |> Seq.toArray) - s = a && l = a + consistency "chunkBySize" s l a + [] let ``chunkBySize is consistent`` () = @@ -92,10 +102,12 @@ let ``chunkBySize is consistent`` () = Check.QuickThrowOnFailure chunkBySize let collect<'a> (xs : 'a []) f = - let s = xs |> Seq.collect f - let l = xs |> List.ofArray |> List.collect (fun x -> f x |> List.ofArray) + let s = xs |> Seq.collect f |> Seq.toArray + let l = xs |> List.ofArray |> List.collect (fun x -> f x |> List.ofArray) |> List.toArray let a = xs |> Array.collect f - Seq.toArray s = a && List.toArray l = a + consistency "collect" s l a + + [] let ``collect is consistent`` () = @@ -107,7 +119,9 @@ let compareWith<'a>(xs : 'a []) (xs2 : 'a []) f = let s = (xs, xs2) ||> Seq.compareWith f let l = (List.ofArray xs, List.ofArray xs2) ||> List.compareWith f let a = (xs, xs2) ||> Array.compareWith f - s = a && l = a + consistency "compareWith" s l a + + [] let ``compareWith is consistent`` () = @@ -116,10 +130,10 @@ let ``compareWith is consistent`` () = Check.QuickThrowOnFailure compareWith let concat<'a when 'a : equality> (xs : 'a [][]) = - let s = xs |> Seq.concat - let l = xs |> List.ofArray |> List.map List.ofArray |> List.concat + let s = xs |> Seq.concat |> Seq.toArray + let l = xs |> List.ofArray |> List.map List.ofArray |> List.concat |> List.toArray let a = xs |> Array.concat - Seq.toArray s = a && List.toArray l = a + consistency "concat" s l a [] let ``concat is consistent`` () = @@ -128,10 +142,10 @@ let ``concat is consistent`` () = Check.QuickThrowOnFailure concat let countBy<'a> (xs : 'a []) f = - let s = xs |> Seq.countBy f - let l = xs |> List.ofArray |> List.countBy f + let s = xs |> Seq.countBy f |> Seq.toArray + let l = xs |> List.ofArray |> List.countBy f |> List.toArray let a = xs |> Array.countBy f - Seq.toArray s = a && List.toArray l = a + consistency "countBy" s l a [] let ``countBy is consistent`` () = @@ -140,10 +154,10 @@ let ``countBy is consistent`` () = Check.QuickThrowOnFailure countBy let distinct<'a when 'a : comparison> (xs : 'a []) = - let s = xs |> Seq.distinct - let l = xs |> List.ofArray |> List.distinct - let a = xs |> Array.distinct - Seq.toArray s = a && List.toArray l = a + let s = xs |> Seq.distinct |> Seq.toArray + let l = xs |> List.ofArray |> List.distinct |> List.toArray + let a = xs |> Array.distinct + consistency "distinct" s l a [] let ``distinct is consistent`` () = @@ -152,10 +166,10 @@ let ``distinct is consistent`` () = Check.QuickThrowOnFailure distinct let distinctBy<'a when 'a : equality> (xs : 'a []) f = - let s = xs |> Seq.distinctBy f - let l = xs |> List.ofArray |> List.distinctBy f - let a = xs |> Array.distinctBy f - Seq.toArray s = a && List.toArray l = a + let s = xs |> Seq.distinctBy f |> Seq.toArray + let l = xs |> List.ofArray |> List.distinctBy f |> List.toArray + let a = xs |> Array.distinctBy f + consistency "distinctBy" s l a [] let ``distinctBy is consistent`` () = @@ -167,7 +181,7 @@ let exactlyOne<'a when 'a : comparison> (xs : 'a []) = let s = runAndCheckErrorType (fun () -> xs |> Seq.exactlyOne) let l = runAndCheckErrorType (fun () -> xs |> List.ofArray |> List.exactlyOne) let a = runAndCheckErrorType (fun () -> xs |> Array.exactlyOne) - s = a && l = a + consistency "exactlyOne" s l a [] let ``exactlyOne is consistent`` () = @@ -176,10 +190,10 @@ let ``exactlyOne is consistent`` () = Check.QuickThrowOnFailure exactlyOne let except<'a when 'a : equality> (xs : 'a []) (itemsToExclude: 'a []) = - let s = xs |> Seq.except itemsToExclude - let l = xs |> List.ofArray |> List.except itemsToExclude + let s = xs |> Seq.except itemsToExclude |> Seq.toArray + let l = xs |> List.ofArray |> List.except itemsToExclude |> List.toArray let a = xs |> Array.except itemsToExclude - Seq.toArray s = a && List.toArray l = a + consistency "except" s l a [] let ``except is consistent`` () = @@ -191,7 +205,7 @@ let exists<'a when 'a : equality> (xs : 'a []) f = let s = xs |> Seq.exists f let l = xs |> List.ofArray |> List.exists f let a = xs |> Array.exists f - s = a && l = a + consistency "exists" s l a [] let ``exists is consistent`` () = @@ -205,7 +219,7 @@ let exists2<'a when 'a : equality> (xs':('a*'a) []) f = let s = runAndCheckErrorType (fun () -> Seq.exists2 f xs xs2) let l = runAndCheckErrorType (fun () -> List.exists2 f (List.ofSeq xs) (List.ofSeq xs2)) let a = runAndCheckErrorType (fun () -> Array.exists2 f (Array.ofSeq xs) (Array.ofSeq xs2)) - s = a && l = a + consistency "exists2" s l a [] let ``exists2 is consistent for collections with equal length`` () = @@ -229,7 +243,7 @@ let find<'a when 'a : equality> (xs : 'a []) predicate = let s = run (fun () -> xs |> Seq.find predicate) let l = run (fun () -> xs |> List.ofArray |> List.find predicate) let a = run (fun () -> xs |> Array.find predicate) - s = a && l = a + consistency "filter" s l a [] let ``find is consistent`` () = @@ -241,7 +255,7 @@ let findBack<'a when 'a : equality> (xs : 'a []) predicate = let s = run (fun () -> xs |> Seq.findBack predicate) let l = run (fun () -> xs |> List.ofArray |> List.findBack predicate) let a = run (fun () -> xs |> Array.findBack predicate) - s = a && l = a + consistency "findBack" s l a [] let ``findBack is consistent`` () = @@ -253,7 +267,7 @@ let findIndex<'a when 'a : equality> (xs : 'a []) predicate = let s = run (fun () -> xs |> Seq.findIndex predicate) let l = run (fun () -> xs |> List.ofArray |> List.findIndex predicate) let a = run (fun () -> xs |> Array.findIndex predicate) - s = a && l = a + consistency "findIndex" s l a [] let ``findIndex is consistent`` () = @@ -265,7 +279,7 @@ let findIndexBack<'a when 'a : equality> (xs : 'a []) predicate = let s = run (fun () -> xs |> Seq.findIndexBack predicate) let l = run (fun () -> xs |> List.ofArray |> List.findIndexBack predicate) let a = run (fun () -> xs |> Array.findIndexBack predicate) - s = a && l = a + consistency "findIndexBack" s l a [] let ``findIndexBack is consistent`` () = @@ -277,7 +291,7 @@ let fold<'a,'b when 'b : equality> (xs : 'a []) f (start:'b) = let s = run (fun () -> xs |> Seq.fold f start) let l = run (fun () -> xs |> List.ofArray |> List.fold f start) let a = run (fun () -> xs |> Array.fold f start) - s = a && l = a + consistency "fold" s l a [] let ``fold is consistent`` () = @@ -292,7 +306,7 @@ let fold2<'a,'b,'c when 'c : equality> (xs': ('a*'b)[]) f (start:'c) = let s = run (fun () -> Seq.fold2 f start xs xs2) let l = run (fun () -> List.fold2 f start (List.ofArray xs) (List.ofArray xs2)) let a = run (fun () -> Array.fold2 f start xs xs2) - s = a && l = a + consistency "fold2" s l a [] let ``fold2 is consistent`` () = @@ -307,7 +321,7 @@ let foldBack<'a,'b when 'b : equality> (xs : 'a []) f (start:'b) = let s = run (fun () -> Seq.foldBack f xs start) let l = run (fun () -> List.foldBack f (xs |> List.ofArray) start) let a = run (fun () -> Array.foldBack f xs start) - s = a && l = a + consistency "foldBack" s l a [] let ``foldBack is consistent`` () = @@ -322,7 +336,7 @@ let foldBack2<'a,'b,'c when 'c : equality> (xs': ('a*'b)[]) f (start:'c) = let s = run (fun () -> Seq.foldBack2 f xs xs2 start) let l = run (fun () -> List.foldBack2 f (List.ofArray xs) (List.ofArray xs2) start) let a = run (fun () -> Array.foldBack2 f xs xs2 start) - s = a && l = a + consistency "foldBack2" s l a [] let ``foldBack2 is consistent`` () = @@ -337,7 +351,7 @@ let forall<'a when 'a : equality> (xs : 'a []) f = let s = xs |> Seq.forall f let l = xs |> List.ofArray |> List.forall f let a = xs |> Array.forall f - s = a && l = a + consistency "forall" s l a [] let ``forall is consistent`` () = @@ -351,7 +365,7 @@ let forall2<'a when 'a : equality> (xs':('a*'a) []) f = let s = runAndCheckErrorType (fun () -> Seq.forall2 f xs xs2) let l = runAndCheckErrorType (fun () -> List.forall2 f (List.ofSeq xs) (List.ofSeq xs2)) let a = runAndCheckErrorType (fun () -> Array.forall2 f (Array.ofSeq xs) (Array.ofSeq xs2)) - s = a && l = a + consistency "forall2" s l a [] let ``forall2 is consistent for collections with equal length`` () = @@ -363,7 +377,7 @@ let groupBy<'a when 'a : equality> (xs : 'a []) f = let s = run (fun () -> xs |> Seq.groupBy f |> Seq.toArray |> Array.map (fun (x,xs) -> x,xs |> Seq.toArray)) let l = run (fun () -> xs |> List.ofArray |> List.groupBy f |> Seq.toArray |> Array.map (fun (x,xs) -> x,xs |> Seq.toArray)) let a = run (fun () -> xs |> Array.groupBy f |> Array.map (fun (x,xs) -> x,xs |> Seq.toArray)) - s = a && l = a + consistency "groupBy" s l a [] let ``groupBy is consistent`` () = @@ -375,7 +389,7 @@ let head<'a when 'a : equality> (xs : 'a []) = let s = runAndCheckIfAnyError (fun () -> xs |> Seq.head) let l = runAndCheckIfAnyError (fun () -> xs |> List.ofArray |> List.head) let a = runAndCheckIfAnyError (fun () -> xs |> Array.head) - s = a && l = a + consistency "head" s l a [] let ``head is consistent`` () = @@ -384,10 +398,10 @@ let ``head is consistent`` () = Check.QuickThrowOnFailure head let indexed<'a when 'a : equality> (xs : 'a []) = - let s = xs |> Seq.indexed - let l = xs |> List.ofArray |> List.indexed + let s = xs |> Seq.indexed |> Seq.toArray + let l = xs |> List.ofArray |> List.indexed |> List.toArray let a = xs |> Array.indexed - Seq.toArray s = a && List.toArray l = a + consistency "indexed" s l a [] let ``indexed is consistent`` () = @@ -399,7 +413,7 @@ let init<'a when 'a : equality> count f = let s = run (fun () -> Seq.init count f |> Seq.toArray) let l = run (fun () -> List.init count f |> Seq.toArray) let a = run (fun () -> Array.init count f) - s = a && l = a + consistency "init" s l a [] let ``init is consistent`` () = @@ -411,7 +425,7 @@ let isEmpty<'a when 'a : equality> (xs : 'a []) = let s = xs |> Seq.isEmpty let l = xs |> List.ofArray |> List.isEmpty let a = xs |> Array.isEmpty - s = a && l = a + consistency "isEmpty" s l a [] let ``isEmpty is consistent`` () = @@ -423,7 +437,7 @@ let item<'a when 'a : equality> (xs : 'a []) index = let s = runAndCheckIfAnyError (fun () -> xs |> Seq.item index) let l = runAndCheckIfAnyError (fun () -> xs |> List.ofArray |> List.item index) let a = runAndCheckIfAnyError (fun () -> xs |> Array.item index) - s = a && l = a + consistency "item" s l a [] let ``item is consistent`` () = @@ -521,7 +535,7 @@ let last<'a when 'a : equality> (xs : 'a []) = let s = runAndCheckIfAnyError (fun () -> xs |> Seq.last) let l = runAndCheckIfAnyError (fun () -> xs |> List.ofArray |> List.last) let a = runAndCheckIfAnyError (fun () -> xs |> Array.last) - s = a && l = a + consistency "last" s l a [] let ``last is consistent`` () = @@ -533,7 +547,7 @@ let length<'a when 'a : equality> (xs : 'a []) = let s = xs |> Seq.length let l = xs |> List.ofArray |> List.length let a = xs |> Array.length - s = a && l = a + consistency "length" s l a [] let ``length is consistent`` () = @@ -542,10 +556,10 @@ let ``length is consistent`` () = Check.QuickThrowOnFailure length let map<'a when 'a : equality> (xs : 'a []) f = - let s = xs |> Seq.map f - let l = xs |> List.ofArray |> List.map f + let s = xs |> Seq.map f |> Seq.toArray + let l = xs |> List.ofArray |> List.map f |> List.toArray let a = xs |> Array.map f - Seq.toArray s = a && List.toArray l = a + consistency "map" s l a [] let ``map is consistent`` () = @@ -665,7 +679,7 @@ let max<'a when 'a : comparison> (xs : 'a []) = let s = runAndCheckIfAnyError (fun () -> xs |> Seq.max) let l = runAndCheckIfAnyError (fun () -> xs |> List.ofArray |> List.max) let a = runAndCheckIfAnyError (fun () -> xs |> Array.max) - s = a && l = a + consistency "max" s l a [] let ``max is consistent`` () = @@ -677,7 +691,7 @@ let maxBy<'a when 'a : comparison> (xs : 'a []) f = let s = runAndCheckIfAnyError (fun () -> xs |> Seq.maxBy f) let l = runAndCheckIfAnyError (fun () -> xs |> List.ofArray |> List.maxBy f) let a = runAndCheckIfAnyError (fun () -> xs |> Array.maxBy f) - s = a && l = a + consistency "maxBy" s l a [] let ``maxBy is consistent`` () = @@ -689,7 +703,7 @@ let min<'a when 'a : comparison> (xs : 'a []) = let s = runAndCheckIfAnyError (fun () -> xs |> Seq.min) let l = runAndCheckIfAnyError (fun () -> xs |> List.ofArray |> List.min) let a = runAndCheckIfAnyError (fun () -> xs |> Array.min) - s = a && l = a + consistency "min" s l a [] let ``min is consistent`` () = @@ -701,7 +715,7 @@ let minBy<'a when 'a : comparison> (xs : 'a []) f = let s = runAndCheckIfAnyError (fun () -> xs |> Seq.minBy f) let l = runAndCheckIfAnyError (fun () -> xs |> List.ofArray |> List.minBy f) let a = runAndCheckIfAnyError (fun () -> xs |> Array.minBy f) - s = a && l = a + consistency "minBy" s l a [] let ``minBy is consistent`` () = @@ -713,7 +727,7 @@ let pairwise<'a when 'a : comparison> (xs : 'a []) = let s = run (fun () -> xs |> Seq.pairwise |> Seq.toArray) let l = run (fun () -> xs |> List.ofArray |> List.pairwise |> List.toArray) let a = run (fun () -> xs |> Array.pairwise) - s = a && l = a + consistency "pairwise" s l a [] let ``pairwise is consistent`` () = @@ -750,7 +764,7 @@ let permute<'a when 'a : comparison> (xs' : list) = let s = run (fun () -> xs |> Seq.permute permutation |> Seq.toArray) let l = run (fun () -> xs |> List.permute permutation |> List.toArray) let a = run (fun () -> xs |> Array.ofSeq |> Array.permute permutation) - s = a && l = a + consistency "partition" s l a [] let ``permute is consistent`` () = @@ -762,7 +776,7 @@ let pick<'a when 'a : comparison> (xs : 'a []) f = let s = run (fun () -> xs |> Seq.pick f) let l = run (fun () -> xs |> List.ofArray |> List.pick f) let a = run (fun () -> xs |> Array.pick f) - s = a && l = a + consistency "pick" s l a [] let ``pick is consistent`` () = @@ -774,7 +788,7 @@ let reduce<'a when 'a : equality> (xs : 'a []) f = let s = runAndCheckErrorType (fun () -> xs |> Seq.reduce f) let l = runAndCheckErrorType (fun () -> xs |> List.ofArray |> List.reduce f) let a = runAndCheckErrorType (fun () -> xs |> Array.reduce f) - s = a && l = a + consistency "reduce" s l a [] let ``reduce is consistent`` () = @@ -786,7 +800,7 @@ let reduceBack<'a when 'a : equality> (xs : 'a []) f = let s = runAndCheckErrorType (fun () -> xs |> Seq.reduceBack f) let l = runAndCheckErrorType (fun () -> xs |> List.ofArray |> List.reduceBack f) let a = runAndCheckErrorType (fun () -> xs |> Array.reduceBack f) - s = a && l = a + consistency "reduceBack" s l a [] let ``reduceBack is consistent`` () = @@ -798,7 +812,7 @@ let replicate<'a when 'a : equality> x count = let s = runAndCheckIfAnyError (fun () -> Seq.replicate count x |> Seq.toArray) let l = runAndCheckIfAnyError (fun () -> List.replicate count x |> List.toArray) let a = runAndCheckIfAnyError (fun () -> Array.replicate count x) - s = a && l = a + consistency "replicate" s l a [] let ``replicate is consistent`` () = @@ -810,7 +824,7 @@ let rev<'a when 'a : equality> (xs : 'a []) = let s = Seq.rev xs |> Seq.toArray let l = xs |> List.ofArray |> List.rev |> List.toArray let a = Array.rev xs - s = a && l = a + consistency "rev" s l a [] let ``rev is consistent`` () = @@ -822,7 +836,7 @@ let scan<'a,'b when 'b : equality> (xs : 'a []) f (start:'b) = let s = run (fun () -> xs |> Seq.scan f start |> Seq.toArray) let l = run (fun () -> xs |> List.ofArray |> List.scan f start |> Seq.toArray) let a = run (fun () -> xs |> Array.scan f start) - s = a && l = a + consistency "scan" s l a [] let ``scan is consistent`` () = @@ -835,7 +849,7 @@ let scanBack<'a,'b when 'b : equality> (xs : 'a []) f (start:'b) = let s = run (fun () -> Seq.scanBack f xs start |> Seq.toArray) let l = run (fun () -> List.scanBack f (xs |> List.ofArray) start |> Seq.toArray) let a = run (fun () -> Array.scanBack f xs start) - s = a && l = a + consistency "scanback" s l a [] let ``scanBack is consistent`` () = @@ -848,7 +862,7 @@ let singleton<'a when 'a : equality> (x : 'a) = let s = Seq.singleton x |> Seq.toArray let l = List.singleton x |> List.toArray let a = Array.singleton x - s = a && l = a + consistency "singleton" s l a [] let ``singleton is consistent`` () = @@ -860,7 +874,7 @@ let skip<'a when 'a : equality> (xs : 'a []) count = let s = runAndCheckIfAnyError (fun () -> Seq.skip count xs |> Seq.toArray) let l = runAndCheckIfAnyError (fun () -> List.skip count (Seq.toList xs) |> List.toArray) let a = runAndCheckIfAnyError (fun () -> Array.skip count xs) - s = a && l = a + consistency "skip" s l a [] let ``skip is consistent`` () = @@ -872,7 +886,7 @@ let skipWhile<'a when 'a : equality> (xs : 'a []) f = let s = runAndCheckIfAnyError (fun () -> Seq.skipWhile f xs |> Seq.toArray) let l = runAndCheckIfAnyError (fun () -> List.skipWhile f (Seq.toList xs) |> List.toArray) let a = runAndCheckIfAnyError (fun () -> Array.skipWhile f xs) - s = a && l = a + consistency "skipWhile" s l a [] let ``skipWhile is consistent`` () = @@ -881,10 +895,10 @@ let ``skipWhile is consistent`` () = Check.QuickThrowOnFailure skipWhile let sort<'a when 'a : comparison> (xs : 'a []) = - let s = xs |> Seq.sort - let l = xs |> List.ofArray |> List.sort + let s = xs |> Seq.sort |> Seq.toArray + let l = xs |> List.ofArray |> List.sort |> List.toArray let a = xs |> Array.sort - Seq.toArray s = a && List.toArray l = a + consistency "sort" s l a [] let ``sort is consistent`` () = @@ -934,10 +948,10 @@ let ``sortWith actually sorts (but is inconsistent in regards of stability)`` () Check.QuickThrowOnFailure sortWith let sortDescending<'a when 'a : comparison> (xs : 'a []) = - let s = xs |> Seq.sortDescending - let l = xs |> List.ofArray |> List.sortDescending + let s = xs |> Seq.sortDescending |> Seq.toArray + let l = xs |> List.ofArray |> List.sortDescending |> List.toArray let a = xs |> Array.sortDescending - Seq.toArray s = a && List.toArray l = a + consistency "sortDescending" s l a [] let ``sortDescending is consistent`` () = @@ -965,7 +979,7 @@ let sum (xs : int []) = let s = run (fun () -> xs |> Seq.sum) let l = run (fun () -> xs |> Array.toList |> List.sum) let a = run (fun () -> xs |> Array.sum) - s = a && l = a + consistency "sum" s l a [] let ``sum is consistent`` () = @@ -975,7 +989,7 @@ let sumBy<'a> (xs : 'a []) (f:'a -> int) = let s = run (fun () -> xs |> Seq.sumBy f) let l = run (fun () -> xs |> Array.toList |> List.sumBy f) let a = run (fun () -> xs |> Array.sumBy f) - s = a && l = a + consistency "sumBy" s l a [] let ``sumBy is consistent`` () = @@ -999,7 +1013,7 @@ let splitInto<'a when 'a : equality> (xs : 'a []) count = let s = run (fun () -> xs |> Seq.splitInto count |> Seq.map Seq.toArray |> Seq.toArray) let l = run (fun () -> xs |> List.ofArray |> List.splitInto count |> Seq.map Seq.toArray |> Seq.toArray) let a = run (fun () -> xs |> Array.splitInto count |> Seq.map Seq.toArray |> Seq.toArray) - s = a && l = a + consistency "splitInto" s l a [] let ``splitInto is consistent`` () = @@ -1011,7 +1025,7 @@ let tail<'a when 'a : equality> (xs : 'a []) = let s = runAndCheckIfAnyError (fun () -> xs |> Seq.tail |> Seq.toArray) let l = runAndCheckIfAnyError (fun () -> xs |> List.ofArray |> List.tail |> Seq.toArray) let a = runAndCheckIfAnyError (fun () -> xs |> Array.tail) - s = a && l = a + consistency "tail" s l a [] let ``tail is consistent`` () = @@ -1023,7 +1037,7 @@ let take<'a when 'a : equality> (xs : 'a []) count = let s = runAndCheckIfAnyError (fun () -> Seq.take count xs |> Seq.toArray) let l = runAndCheckIfAnyError (fun () -> List.take count (Seq.toList xs) |> List.toArray) let a = runAndCheckIfAnyError (fun () -> Array.take count xs) - s = a && l = a + consistency "take" s l a [] let ``take is consistent`` () = @@ -1035,7 +1049,7 @@ let takeWhile<'a when 'a : equality> (xs : 'a []) f = let s = runAndCheckIfAnyError (fun () -> Seq.takeWhile f xs |> Seq.toArray) let l = runAndCheckIfAnyError (fun () -> List.takeWhile f (Seq.toList xs) |> List.toArray) let a = runAndCheckIfAnyError (fun () -> Array.takeWhile f xs) - s = a && l = a + consistency "takeWhile" s l a [] let ``takeWhile is consistent`` () = @@ -1047,7 +1061,7 @@ let truncate<'a when 'a : equality> (xs : 'a []) count = let s = runAndCheckIfAnyError (fun () -> Seq.truncate count xs |> Seq.toArray) let l = runAndCheckIfAnyError (fun () -> List.truncate count (Seq.toList xs) |> List.toArray) let a = runAndCheckIfAnyError (fun () -> Array.truncate count xs) - s = a && l = a + consistency "truncate" s l a [] let ``truncate is consistent`` () = @@ -1059,7 +1073,7 @@ let tryFind<'a when 'a : equality> (xs : 'a []) predicate = let s = xs |> Seq.tryFind predicate let l = xs |> List.ofArray |> List.tryFind predicate let a = xs |> Array.tryFind predicate - s = a && l = a + consistency "tryFind" s l a [] let ``tryFind is consistent`` () = @@ -1071,7 +1085,7 @@ let tryFindBack<'a when 'a : equality> (xs : 'a []) predicate = let s = xs |> Seq.tryFindBack predicate let l = xs |> List.ofArray |> List.tryFindBack predicate let a = xs |> Array.tryFindBack predicate - s = a && l = a + consistency "tryFindBack" s l a [] let ``tryFindBack is consistent`` () = @@ -1083,7 +1097,7 @@ let tryFindIndex<'a when 'a : equality> (xs : 'a []) predicate = let s = xs |> Seq.tryFindIndex predicate let l = xs |> List.ofArray |> List.tryFindIndex predicate let a = xs |> Array.tryFindIndex predicate - s = a && l = a + consistency "tryFindIndex" s l a [] let ``tryFindIndex is consistent`` () = @@ -1095,7 +1109,7 @@ let tryFindIndexBack<'a when 'a : equality> (xs : 'a []) predicate = let s = xs |> Seq.tryFindIndexBack predicate let l = xs |> List.ofArray |> List.tryFindIndexBack predicate let a = xs |> Array.tryFindIndexBack predicate - s = a && l = a + consistency "tryFindIndexBack" s l a [] let ``tryFindIndexBack is consistent`` () = @@ -1107,7 +1121,7 @@ let tryHead<'a when 'a : equality> (xs : 'a []) = let s = xs |> Seq.tryHead let l = xs |> List.ofArray |> List.tryHead let a = xs |> Array.tryHead - s = a && l = a + consistency "tryHead" s l a [] let ``tryHead is consistent`` () = @@ -1119,7 +1133,7 @@ let tryItem<'a when 'a : equality> (xs : 'a []) index = let s = xs |> Seq.tryItem index let l = xs |> List.ofArray |> List.tryItem index let a = xs |> Array.tryItem index - s = a && l = a + consistency "tryItem" s l a [] let ``tryItem is consistent`` () = @@ -1131,7 +1145,7 @@ let tryLast<'a when 'a : equality> (xs : 'a []) = let s = xs |> Seq.tryLast let l = xs |> List.ofArray |> List.tryLast let a = xs |> Array.tryLast - s = a && l = a + consistency "tryLast" s l a [] let ``tryLast is consistent`` () = @@ -1143,7 +1157,7 @@ let tryPick<'a when 'a : comparison> (xs : 'a []) f = let s = xs |> Seq.tryPick f let l = xs |> List.ofArray |> List.tryPick f let a = xs |> Array.tryPick f - s = a && l = a + consistency "tryPick" s l a [] let ``tryPick is consistent`` () = @@ -1163,7 +1177,7 @@ let unfold<'a,'b when 'b : equality> f (start:'a) = let s : 'b [] = Seq.unfold (f()) start |> Seq.toArray let l = List.unfold (f()) start |> List.toArray let a = Array.unfold (f()) start - s = a && l = a + consistency "unfold" s l a [] @@ -1202,10 +1216,10 @@ let ``unzip3 is consistent`` () = Check.QuickThrowOnFailure unzip3 let where<'a when 'a : equality> (xs : 'a []) predicate = - let s = xs |> Seq.where predicate - let l = xs |> List.ofArray |> List.where predicate + let s = xs |> Seq.where predicate |> Seq.toArray + let l = xs |> List.ofArray |> List.where predicate |> List.toArray let a = xs |> Array.where predicate - Seq.toArray s = a && List.toArray l = a + consistency "where" s l a [] let ``where is consistent`` () = @@ -1217,7 +1231,7 @@ let windowed<'a when 'a : equality> (xs : 'a []) windowSize = let s = run (fun () -> xs |> Seq.windowed windowSize |> Seq.toArray |> Array.map Seq.toArray) let l = run (fun () -> xs |> List.ofArray |> List.windowed windowSize |> List.toArray |> Array.map Seq.toArray) let a = run (fun () -> xs |> Array.windowed windowSize) - s = a && l = a + consistency "windowed" s l a [] let ``windowed is consistent`` () = @@ -1231,7 +1245,7 @@ let zip<'a when 'a : equality> (xs':('a*'a) []) = let s = runAndCheckErrorType (fun () -> Seq.zip xs xs2 |> Seq.toArray) let l = runAndCheckErrorType (fun () -> List.zip (List.ofSeq xs) (List.ofSeq xs2) |> List.toArray) let a = runAndCheckErrorType (fun () -> Array.zip (Array.ofSeq xs) (Array.ofSeq xs2)) - s = a && l = a + consistency "zip" s l a [] let ``zip is consistent for collections with equal length`` () = @@ -1246,7 +1260,7 @@ let zip3<'a when 'a : equality> (xs':('a*'a*'a) []) = let s = runAndCheckErrorType (fun () -> Seq.zip3 xs xs2 xs3 |> Seq.toArray) let l = runAndCheckErrorType (fun () -> List.zip3 (List.ofSeq xs) (List.ofSeq xs2) (List.ofSeq xs3) |> List.toArray) let a = runAndCheckErrorType (fun () -> Array.zip3 (Array.ofSeq xs) (Array.ofSeq xs2) (Array.ofSeq xs3)) - s = a && l = a + consistency "zip3" s l a [] let ``zip3 is consistent for collections with equal length`` () = From 5eb80df950e1b9733e061cbdea977c438d119c42 Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Fri, 19 Aug 2016 01:34:21 -0400 Subject: [PATCH 16/38] show results in fscheck labels --- .../CollectionModulesConsistency.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Collections/CollectionModulesConsistency.fs b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Collections/CollectionModulesConsistency.fs index ad4898624dd..658bc324f48 100644 --- a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Collections/CollectionModulesConsistency.fs +++ b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Collections/CollectionModulesConsistency.fs @@ -10,8 +10,8 @@ open Utils /// helper function that creates labeled FsCheck properties for equality comparisons let consistency name sqs ls arr = - (sqs = arr) |@ (sprintf "Seq.%s = Array.%s" name name) .&. - (ls = arr) |@ (sprintf "List.%s = Array.%s" name name) + (sqs = arr) |@ (sprintf "Seq.%s = %A, Array.%s = %A" name sqs name arr) .&. + (ls = arr) |@ (sprintf "List.%s = %A, Array.%s = %A" name ls name arr) let allPairs<'a when 'a : equality> (xs : list<'a>) (xs2 : list<'a>) = From 905fb62b6fd0f4a327f9701b6c8391f387029d76 Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Fri, 19 Aug 2016 03:57:28 -0400 Subject: [PATCH 17/38] additional exn fns for arrays --- src/fsharp/FSharp.Core/local.fs | 14 +++++++++++++- src/fsharp/FSharp.Core/local.fsi | 2 ++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index 1d5170e0418..07b8932a753 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -23,7 +23,7 @@ module internal DetailedExceptions = "{0}\n{1} is {2} {3} shorter than {4}" [|SR.GetString SR.listsHadDifferentLengths; arg1; diff; (if diff=1 then "element" else "elements"); arg2|] - /// throws an invalid argument exception and returns the difference between the lists' lengths + /// throws an invalid argument exception and returns the length of the 3 arrays let invalidArg3ListsDifferent (arg1:string) (arg2:string) (arg3:string) (len1:int) (len2:int) (len3:int) = invalidArgFmt (String.Concat [|arg1; ", "; arg2; ", "; arg3|]) "{0}\n {1}.Length = {2}, {3}.Length = {4}, {5}.Length = {6}" @@ -52,6 +52,18 @@ module internal DetailedExceptions = "{0}\n{1} = {2}, {3} = {4}" [|SR.GetString SR.outOfRange; arg; index; text; bound|] + /// throws an invalid argument exception and returns the difference between the lists' lengths + let invalidArgDifferentArrayLength (arg1:string) (len1:int) (arg2:string) (len2:int) = + invalidArgFmt arg1 + "{0}\n{1}.Length = {2}, {3}.Length = {4}" + [|SR.GetString SR.arraysHadDifferentLengths; arg1; len1; arg2; len2 |] + + /// throws an invalid argument exception and returns the lengths of the 3 arrays + let invalidArg3ArraysDifferent (arg1:string) (arg2:string) (arg3:string) (len1:int) (len2:int) (len3:int) = + invalidArgFmt (String.Concat [|arg1; ", "; arg2; ", "; arg3|]) + "{0}\n {1}.Length = {2}, {3}.Length = {4}, {5}.Length = {6}" + [|SR.GetString SR.arraysHadDifferentLengths; arg1; len1; arg2; len2; arg3; len3|] + namespace Microsoft.FSharp.Primitives.Basics diff --git a/src/fsharp/FSharp.Core/local.fsi b/src/fsharp/FSharp.Core/local.fsi index 3c1b42d2703..2a46a6d6799 100644 --- a/src/fsharp/FSharp.Core/local.fsi +++ b/src/fsharp/FSharp.Core/local.fsi @@ -12,6 +12,8 @@ module internal DetailedExceptions = val inline invalidArgInputMustBeNonNegative: arg:string -> count:int -> _ val inline invalidArgInputMustBePositive: arg:string -> count:int -> _ val invalidArgOutOfRange: arg:string -> index:int -> text:string -> bound:int -> _ + val invalidArgDifferentArrayLength: arg1:string -> len1:int -> arg2:string -> len2:int -> _ + val invalidArg3ArraysDifferent: arg1:string -> arg2:string -> arg3:string -> len1:int -> len2:int -> len3:int -> _ /// Definitions internal for this library. namespace Microsoft.FSharp.Primitives.Basics From 784c881a3fe1dc206b1e9e14cea7324451f53811 Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Fri, 19 Aug 2016 03:57:52 -0400 Subject: [PATCH 18/38] added more detailed array error messages --- src/fsharp/FSharp.Core/array.fs | 33 ++++++++++++++++----------------- 1 file changed, 16 insertions(+), 17 deletions(-) diff --git a/src/fsharp/FSharp.Core/array.fs b/src/fsharp/FSharp.Core/array.fs index 7ef664ba346..047f032d07f 100644 --- a/src/fsharp/FSharp.Core/array.fs +++ b/src/fsharp/FSharp.Core/array.fs @@ -277,7 +277,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "array1" array1 checkNonNull "array2" array2 let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f) - if array1.Length <> array2.Length then invalidArg "array2" (SR.GetString(SR.arraysHadDifferentLengths)); + if array1.Length <> array2.Length then invalidArgDifferentArrayLength "array1" array1.Length "array2" array2.Length for i = 0 to array1.Length-1 do f.Invoke(array1.[i], array2.[i]) @@ -299,7 +299,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "array1" array1 checkNonNull "array2" array2 let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f) - if array1.Length <> array2.Length then invalidArg "array2" (SR.GetString(SR.arraysHadDifferentLengths)); + if array1.Length <> array2.Length then invalidArgDifferentArrayLength "array1" array1.Length "array2" array2.Length let res = Array.zeroCreateUnchecked array1.Length for i = 0 to res.Length-1 do res.[i] <- f.Invoke(array1.[i], array2.[i]) @@ -312,7 +312,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "array3" array3 let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(f) let len1 = array1.Length - if not (len1 = array2.Length && len1 = array3.Length) then invalidArg "" (SR.GetString(SR.arraysHadDifferentLengths)) + if len1 <> array2.Length || len1 <> array3.Length then invalidArg3ArraysDifferent "array1" "array2" "array3" len1 array2.Length array3.Length let res = Array.zeroCreateUnchecked len1 for i = 0 to res.Length-1 do @@ -324,7 +324,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "array1" array1 checkNonNull "array2" array2 let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(f) - if array1.Length <> array2.Length then invalidArg "array2" (SR.GetString(SR.arraysHadDifferentLengths)); + if array1.Length <> array2.Length then invalidArgDifferentArrayLength "array1" array1.Length "array2" array2.Length let res = Array.zeroCreateUnchecked array1.Length for i = 0 to res.Length-1 do res.[i] <- f.Invoke(i,array1.[i], array2.[i]) @@ -342,7 +342,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "array1" array1 checkNonNull "array2" array2 let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(f) - if array1.Length <> array2.Length then invalidArg "array2" (SR.GetString(SR.arraysHadDifferentLengths)); + if array1.Length <> array2.Length then invalidArgDifferentArrayLength "array1" array1.Length "array2" array2.Length for i = 0 to array1.Length-1 do f.Invoke(i,array1.[i], array2.[i]) @@ -388,7 +388,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "array2" array2 let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f) let len1 = array1.Length - if len1 <> array2.Length then invalidArg "array2" (SR.GetString(SR.arraysHadDifferentLengths)) + if len1 <> array2.Length then invalidArgDifferentArrayLength "array1" array1.Length "array2" array2.Length let rec loop i = i < len1 && (f.Invoke(array1.[i], array2.[i]) || loop (i+1)) loop 0 @@ -405,7 +405,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "array2" array2 let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f) let len1 = array1.Length - if len1 <> array2.Length then invalidArg "array2" (SR.GetString(SR.arraysHadDifferentLengths)) + if len1 <> array2.Length then invalidArgDifferentArrayLength "array1" array1.Length "array2" array2.Length let rec loop i = i >= len1 || (f.Invoke(array1.[i], array2.[i]) && loop (i+1)) loop 0 @@ -615,7 +615,7 @@ namespace Microsoft.FSharp.Collections [] let skip count (array:'T[]) = checkNonNull "array" array - if count > array.Length then invalidArg "count" (SR.GetString(SR.outOfRange)) + if count > array.Length then invalidArgOutOfRange "count" count "array.Length" array.Length if count = array.Length then empty else @@ -655,7 +655,7 @@ namespace Microsoft.FSharp.Collections [] let windowed windowSize (array:'T[]) = checkNonNull "array" array - if windowSize <= 0 then invalidArg "windowSize" (SR.GetString(SR.inputMustBePositive)) + if windowSize <= 0 then invalidArgInputMustBePositive "windowSize" windowSize let len = array.Length if windowSize > len then empty @@ -668,7 +668,7 @@ namespace Microsoft.FSharp.Collections [] let chunkBySize chunkSize (array:'T[]) = checkNonNull "array" array - if chunkSize <= 0 then invalidArg "chunkSize" (SR.GetString(SR.inputMustBePositive)) + if chunkSize <= 0 then invalidArgInputMustBePositive "chunkSize" chunkSize let len = array.Length if len = 0 then empty @@ -686,7 +686,7 @@ namespace Microsoft.FSharp.Collections [] let splitInto count (array:_[]) = checkNonNull "array" array - if count <= 0 then invalidArg "count" (SR.GetString(SR.inputMustBePositive)) + if count <= 0 then invalidArgInputMustBePositive "count" count Array.splitInto count array [] @@ -694,7 +694,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "array1" array1 checkNonNull "array2" array2 let len1 = array1.Length - if len1 <> array2.Length then invalidArg "array2" (SR.GetString(SR.arraysHadDifferentLengths)) + if len1 <> array2.Length then invalidArgDifferentArrayLength "array1" array1.Length "array2" array2.Length let res = Array.zeroCreateUnchecked len1 for i = 0 to res.Length-1 do res.[i] <- (array1.[i],array2.[i]) @@ -706,8 +706,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "array2" array2 checkNonNull "array3" array3 let len1 = array1.Length - if len1 <> array2.Length then invalidArg "array2" (SR.GetString(SR.arraysHadDifferentLengths)) - if len1 <> array3.Length then invalidArg "array3" (SR.GetString(SR.arraysHadDifferentLengths)) + if len1 <> array2.Length || len1 <> array3.Length then invalidArg3ArraysDifferent "array1" "array2" "array3" len1 array2.Length array3.Length let res = Array.zeroCreateUnchecked len1 for i = 0 to res.Length-1 do res.[i] <- (array1.[i],array2.[i],array3.[i]) @@ -799,7 +798,7 @@ namespace Microsoft.FSharp.Collections let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(f) let mutable res = acc let len = array1.Length - if len <> array2.Length then invalidArg "array2" (SR.GetString(SR.arraysHadDifferentLengths)) + if len <> array2.Length then invalidArgDifferentArrayLength "array1" len "array2" array2.Length for i = len-1 downto 0 do res <- f.Invoke(array1.[i],array2.[i],res) res @@ -810,7 +809,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "array2" array2 let f = OptimizedClosures.FSharpFunc<_,_,_,_>.Adapt(f) let mutable state = acc - if array1.Length <> array2.Length then invalidArg "array2" (SR.GetString(SR.arraysHadDifferentLengths)) + if array1.Length <> array2.Length then invalidArgDifferentArrayLength "array1" array1.Length "array2" array2.Length for i = 0 to array1.Length-1 do state <- f.Invoke(state,array1.[i],array2.[i]) state @@ -1079,7 +1078,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "array" array if startIndex < 0 then invalidArgInputMustBeNonNegative "startIndex" startIndex if count < 0 then invalidArgInputMustBeNonNegative "count" count - if startIndex + count > array.Length then invalidArg "count" (SR.GetString(SR.outOfRange)) + if startIndex + count > array.Length then invalidArgOutOfRange "count" count "array.Length" array.Length Array.subUnchecked startIndex count array [] From d6cb82c33965e282f8066e92391ce88ec35d9565 Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Fri, 19 Aug 2016 04:22:10 -0400 Subject: [PATCH 19/38] check exns explicitly with FsCheck --- .../CollectionModulesConsistency.fs | 66 +++++++++++++------ 1 file changed, 45 insertions(+), 21 deletions(-) diff --git a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Collections/CollectionModulesConsistency.fs b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Collections/CollectionModulesConsistency.fs index 658bc324f48..e9b836c320f 100644 --- a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Collections/CollectionModulesConsistency.fs +++ b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Collections/CollectionModulesConsistency.fs @@ -17,7 +17,7 @@ let consistency name sqs ls arr = let allPairs<'a when 'a : equality> (xs : list<'a>) (xs2 : list<'a>) = let s = xs |> Seq.allPairs xs2 |> Seq.toArray let l = xs |> List.allPairs xs2 |> List.toArray - let a = xs |> Seq.toArray |> Array.allPairs (Seq.toArray xs2) + let a = xs |> List.toArray |> Array.allPairs (List.toArray xs2) consistency "allPairs" s l a [] @@ -29,7 +29,7 @@ let ``allPairs is consistent`` () = let append<'a when 'a : equality> (xs : list<'a>) (xs2 : list<'a>) = let s = xs |> Seq.append xs2 |> Seq.toArray let l = xs |> List.append xs2 |> List.toArray - let a = xs |> Seq.toArray |> Array.append (Seq.toArray xs2) + let a = xs |> List.toArray |> Array.append (List.toArray xs2) consistency "append" s l a @@ -89,10 +89,16 @@ let ``choose is consistent`` () = Check.QuickThrowOnFailure choose let chunkBySize<'a when 'a : equality> (xs : 'a []) size = - let s = run (fun () -> xs |> Seq.chunkBySize size |> Seq.map Seq.toArray |> Seq.toArray) - let l = run (fun () -> xs |> List.ofArray |> List.chunkBySize size |> Seq.map Seq.toArray |> Seq.toArray) - let a = run (fun () -> xs |> Array.chunkBySize size |> Seq.map Seq.toArray |> Seq.toArray) - consistency "chunkBySize" s l a + let ls = List.ofArray xs + if size <= 0 then + Prop.throws (lazy Seq.chunkBySize size xs) .&. + Prop.throws (lazy Array.chunkBySize size xs) .&. + Prop.throws (lazy List.chunkBySize size ls) + else + let s = xs |> Seq.chunkBySize size |> Seq.map Seq.toArray |> Seq.toArray + let l = ls |> List.chunkBySize size |> Seq.map Seq.toArray |> Seq.toArray + let a = xs |> Array.chunkBySize size |> Seq.map Seq.toArray |> Seq.toArray + consistency "chunkBySize" s l a [] @@ -243,7 +249,7 @@ let find<'a when 'a : equality> (xs : 'a []) predicate = let s = run (fun () -> xs |> Seq.find predicate) let l = run (fun () -> xs |> List.ofArray |> List.find predicate) let a = run (fun () -> xs |> Array.find predicate) - consistency "filter" s l a + consistency "find" s l a [] let ``find is consistent`` () = @@ -998,10 +1004,18 @@ let ``sumBy is consistent`` () = Check.QuickThrowOnFailure sumBy let splitAt<'a when 'a : equality> (xs : 'a []) index = - // no seq version - let l = run (fun () -> xs |> List.ofArray |> List.splitAt index |> fun (a,b) -> List.toArray a,List.toArray b) - let a = run (fun () -> xs |> Array.splitAt index) - l = a + let ls = List.ofArray xs + if index < 0 then + Prop.throws (lazy List.splitAt index ls) .&. + Prop.throws (lazy Array.splitAt index xs) + elif index > xs.Length then + Prop.throws (lazy List.splitAt index ls) .&. + Prop.throws (lazy Array.splitAt index xs) + else + // no seq version + let l = run (fun () -> ls |> List.splitAt index |> fun (a,b) -> List.toArray a,List.toArray b) + let a = run (fun () -> xs |> Array.splitAt index) + (l = a) |@ "splitAt" [] let ``splitAt is consistent`` () = @@ -1010,10 +1024,16 @@ let ``splitAt is consistent`` () = Check.QuickThrowOnFailure splitAt let splitInto<'a when 'a : equality> (xs : 'a []) count = - let s = run (fun () -> xs |> Seq.splitInto count |> Seq.map Seq.toArray |> Seq.toArray) - let l = run (fun () -> xs |> List.ofArray |> List.splitInto count |> Seq.map Seq.toArray |> Seq.toArray) - let a = run (fun () -> xs |> Array.splitInto count |> Seq.map Seq.toArray |> Seq.toArray) - consistency "splitInto" s l a + let ls = List.ofArray xs + if count < 1 then + Prop.throws (lazy List.splitInto count ls) .&. + Prop.throws (lazy Array.splitInto count xs) .&. + Prop.throws (lazy Seq.splitInto count xs) + else + let s = run (fun () -> xs |> Seq.splitInto count |> Seq.map Seq.toArray |> Seq.toArray) + let l = run (fun () -> ls |> List.splitInto count |> Seq.map Seq.toArray |> Seq.toArray) + let a = run (fun () -> xs |> Array.splitInto count |> Seq.map Seq.toArray |> Seq.toArray) + consistency "splitInto" s l a [] let ``splitInto is consistent`` () = @@ -1172,8 +1192,6 @@ let unfold<'a,'b when 'b : equality> f (start:'a) = if !c > 100 then None else // prevent infinity seqs c := !c + 1 f x - - let s : 'b [] = Seq.unfold (f()) start |> Seq.toArray let l = List.unfold (f()) start |> List.toArray let a = Array.unfold (f()) start @@ -1228,10 +1246,16 @@ let ``where is consistent`` () = Check.QuickThrowOnFailure where let windowed<'a when 'a : equality> (xs : 'a []) windowSize = - let s = run (fun () -> xs |> Seq.windowed windowSize |> Seq.toArray |> Array.map Seq.toArray) - let l = run (fun () -> xs |> List.ofArray |> List.windowed windowSize |> List.toArray |> Array.map Seq.toArray) - let a = run (fun () -> xs |> Array.windowed windowSize) - consistency "windowed" s l a + let ls = List.ofArray xs + if windowSize < 1 then + Prop.throws (lazy Seq.windowed windowSize xs) .&. + Prop.throws (lazy Array.windowed windowSize xs) .&. + Prop.throws (lazy List.windowed windowSize ls) + else + let s = run (fun () -> xs |> Seq.windowed windowSize |> Seq.toArray |> Array.map Seq.toArray) + let l = run (fun () -> ls |> List.windowed windowSize |> List.toArray |> Array.map Seq.toArray) + let a = run (fun () -> xs |> Array.windowed windowSize) + consistency "windowed" s l a [] let ``windowed is consistent`` () = From be42923db43edb88da511a4a81552a41a59b589b Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Fri, 19 Aug 2016 13:13:36 -0400 Subject: [PATCH 20/38] simplify error messages in seq.fs --- src/fsharp/FSharp.Core/local.fs | 6 ++++++ src/fsharp/FSharp.Core/local.fsi | 1 + 2 files changed, 7 insertions(+) diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index 07b8932a753..95eae73ada1 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -35,6 +35,12 @@ module internal DetailedExceptions = invalidOpFmt "{0}\nThe list was {1} {2} shorter than the index" [|SR.GetString SR.notEnoughElements; index; (if index=1 then "element" else "elements")|] + + + /// eg. tried to {skip} {2} {elements} past the end of the seq. Seq.Length = {10} + let invalidOpExceededSeqLength (fnName:string) (diff:int) (len:int) = + invalidOpFmt "{0}\ntried to {1} {2} {3} past the end of the seq\nSeq.Length = {4}" + [|SR.GetString SR.notEnoughElements; fnName; diff; (if diff=1 then "element" else "elements");len|] /// throws an invalid argument exception and returns the arg's value let inline invalidArgInputMustBeNonNegative (arg:string) (count:int) = diff --git a/src/fsharp/FSharp.Core/local.fsi b/src/fsharp/FSharp.Core/local.fsi index 2a46a6d6799..71cb6a36424 100644 --- a/src/fsharp/FSharp.Core/local.fsi +++ b/src/fsharp/FSharp.Core/local.fsi @@ -9,6 +9,7 @@ module internal DetailedExceptions = val invalidArgDifferentListLength: arg1:string -> arg2:string -> diff:int -> _ val invalidArg3ListsDifferent: arg1:string -> arg2:string -> arg3:string -> len1:int -> len2:int -> len3:int -> _ val invalidOpListNotEnoughElements: index:int -> _ + val invalidOpExceededSeqLength: fnName:string -> diff:int -> len: int -> _ val inline invalidArgInputMustBeNonNegative: arg:string -> count:int -> _ val inline invalidArgInputMustBePositive: arg:string -> count:int -> _ val invalidArgOutOfRange: arg:string -> index:int -> text:string -> bound:int -> _ From 86320ad1561df86d4f9614c433b3b46a728d8768 Mon Sep 17 00:00:00 2001 From: Jared Hester Date: Wed, 24 Aug 2016 02:09:28 -0400 Subject: [PATCH 21/38] PR cleanup --- .../CollectionModulesConsistency.fs | 4 +-- src/fsharp/FSharp.Core/array.fs | 1 - src/fsharp/FSharp.Core/array2.fs | 1 - src/fsharp/FSharp.Core/array3.fs | 1 - src/fsharp/FSharp.Core/list.fs | 1 - src/fsharp/FSharp.Core/local.fs | 3 +- src/fsharp/FSharp.Core/local.fsi | 1 + src/fsharp/FSharp.Core/seq.fs | 36 ------------------- src/fsharp/FSharp.Core/string.fs | 1 - 9 files changed, 4 insertions(+), 45 deletions(-) diff --git a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Collections/CollectionModulesConsistency.fs b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Collections/CollectionModulesConsistency.fs index e9b836c320f..acf752ff8cd 100644 --- a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Collections/CollectionModulesConsistency.fs +++ b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Collections/CollectionModulesConsistency.fs @@ -10,8 +10,8 @@ open Utils /// helper function that creates labeled FsCheck properties for equality comparisons let consistency name sqs ls arr = - (sqs = arr) |@ (sprintf "Seq.%s = %A, Array.%s = %A" name sqs name arr) .&. - (ls = arr) |@ (sprintf "List.%s = %A, Array.%s = %A" name ls name arr) + (sqs = arr) |@ (sprintf "Seq.%s = '%A', Array.%s = '%A'" name sqs name arr) .&. + (ls = arr) |@ (sprintf "List.%s = '%A', Array.%s = '%A'" name ls name arr) let allPairs<'a when 'a : equality> (xs : list<'a>) (xs2 : list<'a>) = diff --git a/src/fsharp/FSharp.Core/array.fs b/src/fsharp/FSharp.Core/array.fs index 047f032d07f..d935f78b935 100644 --- a/src/fsharp/FSharp.Core/array.fs +++ b/src/fsharp/FSharp.Core/array.fs @@ -7,7 +7,6 @@ namespace Microsoft.FSharp.Collections open System.Collections.Generic open Microsoft.FSharp.Primitives.Basics open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Collections open Microsoft.FSharp.Core.Operators open Microsoft.FSharp.Core.CompilerServices diff --git a/src/fsharp/FSharp.Core/array2.fs b/src/fsharp/FSharp.Core/array2.fs index d60d30bd9bf..4eb258c7210 100644 --- a/src/fsharp/FSharp.Core/array2.fs +++ b/src/fsharp/FSharp.Core/array2.fs @@ -4,7 +4,6 @@ namespace Microsoft.FSharp.Collections open System open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Core.Operators open Microsoft.FSharp.Core.Operators.Checked diff --git a/src/fsharp/FSharp.Core/array3.fs b/src/fsharp/FSharp.Core/array3.fs index 6036ee88725..9c1e6d826c1 100644 --- a/src/fsharp/FSharp.Core/array3.fs +++ b/src/fsharp/FSharp.Core/array3.fs @@ -5,7 +5,6 @@ namespace Microsoft.FSharp.Collections open System.Diagnostics open Microsoft.FSharp.Collections open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Core.Operators open Microsoft.FSharp.Core.Operators.Checked diff --git a/src/fsharp/FSharp.Core/list.fs b/src/fsharp/FSharp.Core/list.fs index 6c8f8caefa1..e616c92eaa5 100644 --- a/src/fsharp/FSharp.Core/list.fs +++ b/src/fsharp/FSharp.Core/list.fs @@ -3,7 +3,6 @@ namespace Microsoft.FSharp.Collections open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Core.Operators open Microsoft.FSharp.Core.LanguagePrimitives open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index 95eae73ada1..6232d9ec3d4 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -2,7 +2,7 @@ namespace Microsoft.FSharp.Core - +[] module internal DetailedExceptions = open System open Microsoft.FSharp.Core @@ -74,7 +74,6 @@ module internal DetailedExceptions = namespace Microsoft.FSharp.Primitives.Basics open Microsoft.FSharp.Core -open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Collections open Microsoft.FSharp.Core.Operators diff --git a/src/fsharp/FSharp.Core/local.fsi b/src/fsharp/FSharp.Core/local.fsi index 71cb6a36424..dcf8f2a6e15 100644 --- a/src/fsharp/FSharp.Core/local.fsi +++ b/src/fsharp/FSharp.Core/local.fsi @@ -3,6 +3,7 @@ namespace Microsoft.FSharp.Core open Microsoft.FSharp.Core +[] module internal DetailedExceptions = val inline invalidArgFmt: arg:string -> format:string -> paramArray:obj array -> _ val inline invalidOpFmt: format:string -> paramArray:obj array -> _ diff --git a/src/fsharp/FSharp.Core/seq.fs b/src/fsharp/FSharp.Core/seq.fs index b931bd8ae70..919add4dc7e 100644 --- a/src/fsharp/FSharp.Core/seq.fs +++ b/src/fsharp/FSharp.Core/seq.fs @@ -8,7 +8,6 @@ namespace Microsoft.FSharp.Collections open System.Collections open System.Collections.Generic open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Core.Operators open Microsoft.FSharp.Control @@ -456,38 +455,6 @@ namespace Microsoft.FSharp.Collections let bindG g cont = GenerateThen<_>.Bind(g,cont) - //let emptyG () = - // { new Generator<_> with - // member x.Apply = (fun () -> Stop) - // member x.Disposer = None } - // - //let delayG f = - // { new Generator<_> with - // member x.Apply = fun () -> Goto(f()) - // member x.Disposer = None } - // - //let useG (v: System.IDisposable) f = - // { new Generator<_> with - // member x.Apply = (fun () -> - // let g = f v in - // // We're leaving this generator but want to maintain the disposal on the target. - // // Hence chain it into the disposer of the target - // Goto(chainDisposeG v.Dispose g)) - // member x.Disposer = Some (fun () -> v.Dispose()) } - // - //let yieldG (v:'T) = - // let yielded = ref false - // { new Generator<_> with - // member x.Apply = fun () -> if !yielded then Stop else (yielded := true; Yield(v)) - // member x.Disposer = None } - // - //let rec whileG gd b = if gd() then bindG (b()) (fun () -> whileG gd b) else emptyG() - // - //let yieldThenG x b = bindG (yieldG x) b - // - //let forG (v: seq<'T>) f = - // let e = v.GetEnumerator() in - // whileG e.MoveNext (fun () -> f e.Current) // Internal type. Drive an underlying generator. Crucially when the generator returns // a new generator we simply update our current generator and continue. Thus the enumerator @@ -510,7 +477,6 @@ namespace Microsoft.FSharp.Collections // Defined as a type so we can optimize Enumerator/Generator chains in enumerateFromLazyGenerator // and GenerateFromEnumerator. - [] type EnumeratorWrappingLazyGenerator<'T>(g:Generator<'T>) = let mutable g = g @@ -565,7 +531,6 @@ namespace Microsoft.FSharp.Core.CompilerServices open System open System.Diagnostics open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Core.Operators open Microsoft.FSharp.Control @@ -857,7 +822,6 @@ namespace Microsoft.FSharp.Collections open System.Collections.Generic open System.Reflection open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Core.Operators open Microsoft.FSharp.Core.CompilerServices diff --git a/src/fsharp/FSharp.Core/string.fs b/src/fsharp/FSharp.Core/string.fs index 1e77918734a..18ead1299c0 100644 --- a/src/fsharp/FSharp.Core/string.fs +++ b/src/fsharp/FSharp.Core/string.fs @@ -6,7 +6,6 @@ namespace Microsoft.FSharp.Core open System.Text open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Core.Operators - open Microsoft.FSharp.Core.DetailedExceptions open Microsoft.FSharp.Core.Operators.Checked open Microsoft.FSharp.Collections From 972f898e935291b0987b143832119ba8081fcc6c Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Wed, 24 Aug 2016 10:07:39 +0200 Subject: [PATCH 22/38] Cleanup QuickParse.fs --- .../src/FSharp.LanguageService/QuickParse.fs | 97 +++++++++---------- 1 file changed, 48 insertions(+), 49 deletions(-) diff --git a/vsintegration/src/FSharp.LanguageService/QuickParse.fs b/vsintegration/src/FSharp.LanguageService/QuickParse.fs index e242f30c591..b31c3c2d76a 100644 --- a/vsintegration/src/FSharp.LanguageService/QuickParse.fs +++ b/vsintegration/src/FSharp.LanguageService/QuickParse.fs @@ -30,12 +30,12 @@ module internal QuickParse = // Adjusts the token tag for the given identifier // - if we're inside active pattern name (at the bar), correct the token TAG to be an identifier let CorrectIdentifierToken (s:string) tokenTag = - if (s.EndsWith("|")) then (Microsoft.FSharp.Compiler.Parser.tagOfToken (Microsoft.FSharp.Compiler.Parser.token.IDENT s)) + if s.EndsWith "|" then Microsoft.FSharp.Compiler.Parser.tagOfToken (Microsoft.FSharp.Compiler.Parser.token.IDENT s) else tokenTag let rec isValidStrippedName (name:string) idx = - if (idx = name.Length) then false - elif (IsIdentifierPartCharacter name.[idx]) then true + if idx = name.Length then false + elif IsIdentifierPartCharacter name.[idx] then true else isValidStrippedName name (idx + 1) // Utility function that recognizes whether a name is valid active pattern name @@ -143,13 +143,13 @@ module internal QuickParse = let l = searchLeft p let r = searchRight p let ident = s.Substring (l, r - l + 1) - if (ident.IndexOf('|') <> -1 && not(isValidActivePatternName(ident))) then None else - let pos = r + magicalAdjustmentConstant + if ident.IndexOf('|') <> -1 && not(isValidActivePatternName(ident)) then None else + let pos = r + magicalAdjustmentConstant Some(ident, pos, false) ) let GetCompleteIdentifierIsland (tolerateJustAfter:bool) (s : string) (p : int) : (string*int*bool) option = - if String.IsNullOrEmpty(s) then None + if String.IsNullOrEmpty s then None else let directResult = GetCompleteIdentifierIslandImpl s p if tolerateJustAfter && directResult = None then @@ -157,11 +157,13 @@ module internal QuickParse = else directResult + let private defaultName = [],"" + /// Get the partial long name of the identifier to the left of index. let GetPartialLongName(line:string,index) = - if isNull line then [],"" - elif index < 0 then [],"" - elif index >= line.Length then [],"" + if isNull line then defaultName + elif index < 0 then defaultName + elif index >= line.Length then defaultName else let IsIdentifierPartCharacter pos = IsIdentifierPartCharacter line.[pos] let IsLongIdentifierPartCharacter pos = IsLongIdentifierPartCharacter line.[pos] @@ -183,10 +185,10 @@ module internal QuickParse = else NameAndResidue() let rec InResidue(pos,right) = - if pos < 0 then [],(line.Substring(pos+1,right-pos)) + if pos < 0 then [],line.Substring(pos+1,right-pos) elif IsDot pos then InName(pos-1,pos,right) elif IsLongIdentifierPartCharacter pos then InResidue(pos-1, right) - else [],(line.Substring(pos+1,right-pos)) + else [],line.Substring(pos+1,right-pos) let result = InResidue(index,index) result @@ -197,33 +199,32 @@ module internal QuickParse = /// Get the partial long name of the identifier to the left of index. let GetPartialLongNameEx(line:string,index) : (string list * string) = - if isNull line then ([],"") - elif index<0 then ([],"") - elif index>=line.Length then ([],"") + if isNull line then defaultName + elif index < 0 then defaultName + elif index >= line.Length then defaultName else - let IsIdentifierPartCharacter(pos) = IsIdentifierPartCharacter(line.[pos]) - let IsIdentifierStartCharacter(pos) = IsIdentifierPartCharacter(pos) - let IsDot(pos) = line.[pos]='.' - let IsTick(pos) = line.[pos]='`' - let IsEndOfComment(pos) = pos < index - 1 && line.[pos] = '*' && line.[pos + 1] = ')' - let IsStartOfComment(pos) = pos < index - 1 && line.[pos] = '(' && line.[pos + 1] = '*' - let IsWhitespace(pos) = Char.IsWhiteSpace(line.[pos]) + let IsIdentifierPartCharacter pos = IsIdentifierPartCharacter line.[pos] + let IsIdentifierStartCharacter pos = IsIdentifierPartCharacter pos + let IsDot pos = line.[pos] = '.' + let IsTick pos = line.[pos] = '`' + let IsEndOfComment pos = pos < index - 1 && line.[pos] = '*' && line.[pos + 1] = ')' + let IsStartOfComment pos = pos < index - 1 && line.[pos] = '(' && line.[pos + 1] = '*' + let IsWhitespace pos = Char.IsWhiteSpace(line.[pos]) let rec SkipWhitespaceBeforeDotIdentifier(pos, ident, current,throwAwayNext) = - if pos > index then [],"" // we're in whitespace after an identifier, if this is where the cursor is, there is no PLID here - elif IsWhitespace(pos) then SkipWhitespaceBeforeDotIdentifier(pos+1,ident,current,throwAwayNext) - elif IsDot(pos) then AtStartOfIdentifier(pos+1,ident::current,throwAwayNext) + if pos > index then defaultName // we're in whitespace after an identifier, if this is where the cursor is, there is no PLID here + elif IsWhitespace pos then SkipWhitespaceBeforeDotIdentifier(pos+1,ident,current,throwAwayNext) + elif IsDot pos then AtStartOfIdentifier(pos+1,ident::current,throwAwayNext) elif IsStartOfComment pos then EatComment(1, pos + 1, EatCommentCallContext.SkipWhiteSpaces(ident, current, throwAwayNext)) else AtStartOfIdentifier(pos,[],false) // Throw away what we have and start over. and EatComment (nesting, pos, callContext) = - if pos > index then [], "" - else - if IsStartOfComment(pos) then + if pos > index then defaultName else + if IsStartOfComment pos then // track balance of closing '*)' EatComment(nesting + 1, pos + 2, callContext) else - if IsEndOfComment(pos) then + if IsEndOfComment pos then if nesting = 1 then // all right, we are at the end of comment, jump outside match callContext with @@ -240,42 +241,42 @@ module internal QuickParse = and InUnquotedIdentifier(left:int,pos:int,current,throwAwayNext) = if pos > index then - if throwAwayNext then [],"" else current,(line.Substring(left,pos-left)) + if throwAwayNext then defaultName else current,line.Substring(left,pos-left) else - if IsIdentifierPartCharacter(pos) then InUnquotedIdentifier(left,pos+1,current,throwAwayNext) - elif IsDot(pos) then + if IsIdentifierPartCharacter pos then InUnquotedIdentifier(left,pos+1,current,throwAwayNext) + elif IsDot pos then let ident = line.Substring(left,pos-left) AtStartOfIdentifier(pos+1,ident::current,throwAwayNext) - elif IsWhitespace(pos) || IsStartOfComment(pos) then + elif IsWhitespace pos || IsStartOfComment pos then let ident = line.Substring(left,pos-left) SkipWhitespaceBeforeDotIdentifier(pos, ident, current,throwAwayNext) else AtStartOfIdentifier(pos,[],false) // Throw away what we have and start over. and InQuotedIdentifier(left:int,pos:int, current,throwAwayNext) = if pos > index then - if throwAwayNext then [],"" else current,(line.Substring(left,pos-left)) + if throwAwayNext then defaultName else current,line.Substring(left,pos-left) else - let remainingLength = line.Length-pos - if IsTick(pos) && remainingLength>1 && IsTick(pos+1) then + let remainingLength = line.Length - pos + if IsTick pos && remainingLength > 1 && IsTick(pos+1) then let ident = line.Substring(left, pos-left) SkipWhitespaceBeforeDotIdentifier(pos+2,ident,current,throwAwayNext) else InQuotedIdentifier(left,pos+1,current,throwAwayNext) and AtStartOfIdentifier(pos:int, current, throwAwayNext) = if pos > index then - if throwAwayNext then [],"" else current,"" + if throwAwayNext then defaultName else current,"" else - if IsWhitespace(pos) then AtStartOfIdentifier(pos+1,current,throwAwayNext) + if IsWhitespace pos then AtStartOfIdentifier(pos+1,current,throwAwayNext) else - let remainingLength = line.Length-pos - if IsTick(pos) && remainingLength>1 && IsTick(pos+1) then InQuotedIdentifier(pos+2,pos+2,current,throwAwayNext) - elif IsStartOfComment(pos) then EatComment(1, pos + 1, EatCommentCallContext.StartIdentifier(current, throwAwayNext)) - elif IsIdentifierStartCharacter(pos) then InUnquotedIdentifier(pos,pos+1,current,throwAwayNext) - elif IsDot(pos) then - if pos=0 then + let remainingLength = line.Length - pos + if IsTick pos && remainingLength > 1 && IsTick(pos+1) then InQuotedIdentifier(pos+2,pos+2,current,throwAwayNext) + elif IsStartOfComment pos then EatComment(1, pos + 1, EatCommentCallContext.StartIdentifier(current, throwAwayNext)) + elif IsIdentifierStartCharacter pos then InUnquotedIdentifier(pos,pos+1,current,throwAwayNext) + elif IsDot pos then + if pos = 0 then // dot on first char of line, currently treat it like empty identifier to the left AtStartOfIdentifier(pos+1,""::current,throwAwayNext) - elif not(pos>0 && (IsIdentifierPartCharacter(pos-1) || IsWhitespace(pos-1))) then + elif not (pos > 0 && (IsIdentifierPartCharacter(pos-1) || IsWhitespace(pos-1))) then // it's not dots as part.of.a.long.ident, it's e.g. the range operator (..), or some other multi-char operator ending in dot if line.[pos-1] = ')' then // one very problematic case is someCall(args).Name @@ -289,15 +290,13 @@ module internal QuickParse = AtStartOfIdentifier(pos+1,""::current,throwAwayNext) else AtStartOfIdentifier(pos+1,[],throwAwayNext) let plid, residue = AtStartOfIdentifier(0,[],false) - let plid = (List.rev plid) + let plid = List.rev plid match plid with - | s::_rest when s.Length > 0 && Char.IsDigit(s.[0]) -> ([],"") // "2.0" is not a longId (this might not be right for ``2.0`` but good enough for common case) + | s::_rest when s.Length > 0 && Char.IsDigit(s.[0]) -> defaultName // "2.0" is not a longId (this might not be right for ``2.0`` but good enough for common case) | _ -> plid, residue - - let TokenNameEquals (tokenInfo : FSharpTokenInfo) token2 = - String.Compare(tokenInfo .TokenName, token2, StringComparison.OrdinalIgnoreCase)=0 + String.Compare(tokenInfo .TokenName, token2, StringComparison.OrdinalIgnoreCase) = 0 // The prefix of the sequence of token names to look for in TestMemberOrOverrideDeclaration, in reverse order let private expected = [ [|"dot"|]; [|"ident"|]; [|"member"; "override"|] ] From 0fd7a027f01aaa58869553648fd6afc55119d2f5 Mon Sep 17 00:00:00 2001 From: ncave Date: Wed, 24 Aug 2016 04:07:52 -0700 Subject: [PATCH 23/38] Fixed tests --- src/fsharp/CompileOps.fs | 4 ++-- tests/fsharpqa/Source/MultiTargeting/E_BadPathToFSharpCore.fs | 2 +- .../fsharpqa/Source/MultiTargeting/E_BadPathToFSharpCore.fsx | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index ee55a308b7a..a53b9c12a8e 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -2583,7 +2583,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = clrRoot, (int v1, sprintf "v%d.%d" v1 v2), (v1=5us && v2=0us && v3=5us) // SL5 mscorlib is 5.0.5.0 | _ -> failwith (FSComp.SR.buildCouldNotReadVersionInfoFromMscorlib()) - with e -> + with e -> error(Error(FSComp.SR.buildErrorOpeningBinaryFile(filename, e.Message), rangeStartup)) | _ -> #if !ENABLE_MONO_SUPPORT @@ -2644,7 +2644,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = checkFSharpBinaryCompatWithMscorlib filename ilReader.ILAssemblyRefs ilReader.ILModuleDef.ManifestOfAssembly.Version rangeStartup; let fslibRoot = Path.GetDirectoryName(FileSystem.GetFullPathShim(filename)) fslibRoot (* , sprintf "v%d.%d" v1 v2 *) - with e -> + with e -> error(Error(FSComp.SR.buildErrorOpeningBinaryFile(filename, e.Message), rangeStartup)) | _ -> data.defaultFSharpBinariesDir diff --git a/tests/fsharpqa/Source/MultiTargeting/E_BadPathToFSharpCore.fs b/tests/fsharpqa/Source/MultiTargeting/E_BadPathToFSharpCore.fs index f9bc3fe2231..a11a5cea146 100644 --- a/tests/fsharpqa/Source/MultiTargeting/E_BadPathToFSharpCore.fs +++ b/tests/fsharpqa/Source/MultiTargeting/E_BadPathToFSharpCore.fs @@ -1,6 +1,6 @@ // #Regression #Multitargeting #NoMono #NETFX40Only // Regression test for FSHARP1.0:6026 // Just a dummy file... -//Unable to read assembly '.+I_DO_NOT_EXIST\\FSharp\.Core\.dll'$ +//Error opening binary file '.+I_DO_NOT_EXIST\\FSharp\.Core\.dll' exit 0 diff --git a/tests/fsharpqa/Source/MultiTargeting/E_BadPathToFSharpCore.fsx b/tests/fsharpqa/Source/MultiTargeting/E_BadPathToFSharpCore.fsx index f9bc3fe2231..a11a5cea146 100644 --- a/tests/fsharpqa/Source/MultiTargeting/E_BadPathToFSharpCore.fsx +++ b/tests/fsharpqa/Source/MultiTargeting/E_BadPathToFSharpCore.fsx @@ -1,6 +1,6 @@ // #Regression #Multitargeting #NoMono #NETFX40Only // Regression test for FSHARP1.0:6026 // Just a dummy file... -//Unable to read assembly '.+I_DO_NOT_EXIST\\FSharp\.Core\.dll'$ +//Error opening binary file '.+I_DO_NOT_EXIST\\FSharp\.Core\.dll' exit 0 From 3634daef4070bd900abfbdb73f5bcb6ec7ad792d Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Wed, 24 Aug 2016 14:26:18 +0200 Subject: [PATCH 24/38] Cleanup printf --- src/fsharp/FSharp.Core/printf.fs | 37 +++++++++++++++----------------- 1 file changed, 17 insertions(+), 20 deletions(-) diff --git a/src/fsharp/FSharp.Core/printf.fs b/src/fsharp/FSharp.Core/printf.fs index 46b61d3e7fc..26c9647b86e 100644 --- a/src/fsharp/FSharp.Core/printf.fs +++ b/src/fsharp/FSharp.Core/printf.fs @@ -936,10 +936,7 @@ module internal PrintfImpl = System.Diagnostics.Debug.Assert((i = n), "i = n") buf.[i] <- ty buf - go ty 0 - - [] - let ContinuationOnStack = -1 + go ty 0 type private PrintfBuilderStack() = let args = Stack(10) @@ -951,7 +948,7 @@ module internal PrintfImpl = arr.[start + i] <- s.Pop() arr - member this.GetArgumentAndTypesAsArrays + member __.GetArgumentAndTypesAsArrays ( argsArraySize, argsArrayStartPos, argsArrayTotalCount, typesArraySize, typesArrayStartPos, typesArrayTotalCount @@ -960,7 +957,7 @@ module internal PrintfImpl = let typesArray = stackToArray typesArraySize typesArrayStartPos typesArrayTotalCount types argsArray, typesArray - member this.PopContinuationWithType() = + member __.PopContinuationWithType() = System.Diagnostics.Debug.Assert(args.Count = 1, "args.Count = 1") System.Diagnostics.Debug.Assert(types.Count = 1, "types.Count = 1") @@ -969,7 +966,7 @@ module internal PrintfImpl = cont, contTy - member this.PopValueUnsafe() = args.Pop() + member __.PopValueUnsafe() = args.Pop() member this.PushContinuationWithType (cont : obj, contTy : Type) = System.Diagnostics.Debug.Assert(this.IsEmpty, "this.IsEmpty") @@ -983,17 +980,17 @@ module internal PrintfImpl = this.PushArgumentWithType(cont, contTy) - member this.PushArgument(value : obj) = + member __.PushArgument(value : obj) = args.Push value - member this.PushArgumentWithType(value : obj, ty) = + member __.PushArgumentWithType(value : obj, ty) = args.Push value types.Push ty - member this.HasContinuationOnStack(expectedNumberOfArguments) = + member __.HasContinuationOnStack(expectedNumberOfArguments) = types.Count = expectedNumberOfArguments + 1 - member this.IsEmpty = + member __.IsEmpty = System.Diagnostics.Debug.Assert(args.Count = types.Count, "args.Count = types.Count") args.Count = 0 @@ -1247,7 +1244,7 @@ module internal PrintfImpl = else buildPlain n prefix - member this.Build<'T>(s : string) : PrintfFactory<'S, 'Re, 'Res, 'T> * int = + member __.Build<'T>(s : string) : PrintfFactory<'S, 'Re, 'Res, 'T> * int = parseFormatString s typeof<'T> :?> _, (2 * count + 1) // second component is used in SprintfEnv as value for internal buffer /// Type of element that is stored in cache @@ -1311,23 +1308,23 @@ module internal PrintfImpl = let buf : string[] = Array.zeroCreate n let mutable ptr = 0 - override this.Finalize() : 'Result = k (String.Concat(buf)) - override this.Write(s : string) = + override __.Finalize() : 'Result = k (String.Concat(buf)) + override __.Write(s : string) = buf.[ptr] <- s ptr <- ptr + 1 override this.WriteT(s) = this.Write s type StringBuilderPrintfEnv<'Result>(k, buf) = inherit PrintfEnv(buf) - override this.Finalize() : 'Result = k () - override this.Write(s : string) = ignore(buf.Append(s)) - override this.WriteT(()) = () + override __.Finalize() : 'Result = k () + override __.Write(s : string) = ignore(buf.Append(s)) + override __.WriteT(()) = () type TextWriterPrintfEnv<'Result>(k, tw : IO.TextWriter) = inherit PrintfEnv(tw) - override this.Finalize() : 'Result = k() - override this.Write(s : string) = tw.Write s - override this.WriteT(()) = () + override __.Finalize() : 'Result = k() + override __.Write(s : string) = tw.Write s + override __.WriteT(()) = () let inline doPrintf fmt f = let formatter, n = Cache<_, _, _, _>.Get fmt From fb8a46dd3c54582819a5084b8a01643014852cbc Mon Sep 17 00:00:00 2001 From: ncave Date: Wed, 24 Aug 2016 07:44:59 -0700 Subject: [PATCH 25/38] No-op --- src/fsharp/CompileOps.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index a53b9c12a8e..879ccf0f2c4 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -2583,7 +2583,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = clrRoot, (int v1, sprintf "v%d.%d" v1 v2), (v1=5us && v2=0us && v3=5us) // SL5 mscorlib is 5.0.5.0 | _ -> failwith (FSComp.SR.buildCouldNotReadVersionInfoFromMscorlib()) - with e -> + with e -> error(Error(FSComp.SR.buildErrorOpeningBinaryFile(filename, e.Message), rangeStartup)) | _ -> #if !ENABLE_MONO_SUPPORT From 2ed74aad0253e2ff859c2e8182e8e377dda0f564 Mon Sep 17 00:00:00 2001 From: liboz Date: Wed, 24 Aug 2016 12:45:14 -0400 Subject: [PATCH 26/38] print public fields --- src/utils/sformat.fs | 31 ++++++++++++++++++++----------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/src/utils/sformat.fs b/src/utils/sformat.fs index eec0d6a7a70..b2ac302b7bb 100644 --- a/src/utils/sformat.fs +++ b/src/utils/sformat.fs @@ -709,8 +709,7 @@ namespace Microsoft.FSharp.Text.StructuredFormat // pprinter: anyL - support functions // -------------------------------------------------------------------- - let getProperty (obj: obj) name = - let ty = obj.GetType() + let getProperty (ty: Type) (obj: obj) name = #if FX_ATLEAST_PORTABLE let prop = ty.GetProperty(name, (BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic)) if isNotNull prop then prop.GetValue(obj,[||]) @@ -732,6 +731,9 @@ namespace Microsoft.FSharp.Text.StructuredFormat ty.InvokeMember(name, (BindingFlags.GetProperty ||| BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic), null, obj, [| |],CultureInfo.InvariantCulture) #endif #endif + let getField obj (fieldInfo: FieldInfo) = + fieldInfo.GetValue(obj) + let formatChar isChar c = match c with | '\'' when isChar -> "\\\'" @@ -862,7 +864,7 @@ namespace Microsoft.FSharp.Text.StructuredFormat let postText = m.Groups.["post"].Value // Everything after the closing bracket let prop = replaceEscapedBrackets(m.Groups.["prop"].Value) // Unescape everything between the opening and closing brackets - match catchExn (fun () -> getProperty x prop) with + match catchExn (fun () -> getProperty ty x prop) with | Choice2Of2 e -> Some (wordL ("")) | Choice1Of2 alternativeObj -> try @@ -1102,8 +1104,11 @@ namespace Microsoft.FSharp.Text.StructuredFormat #else let props = ty.GetProperties(BindingFlags.GetField ||| BindingFlags.Instance ||| BindingFlags.Public) #endif - let props = - props |> Array.filter (fun pi -> + let fields = ty.GetFields(BindingFlags.Instance ||| BindingFlags.Public) + let propsAndFields = + props |> Array.map (fun i -> i :> MemberInfo) + |> Array.append (Array.map (fun i -> i :> MemberInfo) fields) + |> Array.filter (fun pi -> // check if property is annotated with System.Diagnostics.DebuggerBrowsable(Never). // Its evaluation may have unexpected side effects and\or block printing. match Seq.toArray (pi.GetCustomAttributes(typeof, false)) with @@ -1114,17 +1119,21 @@ namespace Microsoft.FSharp.Text.StructuredFormat // massively reign in deep printing of properties let nDepth = depthLim/10 #if FX_ATLEAST_PORTABLE - System.Array.Sort((props),{ new System.Collections.Generic.IComparer with member this.Compare(p1,p2) = compare (p1.Name) (p2.Name) } ); + System.Array.Sort((propsAndFields),{ new System.Collections.Generic.IComparer with member this.Compare(p1,p2) = compare (p1.Name) (p2.Name) } ); #else - System.Array.Sort((props:>System.Array),{ new System.Collections.IComparer with member this.Compare(p1,p2) = compare ((p1 :?> PropertyInfo).Name) ((p2 :?> PropertyInfo).Name) } ); + System.Array.Sort((propsAndFields:>System.Array),{ new System.Collections.IComparer with member this.Compare(p1,p2) = compare ((p1 :?> MemberInfo).Name) ((p2 :?> MemberInfo).Name) } ); #endif - if props.Length = 0 || (nDepth <= 0) then basicL + if propsAndFields.Length = 0 || (nDepth <= 0) then basicL else basicL --- - (props + (propsAndFields |> Array.toList - |> List.map (fun p -> (p.Name,(try Some (objL nDepth Precedence.BracketIfTuple (getProperty obj p.Name)) - with _ -> None))) + |> List.map + (fun m -> + (m.Name, + (try Some (objL nDepth Precedence.BracketIfTuple (getProperty ty obj m.Name)) + with _ -> try Some (objL nDepth Precedence.BracketIfTuple (getField obj (m :?> FieldInfo))) + with _ -> None))) |> makePropertiesL) | _ -> basicL | UnitValue -> countNodes 1; measureL From 3df6b79490f6eb3972c66f944f83bb629fc82a56 Mon Sep 17 00:00:00 2001 From: liboz Date: Wed, 24 Aug 2016 18:19:11 -0400 Subject: [PATCH 27/38] Added test and cleanup --- src/utils/sformat.fs | 10 +++++----- .../Source/InteractiveSession/Misc/PublicField.fsx | 12 ++++++++++++ .../fsharpqa/Source/InteractiveSession/Misc/env.lst | 4 +++- 3 files changed, 20 insertions(+), 6 deletions(-) create mode 100644 tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx diff --git a/src/utils/sformat.fs b/src/utils/sformat.fs index b2ac302b7bb..c1a4460f5be 100644 --- a/src/utils/sformat.fs +++ b/src/utils/sformat.fs @@ -1104,10 +1104,10 @@ namespace Microsoft.FSharp.Text.StructuredFormat #else let props = ty.GetProperties(BindingFlags.GetField ||| BindingFlags.Instance ||| BindingFlags.Public) #endif - let fields = ty.GetFields(BindingFlags.Instance ||| BindingFlags.Public) + let fields = ty.GetFields(BindingFlags.Instance ||| BindingFlags.Public) |> Array.map (fun i -> i :> MemberInfo) let propsAndFields = props |> Array.map (fun i -> i :> MemberInfo) - |> Array.append (Array.map (fun i -> i :> MemberInfo) fields) + |> Array.append fields |> Array.filter (fun pi -> // check if property is annotated with System.Diagnostics.DebuggerBrowsable(Never). // Its evaluation may have unexpected side effects and\or block printing. @@ -1121,19 +1121,19 @@ namespace Microsoft.FSharp.Text.StructuredFormat #if FX_ATLEAST_PORTABLE System.Array.Sort((propsAndFields),{ new System.Collections.Generic.IComparer with member this.Compare(p1,p2) = compare (p1.Name) (p2.Name) } ); #else - System.Array.Sort((propsAndFields:>System.Array),{ new System.Collections.IComparer with member this.Compare(p1,p2) = compare ((p1 :?> MemberInfo).Name) ((p2 :?> MemberInfo).Name) } ); + System.Array.Sort((propsAndFields :> System.Array),{ new System.Collections.IComparer with member this.Compare(p1,p2) = compare ((p1 :?> MemberInfo).Name) ((p2 :?> MemberInfo).Name) } ); #endif if propsAndFields.Length = 0 || (nDepth <= 0) then basicL else basicL --- (propsAndFields - |> Array.toList - |> List.map + |> Array.map (fun m -> (m.Name, (try Some (objL nDepth Precedence.BracketIfTuple (getProperty ty obj m.Name)) with _ -> try Some (objL nDepth Precedence.BracketIfTuple (getField obj (m :?> FieldInfo))) with _ -> None))) + |> Array.toList |> makePropertiesL) | _ -> basicL | UnitValue -> countNodes 1; measureL diff --git a/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx b/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx new file mode 100644 index 00000000000..752b74f9f1e --- /dev/null +++ b/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx @@ -0,0 +1,12 @@ +// #Regression #NoMT #FSI +// Public fields did not print. +//val it : PublicField = FSI_0002+PublicField {X = 2;\n Y = 1;} +[] +type PublicField = + val X : int + val mutable Y : int + new (x) = { X = x ; Y = 1 } + +let t2 = PublicField(2);; +t2;; +#q;; \ No newline at end of file diff --git a/tests/fsharpqa/Source/InteractiveSession/Misc/env.lst b/tests/fsharpqa/Source/InteractiveSession/Misc/env.lst index 03dcd5eb60c..13803307162 100644 --- a/tests/fsharpqa/Source/InteractiveSession/Misc/env.lst +++ b/tests/fsharpqa/Source/InteractiveSession/Misc/env.lst @@ -29,8 +29,10 @@ ReqENU SOURCE=E_InterfaceCrossConstrained02.fsx COMPILE_ONLY=1 FSIMODE=PIPE SC SOURCE=ToStringNull.fsx COMPILE_ONLY=1 FSIMODE=PIPE SCFLAGS="--nologo" # ToStringNull.fsx - SOURCE=EnumerateSets.fsx COMPILE_ONLY=1 FSIMODE=PIPE SCFLAGS="--nologo" # EnumerateSets.fsx + SOURCE=EnumerateSets.fsx COMPILE_ONLY=1 FSIMODE=PIPE SCFLAGS="--nologo" # EnumerateSets.fsx + SOURCE=PublicField.fsx COMPILE_ONLY=1 FSIMODE=PIPE SCFLAGS="--nologo" # PublicField.fsx + # These are the regression tests for FSHARP1.0:5427 # The scenario is a bit convoluted because of the way we end up doing the verification # In the last 2 cases, the verification is achieved by dumping the output of FSI to a file From b21644c1d75ae0dcabbfcb62529506e53f0a99ab Mon Sep 17 00:00:00 2001 From: liboz Date: Wed, 24 Aug 2016 18:20:06 -0400 Subject: [PATCH 28/38] ending with a newline --- tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx b/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx index 752b74f9f1e..5a42e5cfd3b 100644 --- a/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx +++ b/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx @@ -9,4 +9,4 @@ type PublicField = let t2 = PublicField(2);; t2;; -#q;; \ No newline at end of file +#q;; From 116fa5c650c10423a21d4e07d04dd7daf6357e1a Mon Sep 17 00:00:00 2001 From: liboz Date: Wed, 24 Aug 2016 19:17:00 -0400 Subject: [PATCH 29/38] escaped braces --- tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx b/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx index 5a42e5cfd3b..7c31d421c4c 100644 --- a/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx +++ b/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx @@ -1,6 +1,6 @@ // #Regression #NoMT #FSI // Public fields did not print. -//val it : PublicField = FSI_0002+PublicField {X = 2;\n Y = 1;} +//val it : PublicField = FSI_0002+PublicField \{X = 2;\n Y = 1;\} [] type PublicField = val X : int From 26e832fd19e9a03e039cc9bb0434cd7ddc598672 Mon Sep 17 00:00:00 2001 From: liboz Date: Wed, 24 Aug 2016 20:14:07 -0400 Subject: [PATCH 30/38] maybe it needs the spaces... --- tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx b/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx index 7c31d421c4c..0a0f2abe1e0 100644 --- a/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx +++ b/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx @@ -1,6 +1,6 @@ // #Regression #NoMT #FSI // Public fields did not print. -//val it : PublicField = FSI_0002+PublicField \{X = 2;\n Y = 1;\} +//val it : PublicField = FSI_0002+PublicField \{X = 2;\n Y = 1;\} [] type PublicField = val X : int From 81a1c70151adf31d46482349a282235b92d8aead Mon Sep 17 00:00:00 2001 From: liboz Date: Wed, 24 Aug 2016 21:18:10 -0400 Subject: [PATCH 31/38] fix test --- tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx b/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx index 0a0f2abe1e0..d3ac670bff1 100644 --- a/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx +++ b/tests/fsharpqa/Source/InteractiveSession/Misc/PublicField.fsx @@ -1,6 +1,7 @@ // #Regression #NoMT #FSI // Public fields did not print. -//val it : PublicField = FSI_0002+PublicField \{X = 2;\n Y = 1;\} +//val it : PublicField = FSI_0002+PublicField \{X = 2; +// Y = 1;\} [] type PublicField = val X : int From d5bafce032aa46fa306027722f875631c6e20ced Mon Sep 17 00:00:00 2001 From: Kevin Ransom Date: Thu, 25 Aug 2016 10:34:13 -0700 Subject: [PATCH 32/38] 1. Update System.ValueTuple in templates to the official public pre-release. 2. remove a couple of reference tests that were flaky on many platforms due to a dependence on specific VS installation options. 3. Update a test that was relient on an installation of .Net 2.0 --- .../Template/ConsoleApplication.fsproj | 2 +- .../ConsoleProject/Template/packages.config | 2 +- .../LibraryProject/Template/Library.fsproj | 2 +- .../LibraryProject/Template/packages.config | 2 +- .../Template/PortableLibrary.fsproj | 2 +- .../Template/packages.config | 2 +- .../Template/PortableLibrary.fsproj | 2 +- .../NetCore78Project/Template/packages.config | 2 +- .../Template/PortableLibrary.fsproj | 2 +- .../NetCoreProject/Template/packages.config | 2 +- .../Template/PortableLibrary.fsproj | 2 +- .../Template/packages.config | 2 +- .../TutorialProject/Template/Tutorial.fsproj | 2 +- .../TutorialProject/Template/packages.config | 2 +- .../unittests/Tests.LanguageService.Script.fs | 21 ------------------- .../Tests.ProjectSystem.Miscellaneous.fs | 2 -- 16 files changed, 14 insertions(+), 37 deletions(-) diff --git a/vsintegration/ProjectTemplates/ConsoleProject/Template/ConsoleApplication.fsproj b/vsintegration/ProjectTemplates/ConsoleProject/Template/ConsoleApplication.fsproj index 6525f510ab9..2200bd4f253 100644 --- a/vsintegration/ProjectTemplates/ConsoleProject/Template/ConsoleApplication.fsproj +++ b/vsintegration/ProjectTemplates/ConsoleProject/Template/ConsoleApplication.fsproj @@ -46,7 +46,7 @@ True - ..\packages\System.ValueTuple.4.0.1-beta-24423-01\lib\netstandard1.0\System.ValueTuple.dll + ..\packages\System.ValueTuple.4.0.0-rc3-24212-01\lib\netstandard1.1\System.ValueTuple.dll True diff --git a/vsintegration/ProjectTemplates/ConsoleProject/Template/packages.config b/vsintegration/ProjectTemplates/ConsoleProject/Template/packages.config index 7584a99bdaa..2688d2bafb3 100644 --- a/vsintegration/ProjectTemplates/ConsoleProject/Template/packages.config +++ b/vsintegration/ProjectTemplates/ConsoleProject/Template/packages.config @@ -1,4 +1,4 @@  - + \ No newline at end of file diff --git a/vsintegration/ProjectTemplates/LibraryProject/Template/Library.fsproj b/vsintegration/ProjectTemplates/LibraryProject/Template/Library.fsproj index b297de50adb..6bcaa3bec86 100644 --- a/vsintegration/ProjectTemplates/LibraryProject/Template/Library.fsproj +++ b/vsintegration/ProjectTemplates/LibraryProject/Template/Library.fsproj @@ -42,7 +42,7 @@ True - ..\packages\System.ValueTuple.4.0.1-beta-24423-01\lib\netstandard1.0\System.ValueTuple.dll + ..\packages\System.ValueTuple.4.0.0-rc3-24212-01\lib\netstandard1.1\System.ValueTuple.dll True diff --git a/vsintegration/ProjectTemplates/LibraryProject/Template/packages.config b/vsintegration/ProjectTemplates/LibraryProject/Template/packages.config index 7584a99bdaa..2688d2bafb3 100644 --- a/vsintegration/ProjectTemplates/LibraryProject/Template/packages.config +++ b/vsintegration/ProjectTemplates/LibraryProject/Template/packages.config @@ -1,4 +1,4 @@  - + \ No newline at end of file diff --git a/vsintegration/ProjectTemplates/NetCore259Project/Template/PortableLibrary.fsproj b/vsintegration/ProjectTemplates/NetCore259Project/Template/PortableLibrary.fsproj index f4a11c2d502..84f5a353b2d 100644 --- a/vsintegration/ProjectTemplates/NetCore259Project/Template/PortableLibrary.fsproj +++ b/vsintegration/ProjectTemplates/NetCore259Project/Template/PortableLibrary.fsproj @@ -41,7 +41,7 @@ $(MSBuildExtensionsPath32)\..\Reference Assemblies\Microsoft\FSharp\.NETCore\$(TargetFSharpCoreVersion)\FSharp.Core.dll - ..\packages\System.ValueTuple.4.0.1-beta-24423-01\lib\netstandard1.0\System.ValueTuple.dll + ..\packages\System.ValueTuple.4.0.0-rc3-24212-01\lib\netstandard1.1\System.ValueTuple.dll True diff --git a/vsintegration/ProjectTemplates/NetCore259Project/Template/packages.config b/vsintegration/ProjectTemplates/NetCore259Project/Template/packages.config index 7584a99bdaa..2688d2bafb3 100644 --- a/vsintegration/ProjectTemplates/NetCore259Project/Template/packages.config +++ b/vsintegration/ProjectTemplates/NetCore259Project/Template/packages.config @@ -1,4 +1,4 @@  - + \ No newline at end of file diff --git a/vsintegration/ProjectTemplates/NetCore78Project/Template/PortableLibrary.fsproj b/vsintegration/ProjectTemplates/NetCore78Project/Template/PortableLibrary.fsproj index 5c880758847..372c6b5a616 100644 --- a/vsintegration/ProjectTemplates/NetCore78Project/Template/PortableLibrary.fsproj +++ b/vsintegration/ProjectTemplates/NetCore78Project/Template/PortableLibrary.fsproj @@ -41,7 +41,7 @@ $(MSBuildExtensionsPath32)\..\Reference Assemblies\Microsoft\FSharp\.NETCore\$(TargetFSharpCoreVersion)\FSharp.Core.dll - ..\packages\System.ValueTuple.4.0.1-beta-24423-01\lib\netstandard1.0\System.ValueTuple.dll + ..\packages\System.ValueTuple.4.0.0-rc3-24212-01\lib\netstandard1.1\System.ValueTuple.dll True diff --git a/vsintegration/ProjectTemplates/NetCore78Project/Template/packages.config b/vsintegration/ProjectTemplates/NetCore78Project/Template/packages.config index 7584a99bdaa..2688d2bafb3 100644 --- a/vsintegration/ProjectTemplates/NetCore78Project/Template/packages.config +++ b/vsintegration/ProjectTemplates/NetCore78Project/Template/packages.config @@ -1,4 +1,4 @@  - + \ No newline at end of file diff --git a/vsintegration/ProjectTemplates/NetCoreProject/Template/PortableLibrary.fsproj b/vsintegration/ProjectTemplates/NetCoreProject/Template/PortableLibrary.fsproj index 18d9934b858..ecf71f26e49 100644 --- a/vsintegration/ProjectTemplates/NetCoreProject/Template/PortableLibrary.fsproj +++ b/vsintegration/ProjectTemplates/NetCoreProject/Template/PortableLibrary.fsproj @@ -41,7 +41,7 @@ $(MSBuildExtensionsPath32)\..\Reference Assemblies\Microsoft\FSharp\.NETCore\$(TargetFSharpCoreVersion)\FSharp.Core.dll - ..\packages\System.ValueTuple.4.0.1-beta-24423-01\lib\netstandard1.0\System.ValueTuple.dll + ..\packages\System.ValueTuple.4.0.0-rc3-24212-01\lib\netstandard1.1\System.ValueTuple.dll True diff --git a/vsintegration/ProjectTemplates/NetCoreProject/Template/packages.config b/vsintegration/ProjectTemplates/NetCoreProject/Template/packages.config index 7584a99bdaa..2688d2bafb3 100644 --- a/vsintegration/ProjectTemplates/NetCoreProject/Template/packages.config +++ b/vsintegration/ProjectTemplates/NetCoreProject/Template/packages.config @@ -1,4 +1,4 @@  - + \ No newline at end of file diff --git a/vsintegration/ProjectTemplates/PortableLibraryProject/Template/PortableLibrary.fsproj b/vsintegration/ProjectTemplates/PortableLibraryProject/Template/PortableLibrary.fsproj index ddd2f452fdc..dba3e128719 100644 --- a/vsintegration/ProjectTemplates/PortableLibraryProject/Template/PortableLibrary.fsproj +++ b/vsintegration/ProjectTemplates/PortableLibraryProject/Template/PortableLibrary.fsproj @@ -40,7 +40,7 @@ $(MSBuildExtensionsPath32)\..\Reference Assemblies\Microsoft\FSharp\.NETPortable\$(TargetFSharpCoreVersion)\FSharp.Core.dll - ..\packages\System.ValueTuple.4.0.1-beta-24423-01\lib\netstandard1.0\System.ValueTuple.dll + ..\packages\System.ValueTuple.4.0.0-rc3-24212-01\lib\netstandard1.1\System.ValueTuple.dll True diff --git a/vsintegration/ProjectTemplates/PortableLibraryProject/Template/packages.config b/vsintegration/ProjectTemplates/PortableLibraryProject/Template/packages.config index 7584a99bdaa..2688d2bafb3 100644 --- a/vsintegration/ProjectTemplates/PortableLibraryProject/Template/packages.config +++ b/vsintegration/ProjectTemplates/PortableLibraryProject/Template/packages.config @@ -1,4 +1,4 @@  - + \ No newline at end of file diff --git a/vsintegration/ProjectTemplates/TutorialProject/Template/Tutorial.fsproj b/vsintegration/ProjectTemplates/TutorialProject/Template/Tutorial.fsproj index fe3b24711ba..d2e6ae15561 100644 --- a/vsintegration/ProjectTemplates/TutorialProject/Template/Tutorial.fsproj +++ b/vsintegration/ProjectTemplates/TutorialProject/Template/Tutorial.fsproj @@ -56,7 +56,7 @@ - ..\packages\System.ValueTuple.4.0.1-beta-24423-01\lib\netstandard1.0\System.ValueTuple.dll + ..\packages\System.ValueTuple.4.0.0-rc3-24212-01\lib\netstandard1.1\System.ValueTuple.dll True diff --git a/vsintegration/ProjectTemplates/TutorialProject/Template/packages.config b/vsintegration/ProjectTemplates/TutorialProject/Template/packages.config index 7584a99bdaa..2688d2bafb3 100644 --- a/vsintegration/ProjectTemplates/TutorialProject/Template/packages.config +++ b/vsintegration/ProjectTemplates/TutorialProject/Template/packages.config @@ -1,4 +1,4 @@  - + \ No newline at end of file diff --git a/vsintegration/tests/unittests/Tests.LanguageService.Script.fs b/vsintegration/tests/unittests/Tests.LanguageService.Script.fs index f4c005800f0..eea41cd6031 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.Script.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.Script.fs @@ -567,27 +567,6 @@ type UsingMSBuild() as this = """ this.VerifyFSXNoErrorList(fileContent) - [] - [] - - // 'Microsoft.VisualStudio.QualityTools.Common.dll' is resolved via AssemblyFoldersEx over recent VS releases - member public this.``Fsx.NoError.HashR.ResolveFromAssemblyFoldersEx``() = - let fileContent = """ - #light - #r "Microsoft.VisualStudio.QualityTools.Common.dll" - """ - this.VerifyFSXNoErrorList(fileContent) - - [] - [] - // Can be any assembly that is in AssemblyFolders but not AssemblyFoldersEx - member public this.``Fsx.NoError.HashR.ResolveFromAssemblyFolders``() = - let fileContent = """ - #light - #r "Microsoft.SqlServer.SString" - """ - this.VerifyFSXNoErrorList(fileContent) - [] [] member public this.``Fsx.NoError.HashR.ResolveFromFullyQualifiedPath``() = diff --git a/vsintegration/tests/unittests/Tests.ProjectSystem.Miscellaneous.fs b/vsintegration/tests/unittests/Tests.ProjectSystem.Miscellaneous.fs index 7a584aa56d1..07d48aa4ee1 100644 --- a/vsintegration/tests/unittests/Tests.ProjectSystem.Miscellaneous.fs +++ b/vsintegration/tests/unittests/Tests.ProjectSystem.Miscellaneous.fs @@ -516,8 +516,6 @@ type Miscellaneous() = member public this.TestBuildActions () = DoWithTempFile "Test.fsproj" (fun file -> let text = TheTests.FsprojTextWithProjectReferences(["foo.fs";"Bar.resx"; "Bar.de.resx"; "Xyz\Baz.ru.resx"; "Abc.resources"],[],[],"") - // Use toolsversion 2.0 project to have predictable default set of BuildActions - let text = text.Replace("ToolsVersion='4.0'", "ToolsVersion='2.0'") File.AppendAllText(file, text) let dirName = Path.GetDirectoryName(file) From 36c1aba6a8ca8e20887edcc5a70660ed7db703da Mon Sep 17 00:00:00 2001 From: liboz Date: Thu, 25 Aug 2016 15:21:51 -0400 Subject: [PATCH 33/38] Additional cleanup as suggested by feedback --- src/utils/sformat.fs | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/src/utils/sformat.fs b/src/utils/sformat.fs index c1a4460f5be..e106245e185 100644 --- a/src/utils/sformat.fs +++ b/src/utils/sformat.fs @@ -829,7 +829,7 @@ namespace Microsoft.FSharp.Text.StructuredFormat Some (wordL (x.ToString())) else // Try the StructuredFormatDisplayAttribute extensibility attribute - match x.GetType().GetCustomAttributes (typeof, true) with + match ty.GetCustomAttributes (typeof, true) with | null | [| |] -> None | res -> let attr = (res.[0] :?> StructuredFormatDisplayAttribute) @@ -1021,7 +1021,7 @@ namespace Microsoft.FSharp.Text.StructuredFormat #else wordL (formatString s) #endif - | :? System.Array as arr -> + | :? Array as arr -> match arr.Rank with | 1 -> let n = arr.Length @@ -1046,18 +1046,17 @@ namespace Microsoft.FSharp.Text.StructuredFormat // Format 'set' and 'map' nicely | _ when - (let ty = obj.GetType() - ty.IsGenericType && (ty.GetGenericTypeDefinition() = typedefof> + (ty.IsGenericType && (ty.GetGenericTypeDefinition() = typedefof> || ty.GetGenericTypeDefinition() = typedefof>) ) -> - let ty = obj.GetType() let word = if ty.GetGenericTypeDefinition() = typedefof> then "map" else "set" let possibleKeyValueL v = + let tyv = v.GetType() if word = "map" && (match v with null -> false | _ -> true) && - v.GetType().IsGenericType && - v.GetType().GetGenericTypeDefinition() = typedefof> then - objL depthLim Precedence.BracketIfTuple (v.GetType().GetProperty("Key").GetValue(v, [| |]), - v.GetType().GetProperty("Value").GetValue(v, [| |])) + tyv.IsGenericType && + tyv.GetGenericTypeDefinition() = typedefof> then + objL depthLim Precedence.BracketIfTuple (tyv.GetProperty("Key").GetValue(v, [| |]), + tyv.GetProperty("Value").GetValue(v, [| |])) else objL depthLim Precedence.BracketIfTuple v let it = (obj :?> System.Collections.IEnumerable).GetEnumerator() @@ -1091,7 +1090,7 @@ namespace Microsoft.FSharp.Text.StructuredFormat // Also, in the declared values case, if the sequence is actually a known non-lazy type (list, array etc etc) we could print it. wordL "" |> showModeFilter | _ -> - if showMode = ShowTopLevelBinding && typeUsesSystemObjectToString (obj.GetType()) then + if showMode = ShowTopLevelBinding && typeUsesSystemObjectToString ty then emptyL else countNodes 1 @@ -1119,9 +1118,9 @@ namespace Microsoft.FSharp.Text.StructuredFormat // massively reign in deep printing of properties let nDepth = depthLim/10 #if FX_ATLEAST_PORTABLE - System.Array.Sort((propsAndFields),{ new System.Collections.Generic.IComparer with member this.Compare(p1,p2) = compare (p1.Name) (p2.Name) } ); + Array.Sort((propsAndFields),{ new IComparer with member this.Compare(p1,p2) = compare (p1.Name) (p2.Name) } ); #else - System.Array.Sort((propsAndFields :> System.Array),{ new System.Collections.IComparer with member this.Compare(p1,p2) = compare ((p1 :?> MemberInfo).Name) ((p2 :?> MemberInfo).Name) } ); + Array.Sort((propsAndFields :> Array),{ new System.Collections.IComparer with member this.Compare(p1,p2) = compare ((p1 :?> MemberInfo).Name) ((p2 :?> MemberInfo).Name) } ); #endif if propsAndFields.Length = 0 || (nDepth <= 0) then basicL From 21710f6d71b4df186aa47e37c8cfa7caa67567a9 Mon Sep 17 00:00:00 2001 From: kevinr Date: Thu, 25 Aug 2016 22:17:52 -0700 Subject: [PATCH 34/38] Deploy correct dependencies for the compiler --- setup/FSharp.SDK/Common.Wix.Properties.wxs | 180 +++++++++--------- .../component-groups/Compiler_Redist.wxs | 22 +++ 2 files changed, 112 insertions(+), 90 deletions(-) diff --git a/setup/FSharp.SDK/Common.Wix.Properties.wxs b/setup/FSharp.SDK/Common.Wix.Properties.wxs index 6f947532403..5afdc6bcca3 100644 --- a/setup/FSharp.SDK/Common.Wix.Properties.wxs +++ b/setup/FSharp.SDK/Common.Wix.Properties.wxs @@ -2,96 +2,96 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/setup/FSharp.SDK/component-groups/Compiler_Redist.wxs b/setup/FSharp.SDK/component-groups/Compiler_Redist.wxs index bb933585b38..66cc11740ff 100644 --- a/setup/FSharp.SDK/component-groups/Compiler_Redist.wxs +++ b/setup/FSharp.SDK/component-groups/Compiler_Redist.wxs @@ -25,6 +25,11 @@ + + + + + @@ -95,6 +100,7 @@ + @@ -139,6 +145,22 @@ + + + + + + + + + + + + + + + + From 0149ef15a2472d872f91366ad5c4fef634aeaa20 Mon Sep 17 00:00:00 2001 From: kevinr Date: Thu, 25 Aug 2016 22:36:37 -0700 Subject: [PATCH 35/38] Add missing compiler dependencies to F# VS Addin --- setup/Swix/Microsoft.FSharp.Dependencies/Files.swr | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/setup/Swix/Microsoft.FSharp.Dependencies/Files.swr b/setup/Swix/Microsoft.FSharp.Dependencies/Files.swr index bd0094ee811..bf639935d7a 100644 --- a/setup/Swix/Microsoft.FSharp.Dependencies/Files.swr +++ b/setup/Swix/Microsoft.FSharp.Dependencies/Files.swr @@ -21,7 +21,7 @@ folder "InstallDir:Common7\IDE\PublicAssemblies" file source="$(BinariesFolder)\net40\bin\FSharp.Core.dll" vs.file.ngen=yes file source="$(BinariesFolder)\net40\bin\FSharp.Core.optdata" file source="$(BinariesFolder)\net40\bin\FSharp.Core.sigdata" - + folder "InstallDir:Common7\IDE\CommonExtensions\Microsoft\FSharp" file source="$(PackagesFolder)\Microsoft.VisualFSharp.Msbuild.15.0.1.0.1\lib\net45\Microsoft.Build.Conversion.Core.dll" file source="$(PackagesFolder)\Microsoft.VisualFSharp.Msbuild.15.0.1.0.1\lib\net45\Microsoft.Build.dll" @@ -29,11 +29,15 @@ folder "InstallDir:Common7\IDE\CommonExtensions\Microsoft\FSharp" file source="$(PackagesFolder)\Microsoft.VisualFSharp.Msbuild.15.0.1.0.1\lib\net45\Microsoft.Build.Framework.dll" file source="$(PackagesFolder)\Microsoft.VisualFSharp.Msbuild.15.0.1.0.1\lib\net45\Microsoft.Build.Tasks.Core.dll" file source="$(PackagesFolder)\Microsoft.VisualFSharp.Msbuild.15.0.1.0.1\lib\net45\Microsoft.Build.Utilities.Core.dll" - + file source="$(PackagesFolder)\System.Collections.Immutable.1.2.0\lib\netstandard1.0\System.Collections.Immutable.dll" + file source="$(PackagesFolder)\System.Reflection.Metadata.1.4.1-beta-24227-04\lib\netstandard1.1\System.Reflection.Metadata.dll" + file source="$(PackagesFolder)\Microsoft.DiaSymReader.1.0.8\lib\netstandard1.1\Microsoft.DiaSymReader.dll" + file source="$(PackagesFolder)\Microsoft.DiaSymReader.PortablePdb.1.1.0\lib\netstandard1.1\Microsoft.DiaSymReader.PortablePdb.dll" + folder "InstallDir:Common7\IDE\NewScriptItems" file source="$(BinariesFolder)\setup\resources\NewFileDialog\Script\NewFSharpScriptItems.vsdir" file source="$(BinariesFolder)\setup\resources\NewFileDialog\Script\Script.fsx" - + folder "InstallDir:Common7\IDE\NewFileItems" file source="$(BinariesFolder)\setup\resources\NewFileDialog\General\NewFSharpFileItems.vsdir" file source="$(BinariesFolder)\setup\resources\NewFileDialog\General\File.fs" From ca6df19ea1295215a05a4fff62cb63c799c00e69 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Tue, 27 Sep 2016 19:32:12 +1000 Subject: [PATCH 36/38] Initial SeqComposition (filter and map) A generalized version, with a bit more flexible composition, of #1528. --- src/fsharp/FSharp.Core/seq.fs | 212 ++++++++++++++++++++++++++++------ 1 file changed, 177 insertions(+), 35 deletions(-) diff --git a/src/fsharp/FSharp.Core/seq.fs b/src/fsharp/FSharp.Core/seq.fs index 919add4dc7e..b38f0c1bc45 100644 --- a/src/fsharp/FSharp.Core/seq.fs +++ b/src/fsharp/FSharp.Core/seq.fs @@ -15,14 +15,181 @@ namespace Microsoft.FSharp.Collections open Microsoft.FSharp.Primitives.Basics module IEnumerator = - - let noReset() = raise (new System.NotSupportedException(SR.GetString(SR.resetNotSupported))) let notStarted() = raise (new System.InvalidOperationException(SR.GetString(SR.enumerationNotStarted))) let alreadyFinished() = raise (new System.InvalidOperationException(SR.GetString(SR.enumerationAlreadyFinished))) let check started = if not started then notStarted() let dispose (r : System.IDisposable) = r.Dispose() + module SeqComposition = + module SeqAssistant = + let inline avoidTailCall x = + match x with + | true -> true + | false -> false + + type ISeqDoNext<'T,'U> = + abstract DoNext : 'T * byref<'U> -> bool + abstract AddDoNext : ISeqDoNext<'U,'V> -> ISeqDoNext<'T,'V> + + type Factory = + static member Filter f g = Filter (fun x -> f x && g x) + static member Map f g = Map (f >> g) + + and Map<'T,'U> (map:'T->'U) = + interface ISeqDoNext<'T,'U> with + member this.AddDoNext (next:ISeqDoNext<'U,'V>) : ISeqDoNext<'T,'V> = + match next with + | :? Map<'U,'V> as mapU2V -> upcast (Factory.Map this.Map mapU2V.Map) + | :? Filter<'U> as filterU -> unbox (MapFilter (this, filterU)) + | _ -> upcast Composed (this, next) + + member __.DoNext (input:'T, output:byref<'U>) : bool = + output <- map input + true + + member __.Map = map + + and Filter<'T> (filter:'T->bool) = + interface ISeqDoNext<'T,'T> with + member this.AddDoNext (next:ISeqDoNext<'T,'V>) : ISeqDoNext<'T,'V> = + match next with + | :? Map<'T,'V> as mapTV -> upcast FilterMap (this, mapTV) + | :? Filter<'T> as filterT2 -> unbox (Factory.Filter this.Filter filterT2.Filter) + | _ -> upcast Composed (this, next) + + member __.DoNext (input:'T, output:byref<'T>) : bool = + if filter input then + output <- input + true + else + false + + member __.Filter = filter + + and Composed<'T,'U,'V> (first:ISeqDoNext<'T,'U>, second:ISeqDoNext<'U,'V>) = + interface ISeqDoNext<'T,'V> with + member __.DoNext (input:'T, output:byref<'V>) :bool = + let mutable temp = Unchecked.defaultof<'U> + if first.DoNext (input, &temp) then + // tail calls add performance penalty, and these calls shouldn't be deep + SeqAssistant.avoidTailCall (second.DoNext (temp, &output)) + else + false + + member __.AddDoNext (next:ISeqDoNext<'V,'W>):ISeqDoNext<'T,'W> = + upcast Composed (first, second.AddDoNext next) + + member __.First = first + member __.Second = second + + and MapFilter<'T,'U> (map:Map<'T,'U>, filter:Filter<'U>) = + inherit Composed<'T,'U,'U>(map, filter) + + interface ISeqDoNext<'T,'U> with + member __.DoNext (input:'T, output:byref<'U>) :bool = + output <- map.Map input + // tail calls add performance penalty, and these calls shouldn't be deep + SeqAssistant.avoidTailCall (filter.Filter output) + + member this.AddDoNext (next:ISeqDoNext<'U,'V>):ISeqDoNext<'T,'V> = + match next with + | :? Filter<'U> as filterU -> unbox (MapFilter(map, Factory.Filter filter.Filter filterU.Filter)) + | _ -> upcast Composed (this, next) + + and FilterMap<'T,'U> (filter:Filter<'T>, map:Map<'T,'U>) = + inherit Composed<'T,'T,'U>(filter, map) + + interface ISeqDoNext<'T,'U> with + member __.DoNext (input:'T, output:byref<'U>) : bool = + if filter.Filter input then + output <- map.Map input + true + else + false + + member this.AddDoNext (next:ISeqDoNext<'U,'V>) : ISeqDoNext<'T,'V> = + match next with + | :? Map<'U,'V> as filterU -> upcast FilterMap(filter, Factory.Map map.Map filterU.Map) + | _ -> upcast Composed(this, next) + + [] + type SeqDoNextBase<'T> () = + abstract member AddSeqDoNext : (ISeqDoNext<'T,'U>) -> IEnumerable<'U> + + type SeqDoNextStates = + | PreGetEnumerator = 0 + | NotStarted = 1 + | Finished = 2 + | InProcess = 3 + + type SeqDoNext<'T,'U>(generator:IEnumerable<'T>, t2u:ISeqDoNext<'T,'U>, state:SeqDoNextStates) = + inherit SeqDoNextBase<'U>() + + let initialThreadId = System.Environment.CurrentManagedThreadId + let mutable state = state + + let mutable source = + match state with + | SeqDoNextStates.PreGetEnumerator -> Unchecked.defaultof> + | SeqDoNextStates.NotStarted -> generator.GetEnumerator () + | _ -> failwith "unexpected logic" + + let getEnumerator (this:SeqDoNext<'T,'U>) : IEnumerator<'U> = + // state management with InitialThreadId copied from c# generated code to avoid extra object + if state = SeqDoNextStates.PreGetEnumerator && initialThreadId = Environment.CurrentManagedThreadId then + source <- generator.GetEnumerator () + state <- SeqDoNextStates.NotStarted + upcast this + else + upcast (new SeqDoNext<'T,'U>(generator, t2u, SeqDoNextStates.NotStarted)) + + let mutable current = Unchecked.defaultof<_> + + let rec moveNext () = + if source.MoveNext () then + if t2u.DoNext (source.Current, ¤t) then + true + else + moveNext () + else + state <- SeqDoNextStates.Finished + false + + new (generator, t2u) = new SeqDoNext<'T,'U>(generator, t2u, SeqDoNextStates.PreGetEnumerator) + + override __.AddSeqDoNext (u2v:ISeqDoNext<'U,'V>) = + new SeqDoNext<'T,'V>(generator, t2u.AddDoNext u2v, SeqDoNextStates.PreGetEnumerator) :> IEnumerable<'V> + + interface IDisposable with + member x.Dispose():unit = + match source with + | null -> () + | _ -> + source.Dispose () + source <- Unchecked.defaultof<_> + + interface IEnumerator with + member this.Current : obj = box (this:>IEnumerator<'U>).Current + member __.MoveNext () = + state <- SeqDoNextStates.InProcess + moveNext () + member __.Reset () : unit = noReset () + + interface IEnumerator<'U> with + member x.Current = + match state with + | SeqDoNextStates.NotStarted -> notStarted() + | SeqDoNextStates.Finished -> alreadyFinished() + | _ -> () + current + + interface IEnumerable with + member this.GetEnumerator () : IEnumerator = upcast (getEnumerator this) + + interface IEnumerable<'U> with + member this.GetEnumerator () : IEnumerator<'U> = getEnumerator this + let cast (e : IEnumerator) : IEnumerator<'T> = { new IEnumerator<'T> with member x.Current = unbox<'T> e.Current @@ -109,18 +276,6 @@ namespace Microsoft.FSharp.Collections interface System.IDisposable with member this.Dispose() = this.Dispose() - let map f (e : IEnumerator<_>) : IEnumerator<_>= - upcast - { new MapEnumerator<_>() with - member this.DoMoveNext (curr : byref<_>) = - if e.MoveNext() then - curr <- (f e.Current) - true - else - false - member this.Dispose() = e.Dispose() - } - let mapi f (e : IEnumerator<_>) : IEnumerator<_> = let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt(f) let i = ref (-1) @@ -216,23 +371,6 @@ namespace Microsoft.FSharp.Collections interface System.IDisposable with member x.Dispose() = e.Dispose() } - let filter f (e : IEnumerator<'T>) = - let started = ref false - let this = - { new IEnumerator<'T> with - member x.Current = check !started; e.Current - interface IEnumerator with - member x.Current = check !started; box e.Current - member x.MoveNext() = - let rec next() = - if not !started then started := true - e.MoveNext() && (f e.Current || next()) - next() - member x.Reset() = noReset() - interface System.IDisposable with - member x.Dispose() = e.Dispose() } - this - let unfold f x : IEnumerator<_> = let state = ref x upcast @@ -964,17 +1102,21 @@ namespace Microsoft.FSharp.Collections mkSeq (fun () -> f (ie1.GetEnumerator()) (source2.GetEnumerator()) (source3.GetEnumerator())) [] - let filter f source = + let filter<'T> (f:'T->bool) (source:seq<'T>) : seq<'T> = checkNonNull "source" source - revamp (IEnumerator.filter f) source + match source with + | :? IEnumerator.SeqComposition.SeqDoNextBase<'T> as s -> s.AddSeqDoNext (IEnumerator.SeqComposition.Filter f) + | _ -> upcast (new IEnumerator.SeqComposition.SeqDoNext<_,_>(source, IEnumerator.SeqComposition.Filter f)) [] let where f source = filter f source [] - let map f source = + let map<'T,'U> (f:'T->'U) (source:seq<'T>) : seq<'U> = checkNonNull "source" source - revamp (IEnumerator.map f) source + match source with + | :? IEnumerator.SeqComposition.SeqDoNextBase<'T> as s -> s.AddSeqDoNext (IEnumerator.SeqComposition.Map f) + | _ -> upcast (new IEnumerator.SeqComposition.SeqDoNext<_,_>(source, IEnumerator.SeqComposition.Map f)) [] let mapi f source = From 08dcf8146042a3381d4a9b973106f01a10608805 Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Tue, 27 Sep 2016 20:14:09 +1000 Subject: [PATCH 37/38] Versioned access to CurrentManagedThreadId --- src/fsharp/FSharp.Core/seq.fs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/fsharp/FSharp.Core/seq.fs b/src/fsharp/FSharp.Core/seq.fs index b38f0c1bc45..b4151af85b6 100644 --- a/src/fsharp/FSharp.Core/seq.fs +++ b/src/fsharp/FSharp.Core/seq.fs @@ -126,7 +126,6 @@ namespace Microsoft.FSharp.Collections type SeqDoNext<'T,'U>(generator:IEnumerable<'T>, t2u:ISeqDoNext<'T,'U>, state:SeqDoNextStates) = inherit SeqDoNextBase<'U>() - let initialThreadId = System.Environment.CurrentManagedThreadId let mutable state = state let mutable source = @@ -135,6 +134,8 @@ namespace Microsoft.FSharp.Collections | SeqDoNextStates.NotStarted -> generator.GetEnumerator () | _ -> failwith "unexpected logic" +#if FX_ATLEAST_45 + let initialThreadId = System.Environment.CurrentManagedThreadId let getEnumerator (this:SeqDoNext<'T,'U>) : IEnumerator<'U> = // state management with InitialThreadId copied from c# generated code to avoid extra object if state = SeqDoNextStates.PreGetEnumerator && initialThreadId = Environment.CurrentManagedThreadId then @@ -143,6 +144,10 @@ namespace Microsoft.FSharp.Collections upcast this else upcast (new SeqDoNext<'T,'U>(generator, t2u, SeqDoNextStates.NotStarted)) +#else + let getEnumerator (this:SeqDoNext<'T,'U>) : IEnumerator<'U> = + upcast (new SeqDoNext<'T,'U>(generator, t2u, SeqDoNextStates.NotStarted)) +#endif let mutable current = Unchecked.defaultof<_> From 6019689a2e24efc156898357498d4f0a40a9e46a Mon Sep 17 00:00:00 2001 From: Paul Westcott Date: Tue, 27 Sep 2016 20:31:27 +1000 Subject: [PATCH 38/38] underscore unused name in the #else region --- src/fsharp/FSharp.Core/seq.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/FSharp.Core/seq.fs b/src/fsharp/FSharp.Core/seq.fs index b4151af85b6..1deaf49e736 100644 --- a/src/fsharp/FSharp.Core/seq.fs +++ b/src/fsharp/FSharp.Core/seq.fs @@ -145,7 +145,7 @@ namespace Microsoft.FSharp.Collections else upcast (new SeqDoNext<'T,'U>(generator, t2u, SeqDoNextStates.NotStarted)) #else - let getEnumerator (this:SeqDoNext<'T,'U>) : IEnumerator<'U> = + let getEnumerator (_this:SeqDoNext<'T,'U>) : IEnumerator<'U> = upcast (new SeqDoNext<'T,'U>(generator, t2u, SeqDoNextStates.NotStarted)) #endif