Support constraint intersection syntax

src/Compiler/Checking/CheckDeclarations.fs

@@ -2637,7 +2637,7 @@ module EstablishTypeDefinitionCores =
         suppressErrorReporting (fun () -> 
             synTypars|> List.forall (fun synTypar ->
                 try
-                    let (SynTyparDecl(Attributes synAttrs, _)) = synTypar
+                    let (SynTyparDecl (attributes = Attributes synAttrs)) = synTypar
                     let attrs = TcAttributes cenv env AttributeTargets.GenericParameter synAttrs
                     HasFSharpAttribute cenv.g cenv.g.attrib_MeasureAttribute attrs
                 with _ -> false))
@@ -4049,7 +4049,7 @@ module TcDeclarations =
                     if tcref.TyparsNoRange.Length = synTypars.Length then
                         (tcref.TyparsNoRange, synTypars)
                         ||> List.zip
-                        |> List.iter (fun (typar, SynTyparDecl.SynTyparDecl(_, SynTypar(ident = untypedIdent))) ->
+                        |> List.iter (fun (typar, SynTyparDecl.SynTyparDecl (typar = SynTypar (ident = untypedIdent))) ->
                             typar.SetIdent(untypedIdent)
                         )
 

src/Compiler/Checking/CheckExpressions.fs

@@ -4306,8 +4306,8 @@ and TcTypar (cenv: cenv) env newOk tpenv tp : Typar * UnscopedTyparEnv =
 
 and TcTyparDecl (cenv: cenv) env synTyparDecl =
     let g = cenv.g
-    let (SynTyparDecl(Attributes synAttrs, synTypar)) = synTyparDecl
-    let (SynTypar(id, _, _)) = synTypar
+    let (SynTyparDecl (attributes = Attributes synAttrs; typar = synTypar)) = synTyparDecl
+    let (SynTypar (ident = id)) = synTypar
 
     let attrs = TcAttributes cenv env AttributeTargets.GenericParameter synAttrs
     let hasMeasureAttr = HasFSharpAttribute g g.attrib_MeasureAttribute attrs
@@ -4384,6 +4384,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 (tp, tys, m, _) ->
+        TcIntersectionConstraint cenv env newOk checkConstraints occ tpenv tp tys m
+
     | SynType.StaticConstant (synConst, m) ->
         TcTypeStaticConstant kindOpt tpenv synConst m
 
@@ -4569,6 +4572,29 @@ 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 =
+    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
+            | _ -> 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
 
@@ -275,7 +278,8 @@ let visitSynTyparDecls (td: SynTyparDecls) : FileContentEntry list =
     | SynTyparDecls.PrefixList (decls = decls) -> List.collect visitSynTyparDecl decls
     | SynTyparDecls.SinglePrefix (decl = decl) -> visitSynTyparDecl decl
 
-let visitSynTyparDecl (SynTyparDecl (attributes = attributes)) = visitSynAttributes attributes
+let visitSynTyparDecl (SynTyparDecl (attributes = attributes; intersectionConstraints = constraints)) =
+    visitSynAttributes attributes @ List.collect visitSynType constraints
 
 let visitSynTypeConstraint (tc: SynTypeConstraint) : FileContentEntry list =
     match tc with

src/Compiler/FSComp.txt

@@ -1580,6 +1580,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"
 featureChkNotTailRecursive,"Raises warnings if a member or function has the 'TailCall' attribute, but is not being used in a tail recursive way."
 featureWhileBang,"'while!' expression"
 3353,fsiInvalidDirective,"Invalid directive '#%s %s'"
@@ -1706,6 +1707,7 @@ featureInformationalObjInferenceDiagnostic,"Diagnostic 3559 (warn when obj infer
 featureStaticLetInRecordsDusEmptyTypes,"Allow static let bindings in union, record, struct, non-incremental-class types"
 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"
+3572,parsConstraintIntersectionSyntaxUsedWithNonFlexibleType,"Constraint intersection syntax may only be used with flexible types, e.g. '#IDisposable & #ISomeInterface'."
 3568,parsMissingKeyword,"Missing keyword '%s'"
 3570,tcAmbiguousDiscardDotLambda,"The meaning of _ is ambiguous here. It cannot be used for a discarded variable and a function shorthand in the same scope."
 3571,parsUnderScoreDotLambdaNonAtomic," _. shorthand syntax for lambda functions can only be used with atomic expressions. That means expressions with no whitespace unless enclosed in parentheses."

src/Compiler/Facilities/LanguageFeatures.fs

@@ -72,6 +72,7 @@ type LanguageFeature =
     | WarningWhenMultipleRecdTypeChoice
     | ImprovedImpliedArgumentNames
     | DiagnosticForObjInference
+    | ConstraintIntersectionOnFlexibleTypes
     | StaticLetInRecordsDusEmptyTypes
     | WarningWhenTailRecAttributeButNonTailRecUsage
     | UnmanagedConstraintCsharpInterop
@@ -173,6 +174,7 @@ type LanguageVersion(versionText) =
                 LanguageFeature.WarningWhenTailRecAttributeButNonTailRecUsage, previewVersion
                 LanguageFeature.StaticLetInRecordsDusEmptyTypes, previewVersion
                 LanguageFeature.StrictIndentation, previewVersion
+                LanguageFeature.ConstraintIntersectionOnFlexibleTypes, previewVersion
                 LanguageFeature.UnmanagedConstraintCsharpInterop, previewVersion
                 LanguageFeature.WhileBang, previewVersion
             ]
