@@ -5119,17 +5119,41 @@ and TcPatLongIdentActivePatternCase warnOnUpper (cenv: cenv) (env: TcEnv) vFlags
51195119 let vExprTy = vExpr.Type
51205120
51215121 let activePatArgsAsSynPats, patArg =
5122- let rec IsNotSolved ty =
5123- match ty with
5124- | TType_var(v, _) when v.IsSolved ->
5125- match v.Solution with
5126- | Some t -> IsNotSolved t
5127- | None -> false
5128- | TType_var _ -> true
5129- | _ -> false
5130-
5131- // only cases which return unit or unresolved type (in AP definition) can omit output arg
5132- let canOmit retTy = isUnitTy g retTy || IsNotSolved retTy
5122+ // only cases which return unit or unresolved type (in AP definition) compatible with unit can omit output arg
5123+ let canOmit retTy =
5124+ let couldResolveToUnit ty =
5125+ tryDestTyparTy g ty
5126+ |> ValueOption.exists (fun typar ->
5127+ not typar.IsSolved
5128+ && typar.Constraints |> List.forall (fun c ->
5129+ let (|Unit|_|) ty = if isUnitTy g ty then Some Unit else None
5130+
5131+ match c with
5132+ // These apply or could apply to unit.
5133+ | TyparConstraint.IsReferenceType _
5134+ | TyparConstraint.SupportsComparison _
5135+ | TyparConstraint.SupportsEquality _
5136+ | TyparConstraint.DefaultsTo (ty = Unit)
5137+ | TyparConstraint.MayResolveMember _ -> true
5138+
5139+ // Any other kind of constraint is incompatible with unit.
5140+ | TyparConstraint.CoercesTo _
5141+ | TyparConstraint.DefaultsTo _
5142+ | TyparConstraint.IsDelegate _
5143+ | TyparConstraint.IsEnum _
5144+ | TyparConstraint.IsNonNullableStruct _
5145+ | TyparConstraint.IsUnmanaged _
5146+ | TyparConstraint.RequiresDefaultConstructor _
5147+ | TyparConstraint.SimpleChoice _
5148+ | TyparConstraint.SupportsNull _ -> false))
5149+
5150+ let caseRetTy =
5151+ if isOptionTy g retTy then destOptionTy g retTy
5152+ elif isValueOptionTy g retTy then destValueOptionTy g retTy
5153+ elif isChoiceTy g retTy then destChoiceTy g retTy idx
5154+ else retTy
5155+
5156+ isUnitTy g caseRetTy || couldResolveToUnit caseRetTy
51335157
51345158 // This bit of type-directed analysis ensures that parameterized partial active patterns returning unit do not need to take an argument
51355159 let dtys, retTy = stripFunTy g vExprTy
@@ -5169,25 +5193,27 @@ and TcPatLongIdentActivePatternCase warnOnUpper (cenv: cenv) (env: TcEnv) vFlags
51695193
51705194 // active pattern cases returning unit or unknown things (in AP definition) can omit output arg
51715195 elif paramCount = args.Length then
5172- let caseRetTy =
5173- if isOptionTy g retTy then destOptionTy g retTy
5174- elif isValueOptionTy g retTy then destValueOptionTy g retTy
5175- elif isChoiceTy g retTy then destChoiceTy g retTy idx
5176- else retTy
5177-
51785196 // only cases which return unit or unresolved type (in AP definition) can omit output arg
5179- if canOmit caseRetTy then
5197+ if canOmit retTy then
51805198 args, SynPat.Const(SynConst.Unit, m)
51815199 else
51825200 showErrMsg 1
51835201
51845202 // active pattern in function param (e.g. let f (|P|_|) = ...)
5185- elif IsNotSolved vExprTy then
5203+ elif tryDestTyparTy g vExprTy |> ValueOption.exists (fun typar -> not typar.IsSolved) then
51865204 List.frontAndBack args
51875205
51885206 // args count should equal to AP function params count
51895207 elif dtys.Length <> args.Length then
5190- showErrMsg 1
5208+ let returnCount =
5209+ match dtys with
5210+ // val (|P|) : expr1:_ -> unit
5211+ // val (|P|_|) : expr1:_ -> unit option
5212+ // val (|P|_|) : expr1:_ -> unit voption
5213+ | [_] when canOmit retTy -> 0
5214+ | _ -> 1
5215+
5216+ showErrMsg returnCount
51915217 else
51925218 List.frontAndBack args
51935219
0 commit comments