Merge pull request #15858 from dotnet/merges/main-to-release/dev17.8

Author: vzarytovskii

src/Compiler/Checking/CheckExpressions.fs

@@ -1796,6 +1796,12 @@ let FreshenAbstractSlot g amap m synTyparDecls absMethInfo =
     let retTyFromAbsSlot = retTy |> GetFSharpViewOfReturnType g |> instType typarInstFromAbsSlot
     typarsFromAbsSlotAreRigid, typarsFromAbsSlot, argTysFromAbsSlot, retTyFromAbsSlot
 
+let CheckRecdExprDuplicateFields (elems: Ident list) =
+    elems |> List.iteri (fun i (uc1: Ident) -> 
+        elems |> List.iteri (fun j (uc2: Ident) -> 
+            if j > i && uc1.idText = uc2.idText then 
+               errorR (Error(FSComp.SR.tcMultipleFieldsInRecord(uc1.idText), uc1.idRange))))
+
 //-------------------------------------------------------------------------
 // Helpers to typecheck expressions and patterns
 //-------------------------------------------------------------------------
@@ -1807,9 +1813,14 @@ let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * '
 
     if isNil flds then invalidArg "flds" "BuildFieldMap"
 
-    let fldCount = flds.Length
+    let allFields = flds |> List.map (fun ((_, ident), _) -> ident)
+    if allFields.Length > 1 then
+        // In the case of nested record fields on the same level in record copy-and-update.
+        // We need to reverse the list to get the correct order of fields.
+        let idents = if isPartial then allFields |> List.rev else allFields
+        CheckRecdExprDuplicateFields idents
+
     let fldResolutions =