@@ -303,6 +305,7 @@ type LanguageVersion(versionText) =
 
         | LanguageFeature.StaticLetInRecordsDusEmptyTypes -> FSComp.SR.featureStaticLetInRecordsDusEmptyTypes ()
         | LanguageFeature.StrictIndentation -> FSComp.SR.featureStrictIndentation ()
+        | LanguageFeature.ConstraintIntersectionOnFlexibleTypes -> FSComp.SR.featureConstraintIntersectionOnFlexibleTypes ()
         | LanguageFeature.WarningWhenTailRecAttributeButNonTailRecUsage -> FSComp.SR.featureChkNotTailRecursive ()
         | LanguageFeature.UnmanagedConstraintCsharpInterop -> FSComp.SR.featureUnmanagedConstraintCsharpInterop ()
         | LanguageFeature.WhileBang -> FSComp.SR.featureWhileBang ()

src/Compiler/Facilities/LanguageFeatures.fsi

@@ -62,6 +62,7 @@ type LanguageFeature =
     | WarningWhenMultipleRecdTypeChoice
     | ImprovedImpliedArgumentNames
     | DiagnosticForObjInference
+    | ConstraintIntersectionOnFlexibleTypes
     | StaticLetInRecordsDusEmptyTypes
     | WarningWhenTailRecAttributeButNonTailRecUsage
     | UnmanagedConstraintCsharpInterop

src/Compiler/Service/ServiceParseTreeWalk.fs

@@ -737,6 +737,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

@@ -615,10 +615,11 @@ module ParsedInput =
             ifPosInRange ident.idRange (fun _ -> Some EntityKind.Type)
 
         and walkTyparDecl typarDecl =
-            let (SynTyparDecl (Attributes attrs, typar)) = typarDecl
+            let (SynTyparDecl (Attributes attrs, typar, intersectionContraints, _)) = typarDecl
 
             List.tryPick walkAttribute attrs
             |> Option.orElseWith (fun () -> walkTypar typar)
+            |> Option.orElseWith (fun () -> intersectionContraints |> List.tryPick walkType)
 
         and walkTypeConstraint cx =
             match cx with
@@ -697,6 +698,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 _
@@ -1651,9 +1653,10 @@ module ParsedInput =
             addLongIdentWithDots attr.TypeName
             walkExpr attr.ArgExpr
 
-        and walkTyparDecl (SynTyparDecl.SynTyparDecl (Attributes attrs, typar)) =
+        and walkTyparDecl (SynTyparDecl.SynTyparDecl (Attributes attrs, typar, intersectionConstraints, _)) =
             List.iter walkAttribute attrs
             walkTypar typar
