From 90a36db4e779e016c0b714509233b88fd71796eb Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 13 Apr 2017 05:38:03 +0100 Subject: [PATCH] Fix 2730 while maintaining regression compat (#2843) --- src/fsharp/TypeChecker.fs | 74 ++++++++++++++++++++++++++++++- tests/fsharp/core/syntax/test.fsx | 42 ++++++++++++++++++ 2 files changed, 115 insertions(+), 1 deletion(-) diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index f87798d5e..647885639 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -8681,15 +8681,87 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution let expr = Expr.Op(TOp.TraitCall(traitInfo), [], ves, mItem) let expr = mkLambdas mItem [] vs (expr,retTy) + let rec isSimpleArgument e = + match e with + | SynExpr.New(_, _, synExpr, _) + | SynExpr.Paren(synExpr, _, _, _) + | SynExpr.Typed(synExpr, _, _) + | SynExpr.TypeApp (synExpr, _, _, _, _, _, _) + | SynExpr.TypeTest (synExpr, _, _) + | SynExpr.Upcast(synExpr, _, _) + | SynExpr.DotGet(synExpr, _, _, _) + | SynExpr.Downcast(synExpr, _, _) + | SynExpr.InferredUpcast(synExpr, _) + | SynExpr.InferredDowncast(synExpr, _) + | SynExpr.AddressOf(_, synExpr, _, _) + | SynExpr.Quote(_, _, synExpr, _, _) -> isSimpleArgument synExpr + + | SynExpr.Null _ + | SynExpr.Ident _ + | SynExpr.Const _ + | SynExpr.LongIdent _ -> true + + | SynExpr.Tuple(synExprs, _, _) + | SynExpr.StructTuple(synExprs, _, _) + | SynExpr.ArrayOrList(_, synExprs, _) -> synExprs |> List.forall isSimpleArgument + | SynExpr.Record(_,copyOpt,fields, _) -> copyOpt |> Option.forall (fst >> isSimpleArgument) && fields |> List.forall (p23 >> Option.forall isSimpleArgument) + | SynExpr.App (_, _, synExpr, synExpr2, _) -> isSimpleArgument synExpr && isSimpleArgument synExpr2 + | SynExpr.IfThenElse(synExpr, synExpr2, synExprOpt, _, _, _, _) -> isSimpleArgument synExpr && isSimpleArgument synExpr2 && Option.forall isSimpleArgument synExprOpt + | SynExpr.DotIndexedGet(synExpr, _, _, _) -> isSimpleArgument synExpr + | SynExpr.ObjExpr _ + | SynExpr.While _ + | SynExpr.For _ + | SynExpr.ForEach _ + | SynExpr.ArrayOrListOfSeqExpr _ + | SynExpr.CompExpr _ + | SynExpr.Lambda _ + | SynExpr.MatchLambda _ + | SynExpr.Match _ + | SynExpr.Do _ + | SynExpr.Assert _ + | SynExpr.Fixed _ + | SynExpr.TryWith _ + | SynExpr.TryFinally _ + | SynExpr.Lazy _ + | SynExpr.Sequential _ + | SynExpr.LetOrUse _ + | SynExpr.DotSet _ + | SynExpr.DotIndexedSet _ + | SynExpr.LongIdentSet _ + | SynExpr.JoinIn _ + | SynExpr.NamedIndexedPropertySet _ + | SynExpr.DotNamedIndexedPropertySet _ + | SynExpr.LibraryOnlyILAssembly _ + | SynExpr.LibraryOnlyStaticOptimization _ + | SynExpr.LibraryOnlyUnionCaseFieldGet _ + | SynExpr.LibraryOnlyUnionCaseFieldSet _ + | SynExpr.ArbitraryAfterError(_, _) + | SynExpr.FromParseError(_, _) + | SynExpr.DiscardAfterMissingQualificationAfterDot(_, _) + | SynExpr.ImplicitZero _ + | SynExpr.YieldOrReturn _ + | SynExpr.YieldOrReturnFrom _ + | SynExpr.LetOrUseBang _ + | SynExpr.DoBang _ + | SynExpr.TraitCall _ + -> false + + + // Propagte the known application structure into function types Propagate cenv overallTy env tpenv (MakeApplicableExprNoFlex cenv expr) (tyOfExpr cenv.g expr) delayed - let delayed1, delayed2 = List.takeWhile (function (DelayedApp _) -> true | _ -> false) delayed, List.skipWhile (function (DelayedApp _) -> true | _ -> false) delayed + // Take all simple arguments and process them before applying the constraint. + let delayed1, delayed2 = + let pred = (function (DelayedApp (_,arg,_)) -> isSimpleArgument arg | _ -> false) + List.takeWhile pred delayed, List.skipWhile pred delayed let intermediateTy = if isNil delayed2 then overallTy else NewInferenceType () + let resultExpr, tpenv = TcDelayed cenv intermediateTy env tpenv mItem (MakeApplicableExprNoFlex cenv expr) (tyOfExpr cenv.g expr) ExprAtomicFlag.NonAtomic delayed1 // Add the constraint after the application arguments have been checked to allow annotations to kick in on rigid type parameters AddCxMethodConstraint env.DisplayEnv cenv.css mItem NoTrace traitInfo + // Process all remaining arguments after the constraint is asserted let resultExpr2, tpenv2 = TcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprNoFlex cenv resultExpr) intermediateTy ExprAtomicFlag.NonAtomic delayed2 resultExpr2, tpenv2 diff --git a/tests/fsharp/core/syntax/test.fsx b/tests/fsharp/core/syntax/test.fsx index d6927c62d..57c217dfa 100644 --- a/tests/fsharp/core/syntax/test.fsx +++ b/tests/fsharp/core/syntax/test.fsx @@ -63,6 +63,48 @@ module CheckDynamicOperatorsOnTypesUnconstrained = let op = OpDynamic () op?Hello.Prop +module MoreDynamicOpTests = + module Test1 = + type 'a Doge () = class end + with + static member (|~>) (_ : 'b Doge, _ : 'b -> 'c) : 'c Doge = Doge () + + let x : System.DateTime Doge = Doge () + + let y = x |~> (fun dt -> dt.Year) // error on this line around 'dt.Year' + + + module Test2 = + type OpDynamic() = + static member ( ? ) (x, n) = x + member x.Prop = 1 + + let f() = + let op = OpDynamic () + op?Hello.Prop + + module Test3 = + type M() = + static member ($) (x:string, M) = "" + static member ($) (x:int , M) = 0 + static member ($) (x:float , M) = 0.0 + + let inline empty< ^R, ^M when (^R or ^M) : (static member ($) : ^R * M -> ^R) and ^M :> M> = + let m = M() + ((^R or ^M) : (static member ($): ^R * M -> ^R ) (Unchecked.defaultof<'R>, m)) + + let a :int = empty< _ , M > + let b :string = empty< _ , M > + + module Test4 = + type M() = + static member ($) (x:string, M) = "" + static member ($) (x:int , M) = 0 + static member ($) (x:float , M) = 0.0 + + let inline empty< ^R when ( ^R or M) : (static member ( $ ) : ^R * M -> ^R)> = + let m = M() + Unchecked.defaultof< ^R> $ m: ^R // Copyright (c) Microsoft Corporation 2005-2006. . -- GitLab