-        let allFields = flds |> List.map (fun ((_, ident), _) -> ident)
         flds
         |> List.choose (fun (fld, fldExpr) ->
             try
@@ -1838,7 +1849,7 @@ let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * '
                 warning (Error(FSComp.SR.tcFieldsDoNotDetermineUniqueRecordType(), m))
 
             // try finding a record type with the same number of fields as the ones that are given.
-            match tcrefs |> List.tryFind (fun (_, tc) -> tc.TrueFieldsAsList.Length = fldCount) with
+            match tcrefs |> List.tryFind (fun (_, tc) -> tc.TrueFieldsAsList.Length =  flds.Length) with
             | Some (tinst, tcref) -> tinst, tcref
             | _ ->
                 // OK, there isn't a unique, good type dictated by the intersection for the field refs.
@@ -1863,8 +1874,6 @@ let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * '
 
                     CheckFSharpAttributes g fref2.PropertyAttribs ident.idRange |> CommitOperationResult
 
-                    if Map.containsKey fref2.FieldName fs then
-                        errorR (Error(FSComp.SR.tcFieldAppearsTwiceInRecord(fref2.FieldName), m))
                     if showDeprecated then
                         let diagnostic = Deprecated(FSComp.SR.nrRecordTypeNeedsQualifiedAccess(fref2.FieldName, fref2.Tycon.DisplayName) |> snd, m)
                         if g.langVersion.SupportsFeature(LanguageFeature.ErrorOnDeprecatedRequireQualifiedAccess) then
@@ -8152,7 +8161,7 @@ and TcNameOfExpr (cenv: cenv) env tpenv (synArg: SynExpr) =
 
 and TcNameOfExprResult (cenv: cenv) (lastIdent: Ident) m =
     let g = cenv.g
-    let constRange = mkRange m.FileName m.Start (mkPos m.StartLine (m.StartColumn + lastIdent.idText.Length + 2)) // `2` are for quotes
+    let constRange = withEnd (mkPos m.StartLine (m.StartColumn + lastIdent.idText.Length + 2)) m // `2` are for quotes
     Expr.Const(Const.String(lastIdent.idText), constRange, g.string_ty)
 
 //-------------------------------------------------------------------------

src/Compiler/Checking/CheckPatterns.fs

@@ -309,11 +309,6 @@ and TcPat warnOnUpper (cenv: cenv) env valReprInfo vFlags (patEnv: TcPatLinearEn
     | SynPat.Record (flds, m) ->
         TcRecordPat warnOnUpper cenv env vFlags patEnv ty flds m
 
-    | SynPat.DeprecatedCharRange (c1, c2, m) ->
-        errorR(Deprecated(FSComp.SR.tcUseWhenPatternGuard(), m))
-        UnifyTypes cenv env m ty g.char_ty
-        (fun _ -> TPat_range(c1, c2, m)), patEnv
-
     | SynPat.Null m ->
         TcNullPat cenv env patEnv ty m
 
@@ -441,7 +436,7 @@ and TcPatArrayOrList warnOnUpper cenv env vFlags patEnv ty isArray args m =
 
 and TcRecordPat warnOnUpper cenv env vFlags patEnv ty fieldPats m =
     let fieldPats = fieldPats |> List.map (fun (fieldId, _, fieldPat) -> fieldId, fieldPat)
-    match BuildFieldMap cenv env true ty fieldPats m with
+    match BuildFieldMap cenv env false ty fieldPats m with
     | None -> (fun _ -> TPat_error m), patEnv
     | Some(tinst, tcref, fldsmap, _fldsList) ->
 

src/Compiler/Checking/CheckRecordSyntaxHelpers.fs

@@ -79,14 +79,14 @@ let TransformAstForNestedUpdates (cenv: TcFileState) (env: TcEnv) overallTy (lid
                 | [ _ ] -> [ origSepRng ]
                 | _ :: t ->
                     origSepRng
-                    :: List.map (fun (s: Ident, e: Ident) -> mkRange s.idRange.FileName s.idRange.End e.idRange.Start) t
+                    :: List.map (fun (s: Ident, e: Ident) -> withStartEnd s.idRange.End e.idRange.Start s.idRange) t
 
             let lid = buildLid [] id lidwd |> List.rev
 
             (lid, List.pairwise lid |> calcLidSeparatorRanges origSepRng)
 
         let totalRange (origId: Ident) (id: Ident) =
-            mkRange origId.idRange.FileName origId.idRange.End id.idRange.Start
+            withStartEnd origId.idRange.End id.idRange.Start origId.idRange
 
         let rangeOfBlockSeperator (id: Ident) =
             let idEnd = id.idRange.End
@@ -95,7 +95,7 @@ let TransformAstForNestedUpdates (cenv: TcFileState) (env: TcEnv) overallTy (lid
             let blockSeperatorStartPos = mkPos idEnd.Line blockSeperatorStartCol
             let blockSeporatorEndPos = mkPos idEnd.Line blockSeperatorEndCol
 
-            mkRange id.idRange.FileName blockSeperatorStartPos blockSeporatorEndPos
+            withStartEnd blockSeperatorStartPos blockSeporatorEndPos id.idRange
 
         match withExpr with
         | SynExpr.Ident origId, (sepRange, _) ->

src/Compiler/Checking/PatternMatchCompilation.fs

@@ -23,6 +23,7 @@ open FSharp.Compiler.TypedTreeBasics
 open FSharp.Compiler.TypedTreeOps
 open FSharp.Compiler.TypedTreeOps.DebugPrint
 open FSharp.Compiler.TypeRelations
+open type System.MemoryExtensions
 
 exception MatchIncomplete of bool * (string * bool) option * range
 exception RuleNeverMatched of range
@@ -48,7 +49,6 @@ type Pattern =
     | TPat_tuple of  TupInfo * Pattern list * TType list * range
     | TPat_array of  Pattern list * TType * range
     | TPat_recd of TyconRef * TypeInst * Pattern list * range
-    | TPat_range of char * char * range
     | TPat_null of range
     | TPat_isinst of TType * TType * Pattern option * range
     | TPat_error of range
@@ -66,7 +66,6 @@ type Pattern =
         | TPat_tuple(_, _, _, m) -> m
         | TPat_array(_, _, m) -> m
         | TPat_recd(_, _, _, m) -> m
-        | TPat_range(_, _, m) -> m
         | TPat_null m -> m
         | TPat_isinst(_, _, _, m) -> m
         | TPat_error m -> m
@@ -720,7 +719,7 @@ let discrimWithinSimultaneousClass g amap m discrim prev =
 let canInvestigate (pat: Pattern) =
     match pat with
     | TPat_null _ | TPat_isinst _ | TPat_exnconstr _ | TPat_unioncase _
-    | TPat_array _ | TPat_const _ | TPat_query _ | TPat_range _ | TPat_error _ -> true
+    | TPat_array _ | TPat_const _ | TPat_query _ | TPat_error _ -> true
     | _ -> false
 
 /// Decide the next pattern to investigate
@@ -905,43 +904,37 @@ let rec layoutPat pat =
 let mkFrontiers investigations clauseNumber =
      investigations |> List.map (fun (actives, valMap) -> Frontier(clauseNumber, actives, valMap))
 
+let singleFalseInvestigationPoint = [| false |]
+
 // Search for pattern decision points that are decided "one at a time" - i.e. where there is no
 // multi-way switching. For example partial active patterns
 let rec investigationPoints inpPat =
-    seq { 
-        match inpPat with
-        | TPat_query ((_, _, _, _, _, apinfo), subPat, _) ->
-            yield not apinfo.IsTotal
-            yield! investigationPoints subPat
-        | TPat_isinst (_, _tgtTy, subPatOpt, _) -> 
-            yield false
-            match subPatOpt with 
-            | None -> ()
-            | Some subPat ->
-                yield! investigationPoints subPat
-        | TPat_as (subPat, _, _) -> 
-            yield! investigationPoints subPat
-        | TPat_disjs (subPats, _)
-        | TPat_conjs(subPats, _)
-        | TPat_tuple (_, subPats, _, _)
-        | TPat_recd (_, _, subPats, _) -> 
-            for subPat in subPats do 
-                yield! investigationPoints subPat
-        | TPat_exnconstr(_, subPats, _) ->
-            for subPat in subPats do 
-                yield! investigationPoints subPat
-        | TPat_array (subPats, _, _)
-        | TPat_unioncase (_, _, subPats, _) ->
-            yield false
-            for subPat in subPats do 
-                yield! investigationPoints subPat
-        | TPat_range _
-        | TPat_null _ 
-        | TPat_const _ ->
-            yield false
-        | TPat_wild _
-        | TPat_error _ -> ()
-    }
+    match inpPat with
+    | TPat_query((_, _, _, _, _, apinfo), subPat, _) ->
+        Array.prepend (not apinfo.IsTotal) (investigationPoints subPat)
+    | TPat_isinst(_, _tgtTy, subPatOpt, _) -> 
+        match subPatOpt with 
+        | None -> singleFalseInvestigationPoint
+        | Some subPat -> Array.prepend false (investigationPoints subPat)
+    | TPat_as(subPat, _, _) -> investigationPoints subPat
+    | TPat_disjs(subPats, _)
+    | TPat_conjs(subPats, _)
+    | TPat_tuple(_, subPats, _, _)
+    | TPat_exnconstr(_, subPats, _)
+    | TPat_recd(_, _, subPats, _) ->
+        subPats
+        |> Seq.collect investigationPoints
+        |> Seq.toArray
+    | TPat_array (subPats, _, _)
+    | TPat_unioncase (_, _, subPats, _) ->
+        subPats
+        |> Seq.collect investigationPoints
+        |> Seq.toArray
+        |> Array.prepend false
+    | TPat_null _ 
+    | TPat_const _ -> singleFalseInvestigationPoint
+    | TPat_wild _
+    | TPat_error _ -> [||]
 
 let rec erasePartialPatterns inpPat =
     match inpPat with
@@ -959,7 +952,6 @@ let rec erasePartialPatterns inpPat =
     | TPat_isinst (x, y, subPatOpt, m) -> TPat_isinst (x, y, Option.map erasePartialPatterns subPatOpt, m)
     | TPat_const _
     | TPat_wild _
-    | TPat_range _
     | TPat_null _
     | TPat_error _ -> inpPat
 
@@ -1002,7 +994,6 @@ let rec isPatternDisjunctive inpPat =
     | TPat_isinst (_, _, subPatOpt, _) -> Option.exists isPatternDisjunctive subPatOpt
     | TPat_const _ -> false
     | TPat_wild _ -> false
-    | TPat_range _ -> false
     | TPat_null _ -> false
     | TPat_error _ -> false
 
@@ -1605,8 +1596,6 @@ let CompilePatternBasic
                 | _ ->
                     [frontier]
 
-            | _ -> failwith "pattern compilation: GenerateNewFrontiersAfterSuccessfulInvestigation"
-
         else
             [frontier]
 
@@ -1646,12 +1635,6 @@ let CompilePatternBasic
             let newActives = List.mapi (mkSubActive (fun path _j -> path) (fun _j -> inpAccess)) subPats
             BindProjectionPatterns newActives activeState
 
-        | TPat_range (c1, c2, m) ->
-            let mutable res = []
-            for i = int c1 to int c2 do
-                res <- BindProjectionPattern (Active(inpPath, inpExpr, TPat_const(Const.Char(char i), m))) activeState @ res
-            res
-
         // Assign an identifier to each TPat_query based on our knowledge of the 'identity' of the active pattern, if any
         | TPat_query ((_, _, _, apatVrefOpt, _, _), _, _) ->
             let uniqId =
@@ -1740,16 +1723,13 @@ let CompilePatternBasic
 // So disjunction alone isn't considered problematic, but in combination with 'when' patterns
 
 let isProblematicClause (clause: MatchClause) =
-    let ips = 
-        seq { 
-             yield! investigationPoints clause.Pattern
-             if clause.GuardExpr.IsSome then
-                 yield true
-        } |> Seq.toArray
-    let ips = if isPatternDisjunctive clause.Pattern then Array.append ips ips else ips
-    // Look for multiple decision points.
-    // We don't mind about the last logical decision point
-    ips.Length > 0 && Array.exists id ips[0..ips.Length-2] 
+    if clause.GuardExpr.IsSome then
+        isPatternDisjunctive clause.Pattern || Array.exists id (investigationPoints clause.Pattern)
+    else
+        // Look for multiple decision points.
+        // We don't mind about the last logical decision point
+        let ips = investigationPoints clause.Pattern
+        ips.Length > 0 && Span.exists id (ips.AsSpan (0, ips.Length - 1))
 
 let rec CompilePattern  g denv amap tcVal infoReader mExpr mMatch warnOnUnused actionOnFailure (origInputVal, origInputValTypars, origInputExprOpt) (clausesL: MatchClause list) inputTy resultTy =
     match clausesL with

src/Compiler/Checking/PatternMatchCompilation.fsi

@@ -33,7 +33,6 @@ type Pattern =
     | TPat_tuple of TupInfo * Pattern list * TType list * range
     | TPat_array of Pattern list * TType * range
     | TPat_recd of TyconRef * TypeInst * Pattern list * range
-    | TPat_range of char * char * range
     | TPat_null of range
     | TPat_isinst of TType * TType * Pattern option * range
     | TPat_error of range