+            List.iter walkType intersectionConstraints
 
         and walkTypeConstraint cx =
             match cx with
@@ -1741,6 +1744,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/Service/ServiceStructure.fs

@@ -62,7 +62,7 @@ module Structure =
         | [] -> other
         | ls ->
             ls
-            |> List.map (fun (SynTyparDecl (_, typarg)) -> typarg.Range)
+            |> List.map (fun (SynTyparDecl (typar = typarg)) -> typarg.Range)
             |> List.reduce unionRanges
 
     /// Collapse indicates the way a range/snapshot should be collapsed. `Same` is for a scope inside

src/Compiler/SyntaxTree/LexFilter.fs

@@ -1122,7 +1122,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

@@ -308,7 +308,8 @@ type SynBindingKind =
     | Do
 
 [<NoEquality; NoComparison>]
-type SynTyparDecl = SynTyparDecl of attributes: SynAttributes * SynTypar
+type SynTyparDecl =
+    | SynTyparDecl of attributes: SynAttributes * typar: SynTypar * intersectionConstraints: SynType list * trivia: SynTyparDeclTrivia
 
 [<NoEquality; NoComparison; RequireQualifiedAccess>]
 type SynTypeConstraint =
@@ -366,13 +367,28 @@ type SynTyparDecls =
 
     member x.Constraints =
         match x with
-        | PostfixList (constraints = constraints) -> constraints
+        | PostfixList (decls = decls; constraints = constraints) ->
+            // Synthesize SynTypeConstraints implied with any intersection constraints in SynTyparDecl
+            // The parser makes sure we're only dealing with hash constraints here
+            let intersectionConstraints =
+                decls
+                |> List.collect (fun (SynTyparDecl (typar = tp; intersectionConstraints = tys)) ->
+                    tys
+                    |> List.map (fun ty ->
+                        let ty =
+                            match ty with
+                            | SynType.HashConstraint (ty, _) -> ty
+                            | _ -> ty
+
+                        SynTypeConstraint.WhereTyparSubtypeOfType(tp, ty, ty.Range)))
+
+            List.append intersectionConstraints constraints
         | _ -> []
 
     member x.Range =
         match x with
         | PostfixList (range = range)
-        | PrefixList (range = range) -> range
+        | PrefixList (range = range)
         | SinglePrefix (range = range) -> range
 
 [<NoEquality; NoComparison; RequireQualifiedAccess>]
@@ -442,6 +458,8 @@ type SynType =
 
     | FromParseError of range: range
 
+    | Intersection of typar: SynTypar option * types: SynType list * range: range * trivia: SynTyparDeclTrivia
+
     member x.Range =
         match x with
         | SynType.App (range = m)
@@ -461,6 +479,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

@@ -374,7 +374,12 @@ type SynBindingKind =
 
 /// Represents the explicit declaration of a type parameter
 [<NoEquality; NoComparison>]
-type SynTyparDecl = SynTyparDecl of attributes: SynAttributes * SynTypar
+type SynTyparDecl =
+    | SynTyparDecl of
+        attributes: SynAttributes *
+        typar: SynTypar *
+        intersectionConstraints: SynType list *
+        trivia: SynTyparDeclTrivia
 
 /// The unchecked abstract syntax tree of F# type constraints
 [<NoEquality; NoComparison; RequireQualifiedAccess>]
@@ -521,6 +526,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 * trivia: SynTyparDeclTrivia
+
     /// Gets the syntax range of this construct
     member Range: range
 

src/Compiler/SyntaxTree/SyntaxTrivia.fs

@@ -401,6 +401,14 @@ type SynMemberSigMemberTrivia =
 
     static member Zero: SynMemberSigMemberTrivia = { GetSetKeywords = None }
 
