Support constraint intersection syntax

src/Compiler/Checking/CheckExpressions.fs

@@ -4377,6 +4377,9 @@ and TcTypeOrMeasure kindOpt (cenv: cenv) newOk checkConstraints occ (iwsam: Warn
     | SynType.HashConstraint(synInnerTy, m) ->
         TcTypeHashConstraint cenv env newOk checkConstraints occ tpenv synInnerTy m
 
+    | SynType.Intersection (synTypar, types, m) ->
+        TcIntersectionConstraint cenv env newOk checkConstraints occ tpenv synTypar types m
+
     | SynType.StaticConstant (synConst, m) ->
         TcTypeStaticConstant kindOpt tpenv synConst m
 
@@ -4562,6 +4565,33 @@ and TcTypeHashConstraint (cenv: cenv) env newOk checkConstraints occ tpenv synTy
     AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace ty (mkTyparTy tp)
     tp.AsType, tpenv
 
+// (x: 't & #I1 & #I2)
+// (x: #I1 & #I2)
+and TcIntersectionConstraint (cenv: cenv) env newOk checkConstraints occ tpenv synTypar synTys m =
+    checkLanguageFeatureAndRecover cenv.g.langVersion LanguageFeature.ConstraintIntersectionOnFlexibleTypes m
+
+    let tp, tpenv =
+        match synTypar with
+        | Some synTypar -> TcTypeOrMeasureParameter (Some TyparKind.Type) cenv env newOk tpenv synTypar
+        | _ -> TcAnonTypeOrMeasure (Some TyparKind.Type) cenv TyparRigidity.WarnIfNotRigid TyparDynamicReq.Yes newOk m, tpenv
+
+    let typarTy = mkTyparTy tp
+
+    let tpenv =
+        synTys
+        |> List.fold (fun tpenv ty ->
+            match ty with
+            | SynType.HashConstraint (ty, m) ->
+                let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.No env tpenv ty
+                AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace ty typarTy
+                tpenv
+            | _ ->
+                errorR(Error(FSComp.SR.tcConstraintIntersectionSyntaxUsedWithNonFlexibleType(), ty.Range))
+                tpenv
+        ) tpenv
+
+    tp.AsType, tpenv
+
 and TcTypeStaticConstant kindOpt tpenv c m =
     match c, kindOpt with
     | _, Some TyparKind.Type ->

src/Compiler/Driver/GraphChecking/FileContentMapping.fs

@@ -261,6 +261,9 @@ let visitSynType (t: SynType) : FileContentEntry list =
             let continuations = List.map visit [ lhsType; rhsType ]
             Continuation.concatenate continuations continuation
         | SynType.FromParseError _ -> continuation []
+        | SynType.Intersection (types = types) ->
+            let continuations = List.map visit types
+            Continuation.concatenate continuations continuation
 
     visit t id
 

src/Compiler/FSComp.txt

@@ -1575,6 +1575,7 @@ featureExtendedStringInterpolation,"Extended string interpolation similar to C#
 featureWarningWhenMultipleRecdTypeChoice,"Raises warnings when multiple record type matches were found during name resolution because of overlapping field names."
 featureImprovedImpliedArgumentNames,"Improved implied argument names"
 featureStrictIndentation,"Raises errors on incorrect indentation, allows better recovery and analysis during editing"
+featureConstraintIntersectionOnFlexibleTypes,"Constraint intersection on flexible types"
 3353,fsiInvalidDirective,"Invalid directive '#%s %s'"
 3354,tcNotAFunctionButIndexerNamedIndexingNotYetEnabled,"This value supports indexing, e.g. '%s.[index]'. The syntax '%s[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation."
 3354,tcNotAFunctionButIndexerIndexingNotYetEnabled,"This expression supports indexing, e.g. 'expr.[index]'. The syntax 'expr[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation."
@@ -1697,4 +1698,5 @@ featureEscapeBracesInFormattableString,"Escapes curly braces before calling Form
 3565,parsExpectingType,"Expecting type"
 featureInformationalObjInferenceDiagnostic,"Diagnostic 3559 (warn when obj inferred) at informational level, off by default"
 3566,tcMultipleRecdTypeChoice,"Multiple type matches were found:\n%s\nThe type '%s' was used. Due to the overlapping field names\n%s\nconsider using type annotations or change the order of open statements."
-3567,parsMissingMemberBody,"Expecting member body"
+3567,parsMissingMemberBody,"Expecting member body"
+3568,tcConstraintIntersectionSyntaxUsedWithNonFlexibleType,"Constraint intersection syntax may only be used with flexible types, e.g. '#IDisposable & #ISomeInterface'."

src/Compiler/Facilities/LanguageFeatures.fs

@@ -71,6 +71,7 @@ type LanguageFeature =
     | WarningWhenMultipleRecdTypeChoice
     | ImprovedImpliedArgumentNames
     | DiagnosticForObjInference
+    | ConstraintIntersectionOnFlexibleTypes
 
 /// LanguageVersion management
 type LanguageVersion(versionText) =
@@ -165,6 +166,7 @@ type LanguageVersion(versionText) =
                 LanguageFeature.ImprovedImpliedArgumentNames, previewVersion
                 LanguageFeature.DiagnosticForObjInference, previewVersion
                 LanguageFeature.StrictIndentation, previewVersion
+                LanguageFeature.ConstraintIntersectionOnFlexibleTypes, previewVersion
 
             ]
 
@@ -291,6 +293,7 @@ type LanguageVersion(versionText) =
         | LanguageFeature.ImprovedImpliedArgumentNames -> FSComp.SR.featureImprovedImpliedArgumentNames ()
         | LanguageFeature.DiagnosticForObjInference -> FSComp.SR.featureInformationalObjInferenceDiagnostic ()
         | LanguageFeature.StrictIndentation -> FSComp.SR.featureStrictIndentation ()
