From 025c35afceb2743ea1bdd42e1f525bd0e6158d79 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Mon, 5 Sep 2016 16:00:06 +0200 Subject: [PATCH 1/3] Use List.exists for contains --- src/fsharp/lib.fs | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/fsharp/lib.fs b/src/fsharp/lib.fs index 1a1e64acd23..766f6f023f6 100755 --- a/src/fsharp/lib.fs +++ b/src/fsharp/lib.fs @@ -178,14 +178,11 @@ module ListAssoc = //------------------------------------------------------------------------ module ListSet = - (* NOTE: O(n)! *) - let rec contains f x l = - match l with - | [] -> false - | x'::t -> f x x' || contains f x t + let inline contains f x l = List.exists (f x) l (* NOTE: O(n)! *) let insert f x l = if contains f x l then l else x::l + let unionFavourRight f l1 l2 = match l1, l2 with | _, [] -> l1 From dc41206f8ffd4ef047ade0eaf1ae200900609b11 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Thu, 8 Sep 2016 08:26:27 +0200 Subject: [PATCH 2/3] ListSet.contains is List.exists --- src/fsharp/MethodOverrides.fs | 2 +- src/fsharp/PostInferenceChecks.fs | 2 +- src/fsharp/TastOps.fs | 4 ++-- src/fsharp/TypeChecker.fs | 20 ++++++++++---------- src/fsharp/autobox.fs | 4 ++-- src/fsharp/lib.fs | 12 ++++++------ 6 files changed, 22 insertions(+), 22 deletions(-) diff --git a/src/fsharp/MethodOverrides.fs b/src/fsharp/MethodOverrides.fs index b446ea5c06d..a9875619d3b 100644 --- a/src/fsharp/MethodOverrides.fs +++ b/src/fsharp/MethodOverrides.fs @@ -448,7 +448,7 @@ module DispatchSlotChecking = // If so, you do not have to implement all the methods - each // specific method is "optionally" implemented. let isOptional = - ListSet.contains (typeEquiv g) impliedTy availImpliedInterfaces + ListSet.exists ((typeEquiv g) impliedTy) availImpliedInterfaces for reqdSlot in GetImmediateIntrinsicMethInfosOfType (None,AccessibleFromSomewhere) g amap reqdTyRange impliedTy do yield RequiredSlot(reqdSlot, isOptional) else diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index 9926771ffce..16fd81c49f4 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -299,7 +299,7 @@ let CheckEscapes cenv allowProtected m syntacticArgs body = (* m is a range suit // Note that: Local mutables can be free, as they will be boxed later. // These checks must correspond to the tests governing the error messages below. - let passedIn = ListSet.contains valEq v syntacticArgs + let passedIn = ListSet.exists (valEq v) syntacticArgs if passedIn then false else diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 8e5ddb25045..0e9ce120bdd 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -1170,7 +1170,7 @@ let mkGenericBindRhs g m generalizedTyparsForRecursiveBlock typeScheme bodyExpr let isBeingGeneralized tp typeScheme = let (TypeScheme(generalizedTypars,_)) = typeScheme - ListSet.contains typarRefEq tp generalizedTypars + ListSet.exists (typarRefEq tp) generalizedTypars //------------------------------------------------------------------------- // Build conditional expressions... @@ -1985,7 +1985,7 @@ and accFreeInTraitLeftToRight g cxFlag thruFlag acc (TTrait(typs,_,_,argtys,rty, acc and accFreeTyparRefLeftToRight g cxFlag thruFlag acc (tp:Typar) = - if ListSet.contains typarEq tp acc + if ListSet.exists (typarEq tp) acc then acc else let acc = (ListSet.insert typarEq tp acc) diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 45b9b098e92..b62def772ea 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -1593,7 +1593,7 @@ let ChooseCanonicalValSchemeAfterInference g denv valscheme m = valscheme let PlaceTyparsInDeclarationOrder declaredTypars generalizedTypars = - declaredTypars @ (generalizedTypars |> List.filter (fun tp -> not (ListSet.contains typarEq tp declaredTypars))) + declaredTypars @ (generalizedTypars |> List.filter (fun tp -> not (ListSet.exists (typarEq tp) declaredTypars))) let SetTyparRigid _g denv m (tp:Typar) = match tp.Solution with @@ -1621,7 +1621,7 @@ let GeneralizeVal cenv denv enclosingDeclaredTypars generalizedTyparsForThisBind // of the r.h.s. , e.g. let x,y = None,[] let computeRelevantTypars thruFlag = let ftps = (freeInTypeLeftToRight cenv.g thruFlag ty) - let generalizedTypars = generalizedTyparsForThisBinding |> List.filter (fun tp -> ListSet.contains typarEq tp ftps) + let generalizedTypars = generalizedTyparsForThisBinding |> List.filter (fun tp -> ListSet.exists (typarEq tp) ftps) // Put declared typars first let generalizedTypars = PlaceTyparsInDeclarationOrder allDeclaredTypars generalizedTypars generalizedTypars @@ -2163,12 +2163,12 @@ module GeneralizationHelpers = // A condensation typar must have a single constraint "'a :> A" (Option.isSome (relevantUniqueSubtypeConstraint tp)) && // This is type variable is not used on the r.h.s. of the type - not (ListSet.contains typarEq tp returnTypeFreeTypars) && + not (ListSet.exists (typarEq tp) returnTypeFreeTypars) && // A condensation typar can't be used in the constraints of any candidate condensation typars - not (ListSet.contains typarEq tp lhsConstraintTypars) && + not (ListSet.exists (typarEq tp) lhsConstraintTypars) && // A condensation typar must occur precisely once in tyIJ, and must not occur free in any other tyIJ (match allUntupledArgTysWithFreeVars |> List.partition (fun (ty,_) -> isTyparTy cenv.g ty && typarEq (destTyparTy cenv.g ty) tp) with - | [_], rest -> not (rest |> List.exists (fun (_,fvs) -> ListSet.contains typarEq tp fvs)) + | [_], rest -> not (rest |> List.exists (fun (_,fvs) -> ListSet.exists (typarEq tp) fvs)) | _ -> false) let condensationTypars, generalizedTypars = generalizedTypars |> List.partition IsCondensationTypar @@ -2216,7 +2216,7 @@ module GeneralizationHelpers = let generalizedTypars = if canInferTypars then generalizedTypars - else generalizedTypars |> List.filter (fun tp -> ListSet.contains typarEq tp allDeclaredTypars) + else generalizedTypars |> List.filter (fun tp -> ListSet.exists (typarEq tp) allDeclaredTypars) let allConstraints = List.collect (fun (tp:Typar) -> tp.Constraints) generalizedTypars let generalizedTypars = ConstraintSolver.SimplifyMeasuresInTypeScheme cenv.g resultFirst generalizedTypars tauTy allConstraints @@ -15026,7 +15026,7 @@ module EstablishTypeDefinitionCores = noAllowNullLiteralAttributeCheck() let vfld = NewRecdField false None (ident("value__",m)) fieldTy false false [] [] XmlDoc.Empty taccessPublic true - if not (ListSet.contains (typeEquiv cenv.g) fieldTy [ cenv.g.int32_ty; cenv.g.int16_ty; cenv.g.sbyte_ty; cenv.g.int64_ty; cenv.g.char_ty; cenv.g.bool_ty; cenv.g.uint32_ty; cenv.g.uint16_ty; cenv.g.byte_ty; cenv.g.uint64_ty ]) then + if not (ListSet.exists ((typeEquiv cenv.g) fieldTy) [ cenv.g.int32_ty; cenv.g.int16_ty; cenv.g.sbyte_ty; cenv.g.int64_ty; cenv.g.char_ty; cenv.g.bool_ty; cenv.g.uint32_ty; cenv.g.uint16_ty; cenv.g.byte_ty; cenv.g.uint64_ty ]) then errorR(Error(FSComp.SR.tcInvalidTypeForLiteralEnumeration(),m)) writeFakeRecordFieldsToSink fields' @@ -15067,7 +15067,7 @@ module EstablishTypeDefinitionCores = let tycon2 = tc.Deref let acc = accInAbbrevTypes tinst acc // Record immediate recursive references - if ListSet.contains (===) tycon2 tycons then + if ListSet.exists ((===) tycon2) tycons then (tycon,tycon2) :: acc // Expand the representation of abbreviations elif tc.IsTypeAbbrev then @@ -15087,7 +15087,7 @@ module EstablishTypeDefinitionCores = and accInMeasure ms acc = match stripUnitEqns ms with - | Measure.Con tc when ListSet.contains (===) tc.Deref tycons -> + | Measure.Con tc when ListSet.exists ((===) tc.Deref) tycons -> (tycon, tc.Deref) :: acc | Measure.Con tc when tc.IsTypeAbbrev -> accInMeasure (reduceTyconRefAbbrevMeasureable tc) acc @@ -15152,7 +15152,7 @@ module EstablishTypeDefinitionCores = let edgesFrom (tycon:Tycon) = // Record edge (tycon,tycon2), only when tycon2 is an "initial" tycon. let insertEdgeToTycon tycon2 acc = - if ListSet.contains (===) tycon2 tycons && // note: only add if tycon2 is initial + if ListSet.exists ((===) tycon2) tycons && // note: only add if tycon2 is initial not (List.exists (fun (tc,tc2) -> tc === tycon && tc2 === tycon2) acc) // note: only add if (tycon,tycon2) not already an edge then (tycon,tycon2)::acc diff --git a/src/fsharp/autobox.fs b/src/fsharp/autobox.fs index 7d4398fea80..cfa736d5833 100644 --- a/src/fsharp/autobox.fs +++ b/src/fsharp/autobox.fs @@ -17,13 +17,13 @@ open Microsoft.FSharp.Compiler.TypeRelations // Decide the set of mutable locals to promote to heap-allocated reference cells type cenv = - { g: TcGlobals; + { g: TcGlobals amap: Import.ImportMap } /// Find all the mutable locals that escape a method, function or lambda expression let DecideEscapes syntacticArgs body = let cantBeFree v = - let passedIn = ListSet.contains valEq v syntacticArgs + let passedIn = ListSet.exists (valEq v) syntacticArgs not passedIn && (v.IsMutable && v.ValReprInfo.IsNone) let frees = freeInExpr CollectLocals body diff --git a/src/fsharp/lib.fs b/src/fsharp/lib.fs index 766f6f023f6..7a03c7da4ce 100755 --- a/src/fsharp/lib.fs +++ b/src/fsharp/lib.fs @@ -178,10 +178,10 @@ module ListAssoc = //------------------------------------------------------------------------ module ListSet = - let inline contains f x l = List.exists (f x) l + let inline exists f l = List.exists f l (* NOTE: O(n)! *) - let insert f x l = if contains f x l then l else x::l + let insert f x l = if exists (f x) l then l else x::l let unionFavourRight f l1 l2 = match l1, l2 with @@ -205,12 +205,12 @@ module ListSet = (* NOTE: quadratic! *) let rec subtract f l1 l2 = match l2 with - | (h::t) -> subtract f (remove (fun y2 y1 -> f y1 y2) h l1) t + | (h::t) -> subtract f (remove (fun y2 y1 -> f y1 y2) h l1) t | [] -> l1 - let isSubsetOf f l1 l2 = List.forall (fun x1 -> contains f x1 l2) l1 + let isSubsetOf f l1 l2 = List.forall (fun x1 -> exists (f x1) l2) l1 (* nb. preserve orders here: f must be applied to elements of l1 then elements of l2*) - let isSupersetOf f l1 l2 = List.forall (fun x2 -> contains (fun y2 y1 -> f y1 y2) x2 l1) l2 + let isSupersetOf f l1 l2 = List.forall (fun x2 -> exists ((fun y2 y1 -> f y1 y2) x2) l1) l2 let equals f l1 l2 = isSubsetOf f l1 l2 && isSupersetOf f l1 l2 let unionFavourLeft f l1 l2 = @@ -223,7 +223,7 @@ module ListSet = (* NOTE: not tail recursive! *) let rec intersect f l1 l2 = match l2 with - | (h::t) -> if contains f h l1 then h::intersect f l1 t else intersect f l1 t + | (h::t) -> if exists (f h) l1 then h::intersect f l1 t else intersect f l1 t | [] -> [] (* NOTE: quadratic! *) From 3dacd0c1a836a24836ad39addf7fdb66d04464e2 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Thu, 8 Sep 2016 08:41:10 +0200 Subject: [PATCH 3/3] Revert "ListSet.contains is List.exists" This reverts commit dc41206f8ffd4ef047ade0eaf1ae200900609b11. --- src/fsharp/MethodOverrides.fs | 2 +- src/fsharp/PostInferenceChecks.fs | 2 +- src/fsharp/TastOps.fs | 4 ++-- src/fsharp/TypeChecker.fs | 20 ++++++++++---------- src/fsharp/autobox.fs | 2 +- src/fsharp/lib.fs | 12 ++++++------ 6 files changed, 21 insertions(+), 21 deletions(-) diff --git a/src/fsharp/MethodOverrides.fs b/src/fsharp/MethodOverrides.fs index a9875619d3b..b446ea5c06d 100644 --- a/src/fsharp/MethodOverrides.fs +++ b/src/fsharp/MethodOverrides.fs @@ -448,7 +448,7 @@ module DispatchSlotChecking = // If so, you do not have to implement all the methods - each // specific method is "optionally" implemented. let isOptional = - ListSet.exists ((typeEquiv g) impliedTy) availImpliedInterfaces + ListSet.contains (typeEquiv g) impliedTy availImpliedInterfaces for reqdSlot in GetImmediateIntrinsicMethInfosOfType (None,AccessibleFromSomewhere) g amap reqdTyRange impliedTy do yield RequiredSlot(reqdSlot, isOptional) else diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index 16fd81c49f4..9926771ffce 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -299,7 +299,7 @@ let CheckEscapes cenv allowProtected m syntacticArgs body = (* m is a range suit // Note that: Local mutables can be free, as they will be boxed later. // These checks must correspond to the tests governing the error messages below. - let passedIn = ListSet.exists (valEq v) syntacticArgs + let passedIn = ListSet.contains valEq v syntacticArgs if passedIn then false else diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 0e9ce120bdd..8e5ddb25045 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -1170,7 +1170,7 @@ let mkGenericBindRhs g m generalizedTyparsForRecursiveBlock typeScheme bodyExpr let isBeingGeneralized tp typeScheme = let (TypeScheme(generalizedTypars,_)) = typeScheme - ListSet.exists (typarRefEq tp) generalizedTypars + ListSet.contains typarRefEq tp generalizedTypars //------------------------------------------------------------------------- // Build conditional expressions... @@ -1985,7 +1985,7 @@ and accFreeInTraitLeftToRight g cxFlag thruFlag acc (TTrait(typs,_,_,argtys,rty, acc and accFreeTyparRefLeftToRight g cxFlag thruFlag acc (tp:Typar) = - if ListSet.exists (typarEq tp) acc + if ListSet.contains typarEq tp acc then acc else let acc = (ListSet.insert typarEq tp acc) diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index b62def772ea..45b9b098e92 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -1593,7 +1593,7 @@ let ChooseCanonicalValSchemeAfterInference g denv valscheme m = valscheme let PlaceTyparsInDeclarationOrder declaredTypars generalizedTypars = - declaredTypars @ (generalizedTypars |> List.filter (fun tp -> not (ListSet.exists (typarEq tp) declaredTypars))) + declaredTypars @ (generalizedTypars |> List.filter (fun tp -> not (ListSet.contains typarEq tp declaredTypars))) let SetTyparRigid _g denv m (tp:Typar) = match tp.Solution with @@ -1621,7 +1621,7 @@ let GeneralizeVal cenv denv enclosingDeclaredTypars generalizedTyparsForThisBind // of the r.h.s. , e.g. let x,y = None,[] let computeRelevantTypars thruFlag = let ftps = (freeInTypeLeftToRight cenv.g thruFlag ty) - let generalizedTypars = generalizedTyparsForThisBinding |> List.filter (fun tp -> ListSet.exists (typarEq tp) ftps) + let generalizedTypars = generalizedTyparsForThisBinding |> List.filter (fun tp -> ListSet.contains typarEq tp ftps) // Put declared typars first let generalizedTypars = PlaceTyparsInDeclarationOrder allDeclaredTypars generalizedTypars generalizedTypars @@ -2163,12 +2163,12 @@ module GeneralizationHelpers = // A condensation typar must have a single constraint "'a :> A" (Option.isSome (relevantUniqueSubtypeConstraint tp)) && // This is type variable is not used on the r.h.s. of the type - not (ListSet.exists (typarEq tp) returnTypeFreeTypars) && + not (ListSet.contains typarEq tp returnTypeFreeTypars) && // A condensation typar can't be used in the constraints of any candidate condensation typars - not (ListSet.exists (typarEq tp) lhsConstraintTypars) && + not (ListSet.contains typarEq tp lhsConstraintTypars) && // A condensation typar must occur precisely once in tyIJ, and must not occur free in any other tyIJ (match allUntupledArgTysWithFreeVars |> List.partition (fun (ty,_) -> isTyparTy cenv.g ty && typarEq (destTyparTy cenv.g ty) tp) with - | [_], rest -> not (rest |> List.exists (fun (_,fvs) -> ListSet.exists (typarEq tp) fvs)) + | [_], rest -> not (rest |> List.exists (fun (_,fvs) -> ListSet.contains typarEq tp fvs)) | _ -> false) let condensationTypars, generalizedTypars = generalizedTypars |> List.partition IsCondensationTypar @@ -2216,7 +2216,7 @@ module GeneralizationHelpers = let generalizedTypars = if canInferTypars then generalizedTypars - else generalizedTypars |> List.filter (fun tp -> ListSet.exists (typarEq tp) allDeclaredTypars) + else generalizedTypars |> List.filter (fun tp -> ListSet.contains typarEq tp allDeclaredTypars) let allConstraints = List.collect (fun (tp:Typar) -> tp.Constraints) generalizedTypars let generalizedTypars = ConstraintSolver.SimplifyMeasuresInTypeScheme cenv.g resultFirst generalizedTypars tauTy allConstraints @@ -15026,7 +15026,7 @@ module EstablishTypeDefinitionCores = noAllowNullLiteralAttributeCheck() let vfld = NewRecdField false None (ident("value__",m)) fieldTy false false [] [] XmlDoc.Empty taccessPublic true - if not (ListSet.exists ((typeEquiv cenv.g) fieldTy) [ cenv.g.int32_ty; cenv.g.int16_ty; cenv.g.sbyte_ty; cenv.g.int64_ty; cenv.g.char_ty; cenv.g.bool_ty; cenv.g.uint32_ty; cenv.g.uint16_ty; cenv.g.byte_ty; cenv.g.uint64_ty ]) then + if not (ListSet.contains (typeEquiv cenv.g) fieldTy [ cenv.g.int32_ty; cenv.g.int16_ty; cenv.g.sbyte_ty; cenv.g.int64_ty; cenv.g.char_ty; cenv.g.bool_ty; cenv.g.uint32_ty; cenv.g.uint16_ty; cenv.g.byte_ty; cenv.g.uint64_ty ]) then errorR(Error(FSComp.SR.tcInvalidTypeForLiteralEnumeration(),m)) writeFakeRecordFieldsToSink fields' @@ -15067,7 +15067,7 @@ module EstablishTypeDefinitionCores = let tycon2 = tc.Deref let acc = accInAbbrevTypes tinst acc // Record immediate recursive references - if ListSet.exists ((===) tycon2) tycons then + if ListSet.contains (===) tycon2 tycons then (tycon,tycon2) :: acc // Expand the representation of abbreviations elif tc.IsTypeAbbrev then @@ -15087,7 +15087,7 @@ module EstablishTypeDefinitionCores = and accInMeasure ms acc = match stripUnitEqns ms with - | Measure.Con tc when ListSet.exists ((===) tc.Deref) tycons -> + | Measure.Con tc when ListSet.contains (===) tc.Deref tycons -> (tycon, tc.Deref) :: acc | Measure.Con tc when tc.IsTypeAbbrev -> accInMeasure (reduceTyconRefAbbrevMeasureable tc) acc @@ -15152,7 +15152,7 @@ module EstablishTypeDefinitionCores = let edgesFrom (tycon:Tycon) = // Record edge (tycon,tycon2), only when tycon2 is an "initial" tycon. let insertEdgeToTycon tycon2 acc = - if ListSet.exists ((===) tycon2) tycons && // note: only add if tycon2 is initial + if ListSet.contains (===) tycon2 tycons && // note: only add if tycon2 is initial not (List.exists (fun (tc,tc2) -> tc === tycon && tc2 === tycon2) acc) // note: only add if (tycon,tycon2) not already an edge then (tycon,tycon2)::acc diff --git a/src/fsharp/autobox.fs b/src/fsharp/autobox.fs index cfa736d5833..b32e07f0798 100644 --- a/src/fsharp/autobox.fs +++ b/src/fsharp/autobox.fs @@ -23,7 +23,7 @@ type cenv = /// Find all the mutable locals that escape a method, function or lambda expression let DecideEscapes syntacticArgs body = let cantBeFree v = - let passedIn = ListSet.exists (valEq v) syntacticArgs + let passedIn = ListSet.contains valEq v syntacticArgs not passedIn && (v.IsMutable && v.ValReprInfo.IsNone) let frees = freeInExpr CollectLocals body diff --git a/src/fsharp/lib.fs b/src/fsharp/lib.fs index 7a03c7da4ce..766f6f023f6 100755 --- a/src/fsharp/lib.fs +++ b/src/fsharp/lib.fs @@ -178,10 +178,10 @@ module ListAssoc = //------------------------------------------------------------------------ module ListSet = - let inline exists f l = List.exists f l + let inline contains f x l = List.exists (f x) l (* NOTE: O(n)! *) - let insert f x l = if exists (f x) l then l else x::l + let insert f x l = if contains f x l then l else x::l let unionFavourRight f l1 l2 = match l1, l2 with @@ -205,12 +205,12 @@ module ListSet = (* NOTE: quadratic! *) let rec subtract f l1 l2 = match l2 with - | (h::t) -> subtract f (remove (fun y2 y1 -> f y1 y2) h l1) t + | (h::t) -> subtract f (remove (fun y2 y1 -> f y1 y2) h l1) t | [] -> l1 - let isSubsetOf f l1 l2 = List.forall (fun x1 -> exists (f x1) l2) l1 + let isSubsetOf f l1 l2 = List.forall (fun x1 -> contains f x1 l2) l1 (* nb. preserve orders here: f must be applied to elements of l1 then elements of l2*) - let isSupersetOf f l1 l2 = List.forall (fun x2 -> exists ((fun y2 y1 -> f y1 y2) x2) l1) l2 + let isSupersetOf f l1 l2 = List.forall (fun x2 -> contains (fun y2 y1 -> f y1 y2) x2 l1) l2 let equals f l1 l2 = isSubsetOf f l1 l2 && isSupersetOf f l1 l2 let unionFavourLeft f l1 l2 = @@ -223,7 +223,7 @@ module ListSet = (* NOTE: not tail recursive! *) let rec intersect f l1 l2 = match l2 with - | (h::t) -> if exists (f h) l1 then h::intersect f l1 t else intersect f l1 t + | (h::t) -> if contains f h l1 then h::intersect f l1 t else intersect f l1 t | [] -> [] (* NOTE: quadratic! *)