+[<NoEquality; NoComparison>]
+type SynTyparDeclTrivia =
+    {
+        AmpersandRanges: range list
+    }
+
+    static member Zero: SynTyparDeclTrivia = { AmpersandRanges = [] }
+
 [<NoEquality; NoComparison>]
 type SynMeasureConstantTrivia =
     {

src/Compiler/SyntaxTree/SyntaxTrivia.fsi

@@ -516,6 +516,16 @@ type SynMemberSigMemberTrivia =
 
     static member Zero: SynMemberSigMemberTrivia
 
+/// Represents additional information for SynTyparDecl
+[<NoEquality; NoComparison>]
+type SynTyparDeclTrivia =
+    {
+        /// The syntax ranges of the `&` tokens
+        AmpersandRanges: range list
+    }
+
+    static member Zero: SynTyparDeclTrivia
+
 /// Represents additional information for SynConst.Measure
 [<NoEquality; NoComparison>]
 type SynMeasureConstantTrivia =

src/Compiler/pars.fsy

@@ -2488,7 +2488,7 @@ tyconNameAndTyparDecls:
 
 prefixTyparDecls:
   | typar
-      { SynTyparDecls.SinglePrefix(SynTyparDecl([], $1), rhs parseState 1) }
+      { SynTyparDecls.SinglePrefix(SynTyparDecl([], $1, [], SynTyparDeclTrivia.Zero), rhs parseState 1) }
 
   | LPAREN typarDeclList rparen
       { SynTyparDecls.PrefixList(List.rev $2, rhs2 parseState 1 3) }
@@ -2497,9 +2497,14 @@ typarDeclList:
   | typarDeclList COMMA typarDecl { $3 :: $1 }
   | typarDecl { [$1] }
 
-typarDecl :
+typarDecl:
   | opt_attributes typar
-      { SynTyparDecl($1, $2) }
+      { SynTyparDecl($1, $2, [], SynTyparDeclTrivia.Zero) }
+
+  | opt_attributes typar AMP intersectionConstraints
+      { parseState.LexBuffer.CheckLanguageFeatureAndRecover LanguageFeature.ConstraintIntersectionOnFlexibleTypes (rhs2 parseState 3 4)
+        let constraints, mAmpersands = $4
+        SynTyparDecl($1, $2, List.rev constraints, { AmpersandRanges = rhs parseState 3 :: List.rev mAmpersands }) }
 
 /* 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" */
@@ -2553,6 +2558,25 @@ 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
+      { let constraints, mAmpersands = $1
+
+        match $3 with
+        | SynType.HashConstraint _ -> ()
+        | ty -> errorR(Error(FSComp.SR.parsConstraintIntersectionSyntaxUsedWithNonFlexibleType(), ty.Range))
+
+        ($3 :: constraints), (rhs parseState 2 :: mAmpersands) }
+
+  | atomType
+      { match $1 with
+        | SynType.HashConstraint _ -> ()
+        | ty -> errorR(Error(FSComp.SR.parsConstraintIntersectionSyntaxUsedWithNonFlexibleType(), ty.Range))
+
+        [ $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:
@@ -5871,6 +5895,15 @@ tupleOrQuotTypeElements:
   | appType %prec prec_tuptyptail_prefix
       { [ SynTupleTypeSegment.Type $1 ] }
 
+intersectionType:
+  | typar AMP intersectionConstraints %prec prec_no_more_attr_bindings // todo precedence
+    { let constraints, mAmpersands = $3
+      SynType.Intersection(Some $1, List.rev constraints, lhs parseState, { AmpersandRanges = rhs parseState 2 :: List.rev mAmpersands }) }
+
+  | atomType AMP intersectionConstraints %prec prec_no_more_attr_bindings // todo precedence
+    { let constraints, mAmpersands = $3
+      SynType.Intersection(None, $1 :: List.rev constraints, lhs parseState, { AmpersandRanges = rhs parseState 2 :: List.rev mAmpersands }) }
+
 appTypeCon:
   | path %prec prec_atomtyp_path
     { SynType.LongIdent($1) }
@@ -5913,6 +5946,10 @@ appType:
   | powerType
       { $1 }
 
+  | intersectionType
+      { parseState.LexBuffer.CheckLanguageFeatureAndRecover LanguageFeature.ConstraintIntersectionOnFlexibleTypes (lhs parseState)
+        $1 }
+
   | typar COLON_GREATER typ
       { let tp, typ = $1, $3
         let m = lhs parseState