+        | LanguageFeature.ConstraintIntersectionOnFlexibleTypes -> FSComp.SR.featureConstraintIntersectionOnFlexibleTypes ()
 
     /// Get a version string associated with the given feature.
     static member GetFeatureVersionString feature =

src/Compiler/Facilities/LanguageFeatures.fsi

@@ -61,6 +61,7 @@ type LanguageFeature =
     | WarningWhenMultipleRecdTypeChoice
     | ImprovedImpliedArgumentNames
     | DiagnosticForObjInference
+    | ConstraintIntersectionOnFlexibleTypes
 
 /// LanguageVersion management
 type LanguageVersion =

src/Compiler/Service/ServiceParseTreeWalk.fs

@@ -844,6 +844,7 @@ module SyntaxTraversal =
                 | SynType.StaticConstantExpr (expr, _) -> traverseSynExpr [] expr
                 | SynType.Paren (innerType = t)
                 | SynType.SignatureParameter (usedType = t) -> traverseSynType path t
+                | SynType.Intersection (types = types) -> List.tryPick (traverseSynType path) types
                 | SynType.Anon _
                 | SynType.AnonRecd _
                 | SynType.LongIdent _

src/Compiler/Service/ServiceParsedInputOps.fs

@@ -681,6 +681,7 @@ module ParsedInput =
             | SynType.SignatureParameter (usedType = t) -> walkType t
             | SynType.StaticConstantExpr (e, _) -> walkExpr e
             | SynType.StaticConstantNamed (ident, value, _) -> List.tryPick walkType [ ident; value ]
+            | SynType.Intersection (types = types) -> List.tryPick walkType types
             | SynType.Anon _
             | SynType.AnonRecd _
             | SynType.LongIdent _
@@ -1699,6 +1700,7 @@ module ParsedInput =
             | SynType.StaticConstantNamed (ident, value, _) ->
                 walkType ident
                 walkType value
+            | SynType.Intersection (types = types) -> List.iter walkType types
             | SynType.Anon _
             | SynType.AnonRecd _
             | SynType.Var _

src/Compiler/SyntaxTree/LexFilter.fs

@@ -1117,7 +1117,7 @@ type LexFilterImpl (
                     //      f<{| C : int |}>x
                     //      f<x # x>x
                     //      f<x ' x>x
-                    | DEFAULT | COLON | COLON_GREATER | STRUCT | NULL | DELEGATE | AND | WHEN
+                    | DEFAULT | COLON | COLON_GREATER | STRUCT | NULL | DELEGATE | AND | WHEN | AMP
                     | DOT_DOT
                     | NEW
                     | LBRACE_BAR

src/Compiler/SyntaxTree/SyntaxTree.fs

@@ -443,6 +443,8 @@ type SynType =
 
     | FromParseError of range: range
 
+    | Intersection of typar: SynTypar option * types: SynType list * range: range
+
     member x.Range =
         match x with
         | SynType.App (range = m)
@@ -462,6 +464,7 @@ type SynType =
         | SynType.Paren (range = m)
         | SynType.SignatureParameter (range = m)
         | SynType.Or (range = m)
+        | SynType.Intersection (range = m)
         | SynType.FromParseError (range = m) -> m
         | SynType.LongIdent lidwd -> lidwd.Range
 

src/Compiler/SyntaxTree/SyntaxTree.fsi

@@ -521,6 +521,11 @@ type SynType =
     /// A type arising from a parse error
     | FromParseError of range: range
 
+    /// F# syntax: x: #I1 & #I2
+    /// F# syntax: x: 't & #I1 & #I2
+    /// Shorthand for x: 't when 't :> I1 and 't :> I2
+    | Intersection of typar: SynTypar option * types: SynType list * range: range
+
     /// Gets the syntax range of this construct
     member Range: range
 

src/Compiler/pars.fsy

@@ -2367,6 +2367,15 @@ typeConstraints:
   | typeConstraint
      { [$1] }
 
+/* Any tokens in this grammar must be added to the lex filter rule 'peekAdjacentTypars' */
+/* See the F# specification "Lexical analysis of type applications and type parameter definitions" */
+intersectionConstraints:
+  | intersectionConstraints AMP atomType %prec prec_no_more_attr_bindings // todo precedence
+      { $3 :: $1 }
+
+  | atomType
+      { [ $1 ] }
+
 /* Any tokens in this grammar must be added to the lex filter rule 'peekAdjacentTypars' */
 /* See the F# specification "Lexical analysis of type applications and type parameter definitions" */
 typeConstraint:
@@ -5653,6 +5662,15 @@ tupleOrQuotTypeElements:
   | appType %prec prec_tuptyptail_prefix
       { [ SynTupleTypeSegment.Type $1 ] }
 
+/* Any tokens in this grammar must be added to the lex filter rule 'peekAdjacentTypars' */
+/* See the F# specification "Lexical analysis of type applications and type parameter definitions" */
+intersectionType:
+  | typar AMP intersectionConstraints %prec prec_no_more_attr_bindings // todo precedence
+      { SynType.Intersection(Some $1, $3, lhs parseState) }
+
+  | atomType AMP intersectionConstraints %prec prec_no_more_attr_bindings // todo precedence
+    { SynType.Intersection(None, $1 :: $3, lhs parseState) }
+
 appTypeCon:
   | path %prec prec_atomtyp_path
     { SynType.LongIdent($1) }
@@ -5691,6 +5709,9 @@ appType:
   | powerType
       { $1 }
 
+  | intersectionType
+      { $1 }
+
   | typar COLON_GREATER typ
       { let tp, typ = $1, $3
         let m = lhs parseState