From 0e938957ebafaef60e2db57bb717f6fac3c879f0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Victor=20Peter=20Rouven=20M=C3=BCller?= Date: Fri, 8 Jun 2018 11:13:06 +0200 Subject: [PATCH 1/2] Pretify ConstrainsSolver method The method wasn't readable at all before now it's better. --- src/fsharp/ConstraintSolver.fs | 120 +++++++++++++++++---------------- 1 file changed, 63 insertions(+), 57 deletions(-) diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index de502a42649..d9d08973621 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -1914,67 +1914,73 @@ and CanMemberSigsMatchUpToCheck let unnamedCalledOutArgs = calledMeth.UnnamedCalledOutArgs // First equate the method instantiation (if any) with the method type parameters - if minst.Length <> uminst.Length then ErrorD(Error(FSComp.SR.csTypeInstantiationLengthMismatch(), m)) else - - Iterate2D unifyTypes minst uminst ++ (fun () -> - - if not (permitOptArgs || isNil unnamedCalledOptArgs) then ErrorD(Error(FSComp.SR.csOptionalArgumentNotPermittedHere(), m)) else - - - let calledObjArgTys = calledMeth.CalledObjArgTys(m) + if minst.Length <> uminst.Length then + ErrorD(Error(FSComp.SR.csTypeInstantiationLengthMismatch(), m)) + else + trackErrors { + do! Iterate2D unifyTypes minst uminst + do! + if not (permitOptArgs || isNil unnamedCalledOptArgs) then + ErrorD(Error(FSComp.SR.csOptionalArgumentNotPermittedHere(), m)) + else + let calledObjArgTys = calledMeth.CalledObjArgTys(m) - // Check all the argument types. + // Check all the argument types. - if calledObjArgTys.Length <> callerObjArgTys.Length then - if (calledObjArgTys.Length <> 0) then - ErrorD(Error (FSComp.SR.csMemberIsNotStatic(minfo.LogicalName), m)) - else - ErrorD(Error (FSComp.SR.csMemberIsNotInstance(minfo.LogicalName), m)) - else - Iterate2D subsumeTypes calledObjArgTys callerObjArgTys ++ (fun () -> - (calledMeth.ArgSets |> IterateD (fun argSet -> - if argSet.UnnamedCalledArgs.Length <> argSet.UnnamedCallerArgs.Length then ErrorD(Error(FSComp.SR.csArgumentLengthMismatch(), m)) else - Iterate2D subsumeArg argSet.UnnamedCalledArgs argSet.UnnamedCallerArgs)) ++ (fun () -> - (calledMeth.ParamArrayCalledArgOpt |> OptionD (fun calledArg -> - if isArray1DTy g calledArg.CalledArgumentType then - let paramArrayElemTy = destArrayTy g calledArg.CalledArgumentType - let reflArgInfo = calledArg.ReflArgInfo // propgate the reflected-arg info to each param array argument - calledMeth.ParamArrayCallerArgs |> OptionD (IterateD (fun callerArg -> subsumeArg (CalledArg((0, 0), false, NotOptional, NoCallerInfo, false, false, None, reflArgInfo, paramArrayElemTy)) callerArg)) - else - CompleteD) - - ) ++ (fun () -> - (calledMeth.ArgSets |> IterateD (fun argSet -> - argSet.AssignedNamedArgs |> IterateD (fun arg -> subsumeArg arg.CalledArg arg.CallerArg))) ++ (fun () -> - (assignedItemSetters |> IterateD (fun (AssignedItemSetter(_, item, caller)) -> - let name, calledArgTy = - match item with - | AssignedPropSetter(_, pminfo, pminst) -> - let calledArgTy = List.head (List.head (pminfo.GetParamTypes(amap, m, pminst))) - pminfo.LogicalName, calledArgTy - - | AssignedILFieldSetter(finfo) -> - (* Get or set instance IL field *) - let calledArgTy = finfo.FieldType(amap, m) - finfo.FieldName, calledArgTy + if calledObjArgTys.Length <> callerObjArgTys.Length then + if (calledObjArgTys.Length <> 0) then + ErrorD(Error (FSComp.SR.csMemberIsNotStatic(minfo.LogicalName), m)) + else + ErrorD(Error (FSComp.SR.csMemberIsNotInstance(minfo.LogicalName), m)) + else + Iterate2D subsumeTypes calledObjArgTys callerObjArgTys + do! calledMeth.ArgSets + |> IterateD (fun argSet -> + if argSet.UnnamedCalledArgs.Length <> argSet.UnnamedCallerArgs.Length then ErrorD(Error(FSComp.SR.csArgumentLengthMismatch(), m)) else + Iterate2D subsumeArg argSet.UnnamedCalledArgs argSet.UnnamedCallerArgs) + do! calledMeth.ParamArrayCalledArgOpt + |> OptionD + (fun calledArg -> + if isArray1DTy g calledArg.CalledArgumentType then + let paramArrayElemTy = destArrayTy g calledArg.CalledArgumentType + let reflArgInfo = calledArg.ReflArgInfo // propgate the reflected-arg info to each param array argument + calledMeth.ParamArrayCallerArgs |> OptionD (IterateD (fun callerArg -> subsumeArg (CalledArg((0, 0), false, NotOptional, NoCallerInfo, false, false, None, reflArgInfo, paramArrayElemTy)) callerArg)) + else + CompleteD) + do! calledMeth.ArgSets + |> IterateD (fun argSet -> + argSet.AssignedNamedArgs |> IterateD (fun arg -> subsumeArg arg.CalledArg arg.CallerArg)) + do! assignedItemSetters + |> IterateD (fun (AssignedItemSetter(_, item, caller)) -> + let name, calledArgTy = + match item with + | AssignedPropSetter(_, pminfo, pminst) -> + let calledArgTy = List.head (List.head (pminfo.GetParamTypes(amap, m, pminst))) + pminfo.LogicalName, calledArgTy + + | AssignedILFieldSetter(finfo) -> + (* Get or set instance IL field *) + let calledArgTy = finfo.FieldType(amap, m) + finfo.FieldName, calledArgTy - | AssignedRecdFieldSetter(rfinfo) -> - let calledArgTy = rfinfo.FieldType - rfinfo.Name, calledArgTy + | AssignedRecdFieldSetter(rfinfo) -> + let calledArgTy = rfinfo.FieldType + rfinfo.Name, calledArgTy - subsumeArg (CalledArg((-1, 0), false, NotOptional, NoCallerInfo, false, false, Some (mkSynId m name), ReflectedArgInfo.None, calledArgTy)) caller) )) ++ (fun () -> - - // - Always take the return type into account for - // -- op_Explicit, op_Implicit - // -- methods using tupling of unfilled out args - // - Never take into account return type information for constructors - match reqdRetTyOpt with - | None -> CompleteD - | Some _ when minfo.IsConstructor -> CompleteD - | Some _ when not alwaysCheckReturn && isNil unnamedCalledOutArgs -> CompleteD - | Some reqdRetTy -> - let methodRetTy = calledMeth.CalledReturnTypeAfterOutArgTupling - unifyTypes reqdRetTy methodRetTy ))))) + subsumeArg (CalledArg((-1, 0), false, NotOptional, NoCallerInfo, false, false, Some (mkSynId m name), ReflectedArgInfo.None, calledArgTy)) caller) + do! + // - Always take the return type into account for + // -- op_Explicit, op_Implicit + // -- methods using tupling of unfilled out args + // - Never take into account return type information for constructors + match reqdRetTyOpt with + | None -> CompleteD + | Some _ when minfo.IsConstructor -> CompleteD + | Some _ when not alwaysCheckReturn && isNil unnamedCalledOutArgs -> CompleteD + | Some reqdRetTy -> + let methodRetTy = calledMeth.CalledReturnTypeAfterOutArgTupling + unifyTypes reqdRetTy methodRetTy + } // Assert a subtype constraint, and wrap an ErrorsFromAddingSubsumptionConstraint error around any failure // to allow us to report the outer types involved in the constraint From c7fffee0a9ce8ea38b99a49de15dd6dacc590353 Mon Sep 17 00:00:00 2001 From: realvictorprm Date: Fri, 8 Jun 2018 13:22:26 +0200 Subject: [PATCH 2/2] applied review Signed-off-by: realvictorprm --- src/fsharp/ConstraintSolver.fs | 96 +++++++++++++++++----------------- src/fsharp/ErrorLogger.fs | 3 ++ 2 files changed, 50 insertions(+), 49 deletions(-) diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index d9d08973621..24fc159e41d 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -1900,28 +1900,26 @@ and CanMemberSigsMatchUpToCheck (subsumeArg: CalledArg -> CallerArg<_> -> OperationResult) // used to compare the arguments for compatibility reqdRetTyOpt (calledMeth:CalledMeth<_>): ImperativeOperationResult = - - let g = csenv.g - let amap = csenv.amap - let m = csenv.m - - let minfo = calledMeth.Method - let minst = calledMeth.CalledTyArgs - let uminst = calledMeth.CallerTyArgs - let callerObjArgTys = calledMeth.CallerObjArgTys - let assignedItemSetters = calledMeth.AssignedItemSetters - let unnamedCalledOptArgs = calledMeth.UnnamedCalledOptArgs - let unnamedCalledOutArgs = calledMeth.UnnamedCalledOutArgs - - // First equate the method instantiation (if any) with the method type parameters - if minst.Length <> uminst.Length then - ErrorD(Error(FSComp.SR.csTypeInstantiationLengthMismatch(), m)) - else trackErrors { - do! Iterate2D unifyTypes minst uminst - do! + let g = csenv.g + let amap = csenv.amap + let m = csenv.m + + let minfo = calledMeth.Method + let minst = calledMeth.CalledTyArgs + let uminst = calledMeth.CallerTyArgs + let callerObjArgTys = calledMeth.CallerObjArgTys + let assignedItemSetters = calledMeth.AssignedItemSetters + let unnamedCalledOptArgs = calledMeth.UnnamedCalledOptArgs + let unnamedCalledOutArgs = calledMeth.UnnamedCalledOutArgs + + // First equate the method instantiation (if any) with the method type parameters + if minst.Length <> uminst.Length then + return! ErrorD(Error(FSComp.SR.csTypeInstantiationLengthMismatch(), m)) + else + do! Iterate2D unifyTypes minst uminst if not (permitOptArgs || isNil unnamedCalledOptArgs) then - ErrorD(Error(FSComp.SR.csOptionalArgumentNotPermittedHere(), m)) + return! ErrorD(Error(FSComp.SR.csOptionalArgumentNotPermittedHere(), m)) else let calledObjArgTys = calledMeth.CalledObjArgTys(m) @@ -1929,29 +1927,31 @@ and CanMemberSigsMatchUpToCheck if calledObjArgTys.Length <> callerObjArgTys.Length then if (calledObjArgTys.Length <> 0) then - ErrorD(Error (FSComp.SR.csMemberIsNotStatic(minfo.LogicalName), m)) + return! ErrorD(Error (FSComp.SR.csMemberIsNotStatic(minfo.LogicalName), m)) else - ErrorD(Error (FSComp.SR.csMemberIsNotInstance(minfo.LogicalName), m)) + return! ErrorD(Error (FSComp.SR.csMemberIsNotInstance(minfo.LogicalName), m)) else - Iterate2D subsumeTypes calledObjArgTys callerObjArgTys - do! calledMeth.ArgSets - |> IterateD (fun argSet -> - if argSet.UnnamedCalledArgs.Length <> argSet.UnnamedCallerArgs.Length then ErrorD(Error(FSComp.SR.csArgumentLengthMismatch(), m)) else - Iterate2D subsumeArg argSet.UnnamedCalledArgs argSet.UnnamedCallerArgs) - do! calledMeth.ParamArrayCalledArgOpt - |> OptionD - (fun calledArg -> - if isArray1DTy g calledArg.CalledArgumentType then - let paramArrayElemTy = destArrayTy g calledArg.CalledArgumentType - let reflArgInfo = calledArg.ReflArgInfo // propgate the reflected-arg info to each param array argument - calledMeth.ParamArrayCallerArgs |> OptionD (IterateD (fun callerArg -> subsumeArg (CalledArg((0, 0), false, NotOptional, NoCallerInfo, false, false, None, reflArgInfo, paramArrayElemTy)) callerArg)) - else - CompleteD) - do! calledMeth.ArgSets - |> IterateD (fun argSet -> - argSet.AssignedNamedArgs |> IterateD (fun arg -> subsumeArg arg.CalledArg arg.CallerArg)) - do! assignedItemSetters - |> IterateD (fun (AssignedItemSetter(_, item, caller)) -> + do! Iterate2D subsumeTypes calledObjArgTys callerObjArgTys + for argSet in calledMeth.ArgSets do + if argSet.UnnamedCalledArgs.Length <> argSet.UnnamedCallerArgs.Length then + return! ErrorD(Error(FSComp.SR.csArgumentLengthMismatch(), m)) + else + do! Iterate2D subsumeArg argSet.UnnamedCalledArgs argSet.UnnamedCallerArgs + match calledMeth.ParamArrayCalledArgOpt with + | Some calledArg -> + if isArray1DTy g calledArg.CalledArgumentType then + let paramArrayElemTy = destArrayTy g calledArg.CalledArgumentType + let reflArgInfo = calledArg.ReflArgInfo // propgate the reflected-arg info to each param array argument + match calledMeth.ParamArrayCallerArgs with + | Some args -> + for callerArg in args do + do! subsumeArg (CalledArg((0, 0), false, NotOptional, NoCallerInfo, false, false, None, reflArgInfo, paramArrayElemTy)) callerArg + | _ -> () + | _ -> () + for argSet in calledMeth.ArgSets do + for arg in argSet.AssignedNamedArgs do + do! subsumeArg arg.CalledArg arg.CallerArg + for (AssignedItemSetter(_, item, caller)) in assignedItemSetters do let name, calledArgTy = match item with | AssignedPropSetter(_, pminfo, pminst) -> @@ -1967,19 +1967,17 @@ and CanMemberSigsMatchUpToCheck let calledArgTy = rfinfo.FieldType rfinfo.Name, calledArgTy - subsumeArg (CalledArg((-1, 0), false, NotOptional, NoCallerInfo, false, false, Some (mkSynId m name), ReflectedArgInfo.None, calledArgTy)) caller) - do! + do! subsumeArg (CalledArg((-1, 0), false, NotOptional, NoCallerInfo, false, false, Some (mkSynId m name), ReflectedArgInfo.None, calledArgTy)) caller // - Always take the return type into account for // -- op_Explicit, op_Implicit // -- methods using tupling of unfilled out args // - Never take into account return type information for constructors - match reqdRetTyOpt with - | None -> CompleteD - | Some _ when minfo.IsConstructor -> CompleteD - | Some _ when not alwaysCheckReturn && isNil unnamedCalledOutArgs -> CompleteD - | Some reqdRetTy -> + match reqdRetTyOpt with + | Some _ when (minfo.IsConstructor || not alwaysCheckReturn && isNil unnamedCalledOutArgs) -> () + | Some reqdRetTy -> let methodRetTy = calledMeth.CalledReturnTypeAfterOutArgTupling - unifyTypes reqdRetTy methodRetTy + return! unifyTypes reqdRetTy methodRetTy + | _ -> () } // Assert a subtype constraint, and wrap an ErrorsFromAddingSubsumptionConstraint error around any failure diff --git a/src/fsharp/ErrorLogger.fs b/src/fsharp/ErrorLogger.fs index fd922e801b9..d29874bb0d5 100755 --- a/src/fsharp/ErrorLogger.fs +++ b/src/fsharp/ErrorLogger.fs @@ -570,8 +570,11 @@ type TrackErrorsBuilder() = member x.Return res = ResultD res member x.ReturnFrom res = res member x.For(seq, k) = IterateD k seq + member x.Combine(expr1, expr2) = expr1 ++ expr2 member x.While(gd, k) = WhileD gd k member x.Zero() = CompleteD + member x.Delay(fn) = fun () -> fn () + member x.Run(fn) = fn () let trackErrors = TrackErrorsBuilder()