From d8634bc0e5e95dccd304f3caccf0e1c2a5081e47 Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Tue, 2 Jul 2024 15:51:36 -0400 Subject: [PATCH 1/8] Initial support for `Slice` --- src/Compiler/Checking/CheckExpressions.fs | 627 +++++++++++++----- src/Compiler/TypedTree/TcGlobals.fs | 4 + src/Compiler/TypedTree/TypedTreeOps.fs | 4 + src/Compiler/TypedTree/TypedTreeOps.fsi | 4 + .../MethodsAndProperties.fs | 378 ++++++++++- 5 files changed, 842 insertions(+), 175 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 6bdf94ed9ff..bdad32bdad8 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -5386,7 +5386,7 @@ and CheckForAdjacentListExpression (cenv: cenv) synExpr hpa isInfix delayed (arg let g = cenv.g // func (arg)[arg2] gives warning that .[ must be used. match delayed with - | DelayedApp (hpa2, isSugar2, _, arg2, _) :: _ when not isInfix && (hpa = ExprAtomicFlag.NonAtomic) && isAdjacentListExpr isSugar2 hpa2 (Some synExpr) arg2 -> + | DelayedApp (hpa2, isSugar2, _, arg2, _) :: _ when not isInfix && (hpa = ExprAtomicFlag.NonAtomic) && isAdjacentListExpr isSugar2 hpa2 synExpr arg2 -> let mWarning = unionRanges arg.Range arg2.Range match arg with @@ -6374,11 +6374,6 @@ and TcExprILAssembly (cenv: cenv) overallTy env tpenv (ilInstrs, synTyArgs, synA // Converts 'a..b' to a call to the '(..)' operator in FSharp.Core // Converts 'a..b..c' to a call to the '(.. ..)' operator in FSharp.Core -// -// NOTE: we could eliminate these more efficiently in LowerComputedCollections.fs, since -// [| 1..4 |] -// becomes [| for i in (..) 1 4 do yield i |] -// instead of generating the array directly from the ranges and RewriteRangeExpr synExpr = match synExpr with // a..b..c (parsed as (a..b)..c ) @@ -6498,7 +6493,7 @@ and (|IndexerArgs|) expr = and TcIndexerThen (cenv: cenv) env overallTy mWholeExpr mDot tpenv (setInfo: _ option) synLeftExpr indexArgs delayed = let leftExpr, leftExprTy, tpenv = TcExprOfUnknownType cenv env tpenv synLeftExpr let expandedIndexArgs = ExpandIndexArgs cenv (Some synLeftExpr) indexArgs - TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo (Some synLeftExpr) leftExpr leftExprTy expandedIndexArgs indexArgs delayed + TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExpr leftExpr leftExprTy expandedIndexArgs indexArgs delayed // Eliminate GetReverseIndex from index args and ExpandIndexArgs (cenv: cenv) (synLeftExprOpt: SynExpr option) indexArgs = @@ -6552,170 +6547,457 @@ and ExpandIndexArgs (cenv: cenv) (synLeftExprOpt: SynExpr option) indexArgs = // However it's not so simple as all that. First "Item" can have a different name according to an attribute in // .NET metadata. This means we manually typecheck 'expr and look to see if it has a nominal type. We then // do the right thing in each case. -and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprOpt expr exprTy expandedIndexArgs indexArgs delayed = +and TcIndexingThen (cenv: cenv) (env: TcEnv) overallTy mWholeExpr (mDot: range) tpenv setInfo synLeftExpr (expr: Expr) exprTy expandedIndexArgs (indexArgs: SynExpr list) delayed = let g = cenv.g let ad = env.AccessRights - // Find the first type in the effective hierarchy that either has a DefaultMember attribute OR - // has a member called 'Item' - let isIndex = indexArgs |> List.forall (fun indexArg -> match DecodeIndexArg cenv indexArg with IndexArgItem _ -> true | _ -> false) - let propName = - if isIndex then - FoldPrimaryHierarchyOfType (fun ty acc -> - match acc with - | None -> - match tryTcrefOfAppTy g ty with - | ValueSome tcref -> - TryFindTyconRefStringAttribute g mWholeExpr g.attrib_DefaultMemberAttribute tcref - | _ -> - let item = Some "Item" - match AllPropInfosOfTypeInScope ResultCollectionSettings.AtMostOneResult cenv.infoReader env.NameEnv item ad IgnoreOverrides mWholeExpr ty with - | [] -> None - | _ -> item - | _ -> acc) - g - cenv.amap - mWholeExpr - AllowMultiIntfInstantiations.Yes - exprTy - None - else Some "GetSlice" - - let isNominal = isAppTy g exprTy - - let isArray = isArrayTy g exprTy - let isString = typeEquiv g g.string_ty exprTy + let (|Array|String|Nominal|Unknown|) exprTy = + if isArrayTy g exprTy then Array + elif typeEquiv g g.string_ty exprTy then String + elif isAppTy g exprTy then Nominal + else Unknown + + let indexOpPath = ["Microsoft";"FSharp";"Core";"LanguagePrimitives";"IntrinsicFunctions"] + let sliceOpPath = ["Microsoft";"FSharp";"Core";"Operators";"OperatorIntrinsics"] + + /// Look up the appropriate array indexer or slicer path, method, and args. + let (|ArrayIndexerOrSlicer|_|) (indexArgs, setInfo) = + let fixedIndex3d4dEnabled = g.langVersion.SupportsFeature LanguageFeature.FixedIndexSlice3d4d + match indexArgs, setInfo with + | [IndexArgItem _; IndexArgItem _], None -> Some (indexOpPath, "GetArray2D", expandedIndexArgs) + | [IndexArgItem _; IndexArgItem _; IndexArgItem _;], None -> Some (indexOpPath, "GetArray3D", expandedIndexArgs) + | [IndexArgItem _; IndexArgItem _; IndexArgItem _; IndexArgItem _], None -> Some (indexOpPath, "GetArray4D", expandedIndexArgs) + | [IndexArgItem _], None -> Some (indexOpPath, "GetArray", expandedIndexArgs) + | [IndexArgItem _; IndexArgItem _], Some (expr3, _) -> Some (indexOpPath, "SetArray2D", (expandedIndexArgs @ [expr3])) + | [IndexArgItem _; IndexArgItem _; IndexArgItem _;], Some (expr3, _) -> Some (indexOpPath, "SetArray3D", (expandedIndexArgs @ [expr3])) + | [IndexArgItem _; IndexArgItem _; IndexArgItem _; IndexArgItem _], Some (expr3, _) -> Some (indexOpPath, "SetArray4D", (expandedIndexArgs @ [expr3])) + | [IndexArgItem _], Some (expr3, _) -> Some (indexOpPath, "SetArray", (expandedIndexArgs @ [expr3])) + | [IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice", expandedIndexArgs) + | [IndexArgItem _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice2DFixed1", expandedIndexArgs) + | [IndexArgRange _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice2DFixed2", expandedIndexArgs) + | [IndexArgRange _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice2D", expandedIndexArgs) + | [IndexArgRange _;IndexArgRange _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice3D", expandedIndexArgs) + | [IndexArgRange _;IndexArgRange _;IndexArgRange _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice4D", expandedIndexArgs) + | [IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice", (expandedIndexArgs @ [expr3])) + | [IndexArgRange _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice2D", (expandedIndexArgs @ [expr3])) + | [IndexArgItem _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice2DFixed1", (expandedIndexArgs @ [expr3])) + | [IndexArgRange _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice2DFixed2", (expandedIndexArgs @ [expr3])) + | [IndexArgRange _;IndexArgRange _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice3D", (expandedIndexArgs @ [expr3])) + | [IndexArgRange _;IndexArgRange _;IndexArgRange _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4D", (expandedIndexArgs @ [expr3])) + | _ when fixedIndex3d4dEnabled -> + match indexArgs, setInfo with + | [IndexArgItem _;IndexArgRange _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice3DFixedSingle1", expandedIndexArgs) + | [IndexArgRange _;IndexArgItem _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice3DFixedSingle2", expandedIndexArgs) + | [IndexArgRange _;IndexArgRange _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice3DFixedSingle3", expandedIndexArgs) + | [IndexArgItem _;IndexArgItem _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice3DFixedDouble1", expandedIndexArgs) + | [IndexArgItem _;IndexArgRange _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice3DFixedDouble2", expandedIndexArgs) + | [IndexArgRange _;IndexArgItem _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice3DFixedDouble3", expandedIndexArgs) + | [IndexArgItem _;IndexArgRange _;IndexArgRange _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice4DFixedSingle1", expandedIndexArgs) + | [IndexArgRange _;IndexArgItem _;IndexArgRange _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice4DFixedSingle2", expandedIndexArgs) + | [IndexArgRange _;IndexArgRange _;IndexArgItem _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice4DFixedSingle3", expandedIndexArgs) + | [IndexArgRange _;IndexArgRange _;IndexArgRange _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice4DFixedSingle4", expandedIndexArgs) + | [IndexArgItem _;IndexArgItem _;IndexArgRange _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice4DFixedDouble1", expandedIndexArgs) + | [IndexArgItem _;IndexArgRange _;IndexArgItem _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice4DFixedDouble2", expandedIndexArgs) + | [IndexArgItem _;IndexArgRange _;IndexArgRange _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice4DFixedDouble3", expandedIndexArgs) + | [IndexArgRange _;IndexArgItem _;IndexArgItem _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice4DFixedDouble4", expandedIndexArgs) + | [IndexArgRange _;IndexArgItem _;IndexArgRange _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice4DFixedDouble5", expandedIndexArgs) + | [IndexArgRange _;IndexArgRange _;IndexArgItem _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice4DFixedDouble6", expandedIndexArgs) + | [IndexArgRange _;IndexArgItem _;IndexArgItem _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice4DFixedTriple1", expandedIndexArgs) + | [IndexArgItem _;IndexArgRange _;IndexArgItem _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice4DFixedTriple2", expandedIndexArgs) + | [IndexArgItem _;IndexArgItem _;IndexArgRange _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice4DFixedTriple3", expandedIndexArgs) + | [IndexArgItem _;IndexArgItem _;IndexArgItem _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice4DFixedTriple4", expandedIndexArgs) + | [IndexArgItem _;IndexArgRange _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice3DFixedSingle1", (expandedIndexArgs @ [expr3])) + | [IndexArgRange _;IndexArgItem _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice3DFixedSingle2", (expandedIndexArgs @ [expr3])) + | [IndexArgRange _;IndexArgRange _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice3DFixedSingle3", (expandedIndexArgs @ [expr3])) + | [IndexArgItem _;IndexArgItem _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice3DFixedDouble1", (expandedIndexArgs @ [expr3])) + | [IndexArgItem _;IndexArgRange _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice3DFixedDouble2", (expandedIndexArgs @ [expr3])) + | [IndexArgRange _;IndexArgItem _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice3DFixedDouble3", (expandedIndexArgs @ [expr3])) + | [IndexArgItem _;IndexArgRange _;IndexArgRange _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedSingle1", expandedIndexArgs @ [expr3]) + | [IndexArgRange _;IndexArgItem _;IndexArgRange _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedSingle2", expandedIndexArgs @ [expr3]) + | [IndexArgRange _;IndexArgRange _;IndexArgItem _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedSingle3", expandedIndexArgs @ [expr3]) + | [IndexArgRange _;IndexArgRange _;IndexArgRange _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedSingle4", expandedIndexArgs @ [expr3]) + | [IndexArgItem _;IndexArgItem _;IndexArgRange _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedDouble1", expandedIndexArgs @ [expr3]) + | [IndexArgItem _;IndexArgRange _;IndexArgItem _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedDouble2", expandedIndexArgs @ [expr3]) + | [IndexArgItem _;IndexArgRange _;IndexArgRange _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedDouble3", expandedIndexArgs @ [expr3]) + | [IndexArgRange _;IndexArgItem _;IndexArgItem _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedDouble4", expandedIndexArgs @ [expr3]) + | [IndexArgRange _;IndexArgItem _;IndexArgRange _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedDouble5", expandedIndexArgs @ [expr3]) + | [IndexArgRange _;IndexArgRange _;IndexArgItem _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedDouble6", expandedIndexArgs @ [expr3]) + | [IndexArgRange _;IndexArgItem _;IndexArgItem _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedTriple1", expandedIndexArgs @ [expr3]) + | [IndexArgItem _;IndexArgRange _;IndexArgItem _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedTriple2", expandedIndexArgs @ [expr3]) + | [IndexArgItem _;IndexArgItem _;IndexArgRange _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedTriple3", expandedIndexArgs @ [expr3]) + | [IndexArgItem _;IndexArgItem _;IndexArgItem _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedTriple4", expandedIndexArgs @ [expr3]) + | _ -> None + | _ -> None + + /// Look up the appropriate string indexer or slicer path, method, and args. + let (|StringIndexerOrSlicer|_|) (indexArgs, setInfo) = + match indexArgs, setInfo with + | [IndexArgRange _], None -> Some (sliceOpPath, "GetStringSlice", expandedIndexArgs) + | [IndexArgItem _], None -> Some (indexOpPath, "GetString", expandedIndexArgs) + | _ -> None + + /// Try to find a member somewhere in the given type's hierarchy. + let tryFindMember choose exprTy = + FoldPrimaryHierarchyOfType + (fun ty -> Option.orElseWith (fun () -> choose ty)) + g + cenv.amap + mWholeExpr + AllowMultiIntfInstantiations.Yes + exprTy + None + + /// Try to find a `DefaultMemberAttribute` that specifies a named indexed property. + let tryFindDefaultMember ty = + match tryTcrefOfAppTy g ty with + | ValueSome tcref -> TryFindTyconRefStringAttribute g mWholeExpr g.attrib_DefaultMemberAttribute tcref + | ValueNone -> None + + /// Try to find a property with the given name. + let tryFindNamedProp name ty = + let name = Some name + match AllPropInfosOfTypeInScope ResultCollectionSettings.AtMostOneResult cenv.infoReader env.NameEnv name ad IgnoreOverrides mWholeExpr ty with + | [] -> None + | _ :: _ -> name + + /// Try to find methods with the given name. + let tryFindMatchingMeths name choose ty = + match AllMethInfosOfTypeInScope ResultCollectionSettings.AllResults cenv.infoReader env.NameEnv (Some name) ad IgnoreOverrides mWholeExpr ty with + | [] -> None + | matchingMembers -> choose matchingMembers + + /// The `Item` property name. + let Item = "Item" + + /// The `GetSlice` method name. + let GetSlice = "GetSlice" + + /// The `Slice` method name. + let Slice = "Slice" + + /// The `Length` property name. + let Length = "Length" + + /// Try to find a `GetSlice` method. + /// If we have a `GetSlice` method, we don't need a `Length` getter. + let tryFindGetSlice exprTy = + exprTy + |> tryFindMember (tryFindMatchingMeths GetSlice (fun _ -> Some GetSlice)) + + /// Try to find a `Slice` method with a single 2-tuple parameter. + /// If we have a `Slice` method, we also need a `Length` getter. + let tryFindSlice exprTy = + exprTy + |> tryFindMember (tryFindMatchingMeths Slice (List.tryPick (fun slice -> + match slice.GetParamTypes(cenv.amap, mWholeExpr, slice.FormalMethodInst) with + | [[_; _] as tys] when tys |> List.forall (typeEquivAux EraseMeasures g g.int32_ty) -> Some slice + | _ -> None))) + |> Option.bind (fun sliceOverloads -> + // TODO: What about Length: int? + TryFindFSharpSignatureInstanceGetterProperty cenv env expr.Range Length exprTy [g.int32_ty] + |> Option.map (fun getLength -> sliceOverloads, getLength.GetterMethod)) + + /// Whether the syntactic arguments are + /// indicative of indexing or slicing. + /// + /// Indexing := expr1[expr2] + /// + /// Slicing := expr1[expr2..] | expr1[..expr2] | expr1[expr2..expr3] + let (|Indexing|Slicing|) indexArgs = + if indexArgs |> List.forall (fun indexArg -> match indexArg with IndexArgItem _ -> true | _ -> false) then + Indexing + else + Slicing + + /// Match if we find an indexer property or method in scope for the type. + let (|Indexable|_|) exprTy = + exprTy + |> tryFindMember (fun ty -> + tryFindDefaultMember ty + |> Option.orElseWith (fun () -> tryFindNamedProp Item ty) + |> Option.orElseWith (fun () -> tryFindMatchingMeths Item (fun _ -> Some Item) ty)) + + /// Fall back to `Item` for delayed lookup. + let (|PossiblyIndexable|) (_exprTy: TType) = Item + + /// Match if we find a `GetSlice` method in scope for the type. + let (|GetSliceable|_|) = tryFindGetSlice + + /// Match if we find a `Slice` method in scope for the type. + let (|Sliceable|_|) = tryFindSlice + + /// Fall back to `GetSlice` for delayed lookup. + let (|PossiblyGetSliceable|) (_exprTy: TType) = GetSlice + + /// Whether an index or slice is being gotten or set. + let (|Getting|Setting|) setInfo = + match setInfo with + | None -> Getting + | Some (setArg, mOfLeftOfSet) -> Setting (setArg, mOfLeftOfSet) let idxRange = indexArgs |> List.map (fun e -> e.Range) |> List.reduce unionRanges - let MakeIndexParam setSliceArrayOption = - match DecodeIndexArgs cenv indexArgs with - | [] -> failwith "unexpected empty index list" - | [IndexArgItem _] -> SynExpr.Paren (expandedIndexArgs.Head, range0, None, idxRange) - | _ -> SynExpr.Paren (SynExpr.Tuple (false, expandedIndexArgs @ Option.toList setSliceArrayOption, [], idxRange), range0, None, idxRange) - - let attemptArrayString = - let indexOpPath = ["Microsoft";"FSharp";"Core";"LanguagePrimitives";"IntrinsicFunctions"] - let sliceOpPath = ["Microsoft";"FSharp";"Core";"Operators";"OperatorIntrinsics"] - - let info = - if isArray then - let fixedIndex3d4dEnabled = g.langVersion.SupportsFeature LanguageFeature.FixedIndexSlice3d4d - let indexArgs = List.map (DecodeIndexArg cenv) indexArgs - match indexArgs, setInfo with - | [IndexArgItem _; IndexArgItem _], None -> Some (indexOpPath, "GetArray2D", expandedIndexArgs) - | [IndexArgItem _; IndexArgItem _; IndexArgItem _;], None -> Some (indexOpPath, "GetArray3D", expandedIndexArgs) - | [IndexArgItem _; IndexArgItem _; IndexArgItem _; IndexArgItem _], None -> Some (indexOpPath, "GetArray4D", expandedIndexArgs) - | [IndexArgItem _], None -> Some (indexOpPath, "GetArray", expandedIndexArgs) - | [IndexArgItem _; IndexArgItem _], Some (expr3, _) -> Some (indexOpPath, "SetArray2D", (expandedIndexArgs @ [expr3])) - | [IndexArgItem _; IndexArgItem _; IndexArgItem _;], Some (expr3, _) -> Some (indexOpPath, "SetArray3D", (expandedIndexArgs @ [expr3])) - | [IndexArgItem _; IndexArgItem _; IndexArgItem _; IndexArgItem _], Some (expr3, _) -> Some (indexOpPath, "SetArray4D", (expandedIndexArgs @ [expr3])) - | [IndexArgItem _], Some (expr3, _) -> Some (indexOpPath, "SetArray", (expandedIndexArgs @ [expr3])) - | [IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice", expandedIndexArgs) - | [IndexArgItem _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice2DFixed1", expandedIndexArgs) - | [IndexArgRange _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice2DFixed2", expandedIndexArgs) - | [IndexArgRange _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice2D", expandedIndexArgs) - | [IndexArgRange _;IndexArgRange _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice3D", expandedIndexArgs) - | [IndexArgRange _;IndexArgRange _;IndexArgRange _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice4D", expandedIndexArgs) - | [IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice", (expandedIndexArgs @ [expr3])) - | [IndexArgRange _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice2D", (expandedIndexArgs @ [expr3])) - | [IndexArgItem _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice2DFixed1", (expandedIndexArgs @ [expr3])) - | [IndexArgRange _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice2DFixed2", (expandedIndexArgs @ [expr3])) - | [IndexArgRange _;IndexArgRange _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice3D", (expandedIndexArgs @ [expr3])) - | [IndexArgRange _;IndexArgRange _;IndexArgRange _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4D", (expandedIndexArgs @ [expr3])) - | _ when fixedIndex3d4dEnabled -> - match indexArgs, setInfo with - | [IndexArgItem _;IndexArgRange _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice3DFixedSingle1", expandedIndexArgs) - | [IndexArgRange _;IndexArgItem _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice3DFixedSingle2", expandedIndexArgs) - | [IndexArgRange _;IndexArgRange _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice3DFixedSingle3", expandedIndexArgs) - | [IndexArgItem _;IndexArgItem _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice3DFixedDouble1", expandedIndexArgs) - | [IndexArgItem _;IndexArgRange _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice3DFixedDouble2", expandedIndexArgs) - | [IndexArgRange _;IndexArgItem _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice3DFixedDouble3", expandedIndexArgs) - | [IndexArgItem _;IndexArgRange _;IndexArgRange _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice4DFixedSingle1", expandedIndexArgs) - | [IndexArgRange _;IndexArgItem _;IndexArgRange _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice4DFixedSingle2", expandedIndexArgs) - | [IndexArgRange _;IndexArgRange _;IndexArgItem _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice4DFixedSingle3", expandedIndexArgs) - | [IndexArgRange _;IndexArgRange _;IndexArgRange _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice4DFixedSingle4", expandedIndexArgs) - | [IndexArgItem _;IndexArgItem _;IndexArgRange _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice4DFixedDouble1", expandedIndexArgs) - | [IndexArgItem _;IndexArgRange _;IndexArgItem _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice4DFixedDouble2", expandedIndexArgs) - | [IndexArgItem _;IndexArgRange _;IndexArgRange _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice4DFixedDouble3", expandedIndexArgs) - | [IndexArgRange _;IndexArgItem _;IndexArgItem _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice4DFixedDouble4", expandedIndexArgs) - | [IndexArgRange _;IndexArgItem _;IndexArgRange _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice4DFixedDouble5", expandedIndexArgs) - | [IndexArgRange _;IndexArgRange _;IndexArgItem _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice4DFixedDouble6", expandedIndexArgs) - | [IndexArgRange _;IndexArgItem _;IndexArgItem _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice4DFixedTriple1", expandedIndexArgs) - | [IndexArgItem _;IndexArgRange _;IndexArgItem _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice4DFixedTriple2", expandedIndexArgs) - | [IndexArgItem _;IndexArgItem _;IndexArgRange _;IndexArgItem _], None -> Some (sliceOpPath, "GetArraySlice4DFixedTriple3", expandedIndexArgs) - | [IndexArgItem _;IndexArgItem _;IndexArgItem _;IndexArgRange _], None -> Some (sliceOpPath, "GetArraySlice4DFixedTriple4", expandedIndexArgs) - | [IndexArgItem _;IndexArgRange _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice3DFixedSingle1", (expandedIndexArgs @ [expr3])) - | [IndexArgRange _;IndexArgItem _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice3DFixedSingle2", (expandedIndexArgs @ [expr3])) - | [IndexArgRange _;IndexArgRange _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice3DFixedSingle3", (expandedIndexArgs @ [expr3])) - | [IndexArgItem _;IndexArgItem _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice3DFixedDouble1", (expandedIndexArgs @ [expr3])) - | [IndexArgItem _;IndexArgRange _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice3DFixedDouble2", (expandedIndexArgs @ [expr3])) - | [IndexArgRange _;IndexArgItem _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice3DFixedDouble3", (expandedIndexArgs @ [expr3])) - | [IndexArgItem _;IndexArgRange _;IndexArgRange _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedSingle1", expandedIndexArgs @ [expr3]) - | [IndexArgRange _;IndexArgItem _;IndexArgRange _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedSingle2", expandedIndexArgs @ [expr3]) - | [IndexArgRange _;IndexArgRange _;IndexArgItem _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedSingle3", expandedIndexArgs @ [expr3]) - | [IndexArgRange _;IndexArgRange _;IndexArgRange _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedSingle4", expandedIndexArgs @ [expr3]) - | [IndexArgItem _;IndexArgItem _;IndexArgRange _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedDouble1", expandedIndexArgs @ [expr3]) - | [IndexArgItem _;IndexArgRange _;IndexArgItem _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedDouble2", expandedIndexArgs @ [expr3]) - | [IndexArgItem _;IndexArgRange _;IndexArgRange _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedDouble3", expandedIndexArgs @ [expr3]) - | [IndexArgRange _;IndexArgItem _;IndexArgItem _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedDouble4", expandedIndexArgs @ [expr3]) - | [IndexArgRange _;IndexArgItem _;IndexArgRange _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedDouble5", expandedIndexArgs @ [expr3]) - | [IndexArgRange _;IndexArgRange _;IndexArgItem _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedDouble6", expandedIndexArgs @ [expr3]) - | [IndexArgRange _;IndexArgItem _;IndexArgItem _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedTriple1", expandedIndexArgs @ [expr3]) - | [IndexArgItem _;IndexArgRange _;IndexArgItem _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedTriple2", expandedIndexArgs @ [expr3]) - | [IndexArgItem _;IndexArgItem _;IndexArgRange _;IndexArgItem _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedTriple3", expandedIndexArgs @ [expr3]) - | [IndexArgItem _;IndexArgItem _;IndexArgItem _;IndexArgRange _], Some (expr3, _) -> Some (sliceOpPath, "SetArraySlice4DFixedTriple4", expandedIndexArgs @ [expr3]) - | _ -> None - | _ -> None + let parenthesize synExpr = SynExpr.Paren (synExpr, range0, None, idxRange) + + let tupleIfMultiple expandedIndexArgs = + match expandedIndexArgs with + | [arg] -> arg + | args -> SynExpr.Tuple (false, args, [], idxRange) + + /// expr1[expr2] + let mkDelayedIndexedGet indexer = + [ DelayedDotLookup([ident (indexer, mWholeExpr)], mWholeExpr) + DelayedApp(ExprAtomicFlag.Atomic, true, Some synLeftExpr, parenthesize (tupleIfMultiple expandedIndexArgs), mWholeExpr) ] + + /// expr1[expr2] <- expr3 + let mkDelayedIndexedSet indexer setArg mOfLeftOfSet = + [ DelayedDotLookup([ident(indexer, mOfLeftOfSet)], mOfLeftOfSet) + DelayedApp(ExprAtomicFlag.Atomic, true, Some synLeftExpr, parenthesize (tupleIfMultiple expandedIndexArgs), mOfLeftOfSet) + MakeDelayedSet(setArg, mWholeExpr) ] + + /// expr1[expr2..] + /// expr1[..expr2] + /// expr1[expr2..expr3] + let mkDelayedGetSlice indexer = + [ DelayedDotLookup([ident(indexer, mWholeExpr)], mWholeExpr) + DelayedApp(ExprAtomicFlag.Atomic, true, Some synLeftExpr, parenthesize (SynExpr.Tuple (false, expandedIndexArgs, [], idxRange)), mWholeExpr) ] + + /// expr1[expr2..] <- expr3 + /// expr1[..expr2] <- expr3 + /// expr1[expr2..expr3] <- expr3 + let mkDelayedSetSlice setArg mOfLeftOfSet = + [ DelayedDotLookup([ident("SetSlice", mOfLeftOfSet)], mOfLeftOfSet) + DelayedApp(ExprAtomicFlag.Atomic, true, Some synLeftExpr, parenthesize (SynExpr.Tuple (false, expandedIndexArgs @ [setArg], [], idxRange)), mOfLeftOfSet) ] + + /// Match if we can generate a call to a `Slice` method. + let (|Sliceable|_|) ((indexArgs, setInfo), exprTy) = + match (indexArgs, setInfo), exprTy with + | (Slicing & indexArgs, Getting), Sliceable (slice, getLength) -> + let mkAdd m expr1 expr2 = mkCallAdditionOperator g m g.int32_ty expr1 expr2 + let mkSub m expr1 expr2 = mkCallSubtractionOperator g m g.int32_ty expr1 expr2 + + /// Match if the given expression is or is equivalent to System.Int32, + /// ignoring units of measure if present. + let (|Int32|_|) expr = + let expr, tpenv = TcExpr cenv (MustEqual (NewInferenceType g)) env tpenv expr + if typeEquivAux EraseMeasures g (tyOfExpr g expr) g.int32_ty then Some (Int32 (expr, tpenv)) + else None + + match indexArgs with + // expr[start..finish] + | [IndexArgRange (Some (Int32 (start, _), false), Some (Int32 (finish, tpenv), false), m1, m2)] -> + // Compiles to: + // + // let expr = expr in + // let len = expr.Length in + // let start = min (max start 0) len in + // expr.Slice (start, max (min (finish - start + 1) (len - start)) 0) - elif isString then - match DecodeIndexArgs cenv indexArgs, setInfo with - | [IndexArgRange _], None -> Some (sliceOpPath, "GetStringSlice", expandedIndexArgs) - | [IndexArgItem _], None -> Some (indexOpPath, "GetString", expandedIndexArgs) - | _ -> None + let mLhs = expr.Range + let tcVal = LightweightTcValForUsingInBuildMethodCall g - else None + let exprVal, exprExpr = mkCompGenLocal mLhs "expr" exprTy + let lenVal, lenExpr = mkCompGenLocal mLhs "len" g.int32_ty + let startVal, startExpr = mkCompGenLocal mLhs "start" g.int32_ty - match info with - | None -> None - | Some (path, functionName, indexArgs) -> - let operPath = mkSynLidGet (mDot.MakeSynthetic()) path functionName - let f, fty, tpenv = TcExprOfUnknownType cenv env tpenv operPath - let domainTy, resultTy = UnifyFunctionType (Some mWholeExpr) cenv env.DisplayEnv mWholeExpr fty - UnifyTypes cenv env mWholeExpr domainTy exprTy - let f', resultTy = buildApp cenv (MakeApplicableExprNoFlex cenv f) resultTy expr mWholeExpr - let delayed = List.foldBack (fun idx acc -> DelayedApp(ExprAtomicFlag.Atomic, true, None, idx, mWholeExpr) :: acc) indexArgs delayed // atomic, otherwise no ar.[1] <- xyz - Some (PropagateThenTcDelayed cenv overallTy env tpenv mWholeExpr f' resultTy ExprAtomicFlag.Atomic delayed ) - - match attemptArrayString with - | Some res -> res - | None when isNominal || Option.isSome propName -> - let nm = - match propName with - | None -> "Item" - | Some nm -> nm - let delayed = - match setInfo with - // expr1.[expr2] - | None -> - [ DelayedDotLookup([ ident(nm, mWholeExpr)], mWholeExpr) - DelayedApp(ExprAtomicFlag.Atomic, true, synLeftExprOpt, MakeIndexParam None, mWholeExpr) - yield! delayed ] - - // expr1.[expr2] <- expr3 --> expr1.Item(expr2) <- expr3 - | Some (expr3, mOfLeftOfSet) -> - if isIndex then - [ DelayedDotLookup([ident(nm, mOfLeftOfSet)], mOfLeftOfSet) - DelayedApp(ExprAtomicFlag.Atomic, true, synLeftExprOpt, MakeIndexParam None, mOfLeftOfSet) - MakeDelayedSet(expr3, mWholeExpr) - yield! delayed ] - else - [ DelayedDotLookup([ident("SetSlice", mOfLeftOfSet)], mOfLeftOfSet) - DelayedApp(ExprAtomicFlag.Atomic, true, synLeftExprOpt, MakeIndexParam (Some expr3), mWholeExpr) - yield! delayed ] + let len, _ = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr true getLength ValUseFlag.NormalValUse [] [exprExpr] [] None + let start = mkCallMinOperator g m1 g.int32_ty (mkCallMaxOperator g m1 g.int32_ty start (mkZero g m1)) lenExpr + let sliceLen = mkCallMaxOperator g m2 g.int32_ty (mkCallMinOperator g m2 g.int32_ty (mkAdd m2 (mkSub m2 finish startExpr) (mkOne g m2)) (mkSub m2 lenExpr startExpr)) (mkZero g m2) + let slice, ty = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr false slice ValUseFlag.NormalValUse slice.FormalMethodInst [exprExpr] [startExpr; sliceLen] None + + let expr = + mkCompGenLet mLhs exprVal expr + (mkCompGenLet mLhs lenVal len + (mkCompGenLet m1 startVal start + slice)) + + Some (tpenv, expr, ty) + + // expr[^start..finish] + | [IndexArgRange (Some (Int32 (start, _), true), Some (Int32 (finish, tpenv), false), m1, m2)] -> + // Compiles to: + // + // let expr = expr in + // let len = expr.Length in + // let start = max (len - start) 0 in + // expr.Slice (start, max (min (finish - start + 1) (len - start)) 0) + + let mLhs = expr.Range + let tcVal = LightweightTcValForUsingInBuildMethodCall g + + let exprVal, exprExpr = mkCompGenLocal mLhs "expr" exprTy + let lenVal, lenExpr = mkCompGenLocal mLhs "len" g.int32_ty + let startVal, startExpr = mkCompGenLocal mLhs "start" g.int32_ty + + let len, _ = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr true getLength ValUseFlag.NormalValUse [] [exprExpr] [] None + let start = mkCallMaxOperator g m1 g.int32_ty (mkSub m1 lenExpr start) (mkZero g m1) + let sliceLen = mkCallMaxOperator g m2 g.int32_ty (mkCallMinOperator g m2 g.int32_ty (mkAdd m2 (mkSub m2 finish startExpr) (mkOne g m2)) (mkSub m2 lenExpr startExpr)) (mkZero g m2) + let slice, ty = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr false slice ValUseFlag.NormalValUse slice.FormalMethodInst [exprExpr] [startExpr; sliceLen] None + + let expr = + mkCompGenLet mLhs exprVal expr + (mkCompGenLet mLhs lenVal len + (mkCompGenLet m1 startVal start + slice)) + + Some (tpenv, expr, ty) + + // expr[start..^finish] + | [IndexArgRange (Some (Int32 (start, _), false), Some (Int32 (finish, tpenv), true), m1, m2)] -> + // Compiles to: + // + // let expr = expr in + // let len = expr.Length in + // let start = min (max start 0) len in + // expr.Slice (start, max (min (len - finish - start + 1) len) 0) + + let mLhs = expr.Range + let tcVal = LightweightTcValForUsingInBuildMethodCall g + + let exprVal, exprExpr = mkCompGenLocal mLhs "expr" exprTy + let lenVal, lenExpr = mkCompGenLocal mLhs "len" g.int32_ty + let startVal, startExpr = mkCompGenLocal mLhs "start" g.int32_ty + + let len, _ = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr true getLength ValUseFlag.NormalValUse [] [exprExpr] [] None + let start = mkCallMinOperator g m1 g.int32_ty (mkCallMaxOperator g m1 g.int32_ty start (mkZero g m1)) lenExpr + let sliceLen = mkCallMaxOperator g m2 g.int32_ty (mkCallMinOperator g m2 g.int32_ty (mkAdd m2 (mkSub m2 (mkSub m2 lenExpr finish) startExpr) (mkOne g m2)) lenExpr) (mkZero g m2) + let slice, ty = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr false slice ValUseFlag.NormalValUse slice.FormalMethodInst [exprExpr] [startExpr; sliceLen] None + + let expr = + mkCompGenLet mLhs exprVal expr + (mkCompGenLet mLhs lenVal len + (mkCompGenLet m1 startVal start + slice)) + + Some (tpenv, expr, ty) + + // expr[^start..^finish] + | [IndexArgRange (Some (Int32 (start, _), true), Some (Int32 (finish, tpenv), true), m1, m2)] -> + // Compiles to: + // + // let expr = expr in + // let len = expr.Length in + // let start = max (len - start) 0 in + // expr.Slice (start, max (min (len - finish - start + 1) len) 0) + + let mLhs = expr.Range + let tcVal = LightweightTcValForUsingInBuildMethodCall g + + let exprVal, exprExpr = mkCompGenLocal mLhs "expr" exprTy + let lenVal, lenExpr = mkCompGenLocal mLhs "len" g.int32_ty + let startVal, startExpr = mkCompGenLocal mLhs "start" g.int32_ty + + let len, _ = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr true getLength ValUseFlag.NormalValUse [] [exprExpr] [] None + let start = mkCallMaxOperator g m1 g.int32_ty (mkSub m1 lenExpr start) (mkZero g m1) + let sliceLen = mkCallMaxOperator g m2 g.int32_ty (mkCallMinOperator g m2 g.int32_ty (mkAdd m2 (mkSub m2 (mkSub m2 lenExpr finish) startExpr) (mkOne g m2)) lenExpr) (mkZero g m2) + let slice, ty = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr false slice ValUseFlag.NormalValUse slice.FormalMethodInst [exprExpr] [startExpr; sliceLen] None + + let expr = + mkCompGenLet mLhs exprVal expr + (mkCompGenLet mLhs lenVal len + (mkCompGenLet m1 startVal start + slice)) + + Some (tpenv, expr, ty) + + // expr[start..] + | [IndexArgRange (Some (Int32 (start, tpenv), false), None, m1, m2)] -> + // Compiles to: + // + // let expr = expr in + // let len = expr.Length in + // let start = min (max start 0) len in + // expr.Slice (start, len - start) + + let mLhs = expr.Range + let tcVal = LightweightTcValForUsingInBuildMethodCall g + + let exprVal, exprExpr = mkCompGenLocal mLhs "expr" exprTy + let lenVal, lenExpr = mkCompGenLocal mLhs "len" g.int32_ty + let startVal, startExpr = mkCompGenLocal mLhs "start" g.int32_ty + + let len, _ = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr true getLength ValUseFlag.NormalValUse [] [exprExpr] [] None + let start = mkCallMinOperator g m1 g.int32_ty (mkCallMaxOperator g m1 g.int32_ty start (mkZero g m1)) lenExpr + let sliceLen = mkSub m2 lenExpr startExpr + let slice, ty = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr false slice ValUseFlag.NormalValUse slice.FormalMethodInst [exprExpr] [startExpr; sliceLen] None + + let expr = + mkCompGenLet mLhs exprVal expr + (mkCompGenLet mLhs lenVal len + (mkCompGenLet m1 startVal start + slice)) + + Some (tpenv, expr, ty) + // expr[..finish] + | [IndexArgRange (None, Some (Int32 (finish, tpenv), false), m1, m2)] -> + // Compiles to: + // + // let expr = expr in + // expr.Slice (0, max (min (finish + 1) expr.Length) 0) + + let mLhs = expr.Range + let tcVal = LightweightTcValForUsingInBuildMethodCall g + + let exprVal, exprExpr = mkCompGenLocal mLhs "expr" exprTy + + let len, _ = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr true getLength ValUseFlag.NormalValUse [] [exprExpr] [] None + let start = mkZero g m1 + let sliceLen = mkCallMaxOperator g m2 g.int32_ty (mkCallMinOperator g m2 g.int32_ty (mkAdd m2 finish (mkOne g m2)) len) (mkZero g m2) + let slice, ty = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr false slice ValUseFlag.NormalValUse slice.FormalMethodInst [exprExpr] [start; sliceLen] None + + let expr = mkCompGenLet mLhs exprVal expr slice + + Some (tpenv, expr, ty) + + | _ -> None + + | _ -> None + + /// Finish typechecking array or string indexing. + let tcArrayOrStringIndexing (path, functionName, indexArgs) = + let operPath = mkSynLidGet (mDot.MakeSynthetic()) path functionName + let f, fty, tpenv = TcExprOfUnknownType cenv env tpenv operPath + let domainTy, resultTy = UnifyFunctionType (Some mWholeExpr) cenv env.DisplayEnv mWholeExpr fty + UnifyTypes cenv env mWholeExpr domainTy exprTy + let f', resultTy = buildApp cenv (MakeApplicableExprNoFlex cenv f) resultTy expr mWholeExpr + let delayed = List.foldBack (fun idx acc -> DelayedApp(ExprAtomicFlag.Atomic, true, None, idx, mWholeExpr) :: acc) indexArgs delayed // atomic, otherwise no ar.[1] <- xyz + PropagateThenTcDelayed cenv overallTy env tpenv mWholeExpr f' resultTy ExprAtomicFlag.Atomic delayed + + let propagateThenTcDelayed tpenv expr exprTy delayed = PropagateThenTcDelayed cenv overallTy env tpenv mDot (MakeApplicableExprNoFlex cenv expr) exprTy ExprAtomicFlag.Atomic delayed + match (DecodeIndexArgs cenv indexArgs, setInfo), exprTy with + // Look for FSharp.Core array and string indexing/slicing helpers. + | (_, Array) & (ArrayIndexerOrSlicer (path, meth, args), _) + | (_, String) & (StringIndexerOrSlicer (path, meth, args), _) -> tcArrayOrStringIndexing (path, meth, args) + + // Look for an indexer property or method, or delay lookup while assuming `Item`. + | (Indexing, Getting), Indexable indexer + | (Indexing, Getting), (Array | Nominal) & PossiblyIndexable indexer -> + propagateThenTcDelayed tpenv expr exprTy (mkDelayedIndexedGet indexer @ delayed) + + // Look for `GetSlice`. + | (Slicing, Getting), Nominal & GetSliceable slicer -> + propagateThenTcDelayed tpenv expr exprTy (mkDelayedGetSlice slicer @ delayed) + + // In the absence of `GetSlice`, look for `Slice`. + | ((Slicing, Getting), Nominal) & Sliceable (tpenv, expr, exprTy) -> + propagateThenTcDelayed tpenv expr exprTy delayed + + // In the immediate absence of either, delay lookup while assuming `GetSlice`. + | (Slicing, Getting), PossiblyGetSliceable slicer -> + propagateThenTcDelayed tpenv expr exprTy (mkDelayedGetSlice slicer @ delayed) + + // Look for an indexer property or method, or delay lookup while assuming `Item`. + | (Indexing, Setting (setArg, mOfLeftOfSet)), Indexable indexer + | (Indexing, Setting (setArg, mOfLeftOfSet)), (Array | Nominal) & PossiblyIndexable indexer -> + propagateThenTcDelayed tpenv expr exprTy (mkDelayedIndexedSet indexer setArg mOfLeftOfSet @ delayed) + + // Delay lookup of `SetSlice`. + | (Slicing, Setting (setArg, mOfLeftOfSet)), (Array | Nominal) -> + propagateThenTcDelayed tpenv expr exprTy (mkDelayedSetSlice setArg mOfLeftOfSet @ delayed) + | _ -> // deprecated constrained lookup error(Error(FSComp.SR.tcObjectOfIndeterminateTypeUsedRequireTypeConstraint(), mWholeExpr)) @@ -8199,7 +8481,7 @@ and Propagate (cenv: cenv) (overallTy: OverallTy) (env: TcEnv) tpenv (expr: Appl // expr[..idx1] // expr[idx1..idx2] | SynExpr.ArrayOrListComputed(false, _, _) -> - let isAdjacent = isAdjacentListExpr isSugar atomicFlag synLeftExprOpt synArg + let isAdjacent = match synLeftExprOpt with Some synLeftExpr -> isAdjacentListExpr isSugar atomicFlag synLeftExpr synArg | None -> false if isAdjacent && g.langVersion.SupportsFeature LanguageFeature.IndexerNotationWithoutDot then // This is the non-error path () @@ -8430,7 +8712,7 @@ and TcNameOfExprResult (cenv: cenv) (lastIdent: Ident) m = //------------------------------------------------------------------------- // leftExpr[idx] gives a warning -and isAdjacentListExpr isSugar atomicFlag (synLeftExprOpt: SynExpr option) (synArg: SynExpr) = +and isAdjacentListExpr isSugar atomicFlag (synLeftExpr: SynExpr) (synArg: SynExpr) = not isSugar && if atomicFlag = ExprAtomicFlag.Atomic then match synArg with @@ -8438,13 +8720,10 @@ and isAdjacentListExpr isSugar atomicFlag (synLeftExprOpt: SynExpr option) (synA | SynExpr.ArrayOrListComputed (false, _, _) -> true | _ -> false else - match synLeftExprOpt with - | Some synLeftExpr -> - match synArg with - | SynExpr.ArrayOrList (false, _, _) - | SynExpr.ArrayOrListComputed (false, _, _) -> - synLeftExpr.Range.IsAdjacentTo synArg.Range - | _ -> false + match synArg with + | SynExpr.ArrayOrList (false, _, _) + | SynExpr.ArrayOrListComputed (false, _, _) -> + synLeftExpr.Range.IsAdjacentTo synArg.Range | _ -> false // Check f x @@ -8522,12 +8801,12 @@ and TcApplicationThen (cenv: cenv) (overallTy: OverallTy) env tpenv mExprAndArg | ValueNone -> // Type-directed invokables - match synArg with + match synLeftExprOpt, synArg with // leftExpr[idx] // leftExpr[idx] <- expr2 - | SynExpr.ArrayOrListComputed(false, IndexerArgs indexArgs, m) + | Some synLeftExpr, SynExpr.ArrayOrListComputed(false, IndexerArgs indexArgs, m) when - isAdjacentListExpr isSugar atomicFlag synLeftExprOpt synArg && + isAdjacentListExpr isSugar atomicFlag synLeftExpr synArg && g.langVersion.SupportsFeature LanguageFeature.IndexerNotationWithoutDot -> let expandedIndexArgs = ExpandIndexArgs cenv synLeftExprOpt indexArgs @@ -8535,13 +8814,13 @@ and TcApplicationThen (cenv: cenv) (overallTy: OverallTy) env tpenv mExprAndArg match delayed with | DelayedSet(expr3, _) :: rest -> Some (expr3, unionRanges leftExpr.Range synArg.Range), rest | _ -> None, delayed - TcIndexingThen cenv env overallTy mExprAndArg m tpenv setInfo synLeftExprOpt leftExpr.Expr exprTy expandedIndexArgs indexArgs delayed + TcIndexingThen cenv env overallTy mExprAndArg m tpenv setInfo synLeftExpr leftExpr.Expr exprTy expandedIndexArgs indexArgs delayed // Perhaps 'leftExpr' is a computation expression builder, and 'arg' is '{ ... }' or '{ }': // leftExpr { comp } // leftExpr { } - | SynExpr.ComputationExpr (false, comp, _m) - | SynExpr.Record (None, None, EmptyFieldListAsUnit comp, _m) -> + | _, SynExpr.ComputationExpr (false, comp, _m) + | _, SynExpr.Record (None, None, EmptyFieldListAsUnit comp, _m) -> let bodyOfCompExpr, tpenv = cenv.TcComputationExpression cenv env overallTy tpenv (mLeftExpr, leftExpr.Expr, exprTy, comp) TcDelayed cenv overallTy env tpenv mExprAndArg (MakeApplicableExprNoFlex cenv bodyOfCompExpr) (tyOfExpr g bodyOfCompExpr) ExprAtomicFlag.NonAtomic delayed diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 69a99dfe119..5a738f5558a 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -675,6 +675,8 @@ type TcGlobals( let v_or_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, "or" , None , Some "Or" , [], mk_rel_sig v_bool_ty) let v_or2_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, CompileOpName "||" , None , None , [], mk_rel_sig v_bool_ty) let v_compare_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "compare" , None , Some "Compare", [vara], mk_compare_sig varaTy) + let v_max_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "max" , None , Some "Max" , [vara], ([[varaTy];[varaTy]], varaTy)) + let v_min_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "min" , None , Some "Min" , [vara], ([[varaTy];[varaTy]], varaTy)) let v_equals_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, CompileOpName "=" , None , None , [vara], mk_rel_sig varaTy) let v_equals_nullable_operator_info = makeIntrinsicValRef(fslib_MFNullableOperators_nleref, CompileOpName "=?" , None , None , [vara], ([[varaTy];[mkNullableTy varaTy]], v_bool_ty)) let v_nullable_equals_operator_info = makeIntrinsicValRef(fslib_MFNullableOperators_nleref, CompileOpName "?=" , None , None , [vara], ([[mkNullableTy varaTy];[varaTy]], v_bool_ty)) @@ -1673,6 +1675,8 @@ type TcGlobals( member val invalid_op_vref = ValRefForIntrinsic v_invalid_op_info member val failwithf_vref = ValRefForIntrinsic v_failwithf_info + member _.max_operator_info = v_max_operator_info + member _.min_operator_info = v_min_operator_info member _.equals_operator_info = v_equals_operator_info member _.not_equals_operator = v_not_equals_operator_info member _.less_than_operator = v_less_than_operator_info diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 120baae8461..3d60ded3a6b 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -7747,6 +7747,10 @@ let mkCallGenericEqualityWithComparerOuter (g: TcGlobals) m ty comp e1 e2 = mkAp let mkCallGenericHashWithComparerOuter (g: TcGlobals) m ty comp e1 = mkApps g (typedExprForIntrinsic g m g.generic_hash_withc_outer_info, [[ty]], [comp;e1], m) +let mkCallMaxOperator (g: TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.max_operator_info, [[ty]], [ e1;e2 ], m) + +let mkCallMinOperator (g: TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.min_operator_info, [[ty]], [ e1;e2 ], m) + let mkCallEqualsOperator (g: TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.equals_operator_info, [[ty]], [ e1;e2 ], m) let mkCallNotEqualsOperator (g: TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.not_equals_operator, [[ty]], [ e1;e2 ], m) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index cec67a4961d..b6bf52fa5ff 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2084,6 +2084,10 @@ val mkCallGenericEqualityWithComparerOuter: TcGlobals -> range -> TType -> Expr val mkCallGenericHashWithComparerOuter: TcGlobals -> range -> TType -> Expr -> Expr -> Expr +val mkCallMaxOperator: g: TcGlobals -> m: range -> ty: TType -> e1: Expr -> e2: Expr -> Expr + +val mkCallMinOperator: g: TcGlobals -> m: range -> ty: TType -> e1: Expr -> e2: Expr -> Expr + val mkCallEqualsOperator: TcGlobals -> range -> TType -> Expr -> Expr -> Expr val mkCallNotEqualsOperator: TcGlobals -> range -> TType -> Expr -> Expr -> Expr diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/MethodsAndProperties/MethodsAndProperties.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/MethodsAndProperties/MethodsAndProperties.fs index a71f63cbfb9..e838296d639 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/MethodsAndProperties/MethodsAndProperties.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/MethodsAndProperties/MethodsAndProperties.fs @@ -667,4 +667,380 @@ type GenericIndexer<'indexerArgs,'indexerOutput,'indexerInput>() = |> withLangVersionPreview |> typecheck |> shouldFail - |> withSingleDiagnostic (Warning 3581, Line 9, Col 17, Line 9, Col 21, "An indexed property's getter and setter must have the same type. Property 'Item' has getter of type ''indexerOutput' but setter of type ''indexerInput'.") \ No newline at end of file + |> withSingleDiagnostic (Warning 3581, Line 9, Col 17, Line 9, Col 21, "An indexed property's getter and setter must have the same type. Property 'Item' has getter of type ''indexerOutput' but setter of type ''indexerInput'.") + + module Slicing = + let [] SupportedVersion = "preview" + + /// Slicing tests for types in the System namespace that + /// expose a Slice method (but not a GetSlice method). + module SystemTypes = + [] + let ``readOnlySpan[start..finish]``() = + Fsx """ + open System + + let f () = + let span = "abc123".AsSpan () + let actual = span[2..3] + let expected = span.Slice (2, 2) // "c1" + + if not (expected.SequenceEqual actual) then + failwith $"Expected '{expected.ToString ()}' but got '{actual.ToString ()}'." + + f () + """ + |> withLangVersion SupportedVersion + |> runFsi + |> shouldSucceed + + [] + let ``readOnlySpan[start..]``() = + Fsx """ + open System + + let f () = + let span = "abc123".AsSpan () + let actual = span[2..] + let expected = span.Slice (2, span.Length - 2) // "c123" + + if not (expected.SequenceEqual actual) then + failwith $"Expected '{expected.ToString ()}' but got '{actual.ToString ()}'." + + f () + """ + |> withLangVersion SupportedVersion + |> runFsi + |> shouldSucceed + + [] + let ``readOnlySpan[..finish]``() = + Fsx """ + open System + + let f () = + let span = "abc123".AsSpan () + let actual = span[..3] + let expected = span.Slice (0, 4) // "abc1" + + if not (expected.SequenceEqual actual) then + failwith $"Expected '{expected.ToString ()}' but got '{actual.ToString ()}'." + + f () + """ + |> withLangVersion SupportedVersion + |> runFsi + |> shouldSucceed + + [] + let ``readOnlySpan[start () .. finish ()]``() = + Fsx """ + open System + + let f () = + let effects = ResizeArray () + let start () = effects.Add "start"; 2 + let finish () = effects.Add "finish"; 3 + let span = "abc123".AsSpan () + let actual = span[start () .. finish ()] + let expected = span.Slice (2, 2) // "c1" + + if not (expected.SequenceEqual actual) then + failwith $"Expected '{expected.ToString ()}' but got '{actual.ToString ()}'." + + match List.ofSeq effects with + | ["start"; "finish"] -> () + | actual -> failwith $"Expected '[\"start\"; \"finish\"]' but got '%A{actual}'." + + f () + """ + |> withLangVersion SupportedVersion + |> runFsi + |> shouldSucceed + + [] + let ``readOnlySpan[start () ..]``() = + Fsx """ + open System + + let f () = + let effects = ResizeArray () + let start () = effects.Add "start"; 2 + let span = "abc123".AsSpan () + let actual = span[start () ..] + let expected = span.Slice (2, span.Length - 2) // "c123" + + if not (expected.SequenceEqual actual) then + failwith $"Expected '{expected.ToString ()}' but got '{actual.ToString ()}'." + + match List.ofSeq effects with + | ["start"] -> () + | actual -> failwith $"Expected '[\"start\"]' but got '%A{actual}'." + + f () + """ + |> withLangVersion SupportedVersion + |> runFsi + |> shouldSucceed + + [] + let ``readOnlySpan[.. finish ()]``() = + Fsx """ + open System + + let f () = + let effects = ResizeArray () + let finish () = effects.Add "finish"; 3 + let span = "abc123".AsSpan () + let actual = span[.. finish ()] + let expected = span.Slice (0, 4) // "abc1" + + if not (expected.SequenceEqual actual) then + failwith $"Expected '{expected.ToString ()}' but got '{actual.ToString ()}'." + + match List.ofSeq effects with + | ["finish"] -> () + | actual -> failwith $"Expected '[\"finish\"]' but got '%A{actual}'." + + f () + """ + |> withLangVersion SupportedVersion + |> runFsi + |> shouldSucceed + + [] + let ``(readOnlySpan ())[start..finish]``() = + Fsx """ + open System + + let effects = ResizeArray () + + let span () = + effects.Add "span" + "abc123".AsSpan () + + let f () = + let actual = (span ())[2..3] + let expected = "c1".AsSpan () + + if not (expected.SequenceEqual actual) then + failwith $"Expected '{expected.ToString ()}' but got '{actual.ToString ()}'." + + match List.ofSeq effects with + | ["span"] -> () + | actual -> failwith $"Expected '[\"span\"]' but got '%A{actual}'." + + f () + """ + |> withLangVersion SupportedVersion + |> runFsi + |> shouldSucceed + + [] + let ``(readOnlySpan ())[^start..^finish]``() = + Fsx """ + open System + + let effects = ResizeArray () + + let span () = + effects.Add "span" + "abc123".AsSpan () + + let f () = + let actual = (span ())[^4..^3] + let expected = "c1".AsSpan () + + if not (expected.SequenceEqual actual) then + failwith $"Expected '{expected.ToString ()}' but got '{actual.ToString ()}'." + + match List.ofSeq effects with + | ["span"] -> () + | actual -> failwith $"Expected '[\"span\"]' but got '%A{actual}'." + + f () + """ + |> withLangVersion SupportedVersion + |> runFsi + |> shouldSucceed + + /// Slicing tests for types that expose both Slice and GetSlice methods. + module CustomTypes = + [] + let ``sliceAndGetSlice[start..finish]``() = + Fsx """ + open System + + let effects = ResizeArray () + + type T = + | T + + member _.Length = 99 + + member this.GetSlice (start, finish) = + let start = defaultArg start 0 + let finish = defaultArg finish this.Length + effects.Add "GetSlice" + [start..finish] + + member _.Slice (start, length) = + effects.Add "Slice" + [start..length - start] + + let f () = + let actual = T[2..3] + let expected = [2..3] + + if expected <> actual then + failwith $"Expected '%A{expected}' but got '%A{actual}'." + + match List.ofSeq effects with + | ["GetSlice"] -> () + | actual -> failwith $"Expected '\"GetSlice\"' but got '%A{actual}'." + + f () + """ + |> withLangVersion SupportedVersion + |> runFsi + |> shouldSucceed + + [] + let ``justSlice[start..finish]``() = + Fsx """ + open System + + let effects = ResizeArray () + + type T (xs : int array) = + do effects.Add "T" + + member _.Length = xs.Length + + member _.Slice (start, length) = + effects.Add "Slice" + xs.AsSpan().Slice(start, length).ToArray () + + let f () = + let xs = [|1..10|] + let actual = (T xs)[2..3] + let expected = xs[2..3] + + if expected <> actual then + failwith $"Expected '%A{expected}' but got '%A{actual}'." + + match List.ofSeq effects with + | ["T"; "Slice"] -> () + | actual -> failwith $"Expected '[\"T\"; \"Slice\"]' but got '%A{actual}'." + + f () + """ + |> withLangVersion SupportedVersion + |> runFsi + |> shouldSucceed + + [] + let ``justSlice_UnitsOfMeasure[start..finish]``() = + Fsx """ + open System + + type [] m + + let effects = ResizeArray () + + type T (xs : int array) = + do effects.Add "T" + + member _.Length = xs.Length + + member _.Slice (start : int, length : int) = + effects.Add "Slice" + xs.AsSpan().Slice(int start, int length).ToArray () + + let f () = + let xs = [|1..10|] + let actual = (T xs)[2..3] + let expected = xs[2..3] + + if expected <> actual then + failwith $"Expected '%A{expected}' but got '%A{actual}'." + + match List.ofSeq effects with + | ["T"; "Slice"] -> () + | actual -> failwith $"Expected '[\"T\"; \"Slice\"]' but got '%A{actual}'." + + f () + """ + |> withLangVersion SupportedVersion + |> runFsi + |> shouldSucceed + + [] + let ``justGetSlice[start..finish]``() = + Fsx """ + open System + + let effects = ResizeArray () + + type T = + | T + + member _.Length = 99 + + member this.GetSlice (start, finish) = + let start = defaultArg start 0 + let finish = defaultArg finish this.Length + effects.Add "GetSlice" + [start..finish] + + let f () = + let actual = T[2..3] + let expected = [2..3] + + if expected <> actual then + failwith $"Expected '%A{expected}' but got '%A{actual}'." + + match List.ofSeq effects with + | ["GetSlice"] -> () + | actual -> failwith $"Expected '\"GetSlice\"' but got '%A{actual}'." + + f () + """ + |> withLangVersion SupportedVersion + |> runFsi + |> shouldSucceed + + [] + let ``extensionSlice[start..finish]``() = + Fsx """ + open System + + module M = + type T = + { Xs : int array } + + member this.Length = this.Xs.Length + + open M + + module N = + type T with + member this.Slice (start, length) = + { Xs = this.Xs.AsSpan().Slice(start, length).ToArray() } + + open N + + let f () = + let xs = [|1..10|] + let t = { Xs = xs } + let actual = t[2..3] + let expected = xs[2..3] + + if expected <> actual.Xs then + failwith $"Expected '%A{expected}' but got '%A{actual}'." + + f () + """ + |> withLangVersion SupportedVersion + |> runFsi + |> shouldSucceed From 785bf31214a951be257439e205b5162c3240a45a Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Tue, 2 Jul 2024 19:24:55 -0400 Subject: [PATCH 2/8] It seems I misunderstood what that was for --- src/Compiler/Checking/CheckExpressions.fs | 43 ++++++++++++----------- 1 file changed, 23 insertions(+), 20 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index bdad32bdad8..c2691364a05 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -5386,7 +5386,7 @@ and CheckForAdjacentListExpression (cenv: cenv) synExpr hpa isInfix delayed (arg let g = cenv.g // func (arg)[arg2] gives warning that .[ must be used. match delayed with - | DelayedApp (hpa2, isSugar2, _, arg2, _) :: _ when not isInfix && (hpa = ExprAtomicFlag.NonAtomic) && isAdjacentListExpr isSugar2 hpa2 synExpr arg2 -> + | DelayedApp (hpa2, isSugar2, _, arg2, _) :: _ when not isInfix && (hpa = ExprAtomicFlag.NonAtomic) && isAdjacentListExpr isSugar2 hpa2 (Some synExpr) arg2 -> let mWarning = unionRanges arg.Range arg2.Range match arg with @@ -6493,7 +6493,7 @@ and (|IndexerArgs|) expr = and TcIndexerThen (cenv: cenv) env overallTy mWholeExpr mDot tpenv (setInfo: _ option) synLeftExpr indexArgs delayed = let leftExpr, leftExprTy, tpenv = TcExprOfUnknownType cenv env tpenv synLeftExpr let expandedIndexArgs = ExpandIndexArgs cenv (Some synLeftExpr) indexArgs - TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExpr leftExpr leftExprTy expandedIndexArgs indexArgs delayed + TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo (Some synLeftExpr) leftExpr leftExprTy expandedIndexArgs indexArgs delayed // Eliminate GetReverseIndex from index args and ExpandIndexArgs (cenv: cenv) (synLeftExprOpt: SynExpr option) indexArgs = @@ -6547,7 +6547,7 @@ and ExpandIndexArgs (cenv: cenv) (synLeftExprOpt: SynExpr option) indexArgs = // However it's not so simple as all that. First "Item" can have a different name according to an attribute in // .NET metadata. This means we manually typecheck 'expr and look to see if it has a nominal type. We then // do the right thing in each case. -and TcIndexingThen (cenv: cenv) (env: TcEnv) overallTy mWholeExpr (mDot: range) tpenv setInfo synLeftExpr (expr: Expr) exprTy expandedIndexArgs (indexArgs: SynExpr list) delayed = +and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprOpt expr exprTy expandedIndexArgs indexArgs delayed = let g = cenv.g let ad = env.AccessRights @@ -6746,13 +6746,13 @@ and TcIndexingThen (cenv: cenv) (env: TcEnv) overallTy mWholeExpr (mDot: range) /// expr1[expr2] let mkDelayedIndexedGet indexer = - [ DelayedDotLookup([ident (indexer, mWholeExpr)], mWholeExpr) - DelayedApp(ExprAtomicFlag.Atomic, true, Some synLeftExpr, parenthesize (tupleIfMultiple expandedIndexArgs), mWholeExpr) ] + [ DelayedDotLookup([ident(indexer, mWholeExpr)], mWholeExpr) + DelayedApp(ExprAtomicFlag.Atomic, true, synLeftExprOpt, parenthesize (tupleIfMultiple expandedIndexArgs), mWholeExpr) ] /// expr1[expr2] <- expr3 let mkDelayedIndexedSet indexer setArg mOfLeftOfSet = [ DelayedDotLookup([ident(indexer, mOfLeftOfSet)], mOfLeftOfSet) - DelayedApp(ExprAtomicFlag.Atomic, true, Some synLeftExpr, parenthesize (tupleIfMultiple expandedIndexArgs), mOfLeftOfSet) + DelayedApp(ExprAtomicFlag.Atomic, true, synLeftExprOpt, parenthesize (tupleIfMultiple expandedIndexArgs), mOfLeftOfSet) MakeDelayedSet(setArg, mWholeExpr) ] /// expr1[expr2..] @@ -6760,14 +6760,14 @@ and TcIndexingThen (cenv: cenv) (env: TcEnv) overallTy mWholeExpr (mDot: range) /// expr1[expr2..expr3] let mkDelayedGetSlice indexer = [ DelayedDotLookup([ident(indexer, mWholeExpr)], mWholeExpr) - DelayedApp(ExprAtomicFlag.Atomic, true, Some synLeftExpr, parenthesize (SynExpr.Tuple (false, expandedIndexArgs, [], idxRange)), mWholeExpr) ] + DelayedApp(ExprAtomicFlag.Atomic, true, synLeftExprOpt, parenthesize (SynExpr.Tuple (false, expandedIndexArgs, [], idxRange)), mWholeExpr) ] /// expr1[expr2..] <- expr3 /// expr1[..expr2] <- expr3 /// expr1[expr2..expr3] <- expr3 let mkDelayedSetSlice setArg mOfLeftOfSet = [ DelayedDotLookup([ident("SetSlice", mOfLeftOfSet)], mOfLeftOfSet) - DelayedApp(ExprAtomicFlag.Atomic, true, Some synLeftExpr, parenthesize (SynExpr.Tuple (false, expandedIndexArgs @ [setArg], [], idxRange)), mOfLeftOfSet) ] + DelayedApp(ExprAtomicFlag.Atomic, true, synLeftExprOpt, parenthesize (SynExpr.Tuple (false, expandedIndexArgs @ [setArg], [], idxRange)), mOfLeftOfSet) ] /// Match if we can generate a call to a `Slice` method. let (|Sliceable|_|) ((indexArgs, setInfo), exprTy) = @@ -8481,7 +8481,7 @@ and Propagate (cenv: cenv) (overallTy: OverallTy) (env: TcEnv) tpenv (expr: Appl // expr[..idx1] // expr[idx1..idx2] | SynExpr.ArrayOrListComputed(false, _, _) -> - let isAdjacent = match synLeftExprOpt with Some synLeftExpr -> isAdjacentListExpr isSugar atomicFlag synLeftExpr synArg | None -> false + let isAdjacent = isAdjacentListExpr isSugar atomicFlag synLeftExprOpt synArg if isAdjacent && g.langVersion.SupportsFeature LanguageFeature.IndexerNotationWithoutDot then // This is the non-error path () @@ -8712,7 +8712,7 @@ and TcNameOfExprResult (cenv: cenv) (lastIdent: Ident) m = //------------------------------------------------------------------------- // leftExpr[idx] gives a warning -and isAdjacentListExpr isSugar atomicFlag (synLeftExpr: SynExpr) (synArg: SynExpr) = +and isAdjacentListExpr isSugar atomicFlag (synLeftExprOpt: SynExpr option) (synArg: SynExpr) = not isSugar && if atomicFlag = ExprAtomicFlag.Atomic then match synArg with @@ -8720,10 +8720,13 @@ and isAdjacentListExpr isSugar atomicFlag (synLeftExpr: SynExpr) (synArg: SynExp | SynExpr.ArrayOrListComputed (false, _, _) -> true | _ -> false else - match synArg with - | SynExpr.ArrayOrList (false, _, _) - | SynExpr.ArrayOrListComputed (false, _, _) -> - synLeftExpr.Range.IsAdjacentTo synArg.Range + match synLeftExprOpt with + | Some synLeftExpr -> + match synArg with + | SynExpr.ArrayOrList (false, _, _) + | SynExpr.ArrayOrListComputed (false, _, _) -> + synLeftExpr.Range.IsAdjacentTo synArg.Range + | _ -> false | _ -> false // Check f x @@ -8801,12 +8804,12 @@ and TcApplicationThen (cenv: cenv) (overallTy: OverallTy) env tpenv mExprAndArg | ValueNone -> // Type-directed invokables - match synLeftExprOpt, synArg with + match synArg with // leftExpr[idx] // leftExpr[idx] <- expr2 - | Some synLeftExpr, SynExpr.ArrayOrListComputed(false, IndexerArgs indexArgs, m) + | SynExpr.ArrayOrListComputed(false, IndexerArgs indexArgs, m) when - isAdjacentListExpr isSugar atomicFlag synLeftExpr synArg && + isAdjacentListExpr isSugar atomicFlag synLeftExprOpt synArg && g.langVersion.SupportsFeature LanguageFeature.IndexerNotationWithoutDot -> let expandedIndexArgs = ExpandIndexArgs cenv synLeftExprOpt indexArgs @@ -8814,13 +8817,13 @@ and TcApplicationThen (cenv: cenv) (overallTy: OverallTy) env tpenv mExprAndArg match delayed with | DelayedSet(expr3, _) :: rest -> Some (expr3, unionRanges leftExpr.Range synArg.Range), rest | _ -> None, delayed - TcIndexingThen cenv env overallTy mExprAndArg m tpenv setInfo synLeftExpr leftExpr.Expr exprTy expandedIndexArgs indexArgs delayed + TcIndexingThen cenv env overallTy mExprAndArg m tpenv setInfo synLeftExprOpt leftExpr.Expr exprTy expandedIndexArgs indexArgs delayed // Perhaps 'leftExpr' is a computation expression builder, and 'arg' is '{ ... }' or '{ }': // leftExpr { comp } // leftExpr { } - | _, SynExpr.ComputationExpr (false, comp, _m) - | _, SynExpr.Record (None, None, EmptyFieldListAsUnit comp, _m) -> + | SynExpr.ComputationExpr (false, comp, _m) + | SynExpr.Record (None, None, EmptyFieldListAsUnit comp, _m) -> let bodyOfCompExpr, tpenv = cenv.TcComputationExpression cenv env overallTy tpenv (mLeftExpr, leftExpr.Expr, exprTy, comp) TcDelayed cenv overallTy env tpenv mExprAndArg (MakeApplicableExprNoFlex cenv bodyOfCompExpr) (tyOfExpr g bodyOfCompExpr) ExprAtomicFlag.NonAtomic delayed From 5f5706162cacd11888ef24a673c48bae19da3572 Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Tue, 2 Jul 2024 19:27:09 -0400 Subject: [PATCH 3/8] Add release notes entry --- docs/release-notes/.FSharp.Compiler.Service/8.0.400.md | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md index 2687dc328e9..42e9e5aed45 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.400.md @@ -28,6 +28,7 @@ * Expose inner exception information of TypeProviders to help diagnostics in IDE ([PR #17251](https://github.com/dotnet/fsharp/pull/17251)) * Parser: recover on empty match clause ([PR #17233](https://github.com/dotnet/fsharp/pull/17233)) * Support empty-bodied computation expressions. ([Language suggestion #1232](https://github.com/fsharp/fslang-suggestions/issues/1232), [RFC FS-1144 (PR #774)](https://github.com/fsharp/fslang-design/pull/774), [PR #17352](https://github.com/dotnet/fsharp/pull/17352)) +* Support using `Slice` to enable slicing syntax `expr1[expr2..expr3]`. ([Language suggestion #1317](https://github.com/fsharp/fslang-suggestions/issues/1317), [RFC FS-1145 (PR #TODO)](TODO), [PR #17377](https://github.com/dotnet/fsharp/pull/17377)) ### Changed * Enforce `AttributeTargets.Interface` ([PR #17173](https://github.com/dotnet/fsharp/pull/17173)) From cc89eca3aa7bdb6afec23d883a48587ccb61dac0 Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Wed, 3 Jul 2024 13:19:45 -0400 Subject: [PATCH 4/8] =?UTF-8?q?=E2=88=A8?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Compiler/Checking/CheckExpressions.fs | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index c2691364a05..0f1cbc1c39c 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -6647,12 +6647,6 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO exprTy None - /// Try to find a `DefaultMemberAttribute` that specifies a named indexed property. - let tryFindDefaultMember ty = - match tryTcrefOfAppTy g ty with - | ValueSome tcref -> TryFindTyconRefStringAttribute g mWholeExpr g.attrib_DefaultMemberAttribute tcref - | ValueNone -> None - /// Try to find a property with the given name. let tryFindNamedProp name ty = let name = Some name @@ -6713,9 +6707,11 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO let (|Indexable|_|) exprTy = exprTy |> tryFindMember (fun ty -> - tryFindDefaultMember ty - |> Option.orElseWith (fun () -> tryFindNamedProp Item ty) - |> Option.orElseWith (fun () -> tryFindMatchingMeths Item (fun _ -> Some Item) ty)) + // Search each nominal type in the hierarchy for a `DefaultMemberAttribute`. + // If the type is not a nominal type, search for a property named `Item`. + match tryTcrefOfAppTy g ty with + | ValueSome tcref -> TryFindTyconRefStringAttribute g mWholeExpr g.attrib_DefaultMemberAttribute tcref + | ValueNone -> tryFindNamedProp Item ty) /// Fall back to `Item` for delayed lookup. let (|PossiblyIndexable|) (_exprTy: TType) = Item From f5e0f60e60b6945e7a33b8949636fd0baff77d7d Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Wed, 3 Jul 2024 13:20:53 -0400 Subject: [PATCH 5/8] Tidy --- src/Compiler/Checking/CheckExpressions.fs | 49 +++++++++++++---------- 1 file changed, 27 insertions(+), 22 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 0f1cbc1c39c..1ccd00c286e 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -6666,6 +6666,9 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO /// The `GetSlice` method name. let GetSlice = "GetSlice" + /// The `SetSlice` method name. + let SetSlice = "SetSlice" + /// The `Slice` method name. let Slice = "Slice" @@ -6735,35 +6738,35 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO let parenthesize synExpr = SynExpr.Paren (synExpr, range0, None, idxRange) - let tupleIfMultiple expandedIndexArgs = - match expandedIndexArgs with - | [arg] -> arg - | args -> SynExpr.Tuple (false, args, [], idxRange) + let tupleIfMultiple decodedIndexArgs expandedIndexArgs = + match decodedIndexArgs, expandedIndexArgs with + | [IndexArgItem _], [arg] -> arg + | _, args -> SynExpr.Tuple (false, args, [], idxRange) /// expr1[expr2] - let mkDelayedIndexedGet indexer = + let mkDelayedIndexedGet indexer indexArgs = [ DelayedDotLookup([ident(indexer, mWholeExpr)], mWholeExpr) - DelayedApp(ExprAtomicFlag.Atomic, true, synLeftExprOpt, parenthesize (tupleIfMultiple expandedIndexArgs), mWholeExpr) ] + DelayedApp(ExprAtomicFlag.Atomic, true, synLeftExprOpt, parenthesize (tupleIfMultiple indexArgs expandedIndexArgs), mWholeExpr) ] /// expr1[expr2] <- expr3 - let mkDelayedIndexedSet indexer setArg mOfLeftOfSet = + let mkDelayedIndexedSet indexer indexArgs setArg mOfLeftOfSet = [ DelayedDotLookup([ident(indexer, mOfLeftOfSet)], mOfLeftOfSet) - DelayedApp(ExprAtomicFlag.Atomic, true, synLeftExprOpt, parenthesize (tupleIfMultiple expandedIndexArgs), mOfLeftOfSet) + DelayedApp(ExprAtomicFlag.Atomic, true, synLeftExprOpt, parenthesize (tupleIfMultiple indexArgs expandedIndexArgs), mOfLeftOfSet) MakeDelayedSet(setArg, mWholeExpr) ] /// expr1[expr2..] /// expr1[..expr2] /// expr1[expr2..expr3] - let mkDelayedGetSlice indexer = + let mkDelayedGetSlice indexer indexArgs = [ DelayedDotLookup([ident(indexer, mWholeExpr)], mWholeExpr) - DelayedApp(ExprAtomicFlag.Atomic, true, synLeftExprOpt, parenthesize (SynExpr.Tuple (false, expandedIndexArgs, [], idxRange)), mWholeExpr) ] + DelayedApp(ExprAtomicFlag.Atomic, true, synLeftExprOpt, parenthesize (tupleIfMultiple indexArgs expandedIndexArgs), mWholeExpr) ] /// expr1[expr2..] <- expr3 /// expr1[..expr2] <- expr3 /// expr1[expr2..expr3] <- expr3 - let mkDelayedSetSlice setArg mOfLeftOfSet = - [ DelayedDotLookup([ident("SetSlice", mOfLeftOfSet)], mOfLeftOfSet) - DelayedApp(ExprAtomicFlag.Atomic, true, synLeftExprOpt, parenthesize (SynExpr.Tuple (false, expandedIndexArgs @ [setArg], [], idxRange)), mOfLeftOfSet) ] + let mkDelayedSetSlice indexArgs setArg mOfLeftOfSet = + [ DelayedDotLookup([ident(SetSlice, mOfLeftOfSet)], mOfLeftOfSet) + DelayedApp(ExprAtomicFlag.Atomic, true, synLeftExprOpt, parenthesize (tupleIfMultiple indexArgs (expandedIndexArgs @ [setArg])), mOfLeftOfSet) ] /// Match if we can generate a call to a `Slice` method. let (|Sliceable|_|) ((indexArgs, setInfo), exprTy) = @@ -6774,9 +6777,9 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO /// Match if the given expression is or is equivalent to System.Int32, /// ignoring units of measure if present. - let (|Int32|_|) expr = - let expr, tpenv = TcExpr cenv (MustEqual (NewInferenceType g)) env tpenv expr - if typeEquivAux EraseMeasures g (tyOfExpr g expr) g.int32_ty then Some (Int32 (expr, tpenv)) + let (|Int32|_|) synExpr = + let expr, ty, tpenv = TcExprOfUnknownType cenv env tpenv synExpr + if typeEquivAux EraseMeasures g ty g.int32_ty then Some (Int32 (expr, tpenv)) else None match indexArgs with @@ -6963,7 +6966,9 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO let propagateThenTcDelayed tpenv expr exprTy delayed = PropagateThenTcDelayed cenv overallTy env tpenv mDot (MakeApplicableExprNoFlex cenv expr) exprTy ExprAtomicFlag.Atomic delayed - match (DecodeIndexArgs cenv indexArgs, setInfo), exprTy with + let decodedIndexArgs = DecodeIndexArgs cenv indexArgs + + match (decodedIndexArgs, setInfo), exprTy with // Look for FSharp.Core array and string indexing/slicing helpers. | (_, Array) & (ArrayIndexerOrSlicer (path, meth, args), _) | (_, String) & (StringIndexerOrSlicer (path, meth, args), _) -> tcArrayOrStringIndexing (path, meth, args) @@ -6971,11 +6976,11 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO // Look for an indexer property or method, or delay lookup while assuming `Item`. | (Indexing, Getting), Indexable indexer | (Indexing, Getting), (Array | Nominal) & PossiblyIndexable indexer -> - propagateThenTcDelayed tpenv expr exprTy (mkDelayedIndexedGet indexer @ delayed) + propagateThenTcDelayed tpenv expr exprTy (mkDelayedIndexedGet indexer decodedIndexArgs @ delayed) // Look for `GetSlice`. | (Slicing, Getting), Nominal & GetSliceable slicer -> - propagateThenTcDelayed tpenv expr exprTy (mkDelayedGetSlice slicer @ delayed) + propagateThenTcDelayed tpenv expr exprTy (mkDelayedGetSlice slicer decodedIndexArgs @ delayed) // In the absence of `GetSlice`, look for `Slice`. | ((Slicing, Getting), Nominal) & Sliceable (tpenv, expr, exprTy) -> @@ -6983,16 +6988,16 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO // In the immediate absence of either, delay lookup while assuming `GetSlice`. | (Slicing, Getting), PossiblyGetSliceable slicer -> - propagateThenTcDelayed tpenv expr exprTy (mkDelayedGetSlice slicer @ delayed) + propagateThenTcDelayed tpenv expr exprTy (mkDelayedGetSlice slicer decodedIndexArgs @ delayed) // Look for an indexer property or method, or delay lookup while assuming `Item`. | (Indexing, Setting (setArg, mOfLeftOfSet)), Indexable indexer | (Indexing, Setting (setArg, mOfLeftOfSet)), (Array | Nominal) & PossiblyIndexable indexer -> - propagateThenTcDelayed tpenv expr exprTy (mkDelayedIndexedSet indexer setArg mOfLeftOfSet @ delayed) + propagateThenTcDelayed tpenv expr exprTy (mkDelayedIndexedSet indexer decodedIndexArgs setArg mOfLeftOfSet @ delayed) // Delay lookup of `SetSlice`. | (Slicing, Setting (setArg, mOfLeftOfSet)), (Array | Nominal) -> - propagateThenTcDelayed tpenv expr exprTy (mkDelayedSetSlice setArg mOfLeftOfSet @ delayed) + propagateThenTcDelayed tpenv expr exprTy (mkDelayedSetSlice decodedIndexArgs setArg mOfLeftOfSet @ delayed) | _ -> // deprecated constrained lookup From b4d322455ea4b6564c97d358861dbace35233fd8 Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Wed, 3 Jul 2024 13:29:01 -0400 Subject: [PATCH 6/8] Update comments --- src/Compiler/Checking/CheckExpressions.fs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 1ccd00c286e..1b8de018388 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -6973,7 +6973,7 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO | (_, Array) & (ArrayIndexerOrSlicer (path, meth, args), _) | (_, String) & (StringIndexerOrSlicer (path, meth, args), _) -> tcArrayOrStringIndexing (path, meth, args) - // Look for an indexer property or method, or delay lookup while assuming `Item`. + // Look for an indexer property, or else assume `Item`. | (Indexing, Getting), Indexable indexer | (Indexing, Getting), (Array | Nominal) & PossiblyIndexable indexer -> propagateThenTcDelayed tpenv expr exprTy (mkDelayedIndexedGet indexer decodedIndexArgs @ delayed) @@ -6986,16 +6986,16 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO | ((Slicing, Getting), Nominal) & Sliceable (tpenv, expr, exprTy) -> propagateThenTcDelayed tpenv expr exprTy delayed - // In the immediate absence of either, delay lookup while assuming `GetSlice`. + // In the immediate absence of either, assume `GetSlice`. | (Slicing, Getting), PossiblyGetSliceable slicer -> propagateThenTcDelayed tpenv expr exprTy (mkDelayedGetSlice slicer decodedIndexArgs @ delayed) - // Look for an indexer property or method, or delay lookup while assuming `Item`. + // Look for an indexer property, or else assume `Item`. | (Indexing, Setting (setArg, mOfLeftOfSet)), Indexable indexer | (Indexing, Setting (setArg, mOfLeftOfSet)), (Array | Nominal) & PossiblyIndexable indexer -> propagateThenTcDelayed tpenv expr exprTy (mkDelayedIndexedSet indexer decodedIndexArgs setArg mOfLeftOfSet @ delayed) - // Delay lookup of `SetSlice`. + // Assume `SetSlice`. | (Slicing, Setting (setArg, mOfLeftOfSet)), (Array | Nominal) -> propagateThenTcDelayed tpenv expr exprTy (mkDelayedSetSlice decodedIndexArgs setArg mOfLeftOfSet @ delayed) From 4e0779bf65fbdf79af9c0257bdad7a36625e6a68 Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Wed, 3 Jul 2024 14:56:31 -0400 Subject: [PATCH 7/8] Need span --- .../MethodsAndProperties/MethodsAndProperties.fs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/MethodsAndProperties/MethodsAndProperties.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/MethodsAndProperties/MethodsAndProperties.fs index e838296d639..a2bfd5fbfdb 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/MethodsAndProperties/MethodsAndProperties.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/MethodsAndProperties/MethodsAndProperties.fs @@ -669,6 +669,9 @@ type GenericIndexer<'indexerArgs,'indexerOutput,'indexerInput>() = |> shouldFail |> withSingleDiagnostic (Warning 3581, Line 9, Col 17, Line 9, Col 21, "An indexed property's getter and setter must have the same type. Property 'Item' has getter of type ''indexerOutput' but setter of type ''indexerInput'.") +// Strictly speaking, some of these could be made to work for netfx, +// but they would require more custom setup (since we couldn't use ReadOnlySpan.Slice). +#if NETCOREAPP2_1_OR_GREATER module Slicing = let [] SupportedVersion = "preview" @@ -1044,3 +1047,4 @@ type GenericIndexer<'indexerArgs,'indexerOutput,'indexerInput>() = |> withLangVersion SupportedVersion |> runFsi |> shouldSucceed +#endif From aa73a39128a2bcb6ba8482207da600b3406a6b07 Mon Sep 17 00:00:00 2001 From: Brian Rourke Boll Date: Wed, 3 Jul 2024 16:27:11 -0400 Subject: [PATCH 8/8] Support `Count` as well * The C# spec defines "countable" types as those having either a `Length` getter, a `Count` getter, or both; if both, `Length` is preferred. See: https://github.com/dotnet/csharplang/blob/d9caa3ce753a6b9583da9bdeba316bcb0fe84d44/proposals/csharp-8.0/ranges.md#implicit-index-support --- src/Compiler/Checking/CheckExpressions.fs | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 1b8de018388..59488ead5d4 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -6660,6 +6660,15 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO | [] -> None | matchingMembers -> choose matchingMembers + /// Try to find an instance getter with the given name and return type. + let tryFindInstanceGetter name exprTy retTy = + TryFindIntrinsicPropInfo cenv.infoReader mWholeExpr env.AccessRights name exprTy + |> List.tryFind (fun propInfo -> + not propInfo.IsStatic + && propInfo.HasGetter + && propInfo.GetterMethod.IsNullary + && typeEquivAux EraseMeasures g retTy (propInfo.GetterMethod.GetFSharpReturnType(cenv.amap, mWholeExpr, []))) + /// The `Item` property name. let Item = "Item" @@ -6675,14 +6684,17 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO /// The `Length` property name. let Length = "Length" + /// The `Count` property name. + let Count = "Count" + /// Try to find a `GetSlice` method. - /// If we have a `GetSlice` method, we don't need a `Length` getter. + /// If we have a `GetSlice` method, we don't need a `Length` or `Count` getter. let tryFindGetSlice exprTy = exprTy |> tryFindMember (tryFindMatchingMeths GetSlice (fun _ -> Some GetSlice)) /// Try to find a `Slice` method with a single 2-tuple parameter. - /// If we have a `Slice` method, we also need a `Length` getter. + /// If we have a `Slice` method, we also need a `Length` or `Count` getter. let tryFindSlice exprTy = exprTy |> tryFindMember (tryFindMatchingMeths Slice (List.tryPick (fun slice -> @@ -6690,8 +6702,8 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO | [[_; _] as tys] when tys |> List.forall (typeEquivAux EraseMeasures g g.int32_ty) -> Some slice | _ -> None))) |> Option.bind (fun sliceOverloads -> - // TODO: What about Length: int? - TryFindFSharpSignatureInstanceGetterProperty cenv env expr.Range Length exprTy [g.int32_ty] + tryFindInstanceGetter Length exprTy g.int32_ty + |> Option.orElseWith (fun () -> tryFindInstanceGetter Count exprTy g.int32_ty) |> Option.map (fun getLength -> sliceOverloads, getLength.GetterMethod)) /// Whether the syntactic arguments are