From c4d65eae0550336e767c2e7931d0c75c65e4b279 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 17 Apr 2020 18:33:37 +0100 Subject: [PATCH 01/14] cleanup for feature/witness-passing --- src/fsharp/ConstraintSolver.fs | 6 +- src/fsharp/ConstraintSolver.fsi | 8 +- src/fsharp/FSharp.Core/Linq.fs | 156 +++--- src/fsharp/FSharp.Core/quotations.fs | 21 +- src/fsharp/FSharp.Core/quotations.fsi | 3 - src/fsharp/FSharp.Core/reflect.fs | 4 +- src/fsharp/FSharp.Core/seq.fs | 4 +- src/fsharp/IlxGen.fs | 677 ++++++++++++++------------ src/fsharp/Optimizer.fs | 2 +- src/fsharp/PostInferenceChecks.fs | 2 +- src/fsharp/QuotationPickler.fs | 4 +- src/fsharp/QuotationTranslator.fs | 60 ++- src/fsharp/QuotationTranslator.fsi | 7 +- 13 files changed, 510 insertions(+), 444 deletions(-) diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 20ecf317dc8..00c54db4cf5 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -3061,7 +3061,8 @@ let CreateCodegenState tcVal g amap = ExtraCxs = HashMultiMap(10, HashIdentity.Structural) InfoReader = new InfoReader(g, amap) } -let CodegenWitnessThatTypeSupportsTraitConstraint tcVal g amap m (traitInfo: TraitConstraintInfo) argExprs = trackErrors { +/// Generate a witness expression if none is otherwise available, e.g. in legacy non-witness-passing code +let CodegenWitnessForTraitConstraint tcVal g amap m (traitInfo: TraitConstraintInfo) argExprs = trackErrors { let css = CreateCodegenState tcVal g amap let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) @@ -3072,6 +3073,9 @@ let CodegenWitnessThatTypeSupportsTraitConstraint tcVal g amap m (traitInfo: Tra return sln } +/// For some code like "let f() = ([] = [])", a free choice is made for a type parameter +/// for an interior type variable. This chooses a solution for a type parameter subject +/// to its constraints and applies that solution by using a constraint. let ChooseTyparSolutionAndSolve css denv tp = let g = css.g let amap = css.amap diff --git a/src/fsharp/ConstraintSolver.fsi b/src/fsharp/ConstraintSolver.fsi index 2d1107b0a13..864dd0a539d 100644 --- a/src/fsharp/ConstraintSolver.fsi +++ b/src/fsharp/ConstraintSolver.fsi @@ -191,10 +191,14 @@ val SolveTypeAsError: DisplayEnv -> ConstraintSolverState -> range -> TType -> u val ApplyTyparDefaultAtPriority: DisplayEnv -> ConstraintSolverState -> priority: int -> Typar -> unit -val CodegenWitnessThatTypeSupportsTraitConstraint: TcValF -> TcGlobals -> ImportMap -> range -> TraitConstraintInfo -> Expr list -> OperationResult +/// Generate a witness expression if none is otherwise available, e.g. in legacy non-witness-passing code +val CodegenWitnessForTraitConstraint: TcValF -> TcGlobals -> ImportMap -> range -> TraitConstraintInfo -> Expr list -> OperationResult +/// For some code like "let f() = ([] = [])", a free choice is made for a type parameter +/// for an interior type variable. This chooses a solution for a type parameter subject +/// to its constraints and applies that solution by using a constraint. val ChooseTyparSolutionAndSolve: ConstraintSolverState -> DisplayEnv -> Typar -> unit val IsApplicableMethApprox: TcGlobals -> ImportMap -> range -> MethInfo -> TType -> bool -val CanonicalizePartialInferenceProblem: ConstraintSolverState -> DisplayEnv -> range -> Typars -> unit \ No newline at end of file +val CanonicalizePartialInferenceProblem: ConstraintSolverState -> DisplayEnv -> range -> Typars -> unit diff --git a/src/fsharp/FSharp.Core/Linq.fs b/src/fsharp/FSharp.Core/Linq.fs index 028d3bf777a..4dffa2df2f2 100644 --- a/src/fsharp/FSharp.Core/Linq.fs +++ b/src/fsharp/FSharp.Core/Linq.fs @@ -360,86 +360,85 @@ module LeafExpressionConverter = | PlusQ (_, [ty1; ty2; ty3], [x1; x2]) when (ty1 = typeof) && (ty2 = typeof) && (ty3 = typeof) -> Expression.Add(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2, StringConcat) |> asExpr - | GenericEqualityQ (_, _, [x1; x2]) - | EqualsQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.Equal - | NotEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.NotEqual - | GreaterQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.GreaterThan - | GreaterEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.GreaterThanOrEqual - | LessQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.LessThan - | LessEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.LessThanOrEqual - | NotQ (_, _, [x1]) -> Expression.Not(ConvExprToLinqInContext env x1) |> asExpr - - | StaticEqualsQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.Equal - | StaticNotEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.NotEqual - | StaticGreaterQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.GreaterThan - | StaticGreaterEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.GreaterThanOrEqual - | StaticLessQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.LessThan - | StaticLessEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.LessThanOrEqual - - | NullableEqualsQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.Equal - | NullableNotEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.NotEqual - | NullableGreaterQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.GreaterThan - | NullableGreaterEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.GreaterThanOrEqual - | NullableLessQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.LessThan - | NullableLessEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.LessThanOrEqual - - | EqualsNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.Equal - | NotEqNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.NotEqual - | GreaterNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.GreaterThan - | GreaterEqNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.GreaterThanOrEqual - | LessNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.LessThan - | LessEqNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.LessThanOrEqual - - | NullableEqualsNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.Equal - | NullableNotEqNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.NotEqual - | NullableGreaterNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.GreaterThan - | NullableGreaterEqNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.GreaterThanOrEqual - | NullableLessNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.LessThan - | NullableLessEqNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.LessThanOrEqual + | GenericEqualityQ _ + | EqualsQ _ -> transBinOp inp env false args false Expression.Equal + | NotEqQ _ -> transBinOp inp env false args false Expression.NotEqual + | GreaterQ _ -> transBinOp inp env false args false Expression.GreaterThan + | GreaterEqQ _ -> transBinOp inp env false args false Expression.GreaterThanOrEqual + | LessQ _ -> transBinOp inp env false args false Expression.LessThan + | LessEqQ _ -> transBinOp inp env false args false Expression.LessThanOrEqual + | NotQ (_, _, [x1]) -> Expression.Not(ConvExprToLinqInContext env x1) |> asExpr + + | StaticEqualsQ _ -> transBinOp inp env false args false Expression.Equal + | StaticNotEqQ _ -> transBinOp inp env false args false Expression.NotEqual + | StaticGreaterQ _ -> transBinOp inp env false args false Expression.GreaterThan + | StaticGreaterEqQ _ -> transBinOp inp env false args false Expression.GreaterThanOrEqual + | StaticLessQ _ -> transBinOp inp env false args false Expression.LessThan + | StaticLessEqQ _ -> transBinOp inp env false args false Expression.LessThanOrEqual + + | NullableEqualsQ _ -> transBinOp inp env false args true Expression.Equal + | NullableNotEqQ _ -> transBinOp inp env false args true Expression.NotEqual + | NullableGreaterQ _ -> transBinOp inp env false args true Expression.GreaterThan + | NullableGreaterEqQ _ -> transBinOp inp env false args true Expression.GreaterThanOrEqual + | NullableLessQ _ -> transBinOp inp env false args true Expression.LessThan + | NullableLessEqQ _ -> transBinOp inp env false args true Expression.LessThanOrEqual + + | EqualsNullableQ _ -> transBinOp inp env true args false Expression.Equal + | NotEqNullableQ _ -> transBinOp inp env true args false Expression.NotEqual + | GreaterNullableQ _ -> transBinOp inp env true args false Expression.GreaterThan + | GreaterEqNullableQ _ -> transBinOp inp env true args false Expression.GreaterThanOrEqual + | LessNullableQ _ -> transBinOp inp env true args false Expression.LessThan + | LessEqNullableQ _ -> transBinOp inp env true args false Expression.LessThanOrEqual + + | NullableEqualsNullableQ _ -> transBinOp inp env false args false Expression.Equal + | NullableNotEqNullableQ _ -> transBinOp inp env false args false Expression.NotEqual + | NullableGreaterNullableQ _ -> transBinOp inp env false args false Expression.GreaterThan + | NullableGreaterEqNullableQ _ -> transBinOp inp env false args false Expression.GreaterThanOrEqual + | NullableLessNullableQ _ -> transBinOp inp env false args false Expression.LessThan + | NullableLessEqNullableQ _ -> transBinOp inp env false args false Expression.LessThanOrEqual // Detect the F# quotation encoding of decimal literals | MakeDecimalQ (_, _, [Int32 lo; Int32 med; Int32 hi; Bool isNegative; Byte scale]) -> Expression.Constant (new System.Decimal(lo, med, hi, isNegative, scale)) |> asExpr - | NegQ (_, _, [x1]) -> Expression.Negate(ConvExprToLinqInContext env x1) |> asExpr - | PlusQ (_, _, [x1; x2]) -> Expression.Add(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | DivideQ (_, _, [x1; x2]) -> Expression.Divide (ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | MinusQ (_, _, [x1; x2]) -> Expression.Subtract(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | MultiplyQ (_, _, [x1; x2]) -> Expression.Multiply(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | ModuloQ (_, _, [x1; x2]) -> Expression.Modulo (ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - - | ShiftLeftQ (_, _, [x1; x2]) -> Expression.LeftShift(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | ShiftRightQ (_, _, [x1; x2]) -> Expression.RightShift(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | BitwiseAndQ (_, _, [x1; x2]) -> Expression.And(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | BitwiseOrQ (_, _, [x1; x2]) -> Expression.Or(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | BitwiseXorQ (_, _, [x1; x2]) -> Expression.ExclusiveOr(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr + | NegQ (_, _, [x1]) -> Expression.Negate(ConvExprToLinqInContext env x1) |> asExpr + | PlusQ _ -> transBinOp inp env false args false Expression.Add + | DivideQ _ -> transBinOp inp env false args false Expression.Divide + | MinusQ _ -> transBinOp inp env false args false Expression.Subtract + | MultiplyQ _ -> transBinOp inp env false args false Expression.Multiply + | ModuloQ _ -> transBinOp inp env false args false Expression.Modulo + + | ShiftLeftQ _ -> transBinOp inp env false args false Expression.LeftShift + | ShiftRightQ _ -> transBinOp inp env false args false Expression.RightShift + | BitwiseAndQ _ -> transBinOp inp env false args false Expression.And + | BitwiseOrQ _ -> transBinOp inp env false args false Expression.Or + | BitwiseXorQ _ -> transBinOp inp env false args false Expression.ExclusiveOr | BitwiseNotQ (_, _, [x1]) -> Expression.Not(ConvExprToLinqInContext env x1) |> asExpr | CheckedNeg (_, _, [x1]) -> Expression.NegateChecked(ConvExprToLinqInContext env x1) |> asExpr - | CheckedPlusQ (_, _, [x1; x2]) -> Expression.AddChecked(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | CheckedMinusQ (_, _, [x1; x2]) -> Expression.SubtractChecked(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | CheckedMultiplyQ (_, _, [x1; x2]) -> Expression.MultiplyChecked(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr + | CheckedPlusQ _ -> transBinOp inp env false args false Expression.AddChecked + | CheckedMinusQ _ -> transBinOp inp env false args false Expression.SubtractChecked + | CheckedMultiplyQ _ -> transBinOp inp env false args false Expression.MultiplyChecked + | NullablePlusQ _ -> transBinOp inp env false args true Expression.Add + | PlusNullableQ _ -> transBinOp inp env true args false Expression.Add + | NullablePlusNullableQ _ -> transBinOp inp env false args false Expression.Add - | NullablePlusQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.Add - | PlusNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.Add - | NullablePlusNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.Add + | NullableMinusQ _ -> transBinOp inp env false args true Expression.Subtract + | MinusNullableQ _ -> transBinOp inp env true args false Expression.Subtract + | NullableMinusNullableQ _ -> transBinOp inp env false args false Expression.Subtract - | NullableMinusQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.Subtract - | MinusNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.Subtract - | NullableMinusNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.Subtract + | NullableMultiplyQ _ -> transBinOp inp env false args true Expression.Multiply + | MultiplyNullableQ _ -> transBinOp inp env true args false Expression.Multiply + | NullableMultiplyNullableQ _ -> transBinOp inp env false args false Expression.Multiply - | NullableMultiplyQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.Multiply - | MultiplyNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.Multiply - | NullableMultiplyNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.Multiply + | NullableDivideQ _ -> transBinOp inp env false args true Expression.Divide + | DivideNullableQ _ -> transBinOp inp env true args false Expression.Divide + | NullableDivideNullableQ _ -> transBinOp inp env false args false Expression.Divide - | NullableDivideQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.Divide - | DivideNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.Divide - | NullableDivideNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.Divide - - | NullableModuloQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.Modulo - | ModuloNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.Modulo - | NullableModuloNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.Modulo + | NullableModuloQ _ -> transBinOp inp env false args true Expression.Modulo + | ModuloNullableQ _ -> transBinOp inp env true args false Expression.Modulo + | NullableModuloNullableQ _ -> transBinOp inp env false args false Expression.Modulo | ConvNullableCharQ (_, _, [x1]) -> Expression.Convert(ConvExprToLinqInContext env x1, typeof>) |> asExpr | ConvNullableDecimalQ (_, _, [x1]) -> Expression.Convert(ConvExprToLinqInContext env x1, typeof>) |> asExpr @@ -653,15 +652,20 @@ module LeafExpressionConverter = Expression.Call(typeof, "ToFSharpFunc", tyargs, [| convDelegate |]) |> asExpr | _ -> - raise (new NotSupportedException(Printf.sprintf "Could not convert the following F# Quotation to a LINQ Expression Tree\n--------\n%A\n-------------\n" inp)) - - and transBinOp env addConvertLeft x1 x2 addConvertRight (exprErasedConstructor : _ * _ -> _) = - let e1 = ConvExprToLinqInContext env x1 - let e2 = ConvExprToLinqInContext env x2 - let e1 = if addConvertLeft then Expression.Convert(e1, typedefof>.MakeGenericType [| e1.Type |]) |> asExpr else e1 - let e2 = if addConvertRight then Expression.Convert(e2, typedefof>.MakeGenericType [| e2.Type |]) |> asExpr else e2 - exprErasedConstructor(e1, e2) |> asExpr - + failConvert inp + + and failConvert inp = + raise (new NotSupportedException(Printf.sprintf "Could not convert the following F# Quotation to a LINQ Expression Tree\n--------\n%A\n-------------\n" inp)) + + and transBinOp inp env addConvertLeft args addConvertRight (exprErasedConstructor : _ * _ -> _) = + match args with + | [x1; x2] -> + let e1 = ConvExprToLinqInContext env x1 + let e2 = ConvExprToLinqInContext env x2 + let e1 = if addConvertLeft then Expression.Convert(e1, typedefof>.MakeGenericType [| e1.Type |]) |> asExpr else e1 + let e2 = if addConvertRight then Expression.Convert(e2, typedefof>.MakeGenericType [| e2.Type |]) |> asExpr else e2 + exprErasedConstructor(e1, e2) |> asExpr + | _ -> failConvert inp and ConvObjArg env objOpt coerceTo : Expression = match objOpt with diff --git a/src/fsharp/FSharp.Core/quotations.fs b/src/fsharp/FSharp.Core/quotations.fs index 0f6f0a331ef..2c1159c2907 100644 --- a/src/fsharp/FSharp.Core/quotations.fs +++ b/src/fsharp/FSharp.Core/quotations.fs @@ -273,6 +273,7 @@ and [] | CombTerm(TryFinallyOp, args) -> combL "TryFinally" (exprs args) | CombTerm(TryWithOp, [e1;Lambda(v1, e2);Lambda(v2, e3)]) -> combL "TryWith" [expr e1; varL v1; expr e2; varL v2; expr e3] | CombTerm(SequentialOp, args) -> combL "Sequential" (exprs args) + | CombTerm(NewDelegateOp ty, [e]) -> let nargs = (getDelegateInvoke ty).GetParameters().Length if nargs = 0 then @@ -586,7 +587,7 @@ module Patterns = let fty = ((typeOf f): Type) match fty.GetGenericArguments() with | [| _; b|] -> b - | _ -> raise <| System.InvalidOperationException (SR.GetString(SR.QillFormedAppOrLet)) + | _ -> invalidOp (SR.GetString(SR.QillFormedAppOrLet)) /// Returns type of the Raw quotation or fails if the quotation is ill formed /// if 'verify' is true, verifies all branches, otherwise ignores some of them when not needed @@ -976,7 +977,7 @@ module Patterns = res // return MethodInfo for (generic) type's (generic) method match List.tryFind select methInfos with - | None -> raise <| System.InvalidOperationException (SR.GetString SR.QcannotBindToMethod) + | None -> invalidOp (SR.GetString SR.QcannotBindToMethod) | Some methInfo -> methInfo let bindMethodHelper (parentT: Type, nm, marity, argtys, rty) = @@ -999,14 +1000,14 @@ module Patterns = let bindModuleProperty (ty: Type, nm) = match ty.GetProperty(nm, staticBindingFlags) with - | null -> raise <| System.InvalidOperationException (String.Format(SR.GetString(SR.QcannotBindProperty), nm, ty.ToString())) + | null -> invalidOp (String.Format(SR.GetString(SR.QcannotBindProperty), nm, ty.ToString())) | res -> res // tries to locate unique function in a given type // in case of multiple candidates returns None so bindModuleFunctionWithCallSiteArgs will be used for more precise resolution let bindModuleFunction (ty: Type, nm) = match ty.GetMethods staticBindingFlags |> Array.filter (fun mi -> mi.Name = nm) with - | [||] -> raise <| System.InvalidOperationException (String.Format(SR.GetString(SR.QcannotBindFunction), nm, ty.ToString())) + | [||] -> invalidOp (String.Format(SR.GetString(SR.QcannotBindFunction), nm, ty.ToString())) | [| res |] -> Some res | _ -> None @@ -1031,7 +1032,7 @@ module Patterns = let methodTyArgCount = if mi.IsGenericMethod then mi.GetGenericArguments().Length else 0 methodTyArgCount = tyArgs.Length ) - let fail() = raise <| System.InvalidOperationException (String.Format(SR.GetString(SR.QcannotBindFunction), nm, ty.ToString())) + let fail() = invalidOp (String.Format(SR.GetString(SR.QcannotBindFunction), nm, ty.ToString())) match candidates with | [||] -> fail() | [| solution |] -> solution @@ -1332,7 +1333,7 @@ module Patterns = elif a = "." then st.localAssembly else match System.Reflection.Assembly.Load a with - | null -> raise <| System.InvalidOperationException(String.Format(SR.GetString(SR.QfailedToBindAssembly), a.ToString())) + | null -> invalidOp(String.Format(SR.GetString(SR.QfailedToBindAssembly), a.ToString())) | assembly -> assembly let u_NamedType st = @@ -1389,7 +1390,7 @@ module Patterns = let n = tyargs.Length fun idx -> if idx < n then tyargs.[idx] - else raise <| System.InvalidOperationException (SR.GetString(SR.QtypeArgumentOutOfRange)) + else invalidOp (SR.GetString(SR.QtypeArgumentOutOfRange)) let envClosed (spliceTypes: Type[]) = { vars = Map.empty @@ -1672,6 +1673,7 @@ module Patterns = reflectedDefinitionTable.Add(key, Entry exprBuilder))) decodedTopResources.Add((assem, resourceName), 0) + /// Get the reflected definition at the given (always generic) instantiation let tryGetReflectedDefinition (methodBase: MethodBase, tyargs: Type []) = checkNonNull "methodBase" methodBase let data = @@ -1736,6 +1738,7 @@ module Patterns = Some(exprBuilder (envClosed tyargs)) | None -> None + /// Get the reflected definition at the generic instantiation let tryGetReflectedDefinitionInstantiated (methodBase: MethodBase) = checkNonNull "methodBase" methodBase match methodBase with @@ -1913,7 +1916,6 @@ type Expr with checkNonNull "expressionType" expressionType mkValueWithDefn (value, expressionType, definition) - static member Var variable = mkVar variable @@ -2144,8 +2146,7 @@ module ExprShape = | ValueOp(v, ty, None), [] -> mkValue(v, ty) | ValueOp(v, ty, Some nm), [] -> mkValueWithName(v, ty, nm) | WithValueOp(v, ty), [e] -> mkValueWithDefn(v, ty, e) - | _ -> raise <| System.InvalidOperationException (SR.GetString(SR.QillFormedAppOrLet)) - + | _ -> invalidOp (SR.GetString(SR.QillFormedAppOrLet)) EA(e.Tree, attrs) diff --git a/src/fsharp/FSharp.Core/quotations.fsi b/src/fsharp/FSharp.Core/quotations.fsi index a782140fe43..ed7e46d16a1 100644 --- a/src/fsharp/FSharp.Core/quotations.fsi +++ b/src/fsharp/FSharp.Core/quotations.fsi @@ -334,8 +334,6 @@ type Expr = /// The resulting expression. static member WithValue: value: obj * expressionType:Type * definition: Expr -> Expr - - /// Builds an expression that represents a variable /// The input variable. /// The resulting expression. @@ -653,7 +651,6 @@ module Patterns = /// (Var * Expr) option [] val (|VarSet|_|) : input:Expr -> (Var * Expr) option - [] /// Contains a set of derived F# active patterns to analyze F# expression objects diff --git a/src/fsharp/FSharp.Core/reflect.fs b/src/fsharp/FSharp.Core/reflect.fs index 828fddac3d3..3f7c459be64 100644 --- a/src/fsharp/FSharp.Core/reflect.fs +++ b/src/fsharp/FSharp.Core/reflect.fs @@ -70,7 +70,7 @@ module internal Impl = match attrs with | null | [| |] -> None | [| res |] -> let a = (res :?> CompilationMappingAttribute) in Some (a.SourceConstructFlags, a.SequenceNumber, a.VariantNumber) - | _ -> raise <| System.InvalidOperationException (SR.GetString (SR.multipleCompilationMappings)) + | _ -> invalidOp (SR.GetString (SR.multipleCompilationMappings)) let findCompilationMappingAttribute (attrs: obj[]) = match tryFindCompilationMappingAttribute attrs with @@ -292,7 +292,7 @@ module internal Impl = else "New" + constrname match typ.GetMethod(methname, BindingFlags.Static ||| bindingFlags) with - | null -> raise <| System.InvalidOperationException (String.Format (SR.GetString (SR.constructorForUnionCaseNotFound), methname)) + | null -> invalidOp (String.Format (SR.GetString (SR.constructorForUnionCaseNotFound), methname)) | meth -> meth let getUnionCaseConstructor (typ: Type, tag: int, bindingFlags) = diff --git a/src/fsharp/FSharp.Core/seq.fs b/src/fsharp/FSharp.Core/seq.fs index 71f16b6fa2e..a37eca1349f 100644 --- a/src/fsharp/FSharp.Core/seq.fs +++ b/src/fsharp/FSharp.Core/seq.fs @@ -254,7 +254,7 @@ namespace Microsoft.FSharp.Collections setIndex 0 true else - if index = System.Int32.MaxValue then raise <| System.InvalidOperationException (SR.GetString(SR.enumerationPastIntMaxValue)) + if index = System.Int32.MaxValue then invalidOp (SR.GetString(SR.enumerationPastIntMaxValue)) if index = finalIndex then false else @@ -391,7 +391,7 @@ namespace Microsoft.FSharp.Collections member __.Current = match curr with | Some v -> v - | None -> raise <| System.InvalidOperationException (SR.GetString(SR.moveNextNotCalledOrFinished)) + | None -> invalidOp (SR.GetString(SR.moveNextNotCalledOrFinished)) interface System.Collections.IEnumerator with member x.Current = box (x :> IEnumerator<_>).Current diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index a49cdc742e6..9c97cd1d365 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -227,7 +227,7 @@ type cenv = /// A callback for TcVal in the typechecker. Used to generalize values when finding witnesses. /// It is unfortunate this is needed but it is until we supply witnesses through the compilation. - TcVal: ConstraintSolver.TcValF + tcVal: ConstraintSolver.TcValF /// The TAST for the assembly being emitted viewCcu: CcuThunk @@ -690,10 +690,10 @@ type IlxClosureInfo = cloArityInfo: ArityInfo /// The formal return type - cloILFormalRetTy: ILType + ilCloFormalReturnTy: ILType /// An immutable array of free variable descriptions for the closure - cloILFreeVars: IlxClosureFreeVar[] + ilCloAllFreeVars: IlxClosureFreeVar[] /// The ILX specification for the closure cloSpec: IlxClosureSpec @@ -745,15 +745,15 @@ type ValStorage = /// Indicates the value is stored in a static field. | StaticField of ILFieldSpec * ValRef * (*hasLiteralAttr:*)bool * ILType * string * ILType * ILMethodRef * ILMethodRef * OptionalShadowLocal - /// Indicates the value is "stored" as a property that recomputes it each time it is referenced. Used for simple constants that do not cause initialization triggers + /// Indicates the value is represented as a property that recomputes it each time it is referenced. Used for simple constants that do not cause initialization triggers | StaticProperty of ILMethodSpec * OptionalShadowLocal - /// Indicates the value is "stored" as a IL static method (in a "main" class for a F# + /// Indicates the value is represented as an IL method (in a "main" class for a F# /// compilation unit, or as a member) according to its inferred or specified arity. | Method of ValReprInfo * ValRef * ILMethodSpec * Range.range * ArgReprInfo list * TType list * ArgReprInfo /// Indicates the value is stored at the given position in the closure environment accessed via "ldarg 0" - | Env of ILType * int * ILFieldSpec * NamedLocalIlxClosureInfo ref option + | Env of ILType * ILFieldSpec * NamedLocalIlxClosureInfo ref option /// Indicates that the value is an argument of a method being generated | Arg of int @@ -867,7 +867,7 @@ and IlxGenEnv = /// All values in scope valsInScope: ValMap> - /// For optimizing direct tail recursion to a loop - mark says where to branch to. Length is 0 or 1. + /// For optimizing direct tail recursion to a loop - mark says where to branch to. Length is 0 or 1. /// REVIEW: generalize to arbitrary nested local loops?? innerVals: (ValRef * (BranchCallItem * Mark)) list @@ -942,7 +942,8 @@ let AddStorageForVal (g: TcGlobals) (v, s) eenv = else eenv -let AddStorageForLocalVals g vals eenv = List.foldBack (fun (v, s) acc -> AddStorageForVal g (v, notlazy s) acc) vals eenv +let AddStorageForLocalVals g vals eenv = + List.foldBack (fun (v, s) acc -> AddStorageForVal g (v, notlazy s) acc) vals eenv //-------------------------------------------------------------------------- // Lookup eenv @@ -968,7 +969,7 @@ let GetMethodSpecForMemberVal amap g (memberInfo: ValMemberInfo) (vref: ValRef) let m = vref.Range let tps, curriedArgInfos, returnTy, retInfo = assert(vref.ValReprInfo.IsSome) - GetTopValTypeInCompiledForm g (Option.get vref.ValReprInfo) vref.Type m + GetTopValTypeInCompiledForm g vref.ValReprInfo.Value vref.Type m let tyenvUnderTypars = TypeReprEnv.ForTypars tps let flatArgInfos = List.concat curriedArgInfos let isCtor = (memberInfo.MemberFlags.MemberKind = MemberKind.Constructor) @@ -986,6 +987,7 @@ let GetMethodSpecForMemberVal amap g (memberInfo: ValMemberInfo) (vref: ValRef) let ilTy = GenType amap m tyenvUnderTypars (mkAppTy parentTcref (List.map mkTyparTy ctps)) + let nm = vref.CompiledName g.CompilerGlobalState if isCompiledAsInstance || isCtor then // Find the 'this' argument type if any let thisTy, flatArgInfos = @@ -1015,14 +1017,14 @@ let GetMethodSpecForMemberVal amap g (memberInfo: ValMemberInfo) (vref: ValRef) let isSlotSig = memberInfo.MemberFlags.IsDispatchSlot || memberInfo.MemberFlags.IsOverrideOrExplicitImpl let ilMethodArgTys = GenParamTypes amap m tyenvUnderTypars isSlotSig methodArgTys let ilMethodInst = GenTypeArgs amap m tyenvUnderTypars (List.map mkTyparTy mtps) - let mspec = mkILInstanceMethSpecInTy (ilTy, vref.CompiledName g.CompilerGlobalState, ilMethodArgTys, ilActualRetTy, ilMethodInst) + let mspec = mkILInstanceMethSpecInTy (ilTy, nm, ilMethodArgTys, ilActualRetTy, ilMethodInst) mspec, ctps, mtps, paramInfos, retInfo, methodArgTys else let methodArgTys, paramInfos = List.unzip flatArgInfos let ilMethodArgTys = GenParamTypes amap m tyenvUnderTypars false methodArgTys let ilMethodInst = GenTypeArgs amap m tyenvUnderTypars (List.map mkTyparTy mtps) - let mspec = mkILStaticMethSpecInTy (ilTy, vref.CompiledName g.CompilerGlobalState , ilMethodArgTys, ilActualRetTy, ilMethodInst) + let mspec = mkILStaticMethSpecInTy (ilTy, nm, ilMethodArgTys, ilActualRetTy, ilMethodInst) mspec, ctps, mtps, paramInfos, retInfo, methodArgTys @@ -1046,7 +1048,7 @@ let ComputeFieldSpecForVal(optIntraAssemblyInfo: IlxGenIntraAssemblyInfo option, /// Compute the representation information for an F#-declared value (not a member nor a function). /// Mutable and literal static fields must have stable names and live in the "public" location -let ComputeStorageForFSharpValue amap (g:TcGlobals) cloc optIntraAssemblyInfo optShadowLocal isInteractive returnTy (vref: ValRef) m = +let ComputeStorageForFSharpValue amap (g: TcGlobals) cloc optIntraAssemblyInfo optShadowLocal isInteractive returnTy (vref: ValRef) m = let nm = vref.CompiledName g.CompilerGlobalState let vspec = vref.Deref let ilTy = GenType amap m TypeReprEnv.Empty returnTy (* TypeReprEnv.Empty ok: not a field in a generic class *) @@ -1823,7 +1825,9 @@ type CodeGenBuffer(m: range, res member cgbuf.mgbuf = mgbuf + member cgbuf.MethodName = methodName + member cgbuf.PreallocatedArgCount = alreadyUsedArgs member cgbuf.AllocLocal(ranges, ty, isFixed) = @@ -2259,8 +2263,8 @@ and GenExprAux (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = // application of local type functions with type parameters = measure types and body = local value - inline the body GenExpr cenv cgbuf eenv sp v sequel - | Expr.App (f,fty, tyargs, args, m) -> - GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel + | Expr.App (f, fty, tyargs, curriedArgs, m) -> + GenApp cenv cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel | Expr.Val (v, _, m) -> GenGetVal cenv cgbuf eenv (v, m) sequel @@ -3042,7 +3046,7 @@ and GenUntupledArgExpr cenv cgbuf eenv m argInfos expr sequel = let tys = destRefTupleTy g ty assert (tys.Length = numRequiredExprs) // TODO - tupInfoRef - argInfos |> List.iteri (fun i _ -> GenGetTupleField cenv cgbuf eenvinner (tupInfoRef (* TODO *), loce, tys, i, m) Continue) + argInfos |> List.iteri (fun i _ -> GenGetTupleField cenv cgbuf eenvinner (tupInfoRef, loce, tys, i, m) Continue) GenSequel cenv eenv.cloc cgbuf sequel ) @@ -3051,51 +3055,60 @@ and GenUntupledArgExpr cenv cgbuf eenv m argInfos expr sequel = // Generate calls (try to detect direct calls) //-------------------------------------------------------------------------- -and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = +and GenApp cenv cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel = let g = cenv.g - match (f, tyargs, args) with - (* Look for tailcall to turn into branch *) + match (f, tyargs, curriedArgs) with + // Look for tailcall to turn into branch | (Expr.Val (v, _, _), _, _) when match ListAssoc.tryFind g.valRefEq v eenv.innerVals with | Some (kind, _) -> (not v.IsConstructor && - (* when branch-calling methods we must have the right type parameters *) + // when branch-calling methods we must have the right type parameters (match kind with | BranchCallClosure _ -> true | BranchCallMethod (_, _, tps, _, _) -> (List.lengthsEqAndForall2 (fun ty tp -> typeEquiv g ty (mkTyparTy tp)) tyargs tps)) && - (* must be exact #args, ignoring tupling - we untuple if needed below *) + // must be exact #args, ignoring tupling - we untuple if needed below (let arityInfo = match kind with | BranchCallClosure arityInfo | BranchCallMethod (arityInfo, _, _, _, _) -> arityInfo - arityInfo.Length = args.Length + arityInfo.Length = curriedArgs.Length ) && (* no tailcall out of exception handler, etc. *) (match sequelIgnoringEndScopesAndDiscard sequel with Return | ReturnVoid -> true | _ -> false)) | None -> false -> let (kind, mark) = ListAssoc.find g.valRefEq v eenv.innerVals // already checked above in when guard - let ntmargs = - match kind with - | BranchCallClosure arityInfo -> - let ntmargs = List.foldBack (+) arityInfo 0 - GenExprs cenv cgbuf eenv args - ntmargs - | BranchCallMethod (arityInfo, curriedArgInfos, _, ntmargs, numObjArgs) -> - assert (curriedArgInfos.Length = arityInfo.Length ) - assert (curriedArgInfos.Length = args.Length) - //assert (curriedArgInfos.Length = ntmargs ) - GenUntupledArgsDiscardingLoneUnit cenv cgbuf eenv m numObjArgs curriedArgInfos args - if v.IsExtensionMember then - match curriedArgInfos, args with - | [[]], [_] when numObjArgs = 0 -> (ntmargs-1) - | [[_];[]], [_;_] when numObjArgs = 1 -> (ntmargs-1) - | _ -> ntmargs - else ntmargs - - for i = ntmargs - 1 downto 0 do - CG.EmitInstrs cgbuf (pop 1) Push0 [ I_starg (uint16 (i+cgbuf.PreallocatedArgCount)) ] + match kind with + | BranchCallClosure arityInfo -> + GenExprs cenv cgbuf eenv curriedArgs + + let numArgs = List.sum arityInfo + + for i = numArgs - 1 downto 0 do + CG.EmitInstrs cgbuf (pop 1) Push0 [ I_starg (uint16 (cgbuf.PreallocatedArgCount+i)) ] + + | BranchCallMethod (arityInfo, curriedArgInfos, _, numArgs, numObjArgs) -> + assert (curriedArgInfos.Length = arityInfo.Length ) + assert (curriedArgInfos.Length = curriedArgs.Length) + + //assert (curriedArgInfos.Length = numArgs ) + GenUntupledArgsDiscardingLoneUnit cenv cgbuf eenv m numObjArgs curriedArgInfos curriedArgs + + // Extension methods with empty arguments are evidently not quite in sufficiently normalized form, + // so apply a fixup here. This feels like a mistake associated with BindUnitVars, where that is not triggering + // in this case. + let numArgs = + if v.IsExtensionMember then + match curriedArgInfos, curriedArgs with + | [[]], [_] when numObjArgs = 0 -> (numArgs-1) + | [[_];[]], [_;_] when numObjArgs = 1 -> (numArgs-1) + | _ -> numArgs + else numArgs + + for i = numArgs - 1 downto 0 do + CG.EmitInstrs cgbuf (pop 1) Push0 [ I_starg (uint16 (cgbuf.PreallocatedArgCount+i)) ] CG.EmitInstrs cgbuf (pop 0) Push0 [ I_br mark.CodeLabel ] @@ -3156,25 +3169,26 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = | Method (topValInfo, vref, _, _, _, _, _) -> (let tps, argtys, _, _ = GetTopValTypeInFSharpForm g topValInfo vref.Type m tps.Length = tyargs.Length && - argtys.Length <= args.Length) + argtys.Length <= curriedArgs.Length) | _ -> false) -> let storage = StorageForValRef g m vref eenv match storage with | Method (topValInfo, vref, mspec, _, _, _, _) -> - let nowArgs, laterArgs = - let _, curriedArgInfos, _, _ = GetTopValTypeInFSharpForm g topValInfo vref.Type m - List.splitAt curriedArgInfos.Length args + + let _, curriedArgInfos, _, _ = GetTopValTypeInFSharpForm g topValInfo vref.Type m + + let nowArgs, laterArgs = List.splitAt curriedArgInfos.Length curriedArgs let actualRetTy = applyTys g vref.Type (tyargs, nowArgs) + let _, curriedArgInfos, returnTy, _ = GetTopValTypeInCompiledForm g topValInfo vref.Type m let ilTyArgs = GenTypeArgs cenv.amap m eenv.tyenv tyargs - // For instance method calls chop off some type arguments, which are already - // carried by the class. Also work out if it's a virtual call. - let _, virtualCall, newobj, isSuperInit, isSelfInit, _, _, _ = GetMemberCallInfo g (vref, valUseFlags) in + // carried by the class. Also work out if it's a virtual call. + let _, virtualCall, newobj, isSuperInit, isSelfInit, _, _, _ = GetMemberCallInfo g (vref, valUseFlags) // numEnclILTypeArgs will include unit-of-measure args, unfortunately. For now, just cut-and-paste code from GetMemberCallInfo // @REVIEW: refactor this @@ -3276,12 +3290,12 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = // In this case we can often generate a type-specific local expression for the value. // This reduces the number of dynamic type applications. | (Expr.Val (vref, _, _), _, _) -> - GenGetValRefAndSequel cenv cgbuf eenv m vref (Some (tyargs, args, m, sequel)) + GenGetValRefAndSequel cenv cgbuf eenv m vref (Some (tyargs, curriedArgs, m, sequel)) | _ -> (* worst case: generate a first-class function value and call *) GenExpr cenv cgbuf eenv SPSuppress f Continue - GenArgsAndIndirectCall cenv cgbuf eenv (fty, tyargs, args, m) sequel + GenCurriedArgsAndIndirectCall cenv cgbuf eenv (fty, tyargs, curriedArgs, m) sequel and CanTailcall (hasStructObjArg, ccallInfo, withinSEH, hasByrefArg, mustGenerateUnitAfterCall, isDllImport, isSelfInit, makesNoCriticalTailcalls, sequel) = @@ -3328,14 +3342,14 @@ and GenNamedLocalTyFuncCall cenv (cgbuf: CodeGenBuffer) eenv ty cloinfo tyargs m /// Generate an indirect call, converting to an ILX callfunc instruction -and GenArgsAndIndirectCall cenv cgbuf eenv (functy, tyargs, args, m) sequel = +and GenCurriedArgsAndIndirectCall cenv cgbuf eenv (functy, tyargs, curriedArgs, m) sequel = - // Generate the arguments to the indirect call - GenExprs cenv cgbuf eenv args - GenIndirectCall cenv cgbuf eenv (functy, tyargs, args, m) sequel + // Generate the curried arguments to the indirect call + GenExprs cenv cgbuf eenv curriedArgs + GenIndirectCall cenv cgbuf eenv (functy, tyargs, curriedArgs, m) sequel /// Generate an indirect call, converting to an ILX callfunc instruction -and GenIndirectCall cenv cgbuf eenv (functy, tyargs, args, m) sequel = +and GenIndirectCall cenv cgbuf eenv (functy, tyargs, curriedArgs, m) sequel = let g = cenv.g // Fold in the new types into the environment as we generate the formal types. @@ -3349,18 +3363,15 @@ and GenIndirectCall cenv cgbuf eenv (functy, tyargs, args, m) sequel = // This does two phases: REVIEW: the code is too complex for what it's achieving and should be rewritten let formalRetTy, appBuilder = - List.fold - (fun (formalFuncTy, sofar) _ -> - let dty, rty = destFunTy g formalFuncTy - (rty, (fun acc -> sofar (Apps_app(GenType cenv.amap m feenv dty, acc))))) - (formalFuncTy, id) - args + ((formalFuncTy, id), curriedArgs) ||> List.fold (fun (formalFuncTy, appBuilder) _ -> + let dty, rty = destFunTy cenv.g formalFuncTy + (rty, (fun acc -> appBuilder (Apps_app(GenType cenv.amap m feenv dty, acc))))) let ilxRetApps = Apps_done (GenType cenv.amap m feenv formalRetTy) List.foldBack (fun tyarg acc -> Apps_tyapp(GenType cenv.amap m eenv.tyenv tyarg, acc)) tyargs (appBuilder ilxRetApps) - let actualRetTy = applyTys g functy (tyargs, args) + let actualRetTy = applyTys g functy (tyargs, curriedArgs) let ilActualRetTy = GenType cenv.amap m eenv.tyenv actualRetTy // Check if any byrefs are involved to make sure we don't tailcall @@ -3377,7 +3388,7 @@ and GenIndirectCall cenv cgbuf eenv (functy, tyargs, args, m) sequel = // Generate the code code an ILX callfunc operation let instrs = EraseClosures.mkCallFunc g.ilxPubCloEnv (fun ty -> cgbuf.AllocLocal([], ty, false) |> uint16) eenv.tyenv.Count isTailCall ilxClosureApps - CG.EmitInstrs cgbuf (pop (1+args.Length)) (Push [ilActualRetTy]) instrs + CG.EmitInstrs cgbuf (pop (1+curriedArgs.Length)) (Push [ilActualRetTy]) instrs // Done compiling indirect call... GenSequel cenv eenv.cloc cgbuf sequel @@ -3839,15 +3850,15 @@ and GenQuotation cenv cgbuf eenv (ast, conv, m, ety) sequel = let bytesExpr = Expr.Op (TOp.Bytes astSerializedBytes, [], [], m) let deserializeExpr = - match QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat g with - | QuotationTranslator.QuotationSerializationFormat.FSharp_40_Plus -> + let qf = QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat g + if qf.SupportsDeserializeEx then let referencedTypeDefExprs = List.map (mkILNonGenericBoxedTy >> mkTypeOfExpr cenv m) referencedTypeDefs let referencedTypeDefsExpr = mkArray (g.system_Type_ty, referencedTypeDefExprs, m) let spliceTypesExpr = mkArray (g.system_Type_ty, spliceTypeExprs, m) let spliceArgsExpr = mkArray (rawTy, spliceArgExprs, m) mkCallDeserializeQuotationFSharp40Plus g m someTypeInModuleExpr referencedTypeDefsExpr spliceTypesExpr spliceArgsExpr bytesExpr - | QuotationTranslator.QuotationSerializationFormat.FSharp_20_Plus -> + else let mkList ty els = List.foldBack (mkCons g ty) els (mkNil g m ty) let spliceTypesExpr = mkList g.system_Type_ty spliceTypeExprs let spliceArgsExpr = mkList rawTy spliceArgExprs @@ -3917,9 +3928,9 @@ and MakeNotSupportedExnExpr cenv eenv (argExpr, m) = let mref = mkILCtorMethSpecForTy(ilty, [g.ilg.typ_String]).MethodRef Expr.Op (TOp.ILCall (false, false, false, true, NormalValUse, false, false, mref, [], [], [ety]), [], [argExpr], m) -and GenTraitCall cenv cgbuf eenv (traitInfo, argExprs, m) expr sequel = +and GenTraitCall (cenv: cenv) cgbuf eenv (traitInfo: TraitConstraintInfo, argExprs, m) expr sequel = let g = cenv.g - let minfoOpt = CommitOperationResult (ConstraintSolver.CodegenWitnessThatTypeSupportsTraitConstraint cenv.TcVal g cenv.amap m traitInfo argExprs) + let minfoOpt = CommitOperationResult (ConstraintSolver.CodegenWitnessForTraitConstraint cenv.tcVal g cenv.amap m traitInfo argExprs) match minfoOpt with | None -> let exnArg = mkString g m (FSComp.SR.ilDynamicInvocationNotSupported(traitInfo.MemberName)) @@ -3957,7 +3968,7 @@ and GenGetValAddr cenv cgbuf eenv (v: ValRef, m) sequel = let ilTy = if ilTy.IsNominal && ilTy.Boxity = ILBoxity.AsValue then ILType.Byref ilTy else ilTy EmitGetStaticFieldAddr cgbuf ilTy fspec - | Env (_, _, ilField, _) -> + | Env (_, ilField, _) -> CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref ilTy]) [ mkLdarg0; mkNormalLdflda ilField ] | Local (_, _, Some _) | StaticProperty _ | Method _ | Env _ | Null -> @@ -4209,16 +4220,14 @@ and GenObjectExpr cenv cgbuf eenvouter expr (baseType, baseValOpt, basecall, ove let cloinfo, _, eenvinner = GetIlxClosureInfo cenv m false [] eenvouter expr let cloAttribs = cloinfo.cloAttribs - let cloFreeVars = cloinfo.cloFreeVars let ilCloLambdas = cloinfo.ilCloLambdas let cloName = cloinfo.cloName - let ilxCloSpec = cloinfo.cloSpec - let ilCloFreeVars = cloinfo.cloILFreeVars + let ilCloAllFreeVars = cloinfo.ilCloAllFreeVars let ilCloGenericFormals = cloinfo.cloILGenericParams assert (isNil cloinfo.localTypeFuncDirectILGenericParams) let ilCloGenericActuals = cloinfo.cloSpec.GenericArgs - let ilCloRetTy = cloinfo.cloILFormalRetTy + let ilCloRetTy = cloinfo.ilCloFormalReturnTy let ilCloTypeRef = cloinfo.cloSpec.TypeRef let ilTyForOverriding = mkILBoxedTy ilCloTypeRef ilCloGenericActuals @@ -4245,13 +4254,11 @@ and GenObjectExpr cenv cgbuf eenvouter expr (baseType, baseValOpt, basecall, ove let attrs = GenAttrs cenv eenvinner cloAttribs let super = (if isInterfaceTy g baseType then g.ilg.typ_Object else ilCloRetTy) let interfaceTys = interfaceTys @ (if isInterfaceTy g baseType then [ilCloRetTy] else []) - let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, ilCloGenericFormals, attrs, ilCloFreeVars, ilCloLambdas, ilCtorBody, mdefs, mimpls, super, interfaceTys) + let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, ilCloGenericFormals, attrs, ilCloAllFreeVars, ilCloLambdas, ilCtorBody, mdefs, mimpls, super, interfaceTys) for cloTypeDef in cloTypeDefs do cgbuf.mgbuf.AddTypeDef(ilCloTypeRef, cloTypeDef, false, false, None) - CountClosure() - GenGetLocalVals cenv cgbuf eenvouter m cloFreeVars - CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ EraseClosures.mkTyOfLambdas g.ilxPubCloEnv ilCloLambdas]) (I_newobj (ilxCloSpec.Constructor, None)) + GenClosureAlloc cenv cgbuf eenvouter (cloinfo, m) GenSequel cenv eenvouter.cloc cgbuf sequel and GenSequenceExpr @@ -4269,7 +4276,7 @@ and GenSequenceExpr eenvouter |> AddStorageForLocalVals g (stateVars |> List.map (fun v -> v.Deref, Local(0, false, None))) // Get the free variables. Make a lambda to pretend that the 'nextEnumeratorValRef' is bound (it is an argument to GenerateNext) - let (cloAttribs, _, _, cloFreeTyvars, cloFreeVars, ilCloTypeRef: ILTypeRef, ilCloFreeVars, eenvinner) = + let (cloAttribs, _, _, cloFreeTyvars, cloFreeVars, ilCloTypeRef: ILTypeRef, ilCloAllFreeVars, eenvinner) = GetIlxClosureFreeVars cenv m [] eenvouter [] (mkLambda m nextEnumeratorValRef.Deref (generateNextExpr, g.int32_ty)) let ilCloSeqElemTy = GenType cenv.amap m eenvinner.tyenv seqElemTy @@ -4284,7 +4291,7 @@ and GenSequenceExpr // Create a new closure class with a single "MoveNext" method that implements the iterator. let ilCloTyInner = mkILFormalBoxedTy ilCloTypeRef ilCloGenericParams let ilCloLambdas = Lambdas_return ilCloRetTyInner - let cloref = IlxClosureRef(ilCloTypeRef, ilCloLambdas, ilCloFreeVars) + let cloref = IlxClosureRef(ilCloTypeRef, ilCloLambdas, ilCloAllFreeVars) let ilxCloSpec = IlxClosureSpec.Create(cloref, GenGenericArgs m eenvouter.tyenv cloFreeTyvars) let formalClospec = IlxClosureSpec.Create(cloref, mkILFormalGenericArgs 0 ilCloGenericParams) @@ -4299,7 +4306,7 @@ and GenSequenceExpr GenDefaultValue cenv cgbuf eenv (fv.Type, m) else GenGetLocalVal cenv cgbuf eenv m fv None - CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ilCloRetTyInner]) (I_newobj (formalClospec.Constructor, None)) + CG.EmitInstr cgbuf (pop ilCloAllFreeVars.Length) (Push [ilCloRetTyInner]) (I_newobj (formalClospec.Constructor, None)) GenSequel cenv eenv.cloc cgbuf Return), m) mkILNonGenericVirtualMethod("GetFreshEnumerator", ILMemberAccess.Public, [], mkILReturn ilCloEnumeratorTy, MethodBody.IL mbody) @@ -4337,7 +4344,7 @@ and GenSequenceExpr let attrs = GenAttrs cenv eenvinner cloAttribs let cloMethods = [generateNextMethod; closeMethod; checkCloseMethod; lastGeneratedMethod; getFreshMethod] - let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, ilCloGenericParams, attrs, ilCloFreeVars, ilCloLambdas, ilCtorBody, cloMethods, [], ilCloBaseTy, []) + let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, ilCloGenericParams, attrs, ilCloAllFreeVars, ilCloLambdas, ilCtorBody, cloMethods, [], ilCloBaseTy, []) for cloTypeDef in cloTypeDefs do cgbuf.mgbuf.AddTypeDef(ilCloTypeRef, cloTypeDef, false, false, None) @@ -4351,16 +4358,16 @@ and GenSequenceExpr else GenGetLocalVal cenv cgbuf eenvouter m fv None - CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ilCloRetTyOuter]) (I_newobj (ilxCloSpec.Constructor, None)) + CG.EmitInstr cgbuf (pop ilCloAllFreeVars.Length) (Push [ilCloRetTyOuter]) (I_newobj (ilxCloSpec.Constructor, None)) GenSequel cenv eenvouter.cloc cgbuf sequel /// Generate the class for a closure type definition -and GenClosureTypeDefs cenv (tref: ILTypeRef, ilGenParams, attrs, ilCloFreeVars, ilCloLambdas, ilCtorBody, mdefs, mimpls, ext, ilIntfTys) = +and GenClosureTypeDefs cenv (tref: ILTypeRef, ilGenParams, attrs, ilCloAllFreeVars, ilCloLambdas, ilCtorBody, mdefs, mimpls, ext, ilIntfTys) = let g = cenv.g let cloInfo = - { cloFreeVars=ilCloFreeVars + { cloFreeVars=ilCloAllFreeVars cloStructure=ilCloLambdas cloCode=notlazy ilCtorBody } @@ -4449,12 +4456,12 @@ and GenLambdaClosure cenv (cgbuf: CodeGenBuffer) eenv isLocalTypeFunc thisVars e cgbuf.mgbuf.AddTypeDef(ilContractTypeRef, ilContractTypeDef, false, false, None) let ilCtorBody = mkILMethodBody (true, [], 8, nonBranchingInstrsToCode (mkCallBaseConstructor(ilContractTy, [])), None ) - let cloMethods = [ mkILGenericVirtualMethod("DirectInvoke", ILMemberAccess.Assembly, cloinfo.localTypeFuncDirectILGenericParams, [], mkILReturn (cloinfo.cloILFormalRetTy), MethodBody.IL ilCloBody) ] - let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, cloinfo.cloILGenericParams, [], cloinfo.cloILFreeVars, cloinfo.ilCloLambdas, ilCtorBody, cloMethods, [], ilContractTy, []) + let cloMethods = [ mkILGenericVirtualMethod("DirectInvoke", ILMemberAccess.Assembly, cloinfo.localTypeFuncDirectILGenericParams, [], mkILReturn (cloinfo.ilCloFormalReturnTy), MethodBody.IL ilCloBody) ] + let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, cloinfo.cloILGenericParams, [], cloinfo.ilCloAllFreeVars, cloinfo.ilCloLambdas, ilCtorBody, cloMethods, [], ilContractTy, []) cloTypeDefs else - GenClosureTypeDefs cenv (ilCloTypeRef, cloinfo.cloILGenericParams, [], cloinfo.cloILFreeVars, cloinfo.ilCloLambdas, ilCloBody, [], [], g.ilg.typ_Object, []) + GenClosureTypeDefs cenv (ilCloTypeRef, cloinfo.cloILGenericParams, [], cloinfo.ilCloAllFreeVars, cloinfo.ilCloLambdas, ilCloBody, [], [], g.ilg.typ_Object, []) CountClosure() for cloTypeDef in cloTypeDefs do cgbuf.mgbuf.AddTypeDef(ilCloTypeRef, cloTypeDef, false, false, None) @@ -4462,17 +4469,18 @@ and GenLambdaClosure cenv (cgbuf: CodeGenBuffer) eenv isLocalTypeFunc thisVars e | _ -> failwith "GenLambda: not a lambda" -and GenLambdaVal cenv (cgbuf: CodeGenBuffer) eenv (cloinfo, m) = +and GenClosureAlloc cenv (cgbuf: CodeGenBuffer) eenv (cloinfo, m) = let g = cenv.g + CountClosure() GenGetLocalVals cenv cgbuf eenv m cloinfo.cloFreeVars CG.EmitInstr cgbuf - (pop cloinfo.cloILFreeVars.Length) + (pop cloinfo.ilCloAllFreeVars.Length) (Push [EraseClosures.mkTyOfLambdas g.ilxPubCloEnv cloinfo.ilCloLambdas]) (I_newobj (cloinfo.cloSpec.Constructor, None)) and GenLambda cenv cgbuf eenv isLocalTypeFunc thisVars expr sequel = let cloinfo, m = GenLambdaClosure cenv cgbuf eenv isLocalTypeFunc thisVars expr - GenLambdaVal cenv cgbuf eenv (cloinfo, m) + GenClosureAlloc cenv cgbuf eenv (cloinfo, m) GenSequel cenv eenv.cloc cgbuf sequel and GenTypeOfVal cenv eenv (v: Val) = @@ -4482,7 +4490,7 @@ and GenFreevar cenv m eenvouter tyenvinner (fv: Val) = let g = cenv.g match StorageForVal cenv.g m fv eenvouter with // Local type functions - | Local(_, _, Some _) | Env(_, _, _, Some _) -> g.ilg.typ_Object + | Local(_, _, Some _) | Env(_, _, Some _) -> g.ilg.typ_Object #if DEBUG // Check for things that should never make it into the free variable set. Only do this in debug for performance reasons | (StaticField _ | StaticProperty _ | Method _ | Null) -> error(InternalError("GenFreevar: compiler error: unexpected unrealized value", fv.Range)) @@ -4563,26 +4571,32 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) eenvouter takenNames ex // Build the environment that is active inside the closure itself let eenvinner = eenvinner |> AddStorageForLocalVals g (thisVars |> List.map (fun v -> (v.Deref, Arg 0))) - let ilCloFreeVars = - let ilCloFreeVarNames = ChooseFreeVarNames takenNames (List.map nameOfVal cloFreeVars) - let ilCloFreeVars = (cloFreeVars, ilCloFreeVarNames) ||> List.map2 (fun fv nm -> mkILFreeVar (nm, fv.IsCompilerGenerated, GenFreevar cenv m eenvouter eenvinner.tyenv fv)) - ilCloFreeVars + let ilCloFreeVars, ilCloFreeVarStorage = + let names = + cloFreeVars + |> List.map nameOfVal + |> ChooseFreeVarNames takenNames - let ilCloFreeVarStorage = - (cloFreeVars, ilCloFreeVars) ||> List.mapi2 (fun i v fv -> + (cloFreeVars, names) + ||> List.map2 (fun fv nm -> let localCloInfo = - match StorageForVal g m v eenvouter with + match StorageForVal g m fv eenvouter with | Local(_, _, localCloInfo) - | Env(_, _, _, localCloInfo) -> localCloInfo + | Env(_, _, localCloInfo) -> localCloInfo | _ -> None - let ilField = mkILFieldSpecInTy (ilCloTyInner, fv.fvName, fv.fvType) + let ilFv = mkILFreeVar (nm, fv.IsCompilerGenerated, GenFreevar cenv m eenvouter eenvinner.tyenv fv) + let storage = + let ilField = mkILFieldSpecInTy (ilCloTyInner, ilFv.fvName, ilFv.fvType) + Env(ilCloTyInner, ilField, localCloInfo) + ilFv, (fv, storage)) + |> List.unzip - (v, Env(ilCloTyInner, i, ilField, localCloInfo))) + let ilCloAllFreeVars = Array.ofList ilCloFreeVars let eenvinner = eenvinner |> AddStorageForLocalVals g ilCloFreeVarStorage // Return a various results - (cloAttribs, cloInternalFreeTyvars, cloContractFreeTyvars, cloFreeTyvars, cloFreeVars, ilCloTypeRef, Array.ofList ilCloFreeVars, eenvinner) + (cloAttribs, cloInternalFreeTyvars, cloContractFreeTyvars, cloFreeTyvars, cloFreeVars, ilCloTypeRef, ilCloAllFreeVars, eenvinner) and GetIlxClosureInfo cenv m isLocalTypeFunc thisVars eenvouter expr = @@ -4612,22 +4626,22 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc thisVars eenvouter expr = let takenNames = vs |> List.map (fun v -> v.CompiledName g.CompilerGlobalState) // Get the free variables and the information about the closure, add the free variables to the environment - let (cloAttribs, cloInternalFreeTyvars, cloContractFreeTyvars, _, cloFreeVars, ilCloTypeRef, ilCloFreeVars, eenvinner) = + let (cloAttribs, cloInternalFreeTyvars, cloContractFreeTyvars, _, cloFreeVars, ilCloTypeRef, ilCloAllFreeVars, eenvinner) = GetIlxClosureFreeVars cenv m thisVars eenvouter takenNames expr // Put the type and value arguments into the environment - let rec getClosureArgs eenv ntmargs tvsl (vs: Val list) = + let rec getClosureArgs eenv numArgs tvsl (vs: Val list) = match tvsl, vs with | tvs :: rest, _ -> let eenv = AddTyparsToEnv tvs eenv - let l, eenv = getClosureArgs eenv ntmargs rest vs + let l, eenv = getClosureArgs eenv numArgs rest vs let lambdas = (tvs, l) ||> List.foldBack (fun tv sofar -> Lambdas_forall(GenGenericParam cenv eenv tv, sofar)) lambdas, eenv | [], v :: rest -> let nm = v.CompiledName g.CompilerGlobalState let l, eenv = - let eenv = AddStorageForVal g (v, notlazy (Arg ntmargs)) eenv - getClosureArgs eenv (ntmargs+1) [] rest + let eenv = AddStorageForVal g (v, notlazy (Arg numArgs)) eenv + getClosureArgs eenv (numArgs+1) [] rest let lambdas = Lambdas_lambda (mkILParamNamed(nm, GenTypeOfVal cenv eenv v), l) lambdas, eenv | _ -> @@ -4688,7 +4702,7 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc thisVars eenvouter expr = let ilCloGenericFormals = ilContractGenericParams @ ilInternalGenericParams let ilCloGenericActuals = ilContractGenericActuals @ ilInternalGenericActuals - let ilDirectGenericParams, ilReturnTy, ilCloLambdas = + let ilDirectGenericParams, ilCloReturnTy, ilCloLambdas = if isLocalTypeFunc then let rec strip lambdas acc = match lambdas with @@ -4700,14 +4714,14 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc thisVars eenvouter expr = [], ilReturnTy, ilCloLambdas - let ilxCloSpec = IlxClosureSpec.Create(IlxClosureRef(ilCloTypeRef, ilCloLambdas, ilCloFreeVars), ilCloGenericActuals) + let ilxCloSpec = IlxClosureSpec.Create(IlxClosureRef(ilCloTypeRef, ilCloLambdas, ilCloAllFreeVars), ilCloGenericActuals) let cloinfo = { cloExpr=expr cloName=ilCloTypeRef.Name cloArityInfo =narginfo ilCloLambdas=ilCloLambdas - cloILFreeVars = ilCloFreeVars - cloILFormalRetTy=ilReturnTy + ilCloAllFreeVars = ilCloAllFreeVars + ilCloFormalReturnTy=ilCloReturnTy cloSpec = ilxCloSpec cloILGenericParams = ilCloGenericFormals cloFreeVars=cloFreeVars @@ -4821,8 +4835,10 @@ and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod((TSlotSig(_, deleg /// Generate statically-resolved conditionals used for type-directed optimizations. and GenStaticOptimization cenv cgbuf eenv (constraints, e2, e3, _m) sequel = let e = - if DecideStaticOptimizations cenv.g constraints = StaticOptimizationAnswer.Yes then e2 - else e3 + if DecideStaticOptimizations cenv.g constraints = StaticOptimizationAnswer.Yes then + e2 + else + e3 GenExpr cenv cgbuf eenv SPSuppress e sequel //------------------------------------------------------------------------- @@ -5225,7 +5241,7 @@ and GenLetRecBindings cenv (cgbuf: CodeGenBuffer) eenv (allBinds: Bindings, m) = clo.cloFreeVars |> List.iter (fun fv -> if Zset.contains fv forwardReferenceSet then match StorageForVal cenv.g m fv eenvclo with - | Env (_, _, ilField, _) -> fixups := (boundv, fv, (fun () -> GenLetRecFixup cenv cgbuf eenv (clo.cloSpec, access, ilField, exprForVal m fv, m))) :: !fixups + | Env (_, ilField, _) -> fixups := (boundv, fv, (fun () -> GenLetRecFixup cenv cgbuf eenv (clo.cloSpec, access, ilField, exprForVal m fv, m))) :: !fixups | _ -> error (InternalError("GenLetRec: " + fv.LogicalName + " was not in the environment", m)) ) | Expr.Val (vref, _, _) -> @@ -5333,13 +5349,9 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) star let methodVars = List.concat vsl CommitStartScope cgbuf startScopeMarkOpt - let ilxMethInfoArgs = - (vspec, mspec, access, paramInfos, retInfo, topValInfo, ctorThisValOpt, baseValOpt, tps, methodVars, methodArgTys, body', bodyty) // if we have any expression recursion depth, we should delay the generation of a method to prevent stack overflows - if cenv.exprRecursionDepth > 0 then - DelayGenMethodForBinding cenv cgbuf.mgbuf eenv ilxMethInfoArgs - else - GenMethodForBinding cenv cgbuf.mgbuf eenv ilxMethInfoArgs + let generator = if cenv.exprRecursionDepth > 0 then DelayGenMethodForBinding else GenMethodForBinding + generator cenv cgbuf.mgbuf eenv (vspec, mspec, access, paramInfos, retInfo, topValInfo, ctorThisValOpt, baseValOpt, tps, methodVars, methodArgTys, body', bodyty) | StaticProperty (ilGetterMethSpec, optShadowLocal) -> @@ -5615,64 +5627,70 @@ and GenParamAttribs cenv paramTy attribs = inFlag, outFlag, optionalFlag, defaultValue, Marshal, attribs /// Generate IL parameters -and GenParams cenv eenv (mspec: ILMethodSpec) (attribs: ArgReprInfo list) methodArgTys (implValsOpt: Val list option) = +and GenParams (cenv: cenv) eenv (mspec: ILMethodSpec) (argInfos: ArgReprInfo list) methodArgTys (implValsOpt: Val list option) = let g = cenv.g let ilArgTys = mspec.FormalArgTypes - let argInfosAndTypes = - if List.length attribs = List.length ilArgTys then List.zip ilArgTys attribs - else ilArgTys |> List.map (fun ilArgTy -> ilArgTy, ValReprInfo.unnamedTopArg1) - let argInfosAndTypes = + let ilArgInfosAndTypes = + if argInfos.Length = ilArgTys.Length then + List.zip ilArgTys argInfos + else + assert false + ilArgTys |> List.map (fun ilArgTy -> ilArgTy, ValReprInfo.unnamedTopArg1) + + let ilArgInfosAndTypes = match implValsOpt with | Some implVals when (implVals.Length = ilArgTys.Length) -> - List.map2 (fun x y -> x, Some y) argInfosAndTypes implVals + List.map2 (fun x y -> x, Some y) ilArgInfosAndTypes implVals | _ -> - List.map (fun x -> x, None) argInfosAndTypes - - (Set.empty, List.zip methodArgTys argInfosAndTypes) - ||> List.mapFold (fun takenNames (methodArgTy, ((ilArgTy, topArgInfo), implValOpt)) -> - let inFlag, outFlag, optionalFlag, defaultParamValue, Marshal, attribs = GenParamAttribs cenv methodArgTy topArgInfo.Attribs - - let idOpt = (match topArgInfo.Name with - | Some v -> Some v - | None -> match implValOpt with - | Some v -> Some v.Id - | None -> None) - - let nmOpt, takenNames = - match idOpt with - | Some id -> - let nm = - if takenNames.Contains(id.idText) then - // Ensure that we have an g.CompilerGlobalState - assert(g.CompilerGlobalState |> Option.isSome) - g.CompilerGlobalState.Value.NiceNameGenerator.FreshCompilerGeneratedName (id.idText, id.idRange) - else - id.idText - Some nm, takenNames.Add nm - | None -> - None, takenNames + List.map (fun x -> x, None) ilArgInfosAndTypes + + let ilParams, _ = + (Set.empty, List.zip methodArgTys ilArgInfosAndTypes) + ||> List.mapFold (fun takenNames (methodArgTy, ((ilArgTy, topArgInfo), implValOpt)) -> + let inFlag, outFlag, optionalFlag, defaultParamValue, Marshal, attribs = GenParamAttribs cenv methodArgTy topArgInfo.Attribs + + let idOpt = (match topArgInfo.Name with + | Some v -> Some v + | None -> match implValOpt with + | Some v -> Some v.Id + | None -> None) + + let nmOpt, takenNames = + match idOpt with + | Some id -> + let nm = + if takenNames.Contains(id.idText) then + // Ensure that we have an g.CompilerGlobalState + assert(g.CompilerGlobalState |> Option.isSome) + g.CompilerGlobalState.Value.NiceNameGenerator.FreshCompilerGeneratedName (id.idText, id.idRange) + else + id.idText + Some nm, takenNames.Add nm + | None -> + None, takenNames - let ilAttribs = GenAttrs cenv eenv attribs + let ilAttribs = GenAttrs cenv eenv attribs - let ilAttribs = - match GenReadOnlyAttributeIfNecessary g methodArgTy with - | Some attr -> ilAttribs @ [attr] - | None -> ilAttribs + let ilAttribs = + match GenReadOnlyAttributeIfNecessary g methodArgTy with + | Some attr -> ilAttribs @ [attr] + | None -> ilAttribs + + let param: ILParameter = + { Name=nmOpt + Type= ilArgTy + Default=defaultParamValue + Marshal=Marshal + IsIn=inFlag + IsOut=outFlag + IsOptional=optionalFlag + CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs ilAttribs) + MetadataIndex = NoMetadataIdx } - let param: ILParameter = - { Name=nmOpt - Type= ilArgTy - Default=defaultParamValue - Marshal=Marshal - IsIn=inFlag - IsOut=outFlag - IsOptional=optionalFlag - CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs ilAttribs) - MetadataIndex = NoMetadataIdx } + param, takenNames) - param, takenNames) - |> fst + ilParams /// Generate IL method return information and GenReturnInfo cenv eenv ilRetTy (retInfo: ArgReprInfo) : ILReturn = @@ -5713,43 +5731,53 @@ and GenEventForProperty cenv eenvForMeth (mspec: ILMethodSpec) (v: Val) ilAttrsT otherMethods= [], customAttrs = mkILCustomAttrs ilAttrsThatGoOnPrimaryItem) -and ComputeFlagFixupsForMemberBinding cenv (v: Val, memberInfo: ValMemberInfo) = - let g = cenv.g - if isNil memberInfo.ImplementedSlotSigs then - [fixupVirtualSlotFlags] - else - memberInfo.ImplementedSlotSigs |> List.map (fun slotsig -> - let oty = slotsig.ImplementedType - let otcref = tcrefOfAppTy g oty - let tcref = v.MemberApparentEntity - - let useMethodImpl = - // REVIEW: it would be good to get rid of this special casing of Compare and GetHashCode during code generation - isInterfaceTy g oty && - (let isCompare = - Option.isSome tcref.GeneratedCompareToValues && - (typeEquiv g oty g.mk_IComparable_ty || - tyconRefEq g g.system_GenericIComparable_tcref otcref) - - not isCompare) && +and ComputeUseMethodImpl cenv (v: Val, slotsig: SlotSig) = + let oty = slotsig.ImplementedType + let otcref = tcrefOfAppTy cenv.g oty + let tcref = v.MemberApparentEntity + // REVIEW: it would be good to get rid of this special casing of Compare and GetHashCode during code generation + isInterfaceTy cenv.g oty && + (let isCompare = + Option.isSome tcref.GeneratedCompareToValues && + (typeEquiv cenv.g oty cenv.g.mk_IComparable_ty || + tyconRefEq cenv.g cenv.g.system_GenericIComparable_tcref otcref) - (let isGenericEquals = - Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues && tyconRefEq g g.system_GenericIEquatable_tcref otcref - - not isGenericEquals) && - (let isStructural = - (Option.isSome tcref.GeneratedCompareToWithComparerValues && typeEquiv g oty g.mk_IStructuralComparable_ty) || - (Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues && typeEquiv g oty g.mk_IStructuralEquatable_ty) + not isCompare) && + + (let isGenericEquals = + Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues && tyconRefEq cenv.g cenv.g.system_GenericIEquatable_tcref otcref - not isStructural) + not isGenericEquals) && + (let isStructural = + (Option.isSome tcref.GeneratedCompareToWithComparerValues && typeEquiv cenv.g oty cenv.g.mk_IStructuralComparable_ty) || + (Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues && typeEquiv cenv.g oty cenv.g.mk_IStructuralEquatable_ty) - let nameOfOverridingMethod = GenNameOfOverridingMethod cenv (useMethodImpl, slotsig) + not isStructural) + +and ComputeMethodImplNameFixupForMemberBinding cenv (v: Val, memberInfo: ValMemberInfo) = + if isNil memberInfo.ImplementedSlotSigs then + None + else + let slotsig = memberInfo.ImplementedSlotSigs |> List.last + let useMethodImpl = ComputeUseMethodImpl cenv (v, slotsig) + let nameOfOverridingMethod = GenNameOfOverridingMethod cenv (useMethodImpl, slotsig) + Some nameOfOverridingMethod + +and ComputeFlagFixupsForMemberBinding cenv (v: Val, memberInfo: ValMemberInfo) = + [ if isNil memberInfo.ImplementedSlotSigs then + yield fixupVirtualSlotFlags + else + for slotsig in memberInfo.ImplementedSlotSigs do + let useMethodImpl = ComputeUseMethodImpl cenv (v, slotsig) if useMethodImpl then - fixupMethodImplFlags >> renameMethodDef nameOfOverridingMethod + yield fixupMethodImplFlags else - fixupVirtualSlotFlags >> renameMethodDef nameOfOverridingMethod) - + yield fixupVirtualSlotFlags + match ComputeMethodImplNameFixupForMemberBinding cenv (v, memberInfo) with + | Some nm -> yield renameMethodDef nm + | None -> () ] + and ComputeMethodImplAttribs cenv (_v: Val) attrs = let g = cenv.g let implflags = @@ -5781,16 +5809,17 @@ and ComputeMethodImplAttribs cenv (_v: Val) attrs = and DelayGenMethodForBinding cenv mgbuf eenv ilxMethInfoArgs = cenv.delayedGenMethods.Enqueue (fun cenv -> GenMethodForBinding cenv mgbuf eenv ilxMethInfoArgs) -and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, topValInfo, ctorThisValOpt, baseValOpt, tps, methodVars, methodArgTys, body, returnTy) = +and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, topValInfo, ctorThisValOpt, baseValOpt, methLambdaTypars, methLambdaVars, methodArgTys, body, returnTy) = let g = cenv.g let m = v.Range + let selfMethodVars, nonSelfMethodVars, compileAsInstance = match v.MemberInfo with | Some _ when ValSpecIsCompiledAsInstance g v -> - match methodVars with + match methLambdaVars with | [] -> error(InternalError("Internal error: empty argument list for instance method", v.Range)) | h :: t -> [h], t, true - | _ -> [], methodVars, false + | _ -> [], methLambdaVars, false let nonUnitNonSelfMethodVars, body = BindUnitVars g (nonSelfMethodVars, paramInfos, body) let nonUnitMethodVars = selfMethodVars@nonUnitNonSelfMethodVars @@ -5801,7 +5830,7 @@ and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, // The type parameters of the method's type are different to the type parameters // for the big lambda ("tlambda") of the implementation of the method. - let eenvUnderMethLambdaTypars = EnvForTypars tps eenv + let eenvUnderMethLambdaTypars = EnvForTypars methLambdaTypars eenv let eenvUnderMethTypeTypars = EnvForTypars cmtps eenv // Add the arguments to the environment. We add an implicit 'this' argument to constructors @@ -5812,7 +5841,8 @@ and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, let eenvForMeth = AddStorageForLocalVals g (List.mapi (fun i v -> (v, Arg (numImplicitArgs+i))) nonUnitMethodVars) eenvForMeth eenvForMeth - let tailCallInfo = [(mkLocalValRef v, BranchCallMethod (topValInfo.AritiesOfArgs, curriedArgInfos, tps, nonUnitMethodVars.Length, v.NumObjArgs))] + let tailCallInfo = + [(mkLocalValRef v, BranchCallMethod (topValInfo.AritiesOfArgs, curriedArgInfos, methLambdaTypars, nonUnitMethodVars.Length, v.NumObjArgs))] // Discard the result on a 'void' return type. For a constructor just return 'void' let sequel = @@ -5824,7 +5854,7 @@ and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, let hasPreserveSigNamedArg, ilMethodBody, hasDllImport = match TryFindFSharpAttributeOpt g g.attrib_DllImportAttribute v.Attribs with | Some (Attrib(_, _, [ AttribStringArg dll ], namedArgs, _, _, m)) -> - if not (isNil tps) then error(Error(FSComp.SR.ilSignatureForExternalFunctionContainsTypeParameters(), m)) + if not (isNil methLambdaTypars) then error(Error(FSComp.SR.ilSignatureForExternalFunctionContainsTypeParameters(), m)) let hasPreserveSigNamedArg, mbody = GenPInvokeMethod (v.CompiledName g.CompilerGlobalState, dll, namedArgs) hasPreserveSigNamedArg, mbody, true @@ -5877,105 +5907,106 @@ and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, [ yield! GenAttrs cenv eenv attrs yield! GenCompilationArgumentCountsAttr cenv v ] - let ilTypars = GenGenericParams cenv eenvUnderMethLambdaTypars tps + let ilTypars = GenGenericParams cenv eenvUnderMethLambdaTypars methLambdaTypars let ilParams = GenParams cenv eenv mspec paramInfos methodArgTys (Some nonUnitNonSelfMethodVars) let ilReturn = GenReturnInfo cenv eenv mspec.FormalReturnType retInfo let methName = mspec.Name let tref = mspec.MethodRef.DeclaringTypeRef - let EmitTheMethodDef (mdef: ILMethodDef) = - // Does the function have an explicit [] attribute? - let isExplicitEntryPoint = HasFSharpAttribute g g.attrib_EntryPointAttribute attrs - - let mdef = - mdef - .WithSecurity(not (List.isEmpty securityAttributes)) - .WithPInvoke(hasDllImport) - .WithPreserveSig(hasPreserveSigImplFlag || hasPreserveSigNamedArg) - .WithSynchronized(hasSynchronizedImplFlag) - .WithNoInlining(hasNoInliningFlag) - .WithAggressiveInlining(hasAggressiveInliningImplFlag) - .With(isEntryPoint=isExplicitEntryPoint, securityDecls=secDecls) - - let mdef = - if // operator names - mdef.Name.StartsWithOrdinal("op_") || - // active pattern names - mdef.Name.StartsWithOrdinal("|") || - // event add/remove method - v.val_flags.IsGeneratedEventVal then - mdef.WithSpecialName - else - mdef - CountMethodDef() - mgbuf.AddMethodDef(tref, mdef) - - match v.MemberInfo with // don't generate unimplemented abstracts | Some memberInfo when memberInfo.MemberFlags.IsDispatchSlot && not memberInfo.IsImplemented -> // skipping unimplemented abstract method () - | Some memberInfo when not v.IsExtensionMember -> - - let ilMethTypars = ilTypars |> List.drop mspec.DeclaringType.GenericArgs.Length - if memberInfo.MemberFlags.MemberKind = MemberKind.Constructor then - assert (isNil ilMethTypars) - let mdef = mkILCtor (access, ilParams, ilMethodBody) - let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) - EmitTheMethodDef mdef - - elif memberInfo.MemberFlags.MemberKind = MemberKind.ClassConstructor then - assert (isNil ilMethTypars) - let mdef = mkILClassCtor ilMethodBody - let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) - EmitTheMethodDef mdef - - // Generate virtual/override methods + method-impl information if needed - else - let mdef = - if not compileAsInstance then - mkILStaticMethod (ilMethTypars, v.CompiledName g.CompilerGlobalState, access, ilParams, ilReturn, ilMethodBody) - elif (memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) || - memberInfo.MemberFlags.IsOverrideOrExplicitImpl then + // compiling CLIEvent properties + | Some memberInfo + when not v.IsExtensionMember && + (match memberInfo.MemberFlags.MemberKind with + | (MemberKind.PropertySet | MemberKind.PropertyGet) -> CompileAsEvent cenv.g v.Attribs + | _ -> false) -> - let flagFixups = ComputeFlagFixupsForMemberBinding cenv (v, memberInfo) - let mdef = mkILGenericVirtualMethod (v.CompiledName g.CompilerGlobalState, ILMemberAccess.Public, ilMethTypars, ilParams, ilReturn, ilMethodBody) - let mdef = List.fold (fun mdef f -> f mdef) mdef flagFixups + let useMethodImpl = + if compileAsInstance && + ((memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) || + memberInfo.MemberFlags.IsOverrideOrExplicitImpl) then - // fixup can potentially change name of reflected definition that was already recorded - patch it if necessary - mgbuf.ReplaceNameOfReflectedDefinition(v, mdef.Name) - mdef - else - mkILGenericNonVirtualMethod (v.CompiledName g.CompilerGlobalState, access, ilMethTypars, ilParams, ilReturn, ilMethodBody) + let useMethodImpl = memberInfo.ImplementedSlotSigs |> List.exists (fun slotsig -> ComputeUseMethodImpl cenv (v, slotsig)) - let isAbstract = - memberInfo.MemberFlags.IsDispatchSlot && - let tcref = v.MemberApparentEntity - not tcref.Deref.IsFSharpDelegateTycon + let nameOfOverridingMethod = + match ComputeMethodImplNameFixupForMemberBinding cenv (v, memberInfo) with + | None -> mspec.Name + | Some nm -> nm - let mdef = - if mdef.IsVirtual then - mdef.WithFinal(memberInfo.MemberFlags.IsFinal).WithAbstract(isAbstract) - else mdef + // Fixup can potentially change name of reflected definition that was already recorded - patch it if necessary + mgbuf.ReplaceNameOfReflectedDefinition(v, nameOfOverridingMethod) + useMethodImpl + else + false - match memberInfo.MemberFlags.MemberKind with - - | (MemberKind.PropertySet | MemberKind.PropertyGet) -> - if not (isNil ilMethTypars) then - error(InternalError("A property may not be more generic than the enclosing type - constrain the polymorphism in the expression", v.Range)) - - // Check if we're compiling the property as a .NET event - if CompileAsEvent g v.Attribs then + // skip method generation for compiling the property as a .NET event + // Instead emit the pseudo-property as an event. + // on't do this if it's a private method impl. + if not useMethodImpl then + let edef = GenEventForProperty cenv eenvForMeth mspec v ilAttrsThatGoOnPrimaryItem m returnTy + mgbuf.AddEventDef(tref, edef) + | _ -> - // Emit the pseudo-property as an event, but not if its a private method impl - if mdef.Access <> ILMemberAccess.Private then - let edef = GenEventForProperty cenv eenvForMeth mspec v ilAttrsThatGoOnPrimaryItem m returnTy - mgbuf.AddEventDef(tref, edef) - // The method def is dropped on the floor here + let mdef = + match v.MemberInfo with + | Some memberInfo when not v.IsExtensionMember -> + + let ilMethTypars = ilTypars |> List.drop mspec.DeclaringType.GenericArgs.Length + if memberInfo.MemberFlags.MemberKind = MemberKind.Constructor then + assert (isNil ilMethTypars) + let mdef = mkILCtor (access, ilParams, ilMethodBody) + let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) + mdef + + elif memberInfo.MemberFlags.MemberKind = MemberKind.ClassConstructor then + assert (isNil ilMethTypars) + let mdef = mkILClassCtor ilMethodBody + let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) + mdef + + // Generate virtual/override methods + method-impl information if needed + else + let mdef = + if not compileAsInstance then + mkILStaticMethod (ilMethTypars, v.CompiledName g.CompilerGlobalState, access, ilParams, ilReturn, ilMethodBody) + + elif (memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) || + memberInfo.MemberFlags.IsOverrideOrExplicitImpl then + + let flagFixups = ComputeFlagFixupsForMemberBinding cenv (v, memberInfo) + let mdef = mkILGenericVirtualMethod (v.CompiledName g.CompilerGlobalState, ILMemberAccess.Public, ilMethTypars, ilParams, ilReturn, ilMethodBody) + let mdef = List.fold (fun mdef f -> f mdef) mdef flagFixups + + // fixup can potentially change name of reflected definition that was already recorded - patch it if necessary + mgbuf.ReplaceNameOfReflectedDefinition(v, mdef.Name) + mdef + else + mkILGenericNonVirtualMethod (v.CompiledName g.CompilerGlobalState, access, ilMethTypars, ilParams, ilReturn, ilMethodBody) + + let isAbstract = + memberInfo.MemberFlags.IsDispatchSlot && + let tcref = v.MemberApparentEntity + not tcref.Deref.IsFSharpDelegateTycon + + let mdef = + if mdef.IsVirtual then + mdef.WithFinal(memberInfo.MemberFlags.IsFinal).WithAbstract(isAbstract) + else mdef + + match memberInfo.MemberFlags.MemberKind with + + | (MemberKind.PropertySet | MemberKind.PropertyGet) -> + if not (isNil ilMethTypars) then + error(InternalError("A property may not be more generic than the enclosing type - constrain the polymorphism in the expression", v.Range)) - else + // Check if we're compiling the property as a .NET event + assert not (CompileAsEvent cenv.g v.Attribs) + // Emit the property, but not if its a private method impl if mdef.Access <> ILMemberAccess.Private then let vtyp = ReturnTypeOfPropertyVal g v @@ -5986,26 +6017,52 @@ and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, // Add the special name flag for all properties let mdef = mdef.WithSpecialName.With(customAttrs= mkILCustomAttrs ((GenAttrs cenv eenv attrsAppliedToGetterOrSetter) @ sourceNameAttribs @ ilAttrsCompilerGenerated)) - EmitTheMethodDef mdef - | _ -> - let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) - EmitTheMethodDef mdef + mdef + | _ -> + let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) + mdef - | _ -> - let mdef = mkILStaticMethod (ilTypars, methName, access, ilParams, ilReturn, ilMethodBody) + | _ -> + let mdef = mkILStaticMethod (ilTypars, methName, access, ilParams, ilReturn, ilMethodBody) + + // For extension properties, also emit attrsAppliedToGetterOrSetter on the getter or setter method + let ilAttrs = + match v.MemberInfo with + | Some memberInfo when v.IsExtensionMember -> + match memberInfo.MemberFlags.MemberKind with + | (MemberKind.PropertySet | MemberKind.PropertyGet) -> ilAttrsThatGoOnPrimaryItem @ GenAttrs cenv eenv attrsAppliedToGetterOrSetter + | _ -> ilAttrsThatGoOnPrimaryItem + | _ -> ilAttrsThatGoOnPrimaryItem + + let ilCustomAttrs = mkILCustomAttrs (ilAttrs @ sourceNameAttribs @ ilAttrsCompilerGenerated) + let mdef = mdef.With(customAttrs= ilCustomAttrs) + mdef - // For extension properties, also emit attrsAppliedToGetterOrSetter on the getter or setter method - let ilAttrs = - match v.MemberInfo with - | Some memberInfo when v.IsExtensionMember -> - match memberInfo.MemberFlags.MemberKind with - | (MemberKind.PropertySet | MemberKind.PropertyGet) -> ilAttrsThatGoOnPrimaryItem @ GenAttrs cenv eenv attrsAppliedToGetterOrSetter - | _ -> ilAttrsThatGoOnPrimaryItem - | _ -> ilAttrsThatGoOnPrimaryItem - - let ilCustomAttrs = mkILCustomAttrs (ilAttrs @ sourceNameAttribs @ ilAttrsCompilerGenerated) - let mdef = mdef.With(customAttrs= ilCustomAttrs) - EmitTheMethodDef mdef + // Does the function have an explicit [] attribute? + let isExplicitEntryPoint = HasFSharpAttribute g g.attrib_EntryPointAttribute attrs + + let mdef = + mdef + .WithSecurity(not (List.isEmpty securityAttributes)) + .WithPInvoke(hasDllImport) + .WithPreserveSig(hasPreserveSigImplFlag || hasPreserveSigNamedArg) + .WithSynchronized(hasSynchronizedImplFlag) + .WithNoInlining(hasNoInliningFlag) + .WithAggressiveInlining(hasAggressiveInliningImplFlag) + .With(isEntryPoint=isExplicitEntryPoint, securityDecls=secDecls) + + let mdef = + if // operator names + mdef.Name.StartsWithOrdinal("op_") || + // active pattern names + mdef.Name.StartsWithOrdinal("|") || + // event add/remove method + v.val_flags.IsGeneratedEventVal then + mdef.WithSpecialName + else + mdef + CountMethodDef() + mgbuf.AddMethodDef(tref, mdef) and GenPInvokeMethod (nm, dll, namedArgs) = let decoder = AttributeDecoder namedArgs @@ -6044,7 +6101,7 @@ and GenBindings cenv cgbuf eenv binds = List.iter (GenBinding cenv cgbuf eenv) b and GenSetVal cenv cgbuf eenv (vref, e, m) sequel = let storage = StorageForValRef cenv.g m vref eenv match storage with - | Env (ilCloTy, _, _, _) -> + | Env (ilCloTy, _, _) -> CG.EmitInstr cgbuf (pop 0) (Push [ilCloTy]) mkLdarg0 | _ -> () @@ -6122,7 +6179,7 @@ and GenSetStorage m cgbuf storage = | Arg _ -> error(Error(FSComp.SR.ilMutableVariablesCannotEscapeMethod(), m)) - | Env (_, _, ilField, _) -> + | Env (_, ilField, _) -> // Note: ldarg0 has already been emitted in GenSetVal CG.EmitInstr cgbuf (pop 2) Push0 (mkNormalStfld ilField) @@ -6136,7 +6193,7 @@ and CommitGetStorageSequel cenv cgbuf eenv m ty localCloInfo storeSequel = | _, Some ([], [], _, sequel) -> GenSequel cenv eenv.cloc cgbuf sequel | _, Some (tyargs, args, m, sequel) -> - GenArgsAndIndirectCall cenv cgbuf eenv (ty, tyargs, args, m) sequel + GenCurriedArgsAndIndirectCall cenv cgbuf eenv (ty, tyargs, args, m) sequel and GenGetStorageAndSequel cenv cgbuf eenv m (ty, ilTy) storage storeSequel = let g = cenv.g @@ -6185,7 +6242,7 @@ and GenGetStorageAndSequel cenv cgbuf eenv m (ty, ilTy) storage storeSequel = CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdarg (uint16 i)) CommitGetStorageSequel cenv cgbuf eenv m ty None storeSequel - | Env (_, _, ilField, localCloInfo) -> + | Env (_, ilField, localCloInfo) -> // Note: ldarg 0 is emitted in 'cu_erase' erasure of the ldenv instruction CG.EmitInstrs cgbuf (pop 0) (Push [ilTy]) [ mkLdarg0; mkNormalLdfld ilField ] CommitGetStorageSequel cenv cgbuf eenv m ty localCloInfo storeSequel @@ -6254,7 +6311,7 @@ and AllocStorageForBinds cenv cgbuf scopeMarks eenv binds = | Some repr -> match repr with | Local(_, _, Some g) - | Env(_, _, _, Some g) -> + | Env(_, _, Some g) -> match !g with | NamedLocalIlxClosureInfoGenerator f -> g := NamedLocalIlxClosureInfoGenerated (f eenv) | NamedLocalIlxClosureInfoGenerated _ -> () @@ -7773,7 +7830,7 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: Constrai member __.GenerateCode (codeGenOpts, typedAssembly, assemAttribs, moduleAttribs) = let cenv: cenv = { g=tcGlobals - TcVal = tcVal + tcVal = tcVal viewCcu = ccu ilUnitTy = None amap = amap diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index f1c86005ad7..c246dfac66e 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2421,7 +2421,7 @@ and OptimizeWhileLoop cenv env (spWhile, marker, e1, e2, m) = and OptimizeTraitCall cenv env (traitInfo, args, m) = // Resolve the static overloading early (during the compulsory rewrite phase) so we can inline. - match ConstraintSolver.CodegenWitnessThatTypeSupportsTraitConstraint cenv.TcVal cenv.g cenv.amap m traitInfo args with + match ConstraintSolver.CodegenWitnessForTraitConstraint cenv.TcVal cenv.g cenv.amap m traitInfo args with | OkResult (_, Some expr) -> OptimizeExpr cenv env expr diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index 711bae6cbbc..dbfad70ed9f 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -2336,6 +2336,6 @@ let CheckTopImpl (g, amap, reportErrors, infoReader, internalsVisibleToPaths, vi CheckModuleExpr cenv env mexpr CheckAttribs cenv env extraAttribs - if cenv.usesQuotations && QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat g = QuotationTranslator.QuotationSerializationFormat.FSharp_20_Plus then + if cenv.usesQuotations && not (QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat(g).SupportsDeserializeEx) then viewCcu.UsesFSharp20PlusQuotations <- true cenv.entryPointGiven, cenv.anonRecdTypes diff --git a/src/fsharp/QuotationPickler.fs b/src/fsharp/QuotationPickler.fs index 0929b14f6c5..05348a218bd 100644 --- a/src/fsharp/QuotationPickler.fs +++ b/src/fsharp/QuotationPickler.fs @@ -97,7 +97,6 @@ type CombOp = | TryFinallyOp | TryWithOp - /// Represents specifications of a subset of F# expressions type ExprData = | AttrExpr of ExprData * ExprData list @@ -123,7 +122,8 @@ let mkQuoteRaw40 (a) = QuoteRawExpr (a) let mkCond (x1, x2, x3) = CombExpr(CondOp, [], [x1;x2;x3]) -let mkModuleValueApp (tcref, nm, isProp, tyargs, args: ExprData list list) = CombExpr(ModuleValueOp(tcref, nm, isProp), tyargs, List.concat args) +let mkModuleValueApp (tcref, nm, isProp, tyargs, args: ExprData list list) = + CombExpr(ModuleValueOp(tcref, nm, isProp), tyargs, List.concat args) let mkTuple (ty, x) = CombExpr(TupleMkOp, [ty], x) diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index f7b37607275..7c930de439c 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -30,9 +30,10 @@ type IsReflectedDefinition = [] type QuotationSerializationFormat = - /// Indicates that type references are emitted as integer indexes into a supplied table - | FSharp_40_Plus - | FSharp_20_Plus + { + /// Indicates that type references are emitted as integer indexes into a supplied table + SupportsDeserializeEx: bool + } type QuotationGenerationScope = { g: TcGlobals @@ -67,18 +68,16 @@ type QuotationGenerationScope = cenv.exprSplices |> ResizeArray.toList static member ComputeQuotationFormat g = - let deserializeExValRef = ValRefForIntrinsic g.deserialize_quoted_FSharp_40_plus_info - if deserializeExValRef.TryDeref.IsSome then - QuotationSerializationFormat.FSharp_40_Plus - else - QuotationSerializationFormat.FSharp_20_Plus + { + SupportsDeserializeEx = (ValRefForIntrinsic g.deserialize_quoted_FSharp_40_plus_info).TryDeref.IsSome + } type QuotationTranslationEnv = { /// Map from Val to binding index vs: ValMap - nvs: int + numValsInScope: int /// Map from typar stamps to binding index tyvs: StampMap @@ -94,7 +93,7 @@ type QuotationTranslationEnv = static member Empty = { vs = ValMap<_>.Empty - nvs = 0 + numValsInScope = 0 tyvs = Map.empty isinstVals = ValMap<_>.Empty substVals = ValMap<_>.Empty } @@ -104,15 +103,16 @@ type QuotationTranslationEnv = { env with tyvs = env.tyvs.Add(v.Stamp, idx ) } member env.BindTypars vs = - (env, vs) ||> List.fold (fun env v -> env.BindTypar v) // fold left-to-right because indexes are left-to-right + (env, vs) ||> List.fold (fun env v -> env.BindTypar v) let BindFormalTypars (env: QuotationTranslationEnv) vs = { env with tyvs = Map.empty }.BindTypars vs let BindVal env v = + let n = env.numValsInScope { env with - vs = env.vs.Add v env.nvs - nvs = env.nvs + 1 } + vs = env.vs.Add v n + numValsInScope = n + 1 } let BindIsInstVal env v (ty, e) = { env with isinstVals = env.isinstVals.Add v (ty, e) } @@ -120,9 +120,9 @@ let BindIsInstVal env v (ty, e) = let BindSubstVal env v e = { env with substVals = env.substVals.Add v e } -let BindVals env vs = List.fold BindVal env vs // fold left-to-right because indexes are left-to-right +let BindVals env vs = List.fold BindVal env vs -let BindFlatVals env vs = List.fold BindVal env vs // fold left-to-right because indexes are left-to-right +let BindFlatVals env vs = List.fold BindVal env vs exception InvalidQuotedTerm of exn @@ -384,7 +384,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. | Expr.Quote (ast, _, _, _, ety) -> // F# 2.0-3.1 had a bug with nested 'raw' quotations. F# 4.0 + FSharp.Core 4.4.0.0+ allows us to do the right thing. - if cenv.quotationFormat = QuotationSerializationFormat.FSharp_40_Plus && + if cenv.quotationFormat.SupportsDeserializeEx && // Look for a 'raw' quotation tyconRefEq cenv.g (tcrefOfAppTy cenv.g ety) cenv.g.raw_expr_tcr then @@ -421,7 +421,6 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let argsR = ConvExprs cenv env args QP.mkUnion(tcR, s, tyargsR, argsR) - | TOp.Tuple tupInfo, tyargs, _ -> let tyR = ConvType cenv env m (mkAnyTupledTy cenv.g tupInfo tyargs) let argsR = ConvExprs cenv env args @@ -601,10 +600,10 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. QP.mkTryWith(ConvExpr cenv env e1, vfR, ConvExpr cenv envf ef, vhR, ConvExpr cenv envh eh) | TOp.Bytes bytes, [], [] -> - ConvExpr cenv env (Expr.Op (TOp.Array, [cenv.g.byte_ty], List.ofArray (Array.map (mkByte cenv.g m) bytes), m)) + ConvExpr cenv env (Expr.Op (TOp.Array, [cenv.g.byte_ty], List.ofArray (Array.map (mkByte cenv.g m) bytes), m)) | TOp.UInt16s arr, [], [] -> - ConvExpr cenv env (Expr.Op (TOp.Array, [cenv.g.uint16_ty], List.ofArray (Array.map (mkUInt16 cenv.g m) arr), m)) + ConvExpr cenv env (Expr.Op (TOp.Array, [cenv.g.uint16_ty], List.ofArray (Array.map (mkUInt16 cenv.g m) arr), m)) | TOp.UnionCaseProof _, _, [e] -> ConvExpr cenv env e // Note: we erase the union case proof conversions when converting to quotations @@ -987,8 +986,7 @@ and ConvILTypeRefUnadjusted cenv m (tr: ILTypeRef) = ConvILTypeRef cenv trefAdjusted and ConvILTypeRef cenv (tr: ILTypeRef) = - match cenv.quotationFormat with - | QuotationSerializationFormat.FSharp_40_Plus -> + if cenv.quotationFormat.SupportsDeserializeEx then let idx = match cenv.referencedTypeDefsTable.TryGetValue tr with | true, idx -> idx @@ -999,7 +997,7 @@ and ConvILTypeRef cenv (tr: ILTypeRef) = idx QP.Idx idx - | QuotationSerializationFormat.FSharp_20_Plus -> + else let assemblyRef = match tr.Scope with | ILScopeRef.Local -> "." @@ -1091,16 +1089,16 @@ let ConvMethodBase cenv env (methName, v: Val) = let numGenericArgs = tps.Length-numEnclTypeArgs if isNewObj then - QP.MethodBaseData.Ctor - { ctorParent = parentTyconR - ctorArgTypes = methArgTypesR } + QP.MethodBaseData.Ctor + { ctorParent = parentTyconR + ctorArgTypes = methArgTypesR } else - QP.MethodBaseData.Method - { methParent = parentTyconR - methArgTypes = methArgTypesR - methRetType = methRetTypeR - methName = methName - numGenericArgs=numGenericArgs } + QP.MethodBaseData.Method + { methParent = parentTyconR + methArgTypes = methArgTypesR + methRetType = methRetTypeR + methName = methName + numGenericArgs=numGenericArgs } | _ when v.IsExtensionMember -> diff --git a/src/fsharp/QuotationTranslator.fsi b/src/fsharp/QuotationTranslator.fsi index d7fcb7a999b..096bf7db9e6 100755 --- a/src/fsharp/QuotationTranslator.fsi +++ b/src/fsharp/QuotationTranslator.fsi @@ -20,9 +20,10 @@ type IsReflectedDefinition = [] type QuotationSerializationFormat = - /// Indicates that type references are emitted as integer indexes into a supplied table - | FSharp_40_Plus - | FSharp_20_Plus + { + /// Indicates that type references are emitted as integer indexes into a supplied table + SupportsDeserializeEx: bool + } [] type QuotationGenerationScope = From b5154a2d728eca0b01412191a80fccca37a8e2d4 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 17 Apr 2020 19:37:45 +0100 Subject: [PATCH 02/14] witness passing implementation --- src/fsharp/ConstraintSolver.fs | 30 +- src/fsharp/ConstraintSolver.fsi | 13 +- src/fsharp/FSComp.txt | 1 + src/fsharp/FSharp.Core/Linq.fs | 190 +-- src/fsharp/FSharp.Core/prim-types.fs | 1229 ++++++++++++----- src/fsharp/FSharp.Core/prim-types.fsi | 129 +- src/fsharp/FSharp.Core/quotations.fs | 238 +++- src/fsharp/FSharp.Core/quotations.fsi | 29 +- src/fsharp/FSharp.Core/reflect.fs | 4 +- src/fsharp/FSharp.Core/seq.fs | 4 +- src/fsharp/IlxGen.fs | 1057 +++++++++----- src/fsharp/LanguageFeatures.fs | 3 + src/fsharp/LanguageFeatures.fsi | 1 + src/fsharp/MethodCalls.fs | 57 +- src/fsharp/MethodOverrides.fs | 4 +- src/fsharp/NicePrint.fs | 13 +- src/fsharp/Optimizer.fs | 37 +- src/fsharp/PostInferenceChecks.fs | 21 +- src/fsharp/PostInferenceChecks.fsi | 1 + src/fsharp/PrettyNaming.fs | 1 + src/fsharp/QuotationPickler.fs | 34 +- src/fsharp/QuotationPickler.fsi | 7 +- src/fsharp/QuotationTranslator.fs | 276 +++- src/fsharp/QuotationTranslator.fsi | 14 +- src/fsharp/TcGlobals.fs | 94 +- src/fsharp/TypeChecker.fs | 13 +- src/fsharp/TypedTree.fs | 26 +- src/fsharp/TypedTreeOps.fs | 175 ++- src/fsharp/TypedTreeOps.fsi | 46 +- src/fsharp/fsc.fs | 8 +- src/fsharp/infos.fs | 13 +- src/fsharp/symbols/SymbolHelpers.fs | 4 +- .../SurfaceArea.coreclr.fs | 163 +++ .../SurfaceArea.net40.fs | 163 +++ tests/fsharp/core/quotes/test.fsx | 679 ++++++++- tests/fsharp/tests.fs | 2 +- .../ExpressionQuotations/Regressions/env.lst | 2 +- tests/fsharpqa/Source/Printing/Quotation01.fs | 4 +- 38 files changed, 3704 insertions(+), 1081 deletions(-) diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 20ecf317dc8..981732e68f2 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -245,6 +245,11 @@ type ConstraintSolverState = /// The function used to freshen values we encounter during trait constraint solving TcVal: TcValF + /// Indicates if the constraint solver is being run after type checking is complete, + /// e.g. during codegen to determine solutions and witnesses for trait constraints. + /// Suppresses the generation of certain errors such as missing constraint warnings. + codegen: bool + /// This table stores all unsolved, ungeneralized trait constraints, indexed by free type variable. /// That is, there will be one entry in this table for each free type variable in /// each outstanding, unsolved, ungeneralized trait constraint. Constraints are removed from the table and resolved @@ -257,6 +262,7 @@ type ConstraintSolverState = amap = amap ExtraCxs = HashMultiMap(10, HashIdentity.Structural) InfoReader = infoReader + codegen = false TcVal = tcVal } type ConstraintSolverEnv = @@ -1939,14 +1945,14 @@ and AddConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace tp newConstraint | (TyparRigidity.Rigid | TyparRigidity.WillBeRigid), TyparConstraint.DefaultsTo _ -> true | _ -> false) then () - elif tp.Rigidity = TyparRigidity.Rigid then + elif tp.Rigidity = TyparRigidity.Rigid && not csenv.SolverState.codegen then return! ErrorD (ConstraintSolverMissingConstraint(denv, tp, newConstraint, m, m2)) else // It is important that we give a warning if a constraint is missing from a // will-be-made-rigid type variable. This is because the existence of these warnings // is relevant to the overload resolution rules (see 'candidateWarnCount' in the overload resolution // implementation). - if tp.Rigidity.WarnIfMissingConstraint then + if tp.Rigidity.WarnIfMissingConstraint && not csenv.SolverState.codegen then do! WarnD (ConstraintSolverMissingConstraint(denv, tp, newConstraint, m, m2)) let newConstraints = @@ -3059,9 +3065,11 @@ let CreateCodegenState tcVal g amap = amap = amap TcVal = tcVal ExtraCxs = HashMultiMap(10, HashIdentity.Structural) - InfoReader = new InfoReader(g, amap) } + InfoReader = new InfoReader(g, amap) + codegen = true } -let CodegenWitnessThatTypeSupportsTraitConstraint tcVal g amap m (traitInfo: TraitConstraintInfo) argExprs = trackErrors { +/// Generate a witness expression if none is otherwise available, e.g. in legacy non-witness-passing code +let CodegenWitnessForTraitConstraint tcVal g amap m (traitInfo:TraitConstraintInfo) argExprs = trackErrors { let css = CreateCodegenState tcVal g amap let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) @@ -3072,6 +3080,19 @@ let CodegenWitnessThatTypeSupportsTraitConstraint tcVal g amap m (traitInfo: Tra return sln } +/// Generate the arguments passed for a use of a generic construct that accepts trait witnesses +let CodegenWitnessesForTyparInst tcVal g amap m typars tyargs = trackErrors { + let css = CreateCodegenState tcVal g amap + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) + let ftps, _renaming, tinst = FreshenTypeInst m typars + let cxs = GetTraitConstraintInfosOfTypars g ftps + do! SolveTypeEqualsTypeEqns csenv 0 m NoTrace None tinst tyargs + return MethodCalls.GenWitnessArgs amap g m cxs + } + +/// For some code like "let f() = ([] = [])", a free choice is made for a type parameter +/// for an interior type variable. This chooses a solution for a type parameter subject +/// to its constraints and applies that solution by using a constraint. let ChooseTyparSolutionAndSolve css denv tp = let g = css.g let amap = css.amap @@ -3114,6 +3135,7 @@ let IsApplicableMethApprox g amap m (minfo: MethInfo) availObjTy = amap = amap TcVal = (fun _ -> failwith "should not be called") ExtraCxs = HashMultiMap(10, HashIdentity.Structural) + codegen = false InfoReader = new InfoReader(g, amap) } let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) let minst = FreshenMethInfo m minfo diff --git a/src/fsharp/ConstraintSolver.fsi b/src/fsharp/ConstraintSolver.fsi index 2d1107b0a13..ec97e7a1225 100644 --- a/src/fsharp/ConstraintSolver.fsi +++ b/src/fsharp/ConstraintSolver.fsi @@ -191,10 +191,17 @@ val SolveTypeAsError: DisplayEnv -> ConstraintSolverState -> range -> TType -> u val ApplyTyparDefaultAtPriority: DisplayEnv -> ConstraintSolverState -> priority: int -> Typar -> unit -val CodegenWitnessThatTypeSupportsTraitConstraint: TcValF -> TcGlobals -> ImportMap -> range -> TraitConstraintInfo -> Expr list -> OperationResult +/// Generate a witness expression if none is otherwise available, e.g. in legacy non-witness-passing code +val CodegenWitnessForTraitConstraint : TcValF -> TcGlobals -> ImportMap -> range -> TraitConstraintInfo -> Expr list -> OperationResult -val ChooseTyparSolutionAndSolve: ConstraintSolverState -> DisplayEnv -> Typar -> unit +/// Generate the arguments passed when using a generic construct that accepts traits witnesses +val CodegenWitnessesForTyparInst : TcValF -> TcGlobals -> ImportMap -> range -> Typars -> TType list -> OperationResult list> + +/// For some code like "let f() = ([] = [])", a free choice is made for a type parameter +/// for an interior type variable. This chooses a solution for a type parameter subject +/// to its constraints and applies that solution by using a constraint. +val ChooseTyparSolutionAndSolve : ConstraintSolverState -> DisplayEnv -> Typar -> unit val IsApplicableMethApprox: TcGlobals -> ImportMap -> range -> MethInfo -> TType -> bool -val CanonicalizePartialInferenceProblem: ConstraintSolverState -> DisplayEnv -> range -> Typars -> unit \ No newline at end of file +val CanonicalizePartialInferenceProblem: ConstraintSolverState -> DisplayEnv -> range -> Typars -> unit diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index bbcd42bf9f7..ffcf210d9bf 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -1509,3 +1509,4 @@ featureFixedIndexSlice3d4d,"fixed-index slice 3d/4d" featureAndBang,"applicative computation expressions" featureNullableOptionalInterop,"nullable optional interop" featureDefaultInterfaceMemberConsumption,"default interface member consumption" +featureWitnessPassing,"witness passing" diff --git a/src/fsharp/FSharp.Core/Linq.fs b/src/fsharp/FSharp.Core/Linq.fs index 028d3bf777a..8bc7fcf5615 100644 --- a/src/fsharp/FSharp.Core/Linq.fs +++ b/src/fsharp/FSharp.Core/Linq.fs @@ -360,88 +360,87 @@ module LeafExpressionConverter = | PlusQ (_, [ty1; ty2; ty3], [x1; x2]) when (ty1 = typeof) && (ty2 = typeof) && (ty3 = typeof) -> Expression.Add(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2, StringConcat) |> asExpr - | GenericEqualityQ (_, _, [x1; x2]) - | EqualsQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.Equal - | NotEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.NotEqual - | GreaterQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.GreaterThan - | GreaterEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.GreaterThanOrEqual - | LessQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.LessThan - | LessEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.LessThanOrEqual - | NotQ (_, _, [x1]) -> Expression.Not(ConvExprToLinqInContext env x1) |> asExpr - - | StaticEqualsQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.Equal - | StaticNotEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.NotEqual - | StaticGreaterQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.GreaterThan - | StaticGreaterEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.GreaterThanOrEqual - | StaticLessQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.LessThan - | StaticLessEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.LessThanOrEqual - - | NullableEqualsQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.Equal - | NullableNotEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.NotEqual - | NullableGreaterQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.GreaterThan - | NullableGreaterEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.GreaterThanOrEqual - | NullableLessQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.LessThan - | NullableLessEqQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.LessThanOrEqual - - | EqualsNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.Equal - | NotEqNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.NotEqual - | GreaterNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.GreaterThan - | GreaterEqNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.GreaterThanOrEqual - | LessNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.LessThan - | LessEqNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.LessThanOrEqual - - | NullableEqualsNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.Equal - | NullableNotEqNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.NotEqual - | NullableGreaterNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.GreaterThan - | NullableGreaterEqNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.GreaterThanOrEqual - | NullableLessNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.LessThan - | NullableLessEqNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.LessThanOrEqual - + | GenericEqualityQ _ + | EqualsQ _ -> transBinOp inp env false args false Expression.Equal + | NotEqQ _ -> transBinOp inp env false args false Expression.NotEqual + | GreaterQ _ -> transBinOp inp env false args false Expression.GreaterThan + | GreaterEqQ _ -> transBinOp inp env false args false Expression.GreaterThanOrEqual + | LessQ _ -> transBinOp inp env false args false Expression.LessThan + | LessEqQ _ -> transBinOp inp env false args false Expression.LessThanOrEqual + | NotQ (_, _, [x1]) -> Expression.Not(ConvExprToLinqInContext env x1) |> asExpr + + | StaticEqualsQ _ -> transBinOp inp env false args false Expression.Equal + | StaticNotEqQ _ -> transBinOp inp env false args false Expression.NotEqual + | StaticGreaterQ _ -> transBinOp inp env false args false Expression.GreaterThan + | StaticGreaterEqQ _ -> transBinOp inp env false args false Expression.GreaterThanOrEqual + | StaticLessQ _ -> transBinOp inp env false args false Expression.LessThan + | StaticLessEqQ _ -> transBinOp inp env false args false Expression.LessThanOrEqual + + | NullableEqualsQ _ -> transBinOp inp env false args true Expression.Equal + | NullableNotEqQ _ -> transBinOp inp env false args true Expression.NotEqual + | NullableGreaterQ _ -> transBinOp inp env false args true Expression.GreaterThan + | NullableGreaterEqQ _ -> transBinOp inp env false args true Expression.GreaterThanOrEqual + | NullableLessQ _ -> transBinOp inp env false args true Expression.LessThan + | NullableLessEqQ _ -> transBinOp inp env false args true Expression.LessThanOrEqual + + | EqualsNullableQ _ -> transBinOp inp env true args false Expression.Equal + | NotEqNullableQ _ -> transBinOp inp env true args false Expression.NotEqual + | GreaterNullableQ _ -> transBinOp inp env true args false Expression.GreaterThan + | GreaterEqNullableQ _ -> transBinOp inp env true args false Expression.GreaterThanOrEqual + | LessNullableQ _ -> transBinOp inp env true args false Expression.LessThan + | LessEqNullableQ _ -> transBinOp inp env true args false Expression.LessThanOrEqual + + | NullableEqualsNullableQ _ -> transBinOp inp env false args false Expression.Equal + | NullableNotEqNullableQ _ -> transBinOp inp env false args false Expression.NotEqual + | NullableGreaterNullableQ _ -> transBinOp inp env false args false Expression.GreaterThan + | NullableGreaterEqNullableQ _ -> transBinOp inp env false args false Expression.GreaterThanOrEqual + | NullableLessNullableQ _ -> transBinOp inp env false args false Expression.LessThan + | NullableLessEqNullableQ _ -> transBinOp inp env false args false Expression.LessThanOrEqual + // Detect the F# quotation encoding of decimal literals | MakeDecimalQ (_, _, [Int32 lo; Int32 med; Int32 hi; Bool isNegative; Byte scale]) -> Expression.Constant (new System.Decimal(lo, med, hi, isNegative, scale)) |> asExpr - | NegQ (_, _, [x1]) -> Expression.Negate(ConvExprToLinqInContext env x1) |> asExpr - | PlusQ (_, _, [x1; x2]) -> Expression.Add(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | DivideQ (_, _, [x1; x2]) -> Expression.Divide (ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | MinusQ (_, _, [x1; x2]) -> Expression.Subtract(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | MultiplyQ (_, _, [x1; x2]) -> Expression.Multiply(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | ModuloQ (_, _, [x1; x2]) -> Expression.Modulo (ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - - | ShiftLeftQ (_, _, [x1; x2]) -> Expression.LeftShift(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | ShiftRightQ (_, _, [x1; x2]) -> Expression.RightShift(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | BitwiseAndQ (_, _, [x1; x2]) -> Expression.And(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | BitwiseOrQ (_, _, [x1; x2]) -> Expression.Or(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | BitwiseXorQ (_, _, [x1; x2]) -> Expression.ExclusiveOr(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr + | NegQ (_, _, [x1]) -> Expression.Negate(ConvExprToLinqInContext env x1) |> asExpr + | PlusQ _ -> transBinOp inp env false args false Expression.Add + | DivideQ _ -> transBinOp inp env false args false Expression.Divide + | MinusQ _ -> transBinOp inp env false args false Expression.Subtract + | MultiplyQ _ -> transBinOp inp env false args false Expression.Multiply + | ModuloQ _ -> transBinOp inp env false args false Expression.Modulo + + | ShiftLeftQ _ -> transBinOp inp env false args false Expression.LeftShift + | ShiftRightQ _ -> transBinOp inp env false args false Expression.RightShift + | BitwiseAndQ _ -> transBinOp inp env false args false Expression.And + | BitwiseOrQ _ -> transBinOp inp env false args false Expression.Or + | BitwiseXorQ _ -> transBinOp inp env false args false Expression.ExclusiveOr | BitwiseNotQ (_, _, [x1]) -> Expression.Not(ConvExprToLinqInContext env x1) |> asExpr - - | CheckedNeg (_, _, [x1]) -> Expression.NegateChecked(ConvExprToLinqInContext env x1) |> asExpr - | CheckedPlusQ (_, _, [x1; x2]) -> Expression.AddChecked(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | CheckedMinusQ (_, _, [x1; x2]) -> Expression.SubtractChecked(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - | CheckedMultiplyQ (_, _, [x1; x2]) -> Expression.MultiplyChecked(ConvExprToLinqInContext env x1, ConvExprToLinqInContext env x2) |> asExpr - - - | NullablePlusQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.Add - | PlusNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.Add - | NullablePlusNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.Add - - | NullableMinusQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.Subtract - | MinusNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.Subtract - | NullableMinusNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.Subtract - - | NullableMultiplyQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.Multiply - | MultiplyNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.Multiply - | NullableMultiplyNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.Multiply - - | NullableDivideQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.Divide - | DivideNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.Divide - | NullableDivideNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.Divide - - | NullableModuloQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 true Expression.Modulo - | ModuloNullableQ (_, _, [x1; x2]) -> transBinOp env true x1 x2 false Expression.Modulo - | NullableModuloNullableQ (_, _, [x1; x2]) -> transBinOp env false x1 x2 false Expression.Modulo - - | ConvNullableCharQ (_, _, [x1]) -> Expression.Convert(ConvExprToLinqInContext env x1, typeof>) |> asExpr + + | CheckedNeg (_, _, [x1]) -> Expression.NegateChecked(ConvExprToLinqInContext env x1) |> asExpr + | CheckedPlusQ _ -> transBinOp inp env false args false Expression.AddChecked + | CheckedMinusQ _ -> transBinOp inp env false args false Expression.SubtractChecked + | CheckedMultiplyQ _ -> transBinOp inp env false args false Expression.MultiplyChecked + + | NullablePlusQ _ -> transBinOp inp env false args true Expression.Add + | PlusNullableQ _ -> transBinOp inp env true args false Expression.Add + | NullablePlusNullableQ _ -> transBinOp inp env false args false Expression.Add + + | NullableMinusQ _ -> transBinOp inp env false args true Expression.Subtract + | MinusNullableQ _ -> transBinOp inp env true args false Expression.Subtract + | NullableMinusNullableQ _ -> transBinOp inp env false args false Expression.Subtract + + | NullableMultiplyQ _ -> transBinOp inp env false args true Expression.Multiply + | MultiplyNullableQ _ -> transBinOp inp env true args false Expression.Multiply + | NullableMultiplyNullableQ _ -> transBinOp inp env false args false Expression.Multiply + + | NullableDivideQ _ -> transBinOp inp env false args true Expression.Divide + | DivideNullableQ _ -> transBinOp inp env true args false Expression.Divide + | NullableDivideNullableQ _ -> transBinOp inp env false args false Expression.Divide + + | NullableModuloQ _ -> transBinOp inp env false args true Expression.Modulo + | ModuloNullableQ _ -> transBinOp inp env true args false Expression.Modulo + | NullableModuloNullableQ _ -> transBinOp inp env false args false Expression.Modulo + + | ConvNullableCharQ (_, _, [x1]) -> Expression.Convert(ConvExprToLinqInContext env x1, typeof>) |> asExpr | ConvNullableDecimalQ (_, _, [x1]) -> Expression.Convert(ConvExprToLinqInContext env x1, typeof>) |> asExpr | ConvNullableFloatQ (_, _, [x1]) -> Expression.Convert(ConvExprToLinqInContext env x1, typeof>) |> asExpr | ConvNullableDoubleQ (_, _, [x1]) -> Expression.Convert(ConvExprToLinqInContext env x1, typeof>) |> asExpr @@ -497,10 +496,19 @@ module LeafExpressionConverter = // Throw away markers inserted to satisfy C#'s design where they pass an argument // or type T to an argument expecting Expression. | ImplicitExpressionConversionHelperQ (_, [_], [x1]) -> ConvExprToLinqInContext env x1 - - | _ -> - let argsP = ConvExprsToLinq env args - Expression.Call(ConvObjArg env objOpt None, minfo, argsP) |> asExpr + + /// Use witnesses if they are available + | CallWithWitnesses (objArgOpt, _, minfo2, witnessArgs, args) -> + let fullArgs = witnessArgs @ args + let replacementExpr = + match objArgOpt with + | None -> Expr.Call(minfo2, fullArgs) + | Some objArg -> Expr.Call(objArg, minfo2, fullArgs) + ConvExprToLinqInContext env replacementExpr + + | _ -> + let argsP = ConvExprsToLinq env args + Expression.Call(ConvObjArg env objOpt None, minfo, argsP) |> asExpr #if !NO_CURRIED_FUNCTION_OPTIMIZATIONS // f x1 x2 x3 x4 --> InvokeFast4 @@ -651,17 +659,21 @@ module LeafExpressionConverter = let convType = lambdaTy.MakeGenericType tyargs let convDelegate = Expression.Lambda(convType, bodyP, [| vP |]) |> asExpr Expression.Call(typeof, "ToFSharpFunc", tyargs, [| convDelegate |]) |> asExpr - | _ -> - raise (new NotSupportedException(Printf.sprintf "Could not convert the following F# Quotation to a LINQ Expression Tree\n--------\n%A\n-------------\n" inp)) + failConvert inp - and transBinOp env addConvertLeft x1 x2 addConvertRight (exprErasedConstructor : _ * _ -> _) = - let e1 = ConvExprToLinqInContext env x1 - let e2 = ConvExprToLinqInContext env x2 - let e1 = if addConvertLeft then Expression.Convert(e1, typedefof>.MakeGenericType [| e1.Type |]) |> asExpr else e1 - let e2 = if addConvertRight then Expression.Convert(e2, typedefof>.MakeGenericType [| e2.Type |]) |> asExpr else e2 - exprErasedConstructor(e1, e2) |> asExpr + and failConvert inp = + raise (new NotSupportedException(Printf.sprintf "Could not convert the following F# Quotation to a LINQ Expression Tree\n--------\n%A\n-------------\n" inp)) + and transBinOp inp env addConvertLeft args addConvertRight (exprErasedConstructor : _ * _ -> _) = + match args with + | [x1; x2] -> + let e1 = ConvExprToLinqInContext env x1 + let e2 = ConvExprToLinqInContext env x2 + let e1 = if addConvertLeft then Expression.Convert(e1, typedefof>.MakeGenericType [| e1.Type |]) |> asExpr else e1 + let e2 = if addConvertRight then Expression.Convert(e2, typedefof>.MakeGenericType [| e2.Type |]) |> asExpr else e2 + exprErasedConstructor(e1, e2) |> asExpr + | _ -> failConvert inp and ConvObjArg env objOpt coerceTo : Expression = match objOpt with diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 78441e75df8..e7c2c4926fa 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -316,10 +316,15 @@ namespace Microsoft.FSharp.Core [] [] - type NoDynamicInvocationAttribute() = + type NoDynamicInvocationAttribute(isLegacy: bool) = + inherit System.Attribute() - [] + new () = NoDynamicInvocationAttribute(false) + + member x.IsLegacy = isLegacy + + [] [] type OptionalArgumentAttribute() = inherit System.Attribute() @@ -392,6 +397,7 @@ namespace Microsoft.FSharp.Core module internal BasicInlinedOperations = let inline unboxPrim<'T>(x:obj) = (# "unbox.any !0" type ('T) x : 'T #) let inline box (x:'T) = (# "box !0" type ('T) x : obj #) + let inline convPrim<'T1, 'T2>(x: 'T1) : 'T2 = unboxPrim<'T2> (box x) let inline not (b:bool) = (# "ceq" b false : bool #) let inline (=) (x:int) (y:int) = (# "ceq" x y : bool #) let inline (<>) (x:int) (y:int) = not(# "ceq" x y : bool #) @@ -456,14 +462,14 @@ namespace Microsoft.FSharp.Core let inline iscastPrim<'T when 'T : not struct>(x:obj) = (# "isinst !0" type ('T) x : 'T #) + let inline mask (n:int) (m:int) = (# "and" n m : int #) open BasicInlinedOperations module TupleUtils = - // adapted from System.Tuple :: CombineHashCodes - let inline mask (n:int) (m:int) = (# "and" n m : int #) + // adapted from System.Tuple::CombineHashCodes let inline opshl (x:int) (n:int) : int = (# "shl" x (mask n 31) : int #) let inline opxor (x:int) (y:int) : int = (# "xor" x y : int32 #) let inline combineTupleHashes (h1 : int) (h2 : int) = (opxor ((opshl h1 5) + h1) h2) @@ -584,7 +590,7 @@ namespace Microsoft.FSharp.Core then TypeNullnessSemantics_NullNotLiked else TypeNullnessSemantics_NullTrueValue - [] + type TypeInfo<'T>() = // Compute an on-demand per-instantiation static field static let info = getTypeInfo typeof<'T> @@ -1979,6 +1985,10 @@ namespace Microsoft.FSharp.Core let inline PhysicalHash obj = HashCompare.PhysicalHashFast obj + let inline typeeq<'T, 'U> = PhysicalEquality typeof<'T> typeof<'U> + let inline type2eq<'T1, 'T2, 'U> = typeeq<'T1, 'U> && typeeq<'T2, 'U> + let inline type3eq<'T1, 'T2, 'T3, 'U> = typeeq<'T1, 'U> && typeeq<'T2, 'U> && typeeq<'T3, 'U> + let GenericComparer = HashCompare.fsComparerER :> IComparer let GenericEqualityComparer = HashCompare.fsEqualityComparerUnlimitedHashingPER :> IEqualityComparer @@ -2212,7 +2222,7 @@ namespace Microsoft.FSharp.Core let inline EnumOfValue (value : 'T) : 'Enum when 'Enum : enum<'T> = unboxPrim<'Enum>(box value) // According to the somewhat subtle rules of static optimizations, - // this condition is used whenever 'Enum is resolved to a nominal type + // this condition is used whenever 'Enum is resolved to a nominal when 'Enum : 'Enum = (retype value : 'Enum) let inline EnumToValue (enum : 'Enum) : 'T when 'Enum : enum<'T> = @@ -2345,7 +2355,22 @@ namespace Microsoft.FSharp.Core | 'o' -> parseOctalUInt64 (s.Substring(p)) | _ -> UInt64.Parse(s.Substring(p), NumberStyles.AllowLeadingSign, CultureInfo.InvariantCulture) + let inline ParseByte (s:string) = (# "conv.ovf.u1" (ParseUInt32 s) : byte #) + + let inline ParseSByte (s:string) = (# "conv.ovf.i1" (ParseInt32 s) : sbyte #) + + let inline ParseInt16 (s:string) = (# "conv.ovf.i2" (ParseInt32 s) : int16 #) + + let inline ParseUInt16 (s:string) = (# "conv.ovf.u2" (ParseUInt32 s) : uint16 #) + + let inline ParseIntPtr (s:string) = (# "conv.ovf.i" (ParseInt64 s) : nativeint #) + let inline ParseUIntPtr (s:string) = (# "conv.ovf.u" (ParseInt64 s) : unativeint #) + + let inline ParseDouble (s:string) = Double.Parse(removeUnderscores s,NumberStyles.Float, CultureInfo.InvariantCulture) + + let inline ParseSingle (s:string) = Single.Parse(removeUnderscores s,NumberStyles.Float, CultureInfo.InvariantCulture) + [] type GenericZeroDynamicImplTable<'T>() = static let result : 'T = @@ -2438,197 +2463,671 @@ namespace Microsoft.FSharp.Core // That is, not in the generic implementation of '+' when ^T : ^T = (^T : (static member One : ^T) ()) - [] - type GenericDivideByIntDynamicImplTable<'T>() = - static let result : ('T -> int -> 'T) = + type System.Type with + + member inline this.GetSingleStaticMethodByTypes(name: string, parameterTypes: Type[]) = + let staticBindingFlags = (# "" 0b111000 : BindingFlags #) // BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic + this.GetMethod(name, staticBindingFlags, null, parameterTypes, null ) + + let UnaryDynamicImpl nm : ('T -> 'U) = + let aty = typeof<'T> + let minfo = aty.GetSingleStaticMethodByTypes(nm, [| aty |]) + (fun x -> unboxPrim<_>(minfo.Invoke(null,[| box x|]))) + + let BinaryDynamicImpl nm : ('T -> 'U -> 'V) = + let aty = typeof<'T> + let bty = typeof<'U> + let minfo = aty.GetSingleStaticMethodByTypes(nm, [| aty; bty |]) + (fun x y -> unboxPrim<_>(minfo.Invoke(null,[| box x; box y|]))) + + // Legacy dynamic implementation of operator resolution if no built in solution is used and no witness passed + type UnaryOpDynamicImplTable<'OpInfo,'T,'U>() = + static let mutable meth : MethodInfo = null + + static member Invoke opName (x: 'T) : 'U = // The dynamic implementation let aty = typeof<'T> - if aty.Equals(typeof) then unboxPrim<_> (box (fun (x:decimal) (n:int) -> System.Decimal.Divide(x, System.Convert.ToDecimal(n)))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:float) (n:int) -> (# "div" x ((# "conv.r8" n : float #)) : float #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:float32) (n:int) -> (# "div" x ((# "conv.r4" n : float32 #)) : float32 #))) - else - match aty.GetMethod("DivideByInt",[| aty; typeof |]) with - | null -> raise (NotSupportedException (SR.GetString(SR.dyInvDivByIntCoerce))) - | m -> (fun x n -> unboxPrim<_> (m.Invoke(null,[| box x; box n |]))) - - static member Result : ('T -> int -> 'T) = result - - let DivideByIntDynamic<'T> x y = GenericDivideByIntDynamicImplTable<('T)>.Result x y - let inline DivideByInt< ^T when ^T : (static member DivideByInt : ^T * int -> ^T) > (x:^T) (y:int) : ^T = - DivideByIntDynamic<'T> x y - when ^T : float = (# "div" x ((# "conv.r8" (y:int) : float #)) : float #) - when ^T : float32 = (# "div" x ((# "conv.r4" (y:int) : float32 #)) : float32 #) - when ^T : decimal = System.Decimal.Divide((retype x:decimal), System.Convert.ToDecimal(y)) - when ^T : ^T = (^T : (static member DivideByInt : ^T * int -> ^T) (x, y)) - - - // Dynamic implementation of addition operator resolution - [] - type AdditionDynamicImplTable<'T,'U,'V>() = - static let impl : ('T -> 'U -> 'V) = - // The dynamic implementation - let aty = typeof<'T> - let bty = typeof<'U> - let cty = typeof<'V> - let dyn() = - let ameth = aty.GetMethod("op_Addition",[| aty; bty |]) - let bmeth = if aty.Equals(bty) then null else bty.GetMethod("op_Addition",[| aty; bty |]) - match ameth,bmeth with - | null, null -> raise (NotSupportedException (SR.GetString(SR.dyInvOpAddCoerce))) - | m,null | null,m -> (fun x y -> unboxPrim<_> (m.Invoke(null,[| box x; box y |]))) - | _ -> raise (NotSupportedException (SR.GetString(SR.dyInvOpAddOverload))) - - if aty.Equals(bty) && bty.Equals(cty) then - if aty.Equals(typeof) then unboxPrim<_> (box (fun (x:sbyte) (y:sbyte) -> (# "conv.i1" (# "add" x y : int32 #) : sbyte #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:int16) (y:int16) -> (# "conv.i2" (# "add" x y : int32 #) : int16 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:int32) (y:int32) -> (# "add" x y : int32 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:int64) (y:int64) -> (# "add" x y : int64 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:nativeint) (y:nativeint) -> (# "add" x y : nativeint #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:byte) (y:byte) -> (# "conv.u1" (# "add" x y : uint32 #) : byte #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:uint16) (y:uint16) -> (# "conv.u2" (# "add" x y : uint32 #) : uint16 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:uint32) (y:uint32) -> (# "add" x y : uint32 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:uint64) (y:uint64) -> (# "add" x y : uint64 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:unativeint) (y:unativeint) -> (# "add" x y : unativeint #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:float) (y:float) -> (# "add" x y : float #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:float32) (y:float32) -> (# "add" x y : float32 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:string) (y:string) -> System.String.Concat(x,y))) - else dyn() - else dyn() - - static member Impl : ('T -> 'U -> 'V) = impl - - let AdditionDynamic<'T,'U,'V> x y = AdditionDynamicImplTable<'T,'U,'V>.Impl x y - - // Dynamic implementation of checked addition operator resolution - [] - type CheckedAdditionDynamicImplTable<'T,'U,'V>() = - static let impl : ('T -> 'U -> 'V) = - // The dynamic implementation - let aty = typeof<'T> - let bty = typeof<'U> - let cty = typeof<'V> - let dyn() = - let ameth = aty.GetMethod("op_Addition",[| aty; bty |]) - let bmeth = if aty.Equals(bty) then null else bty.GetMethod("op_Addition",[| aty; bty |]) - match ameth,bmeth with + match meth with + | null -> + let ameth = aty.GetSingleStaticMethodByTypes(opName, [| aty |]) + match ameth with + | null -> raise (NotSupportedException (SR.GetString(SR.dyInvOpAddCoerce))) + | res -> + meth <- res + | _ -> () + unboxPrim<'U> (meth.Invoke(null,[| box x |])) + + // Legacy dynamic implementation of operator resolution, if no built in solution is used and no witness passed + type BinaryOpDynamicImplTable<'OpInfo,'T1,'T2,'U>() = + static let mutable meth : MethodInfo = null + + static member Invoke opName (x: 'T1) (y: 'T2) : 'U = + match meth with + | null -> + // The dynamic implementation + let aty = typeof<'T1> + let bty = typeof<'T2> + + let ameth = aty.GetSingleStaticMethodByTypes(opName, [| aty; bty |]) + let bmeth = + if aty.Equals(bty) then null else + bty.GetSingleStaticMethodByTypes(opName, [| aty; bty |]) + match ameth, bmeth with | null, null -> raise (NotSupportedException (SR.GetString(SR.dyInvOpAddCoerce))) - | m,null | null,m -> (fun x y -> unboxPrim<_> (m.Invoke(null,[| box x; box y |]))) + | m, null | null, m -> + meth <- m | _ -> raise (NotSupportedException (SR.GetString(SR.dyInvOpAddOverload))) - - if aty.Equals(bty) && bty.Equals(cty) then - if aty.Equals(typeof) then unboxPrim<_> (box (fun (x:sbyte) (y:sbyte) -> (# "conv.ovf.i1" (# "add.ovf" x y : int32 #) : sbyte #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:int16) (y:int16) -> (# "conv.ovf.i2" (# "add.ovf" x y : int32 #) : int16 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:int32) (y:int32) -> (# "add.ovf" x y : int32 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:int64) (y:int64) -> (# "add.ovf" x y : int64 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:nativeint) (y:nativeint) -> (# "add.ovf" x y : nativeint #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:byte) (y:byte) -> (# "conv.ovf.u1.un" (# "add.ovf.un" x y : uint32 #) : byte #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:uint16) (y:uint16) -> (# "conv.ovf.u2.un" (# "add.ovf.un" x y : uint32 #) : uint16 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:char) (y:char) -> (# "conv.ovf.u2.un" (# "add.ovf.un" x y : uint32 #) : char #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:uint32) (y:uint32) -> (# "add.ovf.un" x y : uint32 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:uint64) (y:uint64) -> (# "add.ovf.un" x y : uint64 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:unativeint) (y:unativeint) -> (# "add.ovf.un" x y : unativeint #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:float) (y:float) -> (# "add" x y : float #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:float32) (y:float32) -> (# "add" x y : float32 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:string) (y:string) -> System.String.Concat(x,y))) - else dyn() - else dyn() - - - static member Impl : ('T -> 'U -> 'V) = impl - - let CheckedAdditionDynamic<'T,'U,'V> x y = CheckedAdditionDynamicImplTable<'T,'U,'V>.Impl x y - - - // Dynamic implementation of addition operator resolution - [] - type MultiplyDynamicImplTable<'T,'U,'V>() = - static let impl : ('T -> 'U -> 'V) = - // The dynamic implementation - let aty = typeof<'T> - let bty = typeof<'U> - let cty = typeof<'V> - let dyn() = - let ameth = aty.GetMethod("op_Multiply",[| aty; bty |]) - let bmeth = if aty.Equals(bty) then null else bty.GetMethod("op_Multiply",[| aty; bty |]) - match ameth,bmeth with - | null, null -> raise (NotSupportedException (SR.GetString(SR.dyInvOpMultCoerce))) - | m,null | null,m -> (fun x y -> unboxPrim<_> (m.Invoke(null,[| box x; box y |]))) - | _ -> raise (NotSupportedException (SR.GetString(SR.dyInvOpMultOverload))) - - if aty.Equals(bty) && bty.Equals(cty) then - if aty.Equals(typeof) then unboxPrim<_> (box (fun (x:sbyte) (y:sbyte) -> (# "conv.i1" (# "mul" x y : int32 #) : sbyte #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:int16) (y:int16) -> (# "conv.i2" (# "mul" x y : int32 #) : int16 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:int32) (y:int32) -> (# "mul" x y : int32 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:int64) (y:int64) -> (# "mul" x y : int64 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:nativeint) (y:nativeint) -> (# "mul" x y : nativeint #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:byte) (y:byte) -> (# "conv.u1" (# "mul" x y : uint32 #) : byte #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:uint16) (y:uint16) -> (# "conv.u2" (# "mul" x y : uint32 #) : uint16 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:uint32) (y:uint32) -> (# "mul" x y : uint32 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:uint64) (y:uint64) -> (# "mul" x y : uint64 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:unativeint) (y:unativeint) -> (# "mul" x y : unativeint #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:float) (y:float) -> (# "mul" x y : float #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:float32) (y:float32) -> (# "mul" x y : float32 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:string) (y:string) -> System.String.Concat(x,y))) - else dyn() - else dyn() - - static member Impl : ('T -> 'U -> 'V) = impl - - let MultiplyDynamic<'T,'U,'V> x y = MultiplyDynamicImplTable<'T,'U,'V>.Impl x y - - // Dynamic implementation of checked addition operator resolution - [] - type CheckedMultiplyDynamicImplTable<'T,'U,'V>() = - static let impl : ('T -> 'U -> 'V) = - // The dynamic implementation - let aty = typeof<'T> - let bty = typeof<'U> - let cty = typeof<'V> - let dyn() = - let ameth = aty.GetMethod("op_Multiply",[| aty; bty |]) - let bmeth = if aty.Equals(bty) then null else bty.GetMethod("op_Multiply",[| aty; bty |]) - match ameth,bmeth with - | null, null -> raise (NotSupportedException (SR.GetString(SR.dyInvOpMultCoerce))) - | m,null | null,m -> (fun x y -> unboxPrim<_> (m.Invoke(null,[| box x; box y |]))) - | _ -> raise (NotSupportedException (SR.GetString(SR.dyInvOpMultOverload))) - - if aty.Equals(bty) && bty.Equals(cty) then - if aty.Equals(typeof) then unboxPrim<_> (box (fun (x:sbyte) (y:sbyte) -> (# "conv.ovf.i1" (# "mul.ovf" x y : int32 #) : sbyte #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:int16) (y:int16) -> (# "conv.ovf.i2" (# "mul.ovf" x y : int32 #) : int16 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:int32) (y:int32) -> (# "mul.ovf" x y : int32 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:int64) (y:int64) -> (# "mul.ovf" x y : int64 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:nativeint) (y:nativeint) -> (# "mul.ovf" x y : nativeint #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:byte) (y:byte) -> (# "conv.ovf.u1.un" (# "mul.ovf.un" x y : uint32 #) : byte #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:uint16) (y:uint16) -> (# "conv.ovf.u2.un" (# "mul.ovf.un" x y : uint16 #) : uint16 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:uint32) (y:uint32) -> (# "mul.ovf.un" x y : uint32 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:uint64) (y:uint64) -> (# "mul.ovf.un" x y : uint64 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:unativeint) (y:unativeint) -> (# "mul.ovf.un" x y : unativeint #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:float) (y:float) -> (# "mul" x y : float #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:float32) (y:float32) -> (# "mul" x y : float32 #))) - elif aty.Equals(typeof) then unboxPrim<_> (box (fun (x:string) (y:string) -> System.String.Concat(x,y))) - else dyn() - else dyn() - - static member Impl : ('T -> 'U -> 'V) = impl - - let CheckedMultiplyDynamic<'T,'U,'V> x y = CheckedMultiplyDynamicImplTable<'T,'U,'V>.Impl x y - - -namespace System - - open System - open System.Collections - open System.Collections.Generic - open System.Diagnostics - open System.Globalization - open System.Text - open Microsoft.FSharp.Core - open Microsoft.FSharp.Core.BasicInlinedOperations - open Microsoft.FSharp.Core.LanguagePrimitives - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicFunctions - + | _ -> () + unboxPrim<'U> (meth.Invoke(null,[| box x; box y |])) + + type OpAdditionInfo = class end + + let AdditionDynamic<'T1, 'T2, 'U> (x: 'T1) (y: 'T2) : 'U = + if type3eq<'T1, 'T2, 'U, int32> then convPrim<_,'U> (# "add" (convPrim<_,int32> x) (convPrim<_,int32> y) : int32 #) + elif type3eq<'T1, 'T2, 'U, float> then convPrim<_,'U> (# "add" (convPrim<_,float> x) (convPrim<_,float> y) : float #) + elif type3eq<'T1, 'T2, 'U, float32> then convPrim<_,'U> (# "add" (convPrim<_,float32> x) (convPrim<_,float32> y) : float32 #) + elif type3eq<'T1, 'T2, 'U, int64> then convPrim<_,'U> (# "add" (convPrim<_,int64> x) (convPrim<_,int64> y) : int64 #) + elif type3eq<'T1, 'T2, 'U, uint64> then convPrim<_,'U> (# "add" (convPrim<_,uint64> x) (convPrim<_,uint64> y) : uint64 #) + elif type3eq<'T1, 'T2, 'U, uint32> then convPrim<_,'U> (# "add" (convPrim<_,uint32> x) (convPrim<_,uint32> y) : uint32 #) + elif type3eq<'T1, 'T2, 'U, nativeint> then convPrim<_,'U> (# "add" (convPrim<_,nativeint> x) (convPrim<_,nativeint> y) : nativeint #) + elif type3eq<'T1, 'T2, 'U, unativeint> then convPrim<_,'U> (# "add" (convPrim<_,unativeint> x) (convPrim<_,unativeint> y) : unativeint #) + elif type3eq<'T1, 'T2, 'U, int16> then convPrim<_,'U> (# "conv.i2" (# "add" (convPrim<_,int16> x) (convPrim<_,int16> y) : int32 #) : int16 #) + elif type3eq<'T1, 'T2, 'U, uint16> then convPrim<_,'U> (# "conv.u2" (# "add" (convPrim<_,uint16> x) (convPrim<_,uint16> y) : uint32 #) : uint16 #) + elif type3eq<'T1, 'T2, 'U, char> then convPrim<_,'U> (# "conv.u2" (# "add" (convPrim<_,char> x) (convPrim<_,char> y) : uint32 #) : char #) + elif type3eq<'T1, 'T2, 'U, sbyte> then convPrim<_,'U> (# "conv.i1" (# "add" (convPrim<_,sbyte> x) (convPrim<_,sbyte> y) : int32 #) : sbyte #) + elif type3eq<'T1, 'T2, 'U, byte> then convPrim<_,'U> (# "conv.u1" (# "add" (convPrim<_,byte> x) (convPrim<_,byte> y) : uint32 #) : byte #) + elif type3eq<'T1, 'T2, 'U, string> then convPrim<_,'U> (String.Concat(convPrim<_,string> x, convPrim<_,string> y)) + elif type3eq<'T1, 'T2, 'U, decimal> then convPrim<_,'U> (Decimal.op_Addition(convPrim<_,decimal> x, convPrim<_,decimal> y)) + else BinaryOpDynamicImplTable.Invoke "op_Addition" x y + + type OpSubtractionInfo = class end + let SubtractionDynamic<'T1, 'T2, 'U> (x: 'T1) (y: 'T2) : 'U = + if type3eq<'T1, 'T2, 'U, int32> then convPrim<_,'U> (# "sub" (convPrim<_,int32> x) (convPrim<_,int32> y) : int32 #) + elif type3eq<'T1, 'T2, 'U, float> then convPrim<_,'U> (# "sub" (convPrim<_,float> x) (convPrim<_,float> y) : float #) + elif type3eq<'T1, 'T2, 'U, float32> then convPrim<_,'U> (# "sub" (convPrim<_,float32> x) (convPrim<_,float32> y) : float32 #) + elif type3eq<'T1, 'T2, 'U, int64> then convPrim<_,'U> (# "sub" (convPrim<_,int64> x) (convPrim<_,int64> y) : int64 #) + elif type3eq<'T1, 'T2, 'U, uint64> then convPrim<_,'U> (# "sub" (convPrim<_,uint64> x) (convPrim<_,uint64> y) : uint64 #) + elif type3eq<'T1, 'T2, 'U, uint32> then convPrim<_,'U> (# "sub" (convPrim<_,uint32> x) (convPrim<_,uint32> y) : uint32 #) + elif type3eq<'T1, 'T2, 'U, nativeint> then convPrim<_,'U> (# "sub" (convPrim<_,nativeint> x) (convPrim<_,nativeint> y) : nativeint #) + elif type3eq<'T1, 'T2, 'U, unativeint> then convPrim<_,'U> (# "sub" (convPrim<_,unativeint> x) (convPrim<_,unativeint> y) : unativeint #) + elif type3eq<'T1, 'T2, 'U, int16> then convPrim<_,'U> (# "conv.i2" (# "sub" (convPrim<_,int16> x) (convPrim<_,int16> y) : int32 #) : int16 #) + elif type3eq<'T1, 'T2, 'U, uint16> then convPrim<_,'U> (# "conv.u2" (# "sub" (convPrim<_,uint16> x) (convPrim<_,uint16> y) : uint32 #) : uint16 #) + elif type3eq<'T1, 'T2, 'U, sbyte> then convPrim<_,'U> (# "conv.i1" (# "sub" (convPrim<_,sbyte> x) (convPrim<_,sbyte> y) : int32 #) : sbyte #) + elif type3eq<'T1, 'T2, 'U, byte> then convPrim<_,'U> (# "conv.u1" (# "sub" (convPrim<_,byte> x) (convPrim<_,byte> y) : uint32 #) : byte #) + elif type3eq<'T1, 'T2, 'U, decimal> then convPrim<_,'U> (Decimal.op_Subtraction(convPrim<_,decimal> x, convPrim<_,decimal> y)) + else BinaryOpDynamicImplTable.Invoke "op_Subtraction" x y + + type OpMultiplyInfo = class end + let MultiplyDynamic<'T1, 'T2, 'U> (x: 'T1) (y: 'T2) : 'U = + if type3eq<'T1, 'T2, 'U, int32> then convPrim<_,'U> (# "mul" (convPrim<_,int32> x) (convPrim<_,int32> y) : int32 #) + elif type3eq<'T1, 'T2, 'U, float> then convPrim<_,'U> (# "mul" (convPrim<_,float> x) (convPrim<_,float> y) : float #) + elif type3eq<'T1, 'T2, 'U, float32> then convPrim<_,'U> (# "mul" (convPrim<_,float32> x) (convPrim<_,float32> y) : float32 #) + elif type3eq<'T1, 'T2, 'U, int64> then convPrim<_,'U> (# "mul" (convPrim<_,int64> x) (convPrim<_,int64> y) : int64 #) + elif type3eq<'T1, 'T2, 'U, uint64> then convPrim<_,'U> (# "mul" (convPrim<_,uint64> x) (convPrim<_,uint64> y) : uint64 #) + elif type3eq<'T1, 'T2, 'U, uint32> then convPrim<_,'U> (# "mul" (convPrim<_,uint32> x) (convPrim<_,uint32> y) : uint32 #) + elif type3eq<'T1, 'T2, 'U, nativeint> then convPrim<_,'U> (# "mul" (convPrim<_,nativeint> x) (convPrim<_,nativeint> y) : nativeint #) + elif type3eq<'T1, 'T2, 'U, unativeint> then convPrim<_,'U> (# "mul" (convPrim<_,unativeint> x) (convPrim<_,unativeint> y) : unativeint #) + elif type3eq<'T1, 'T2, 'U, int16> then convPrim<_,'U> (# "conv.i2" (# "mul" (convPrim<_,int16> x) (convPrim<_,int16> y) : int32 #) : int16 #) + elif type3eq<'T1, 'T2, 'U, uint16> then convPrim<_,'U> (# "conv.u2" (# "mul" (convPrim<_,uint16> x) (convPrim<_,uint16> y) : uint32 #) : uint16 #) + elif type3eq<'T1, 'T2, 'U, sbyte> then convPrim<_,'U> (# "conv.i1" (# "mul" (convPrim<_,sbyte> x) (convPrim<_,sbyte> y) : int32 #) : sbyte #) + elif type3eq<'T1, 'T2, 'U, byte> then convPrim<_,'U> (# "conv.u1" (# "mul" (convPrim<_,byte> x) (convPrim<_,byte> y) : uint32 #) : byte #) + elif type3eq<'T1, 'T2, 'U, decimal> then convPrim<_,'U> (Decimal.op_Multiply(convPrim<_,decimal> x, convPrim<_,decimal> y)) + else BinaryOpDynamicImplTable.Invoke "op_Multiply" x y + + type OpDivisionInfo = class end + let DivisionDynamic<'T1, 'T2, 'U> (x: 'T1) (y: 'T2) : 'U = + if type3eq<'T1, 'T2, 'U,int32> then convPrim<_,'U> (# "div" (convPrim<_,int32> x) (convPrim<_,int32> y) : int32 #) + elif type3eq<'T1, 'T2, 'U,float> then convPrim<_,'U> (# "div" (convPrim<_,float> x) (convPrim<_,float> y) : float #) + elif type3eq<'T1, 'T2, 'U,float32> then convPrim<_,'U> (# "div" (convPrim<_,float32> x) (convPrim<_,float32> y) : float32 #) + elif type3eq<'T1, 'T2, 'U,int64> then convPrim<_,'U> (# "div" (convPrim<_,int64> x) (convPrim<_,int64> y) : int64 #) + elif type3eq<'T1, 'T2, 'U,uint64> then convPrim<_,'U> (# "div.un" (convPrim<_,uint64> x) (convPrim<_,uint64> y) : uint64 #) + elif type3eq<'T1, 'T2, 'U,uint32> then convPrim<_,'U> (# "div.un" (convPrim<_,uint32> x) (convPrim<_,uint32> y) : uint32 #) + elif type3eq<'T1, 'T2, 'U,nativeint> then convPrim<_,'U> (# "div" (convPrim<_,nativeint> x) (convPrim<_,nativeint> y) : nativeint #) + elif type3eq<'T1, 'T2, 'U,unativeint> then convPrim<_,'U> (# "div.un" (convPrim<_,unativeint> x) (convPrim<_,unativeint> y) : unativeint #) + elif type3eq<'T1, 'T2, 'U,int16> then convPrim<_,'U> (# "conv.i2" (# "div" (convPrim<_,int16> x) (convPrim<_,int16> y) : int32 #) : int16 #) + elif type3eq<'T1, 'T2, 'U,uint16> then convPrim<_,'U> (# "conv.u2" (# "div.un" (convPrim<_,uint16> x) (convPrim<_,uint16> y) : uint32 #) : uint16 #) + elif type3eq<'T1, 'T2, 'U,sbyte> then convPrim<_,'U> (# "conv.i1" (# "div" (convPrim<_,sbyte> x) (convPrim<_,sbyte> y) : int32 #) : sbyte #) + elif type3eq<'T1, 'T2, 'U,byte> then convPrim<_,'U> (# "conv.u1" (# "div.un" (convPrim<_,byte> x) (convPrim<_,byte> y) : uint32 #) : byte #) + elif type3eq<'T1, 'T2, 'U, decimal> then convPrim<_,'U> (Decimal.op_Division(convPrim<_,decimal> x, convPrim<_,decimal> y)) + else BinaryOpDynamicImplTable.Invoke "op_Division" x y + + type OpModulusInfo = class end + let ModulusDynamic<'T1, 'T2, 'U> (x: 'T1) (y: 'T2) : 'U = + if type3eq<'T1, 'T2, 'U, int32> then convPrim<_,'U> (# "rem" (convPrim<_,int32> x) (convPrim<_,int32> y) : int32 #) + elif type3eq<'T1, 'T2, 'U, float> then convPrim<_,'U> (# "rem" (convPrim<_,float> x) (convPrim<_,float> y) : float #) + elif type3eq<'T1, 'T2, 'U, float32> then convPrim<_,'U> (# "rem" (convPrim<_,float32> x) (convPrim<_,float32> y) : float32 #) + elif type3eq<'T1, 'T2, 'U, int64> then convPrim<_,'U> (# "rem" (convPrim<_,int64> x) (convPrim<_,int64> y) : int64 #) + elif type3eq<'T1, 'T2, 'U, uint64> then convPrim<_,'U> (# "rem.un" (convPrim<_,uint64> x) (convPrim<_,uint64> y) : uint64 #) + elif type3eq<'T1, 'T2, 'U, uint32> then convPrim<_,'U> (# "rem.un" (convPrim<_,uint32> x) (convPrim<_,uint32> y) : uint32 #) + elif type3eq<'T1, 'T2, 'U, nativeint> then convPrim<_,'U> (# "rem" (convPrim<_,nativeint> x) (convPrim<_,nativeint> y) : nativeint #) + elif type3eq<'T1, 'T2, 'U, unativeint> then convPrim<_,'U> (# "rem.un" (convPrim<_,unativeint> x) (convPrim<_,unativeint> y) : unativeint #) + elif type3eq<'T1, 'T2, 'U, int16> then convPrim<_,'U> (# "conv.i2" (# "rem" (convPrim<_,int16> x) (convPrim<_,int16> y) : int32 #) : int16 #) + elif type3eq<'T1, 'T2, 'U, uint16> then convPrim<_,'U> (# "conv.u2" (# "rem.un" (convPrim<_,uint16> x) (convPrim<_,uint16> y) : uint32 #) : uint16 #) + elif type3eq<'T1, 'T2, 'U, sbyte> then convPrim<_,'U> (# "conv.i1" (# "rem" (convPrim<_,sbyte> x) (convPrim<_,sbyte> y) : int32 #) : sbyte #) + elif type3eq<'T1, 'T2, 'U, byte> then convPrim<_,'U> (# "conv.u1" (# "rem.un" (convPrim<_,byte> x) (convPrim<_,byte> y) : uint32 #) : byte #) + elif type3eq<'T1, 'T2, 'U, decimal> then convPrim<_,'U> (Decimal.op_Modulus(convPrim<_,decimal> x, convPrim<_,decimal> y)) + else BinaryOpDynamicImplTable.Invoke "op_Modulus" x y + + type OpUnaryNegationInfo = class end + let UnaryNegationDynamic<'T,'U> (value: 'T) : 'U = + if type2eq<'T, 'U, int32> then convPrim<_,'U> (# "neg" (convPrim<_,int32> value) : int32 #) + elif type2eq<'T, 'U, float> then convPrim<_,'U> (# "neg" (convPrim<_,float> value) : float #) + elif type2eq<'T, 'U, float32> then convPrim<_,'U> (# "neg" (convPrim<_,float32> value) : float32 #) + elif type2eq<'T, 'U, int64> then convPrim<_,'U> (# "neg" (convPrim<_,int64> value) : int64 #) + elif type2eq<'T, 'U, nativeint> then convPrim<_,'U> (# "neg" (convPrim<_,nativeint> value) : nativeint #) + elif type2eq<'T, 'U, int16> then convPrim<_,'U> (# "conv.i2" (# "neg" (convPrim<_,int16> value) : int32 #) : int16 #) + elif type2eq<'T, 'U, sbyte> then convPrim<_,'U> (# "conv.i1" (# "neg" (convPrim<_,sbyte> value) : int32 #) : sbyte #) + elif type2eq<'T, 'U, decimal> then convPrim<_,'U> (Decimal.op_UnaryNegation(convPrim<_,decimal> value)) + else UnaryOpDynamicImplTable.Invoke "op_UnaryNegation" value + + type OpCheckedAdditionInfo = class end + let CheckedAdditionDynamic<'T1, 'T2, 'U> (x: 'T1) (y: 'T2) : 'U = + if type3eq<'T1, 'T2, 'U, int32> then convPrim<_,'U> (# "add.ovf" (convPrim<_,int32> x) (convPrim<_,int32> y) : int32 #) + elif type3eq<'T1, 'T2, 'U, float> then convPrim<_,'U> (# "add" (convPrim<_,float> x) (convPrim<_,float> y) : float #) + elif type3eq<'T1, 'T2, 'U, float32> then convPrim<_,'U> (# "add" (convPrim<_,float32> x) (convPrim<_,float32> y) : float32 #) + elif type3eq<'T1, 'T2, 'U, int64> then convPrim<_,'U> (# "add.ovf" (convPrim<_,int64> x) (convPrim<_,int64> y) : int64 #) + elif type3eq<'T1, 'T2, 'U, uint64> then convPrim<_,'U> (# "add.ovf.un" (convPrim<_,uint64> x) (convPrim<_,uint64> y) : uint64 #) + elif type3eq<'T1, 'T2, 'U, uint32> then convPrim<_,'U> (# "add.ovf.un" (convPrim<_,uint32> x) (convPrim<_,uint32> y) : uint32 #) + elif type3eq<'T1, 'T2, 'U, nativeint> then convPrim<_,'U> (# "add.ovf" (convPrim<_,nativeint> x) (convPrim<_,nativeint> y) : nativeint #) + elif type3eq<'T1, 'T2, 'U, unativeint> then convPrim<_,'U> (# "add.ovf.un" (convPrim<_,unativeint> x) (convPrim<_,unativeint> y) : unativeint #) + elif type3eq<'T1, 'T2, 'U, int16> then convPrim<_,'U> (# "conv.ovf.i2" (# "add.ovf" (convPrim<_,int16> x) (convPrim<_,int16> y) : int32 #) : int16 #) + elif type3eq<'T1, 'T2, 'U, uint16> then convPrim<_,'U> (# "conv.ovf.u2.un" (# "add.ovf.un" (convPrim<_,uint16> x) (convPrim<_,uint16> y) : uint32 #) : uint16 #) + elif type3eq<'T1, 'T2, 'U, char> then convPrim<_,'U> (# "conv.ovf.u2.un" (# "add.ovf.un" (convPrim<_,char> x) (convPrim<_,char> y) : uint32 #) : uint16 #) + elif type3eq<'T1, 'T2, 'U, sbyte> then convPrim<_,'U> (# "conv.ovf.i1" (# "add.ovf" (convPrim<_,sbyte> x) (convPrim<_,sbyte> y) : int32 #) : sbyte #) + elif type3eq<'T1, 'T2, 'U, byte> then convPrim<_,'U> (# "conv.ovf.u1.un" (# "add.ovf.un" (convPrim<_,byte> x) (convPrim<_,byte> y) : uint32 #) : byte #) + elif type3eq<'T1, 'T2, 'U, string> then convPrim<_,'U> (String.Concat(convPrim<_,string> x, convPrim<_,string> y)) + elif type3eq<'T1, 'T2, 'U, decimal> then convPrim<_,'U> (Decimal.op_Addition(convPrim<_,decimal> x, convPrim<_,decimal> y)) + else BinaryOpDynamicImplTable.Invoke "op_Addition" x y + + type OpCheckedSubtractionInfo = class end + let CheckedSubtractionDynamic<'T1, 'T2, 'U> (x: 'T1) (y: 'T2) : 'U = + if type3eq<'T1, 'T2, 'U, int32> then convPrim<_,'U> (# "sub.ovf" (convPrim<_,int32> x) (convPrim<_,int32> y) : int32 #) + elif type3eq<'T1, 'T2, 'U, float> then convPrim<_,'U> (# "sub" (convPrim<_,float> x) (convPrim<_,float> y) : float #) + elif type3eq<'T1, 'T2, 'U, float32> then convPrim<_,'U> (# "sub" (convPrim<_,float32> x) (convPrim<_,float32> y) : float32 #) + elif type3eq<'T1, 'T2, 'U, int64> then convPrim<_,'U> (# "sub.ovf" (convPrim<_,int64> x) (convPrim<_,int64> y) : int64 #) + elif type3eq<'T1, 'T2, 'U, uint64> then convPrim<_,'U> (# "sub.ovf.un" (convPrim<_,uint64> x) (convPrim<_,uint64> y) : uint64 #) + elif type3eq<'T1, 'T2, 'U, uint32> then convPrim<_,'U> (# "sub.ovf.un" (convPrim<_,uint32> x) (convPrim<_,uint32> y) : uint32 #) + elif type3eq<'T1, 'T2, 'U, nativeint> then convPrim<_,'U> (# "sub.ovf" (convPrim<_,nativeint> x) (convPrim<_,nativeint> y) : nativeint #) + elif type3eq<'T1, 'T2, 'U, unativeint> then convPrim<_,'U> (# "sub.ovf.un" (convPrim<_,unativeint> x) (convPrim<_,unativeint> y) : unativeint #) + elif type3eq<'T1, 'T2, 'U, int16> then convPrim<_,'U> (# "conv.ovf.i2" (# "sub.ovf" (convPrim<_,int16> x) (convPrim<_,int16> y) : int32 #) : int16 #) + elif type3eq<'T1, 'T2, 'U, uint16> then convPrim<_,'U> (# "conv.ovf.u2.un" (# "sub.ovf.un" (convPrim<_,uint16> x) (convPrim<_,uint16> y) : uint32 #) : uint16 #) + elif type3eq<'T1, 'T2, 'U, sbyte> then convPrim<_,'U> (# "conv.ovf.i1" (# "sub.ovf" (convPrim<_,sbyte> x) (convPrim<_,sbyte> y) : int32 #) : sbyte #) + elif type3eq<'T1, 'T2, 'U, byte> then convPrim<_,'U> (# "conv.ovf.u1.un" (# "sub.ovf.un" (convPrim<_,byte> x) (convPrim<_,byte> y) : uint32 #) : byte #) + elif type3eq<'T1, 'T2, 'U, decimal> then convPrim<_,'U> (Decimal.op_Subtraction(convPrim<_,decimal> x, convPrim<_,decimal> y)) + else BinaryOpDynamicImplTable.Invoke "op_Subtraction" x y + + type OpCheckedMultiplyInfo = class end + let CheckedMultiplyDynamic<'T1, 'T2, 'U> (x: 'T1) (y: 'T2) : 'U = + if type3eq<'T1, 'T2, 'U, int32> then convPrim<_,'U> (# "mul.ovf" (convPrim<_,int32> x) (convPrim<_,int32> y) : int32 #) + elif type3eq<'T1, 'T2, 'U, float> then convPrim<_,'U> (# "mul" (convPrim<_,float> x) (convPrim<_,float> y) : float #) + elif type3eq<'T1, 'T2, 'U, float32> then convPrim<_,'U> (# "mul" (convPrim<_,float32> x) (convPrim<_,float32> y) : float32 #) + elif type3eq<'T1, 'T2, 'U, int64> then convPrim<_,'U> (# "mul.ovf" (convPrim<_,int64> x) (convPrim<_,int64> y) : int64 #) + elif type3eq<'T1, 'T2, 'U, uint64> then convPrim<_,'U> (# "mul.ovf.un" (convPrim<_,uint64> x) (convPrim<_,uint64> y) : uint64 #) + elif type3eq<'T1, 'T2, 'U, uint32> then convPrim<_,'U> (# "mul.ovf.un" (convPrim<_,uint32> x) (convPrim<_,uint32> y) : uint32 #) + elif type3eq<'T1, 'T2, 'U, nativeint> then convPrim<_,'U> (# "mul.ovf" (convPrim<_,nativeint> x) (convPrim<_,nativeint> y) : nativeint #) + elif type3eq<'T1, 'T2, 'U, unativeint> then convPrim<_,'U> (# "mul.ovf.un" (convPrim<_,unativeint> x) (convPrim<_,unativeint> y) : unativeint #) + elif type3eq<'T1, 'T2, 'U, int16> then convPrim<_,'U> (# "conv.ovf.i2" (# "mul.ovf" (convPrim<_,int16> x) (convPrim<_,int16> y) : int32 #) : int16 #) + elif type3eq<'T1, 'T2, 'U, uint16> then convPrim<_,'U> (# "conv.ovf.u2.un" (# "mul.ovf.un" (convPrim<_,uint16> x) (convPrim<_,uint16> y) : uint32 #) : uint16 #) + elif type3eq<'T1, 'T2, 'U, sbyte> then convPrim<_,'U> (# "conv.ovf.i1" (# "mul.ovf" (convPrim<_,sbyte> x) (convPrim<_,sbyte> y) : int32 #) : sbyte #) + elif type3eq<'T1, 'T2, 'U, byte> then convPrim<_,'U> (# "conv.ovf.u1.un" (# "mul.ovf.un" (convPrim<_,byte> x) (convPrim<_,byte> y) : uint32 #) : byte #) + elif type3eq<'T1, 'T2, 'U, decimal> then convPrim<_,'U> (Decimal.op_Multiply(convPrim<_,decimal> x, convPrim<_,decimal> y)) + else BinaryOpDynamicImplTable.Invoke "op_Multiply" x y + + type OpCheckedUnaryNegationInfo = class end + let CheckedUnaryNegationDynamic<'T,'U> value = + if type2eq<'T, 'U, int32> then convPrim<_,'U> (# "sub.ovf" 0 (convPrim<_,int32> value) : int32 #) + elif type2eq<'T, 'U, float> then convPrim<_,'U> (# "neg" (convPrim<_,float> value) : float #) + elif type2eq<'T, 'U, float32> then convPrim<_,'U> (# "neg" (convPrim<_,float32> value) : float32 #) + elif type2eq<'T, 'U, int64> then convPrim<_,'U> (# "sub.ovf" 0L (convPrim<_,int64> value) : int64 #) + elif type2eq<'T, 'U, nativeint> then convPrim<_,'U> (# "sub.ovf" 0n (convPrim<_,nativeint> value) : nativeint #) + elif type2eq<'T, 'U, int16> then convPrim<_,'U> (# "sub.ovf" 0s (convPrim<_,int16> value) : int16 #) + elif type2eq<'T, 'U, sbyte> then convPrim<_,'U> (# "sub.ovf" 0y (convPrim<_,sbyte> value) : sbyte #) + elif type2eq<'T, 'U, decimal> then convPrim<_,'U> (Decimal.op_UnaryNegation(convPrim<_,decimal> value)) + else UnaryOpDynamicImplTable.Invoke "op_UnaryNegation" value + + type OpLeftShiftInfo = class end + let LeftShiftDynamic<'T1, 'T2, 'U> (value: 'T1) (shift: 'T2) : 'U = + if type2eq<'T1, 'U, sbyte> && typeeq<'T2, int> then convPrim<_,'U> (# "conv.i1" (# "shl" (convPrim<_,sbyte> value) (mask (convPrim<_,int32> shift) 7) : int32 #) : sbyte #) + elif type2eq<'T1, 'U, byte> && typeeq<'T2, int> then convPrim<_,'U> (# "conv.u1" (# "shl" (convPrim<_,byte> value) (mask (convPrim<_,int32> shift) 7) : uint32 #) : byte #) + elif type2eq<'T1, 'U, int16> && typeeq<'T2, int> then convPrim<_,'U> (# "conv.i2" (# "shl" (convPrim<_,int16> value) (mask (convPrim<_,int32> shift) 15) : int32 #) : int16 #) + elif type2eq<'T1, 'U, uint16> && typeeq<'T2, int> then convPrim<_,'U> (# "conv.u2" (# "shl" (convPrim<_,uint16> value) (mask (convPrim<_,int32> shift) 15) : uint32 #) : uint16 #) + elif type2eq<'T1, 'U, int32> && typeeq<'T2, int> then convPrim<_,'U> (# "shl" (convPrim<_,int32> value) (mask (convPrim<_,int32> shift) 31) : int32 #) + elif type2eq<'T1, 'U, uint32> && typeeq<'T2, int> then convPrim<_,'U> (# "shl" (convPrim<_,uint32> value) (mask (convPrim<_,int32> shift) 31) : uint32 #) + elif type2eq<'T1, 'U, int64> && typeeq<'T2, int> then convPrim<_,'U> (# "shl" (convPrim<_,int64> value) (mask (convPrim<_,int32> shift) 63) : int64 #) + elif type2eq<'T1, 'U, uint64> && typeeq<'T2, int> then convPrim<_,'U> (# "shl" (convPrim<_,uint64> value) (mask (convPrim<_,int32> shift) 63) : uint64 #) + elif type2eq<'T1, 'U, nativeint> && typeeq<'T2, int> then convPrim<_,'U> (# "shl" (convPrim<_,nativeint> value) (convPrim<_,int32> shift) : nativeint #) + elif type2eq<'T1, 'U, unativeint> && typeeq<'T2, int> then convPrim<_,'U> (# "shl" (convPrim<_,unativeint> value) (convPrim<_,int32> shift) : unativeint #) + else BinaryOpDynamicImplTable.Invoke "op_LeftShift" value shift + + type OpRightShiftInfo = class end + let RightShiftDynamic<'T1, 'T2, 'U> (value: 'T1) (shift: 'T2) : 'U = + if type2eq<'T1, 'U, sbyte> && typeeq<'T2, int> then convPrim<_,'U> (# "shr" (convPrim<_,sbyte> value) (mask (convPrim<_,int32> shift) 7) : sbyte #) + elif type2eq<'T1, 'U, byte> && typeeq<'T2, int> then convPrim<_,'U> (# "shr.un" (convPrim<_,byte> value) (mask (convPrim<_,int32> shift) 7) : byte #) + elif type2eq<'T1, 'U, int16> && typeeq<'T2, int> then convPrim<_,'U> (# "shr" (convPrim<_,int16> value) (mask (convPrim<_,int32> shift) 15): int16 #) + elif type2eq<'T1, 'U, uint16> && typeeq<'T2, int> then convPrim<_,'U> (# "shr.un" (convPrim<_,uint16> value) (mask (convPrim<_,int32> shift) 15) : uint16 #) + elif type2eq<'T1, 'U, int32> && typeeq<'T2, int> then convPrim<_,'U> (# "shr" (convPrim<_,int32> value) (mask (convPrim<_,int32> shift) 31) : int32 #) + elif type2eq<'T1, 'U, uint32> && typeeq<'T2, int> then convPrim<_,'U> (# "shr.un" (convPrim<_,uint32> value) (mask (convPrim<_,int32> shift) 31) : uint32 #) + elif type2eq<'T1, 'U, int64> && typeeq<'T2, int> then convPrim<_,'U> (# "shr" (convPrim<_,int64> value) (mask (convPrim<_,int32> shift) 63) : int64 #) + elif type2eq<'T1, 'U, uint64> && typeeq<'T2, int> then convPrim<_,'U> (# "shr.un" (convPrim<_,uint64> value) (mask (convPrim<_,int32> shift) 63) : uint64 #) + elif type2eq<'T1, 'U, nativeint> && typeeq<'T2, int> then convPrim<_,'U> (# "shr" (convPrim<_,nativeint> value) (convPrim<_,int32> shift) : nativeint #) + elif type2eq<'T1, 'U, unativeint> && typeeq<'T2, int> then convPrim<_,'U> (# "shr.un" (convPrim<_,unativeint> value) (convPrim<_,int32> shift) : unativeint #) + else BinaryOpDynamicImplTable.Invoke "op_RightShift" value shift + + type OpBitwiseAndInfo = class end + let BitwiseAndDynamic<'T1, 'T2, 'U> (x: 'T1) (y: 'T2) : 'U = + if type3eq<'T1, 'T2, 'U, sbyte> then convPrim<_,'U> (# "and" (convPrim<_,sbyte> x) (convPrim<_,sbyte> y) : sbyte #) + elif type3eq<'T1, 'T2, 'U, byte> then convPrim<_,'U> (# "and" (convPrim<_,byte> x) (convPrim<_,byte> y) : byte #) + elif type3eq<'T1, 'T2, 'U, int16> then convPrim<_,'U> (# "and" (convPrim<_,int16> x) (convPrim<_,int16> y) : int16 #) + elif type3eq<'T1, 'T2, 'U, uint16> then convPrim<_,'U> (# "and" (convPrim<_,uint16> x) (convPrim<_,uint16> y) : uint16 #) + elif type3eq<'T1, 'T2, 'U, int32> then convPrim<_,'U> (# "and" (convPrim<_,int32> x) (convPrim<_,int32> y) : int32 #) + elif type3eq<'T1, 'T2, 'U, uint32> then convPrim<_,'U> (# "and" (convPrim<_,uint32> x) (convPrim<_,uint32> y) : uint32 #) + elif type3eq<'T1, 'T2, 'U, int64> then convPrim<_,'U> (# "and" (convPrim<_,int64> x) (convPrim<_,int64> y) : int64 #) + elif type3eq<'T1, 'T2, 'U, uint64> then convPrim<_,'U> (# "and" (convPrim<_,uint64> x) (convPrim<_,uint64> y) : uint64 #) + elif type3eq<'T1, 'T2, 'U, nativeint> then convPrim<_,'U> (# "and" (convPrim<_,nativeint> x) (convPrim<_,nativeint> y) : nativeint #) + elif type3eq<'T1, 'T2, 'U, unativeint> then convPrim<_,'U> (# "and" (convPrim<_,unativeint> x) (convPrim<_,unativeint> y) : unativeint #) + else BinaryOpDynamicImplTable.Invoke "op_BitwiseAnd" x y + + type OpBitwiseOrInfo = class end + let BitwiseOrDynamic<'T1, 'T2, 'U> (x: 'T1) (y: 'T2) : 'U = + if type3eq<'T1, 'T2, 'U, sbyte> then convPrim<_,'U> (# "or" (convPrim<_,sbyte> x) (convPrim<_,sbyte> y) : sbyte #) + elif type3eq<'T1, 'T2, 'U, byte> then convPrim<_,'U> (# "or" (convPrim<_,byte> x) (convPrim<_,byte> y) : byte #) + elif type3eq<'T1, 'T2, 'U, int16> then convPrim<_,'U> (# "or" (convPrim<_,int16> x) (convPrim<_,int16> y) : int16 #) + elif type3eq<'T1, 'T2, 'U, uint16> then convPrim<_,'U> (# "or" (convPrim<_,uint16> x) (convPrim<_,uint16> y) : uint16 #) + elif type3eq<'T1, 'T2, 'U, int32> then convPrim<_,'U> (# "or" (convPrim<_,int32> x) (convPrim<_,int32> y) : int32 #) + elif type3eq<'T1, 'T2, 'U, uint32> then convPrim<_,'U> (# "or" (convPrim<_,uint32> x) (convPrim<_,uint32> y) : uint32 #) + elif type3eq<'T1, 'T2, 'U, int64> then convPrim<_,'U> (# "or" (convPrim<_,int64> x) (convPrim<_,int64> y) : int64 #) + elif type3eq<'T1, 'T2, 'U, uint64> then convPrim<_,'U> (# "or" (convPrim<_,uint64> x) (convPrim<_,uint64> y) : uint64 #) + elif type3eq<'T1, 'T2, 'U, nativeint> then convPrim<_,'U> (# "or" (convPrim<_,nativeint> x) (convPrim<_,nativeint> y) : nativeint #) + elif type3eq<'T1, 'T2, 'U, unativeint> then convPrim<_,'U> (# "or" (convPrim<_,unativeint> x) (convPrim<_,unativeint> y) : unativeint #) + else BinaryOpDynamicImplTable.Invoke "op_BitwiseOr" x y + + type OpExclusiveOrInfo = class end + let ExclusiveOrDynamic<'T1, 'T2, 'U> (x: 'T1) (y: 'T2) : 'U = + if type3eq<'T1, 'T2, 'U, sbyte> then convPrim<_,'U> (# "xor" (convPrim<_,sbyte> x) (convPrim<_,sbyte> y) : sbyte #) + elif type3eq<'T1, 'T2, 'U, byte> then convPrim<_,'U> (# "xor" (convPrim<_,byte> x) (convPrim<_,byte> y) : byte #) + elif type3eq<'T1, 'T2, 'U, int16> then convPrim<_,'U> (# "xor" (convPrim<_,int16> x) (convPrim<_,int16> y) : int16 #) + elif type3eq<'T1, 'T2, 'U, uint16> then convPrim<_,'U> (# "xor" (convPrim<_,uint16> x) (convPrim<_,uint16> y) : uint16 #) + elif type3eq<'T1, 'T2, 'U, int32> then convPrim<_,'U> (# "xor" (convPrim<_,int32> x) (convPrim<_,int32> y) : int32 #) + elif type3eq<'T1, 'T2, 'U, uint32> then convPrim<_,'U> (# "xor" (convPrim<_,uint32> x) (convPrim<_,uint32> y) : uint32 #) + elif type3eq<'T1, 'T2, 'U, int64> then convPrim<_,'U> (# "xor" (convPrim<_,int64> x) (convPrim<_,int64> y) : int64 #) + elif type3eq<'T1, 'T2, 'U, uint64> then convPrim<_,'U> (# "xor" (convPrim<_,uint64> x) (convPrim<_,uint64> y) : uint64 #) + elif type3eq<'T1, 'T2, 'U, nativeint> then convPrim<_,'U> (# "xor" (convPrim<_,nativeint> x) (convPrim<_,nativeint> y) : nativeint #) + elif type3eq<'T1, 'T2, 'U, unativeint> then convPrim<_,'U> (# "xor" (convPrim<_,unativeint> x) (convPrim<_,unativeint> y) : unativeint #) + else BinaryOpDynamicImplTable.Invoke "op_ExclusiveOr" x y + + type OpLogicalNotInfo = class end + let LogicalNotDynamic<'T,'U> (value: 'T) : 'U = + if type2eq<'T, 'U, sbyte> then convPrim<_,'U> (# "conv.i1" (# "not" (convPrim<_,sbyte> value) : int32 #) : sbyte #) + elif type2eq<'T, 'U, byte> then convPrim<_,'U> (# "conv.u1" (# "not" (convPrim<_,byte> value) : uint32 #) : byte #) + elif type2eq<'T, 'U, int16> then convPrim<_,'U> (# "conv.i2" (# "not" (convPrim<_,int16> value) : int32 #) : int16 #) + elif type2eq<'T, 'U, uint16> then convPrim<_,'U> (# "conv.u2" (# "not" (convPrim<_,uint16> value) : uint32 #) : uint16 #) + elif type2eq<'T, 'U, int32> then convPrim<_,'U> (# "not" (convPrim<_,int32> value) : int32 #) + elif type2eq<'T, 'U, uint32> then convPrim<_,'U> (# "not" (convPrim<_,uint32> value) : uint32 #) + elif type2eq<'T, 'U, int64> then convPrim<_,'U> (# "not" (convPrim<_,int64> value) : int64 #) + elif type2eq<'T, 'U, uint64> then convPrim<_,'U> (# "not" (convPrim<_,uint64> value) : uint64 #) + elif type2eq<'T, 'U, nativeint> then convPrim<_,'U> (# "not" (convPrim<_,nativeint> value) : nativeint #) + elif type2eq<'T, 'U, unativeint> then convPrim<_,'U> (# "not" (convPrim<_,unativeint> value) : unativeint #) + else UnaryOpDynamicImplTable.Invoke "op_LogicalNot" value + + type OpExplicitInfo = class end + let ExplicitDynamic<'T, 'U> (value: 'T) : 'U = + if typeeq<'U, byte> then + if typeeq<'T, sbyte> then convPrim<_,'U> (# "conv.u1" (convPrim<_,sbyte> value) : byte #) + elif typeeq<'T, byte> then convPrim<_,'U> (# "conv.u1" (convPrim<_,byte> value) : byte #) + elif typeeq<'T, int16> then convPrim<_,'U> (# "conv.u1" (convPrim<_,int16> value) : byte #) + elif typeeq<'T, uint16> then convPrim<_,'U> (# "conv.u1" (convPrim<_,uint16> value) : byte #) + elif typeeq<'T, int32> then convPrim<_,'U> (# "conv.u1" (convPrim<_,int32> value) : byte #) + elif typeeq<'T, uint32> then convPrim<_,'U> (# "conv.u1" (convPrim<_,uint32> value) : byte #) + elif typeeq<'T, int64> then convPrim<_,'U> (# "conv.u1" (convPrim<_,int64> value) : byte #) + elif typeeq<'T, uint64> then convPrim<_,'U> (# "conv.u1" (convPrim<_,uint64> value) : byte #) + elif typeeq<'T, nativeint> then convPrim<_,'U> (# "conv.u1" (convPrim<_,nativeint> value) : byte #) + elif typeeq<'T, unativeint> then convPrim<_,'U> (# "conv.u1" (convPrim<_,unativeint> value) : byte #) + elif typeeq<'T, float> then convPrim<_,'U> (# "conv.u1" (convPrim<_,float> value) : byte #) + elif typeeq<'T, float32> then convPrim<_,'U> (# "conv.u1" (convPrim<_,float32> value) : byte #) + elif typeeq<'T, char> then convPrim<_,'U> (# "conv.u1" (convPrim<_,char> value) : byte #) + elif typeeq<'T, string> then convPrim<_,'U> (ParseByte (convPrim<_,string> value)) + else UnaryOpDynamicImplTable.Invoke "op_Explicit" value + elif typeeq<'U, sbyte> then + if typeeq<'T, sbyte> then convPrim<_,'U> (# "conv.i1" (convPrim<_,sbyte> value) : sbyte #) + elif typeeq<'T, byte> then convPrim<_,'U> (# "conv.i1" (convPrim<_,byte> value) : sbyte #) + elif typeeq<'T, int16> then convPrim<_,'U> (# "conv.i1" (convPrim<_,int16> value) : sbyte #) + elif typeeq<'T, uint16> then convPrim<_,'U> (# "conv.i1" (convPrim<_,uint16> value) : sbyte #) + elif typeeq<'T, int32> then convPrim<_,'U> (# "conv.i1" (convPrim<_,int32> value) : sbyte #) + elif typeeq<'T, uint32> then convPrim<_,'U> (# "conv.i1" (convPrim<_,uint32> value) : sbyte #) + elif typeeq<'T, int64> then convPrim<_,'U> (# "conv.i1" (convPrim<_,int64> value) : sbyte #) + elif typeeq<'T, uint64> then convPrim<_,'U> (# "conv.i1" (convPrim<_,uint64> value) : sbyte #) + elif typeeq<'T, nativeint> then convPrim<_,'U> (# "conv.i1" (convPrim<_,nativeint> value) : sbyte #) + elif typeeq<'T, unativeint> then convPrim<_,'U> (# "conv.i1" (convPrim<_,unativeint> value) : sbyte #) + elif typeeq<'T, float> then convPrim<_,'U> (# "conv.i1" (convPrim<_,float> value) : sbyte #) + elif typeeq<'T, float32> then convPrim<_,'U> (# "conv.i1" (convPrim<_,float32> value) : sbyte #) + elif typeeq<'T, char> then convPrim<_,'U> (# "conv.i1" (convPrim<_,char> value) : sbyte #) + elif typeeq<'T, string> then convPrim<_,'U> (ParseSByte (convPrim<_,string> value)) + else UnaryOpDynamicImplTable.Invoke "op_Explicit" value + elif typeeq<'U, uint16> then + if typeeq<'T, sbyte> then convPrim<_,'U> (# "conv.u2" (convPrim<_,sbyte> value) : uint16 #) + elif typeeq<'T, byte> then convPrim<_,'U> (# "conv.u2" (convPrim<_,byte> value) : uint16 #) + elif typeeq<'T, int16> then convPrim<_,'U> (# "conv.u2" (convPrim<_,int16> value) : uint16 #) + elif typeeq<'T, uint16> then convPrim<_,'U> (# "conv.u2" (convPrim<_,uint16> value) : uint16 #) + elif typeeq<'T, int32> then convPrim<_,'U> (# "conv.u2" (convPrim<_,int32> value) : uint16 #) + elif typeeq<'T, uint32> then convPrim<_,'U> (# "conv.u2" (convPrim<_,uint32> value) : uint16 #) + elif typeeq<'T, int64> then convPrim<_,'U> (# "conv.u2" (convPrim<_,int64> value) : uint16 #) + elif typeeq<'T, uint64> then convPrim<_,'U> (# "conv.u2" (convPrim<_,uint64> value) : uint16 #) + elif typeeq<'T, nativeint> then convPrim<_,'U> (# "conv.u2" (convPrim<_,nativeint> value) : uint16 #) + elif typeeq<'T, unativeint> then convPrim<_,'U> (# "conv.u2" (convPrim<_,unativeint> value) : uint16 #) + elif typeeq<'T, float> then convPrim<_,'U> (# "conv.u2" (convPrim<_,float> value) : uint16 #) + elif typeeq<'T, float32> then convPrim<_,'U> (# "conv.u2" (convPrim<_,float32> value) : uint16 #) + elif typeeq<'T, char> then convPrim<_,'U> (# "conv.u2" (convPrim<_,char> value) : uint16 #) + elif typeeq<'T, string> then convPrim<_,'U> (ParseUInt16 (convPrim<_,string> value)) + else UnaryOpDynamicImplTable.Invoke "op_Explicit" value + elif typeeq<'U, int16> then + if typeeq<'T, sbyte> then convPrim<_,'U> (# "conv.i2" (convPrim<_,sbyte> value) : int16 #) + elif typeeq<'T, byte> then convPrim<_,'U> (# "conv.i2" (convPrim<_,byte> value) : int16 #) + elif typeeq<'T, int16> then convPrim<_,'U> (# "conv.i2" (convPrim<_,int16> value) : int16 #) + elif typeeq<'T, uint16> then convPrim<_,'U> (# "conv.i2" (convPrim<_,uint16> value) : int16 #) + elif typeeq<'T, int32> then convPrim<_,'U> (# "conv.i2" (convPrim<_,int32> value) : int16 #) + elif typeeq<'T, uint32> then convPrim<_,'U> (# "conv.i2" (convPrim<_,uint32> value) : int16 #) + elif typeeq<'T, int64> then convPrim<_,'U> (# "conv.i2" (convPrim<_,int64> value) : int16 #) + elif typeeq<'T, uint64> then convPrim<_,'U> (# "conv.i2" (convPrim<_,uint64> value) : int16 #) + elif typeeq<'T, nativeint> then convPrim<_,'U> (# "conv.i2" (convPrim<_,nativeint> value) : int16 #) + elif typeeq<'T, unativeint> then convPrim<_,'U> (# "conv.i2" (convPrim<_,unativeint> value) : int16 #) + elif typeeq<'T, float> then convPrim<_,'U> (# "conv.i2" (convPrim<_,float> value) : int16 #) + elif typeeq<'T, float32> then convPrim<_,'U> (# "conv.i2" (convPrim<_,float32> value) : int16 #) + elif typeeq<'T, char> then convPrim<_,'U> (# "conv.i2" (convPrim<_,char> value) : int16 #) + elif typeeq<'T, string> then convPrim<_,'U> (ParseInt16 (convPrim<_,string> value)) + else UnaryOpDynamicImplTable.Invoke "op_Explicit" value + elif typeeq<'U, uint32> then + if typeeq<'T, sbyte> then convPrim<_,'U> (# "conv.u4" (convPrim<_,sbyte> value) : uint32 #) + elif typeeq<'T, byte> then convPrim<_,'U> (# "conv.u4" (convPrim<_,byte> value) : uint32 #) + elif typeeq<'T, int16> then convPrim<_,'U> (# "conv.u4" (convPrim<_,int16> value) : uint32 #) + elif typeeq<'T, uint16> then convPrim<_,'U> (# "conv.u4" (convPrim<_,uint16> value) : uint32 #) + elif typeeq<'T, int32> then convPrim<_,'U> (# "conv.u4" (convPrim<_,int32> value) : uint32 #) + elif typeeq<'T, uint32> then convPrim<_,'U> (# "conv.u4" (convPrim<_,uint32> value) : uint32 #) + elif typeeq<'T, int64> then convPrim<_,'U> (# "conv.u4" (convPrim<_,int64> value) : uint32 #) + elif typeeq<'T, uint64> then convPrim<_,'U> (# "conv.u4" (convPrim<_,uint64> value) : uint32 #) + elif typeeq<'T, nativeint> then convPrim<_,'U> (# "conv.u4" (convPrim<_,nativeint> value) : uint32 #) + elif typeeq<'T, unativeint> then convPrim<_,'U> (# "conv.u4" (convPrim<_,unativeint> value) : uint32 #) + elif typeeq<'T, float> then convPrim<_,'U> (# "conv.u4" (convPrim<_,float> value) : uint32 #) + elif typeeq<'T, float32> then convPrim<_,'U> (# "conv.u4" (convPrim<_,float32> value) : uint32 #) + elif typeeq<'T, char> then convPrim<_,'U> (# "conv.u4" (convPrim<_,char> value) : uint32 #) + elif typeeq<'T, string> then convPrim<_,'U> (ParseUInt32 (convPrim<_,string> value)) + else UnaryOpDynamicImplTable.Invoke "op_Explicit" value + elif typeeq<'U, int32> then + if typeeq<'T, sbyte> then convPrim<_,'U> (# "conv.i4" (convPrim<_,sbyte> value) : int32 #) + elif typeeq<'T, byte> then convPrim<_,'U> (# "conv.i4" (convPrim<_,byte> value) : int32 #) + elif typeeq<'T, int16> then convPrim<_,'U> (# "conv.i4" (convPrim<_,int16> value) : int32 #) + elif typeeq<'T, uint16> then convPrim<_,'U> (# "conv.i4" (convPrim<_,uint16> value) : int32 #) + elif typeeq<'T, int32> then convPrim<_,'U> (# "conv.i4" (convPrim<_,int32> value) : int32 #) + elif typeeq<'T, uint32> then convPrim<_,'U> (# "conv.i4" (convPrim<_,uint32> value) : int32 #) + elif typeeq<'T, int64> then convPrim<_,'U> (# "conv.i4" (convPrim<_,int64> value) : int32 #) + elif typeeq<'T, uint64> then convPrim<_,'U> (# "conv.i4" (convPrim<_,uint64> value) : int32 #) + elif typeeq<'T, nativeint> then convPrim<_,'U> (# "conv.i4" (convPrim<_,nativeint> value) : int32 #) + elif typeeq<'T, unativeint> then convPrim<_,'U> (# "conv.i4" (convPrim<_,unativeint> value) : int32 #) + elif typeeq<'T, float> then convPrim<_,'U> (# "conv.i4" (convPrim<_,float> value) : int32 #) + elif typeeq<'T, float32> then convPrim<_,'U> (# "conv.i4" (convPrim<_,float32> value) : int32 #) + elif typeeq<'T, char> then convPrim<_,'U> (# "conv.i4" (convPrim<_,char> value) : int32 #) + elif typeeq<'T, string> then convPrim<_,'U> (ParseInt32 (convPrim<_,string> value)) + else UnaryOpDynamicImplTable.Invoke "op_Explicit" value + elif typeeq<'U, uint64> then + if typeeq<'T, sbyte> then convPrim<_,'U> (# "conv.i8" (convPrim<_,sbyte> value) : uint64 #) + elif typeeq<'T, byte> then convPrim<_,'U> (# "conv.u8" (convPrim<_,byte> value) : uint64 #) + elif typeeq<'T, int16> then convPrim<_,'U> (# "conv.i8" (convPrim<_,int16> value) : uint64 #) + elif typeeq<'T, uint16> then convPrim<_,'U> (# "conv.u8" (convPrim<_,uint16> value) : uint64 #) + elif typeeq<'T, int32> then convPrim<_,'U> (# "conv.i8" (convPrim<_,int32> value) : uint64 #) + elif typeeq<'T, uint32> then convPrim<_,'U> (# "conv.u8" (convPrim<_,uint32> value) : uint64 #) + elif typeeq<'T, int64> then convPrim<_,'U> (# "" (convPrim<_,int64> value) : uint64 #) + elif typeeq<'T, uint64> then convPrim<_,'U> (# "conv.i8" (convPrim<_,uint64> value) : uint64 #) + elif typeeq<'T, nativeint> then convPrim<_,'U> (# "conv.i8" (convPrim<_,nativeint> value) : uint64 #) + elif typeeq<'T, unativeint> then convPrim<_,'U> (# "conv.u8" (convPrim<_,unativeint> value) : uint64 #) + elif typeeq<'T, float> then convPrim<_,'U> (# "conv.u8" (convPrim<_,float> value) : uint64 #) + elif typeeq<'T, float32> then convPrim<_,'U> (# "conv.u8" (convPrim<_,float32> value) : uint64 #) + elif typeeq<'T, char> then convPrim<_,'U> (# "conv.u8" (convPrim<_,char> value) : uint64 #) + elif typeeq<'T, string> then convPrim<_,'U> (ParseUInt64 (convPrim<_,string> value)) + else UnaryOpDynamicImplTable.Invoke "op_Explicit" value + elif typeeq<'U, int64> then + if typeeq<'T, sbyte> then convPrim<_,'U> (# "conv.i8" (convPrim<_,sbyte> value) : int64 #) + elif typeeq<'T, byte> then convPrim<_,'U> (# "conv.u8" (convPrim<_,byte> value) : int64 #) + elif typeeq<'T, int16> then convPrim<_,'U> (# "conv.i8" (convPrim<_,int16> value) : int64 #) + elif typeeq<'T, uint16> then convPrim<_,'U> (# "conv.u8" (convPrim<_,uint16> value) : int64 #) + elif typeeq<'T, int32> then convPrim<_,'U> (# "conv.i8" (convPrim<_,int32> value) : int64 #) + elif typeeq<'T, uint32> then convPrim<_,'U> (# "conv.u8" (convPrim<_,uint32> value) : int64 #) + elif typeeq<'T, int64> then convPrim<_,'U> (convPrim<_,int64> value) + elif typeeq<'T, uint64> then convPrim<_,'U> (# "" (convPrim<_,uint64> value) : int64 #) + elif typeeq<'T, nativeint> then convPrim<_,'U> (# "conv.i8" (convPrim<_,nativeint> value) : int64 #) + elif typeeq<'T, unativeint> then convPrim<_,'U> (# "conv.u8" (convPrim<_,unativeint> value) : int64 #) + elif typeeq<'T, float> then convPrim<_,'U> (# "conv.u8" (convPrim<_,float> value) : int64 #) + elif typeeq<'T, float32> then convPrim<_,'U> (# "conv.u8" (convPrim<_,float32> value) : int64 #) + elif typeeq<'T, char> then convPrim<_,'U> (# "conv.u8" (convPrim<_,char> value) : int64 #) + elif typeeq<'T, string> then convPrim<_,'U> (ParseInt64 (convPrim<_,string> value)) + else UnaryOpDynamicImplTable.Invoke "op_Explicit" value + elif typeeq<'U, float32> then + if typeeq<'T, sbyte> then convPrim<_,'U> (# "conv.r4" (convPrim<_,sbyte> value) : float32 #) + elif typeeq<'T, byte> then convPrim<_,'U> (# "conv.r.un conv.r4" (convPrim<_,byte> value) : float32 #) + elif typeeq<'T, int16> then convPrim<_,'U> (# "conv.r4" (convPrim<_,int16> value) : float32 #) + elif typeeq<'T, uint16> then convPrim<_,'U> (# "conv.r.un conv.r4" (convPrim<_,uint16> value) : float32 #) + elif typeeq<'T, int32> then convPrim<_,'U> (# "conv.r4" (convPrim<_,int32> value) : float32 #) + elif typeeq<'T, uint32> then convPrim<_,'U> (# "conv.r.un conv.r4" (convPrim<_,uint32> value) : float32 #) + elif typeeq<'T, int64> then convPrim<_,'U> (# "conv.r4" (convPrim<_,int64> value) : float32 #) + elif typeeq<'T, uint64> then convPrim<_,'U> (# "conv.r.un conv.r4" (convPrim<_,uint64> value) : float32 #) + elif typeeq<'T, nativeint> then convPrim<_,'U> (# "conv.r4" (convPrim<_,nativeint> value) : float32 #) + elif typeeq<'T, unativeint> then convPrim<_,'U> (# "conv.r.un conv.r4" (convPrim<_,unativeint> value) : float32 #) + elif typeeq<'T, float> then convPrim<_,'U> (# "conv.r4" (convPrim<_,float> value) : float32 #) + elif typeeq<'T, float32> then convPrim<_,'U> (# "conv.r4" (convPrim<_,float32> value) : float32 #) + elif typeeq<'T, char> then convPrim<_,'U> (# "conv.r.un conv.r4" (convPrim<_,char> value) : float32 #) + elif typeeq<'T, string> then convPrim<_,'U> (ParseSingle (convPrim<_,string> value)) + else UnaryOpDynamicImplTable.Invoke "op_Explicit" value + elif typeeq<'U, float> then + if typeeq<'T, sbyte> then convPrim<_,'U> (# "conv.r8" (convPrim<_,sbyte> value) : float #) + elif typeeq<'T, byte> then convPrim<_,'U> (# "conv.r.un conv.r8" (convPrim<_,byte> value) : float #) + elif typeeq<'T, int16> then convPrim<_,'U> (# "conv.r8" (convPrim<_,int16> value) : float #) + elif typeeq<'T, uint16> then convPrim<_,'U> (# "conv.r.un conv.r8" (convPrim<_,uint16> value) : float #) + elif typeeq<'T, int32> then convPrim<_,'U> (# "conv.r8" (convPrim<_,int32> value) : float #) + elif typeeq<'T, uint32> then convPrim<_,'U> (# "conv.r.un conv.r8" (convPrim<_,uint32> value) : float #) + elif typeeq<'T, int64> then convPrim<_,'U> (# "conv.r8" (convPrim<_,int64> value) : float #) + elif typeeq<'T, uint64> then convPrim<_,'U> (# "conv.r.un conv.r8" (convPrim<_,uint64> value) : float #) + elif typeeq<'T, nativeint> then convPrim<_,'U> (# "conv.r8" (convPrim<_,nativeint> value) : float #) + elif typeeq<'T, unativeint> then convPrim<_,'U> (# "conv.r.un conv.r8" (convPrim<_,unativeint> value) : float #) + elif typeeq<'T, float> then convPrim<_,'U> (# "conv.r8" (convPrim<_,float> value) : float #) + elif typeeq<'T, float32> then convPrim<_,'U> (# "conv.r8" (convPrim<_,float32> value) : float #) + elif typeeq<'T, char> then convPrim<_,'U> (# "conv.r.un conv.r8" (convPrim<_,char> value) : float #) + elif typeeq<'T, decimal> then convPrim<_,'U> (Convert.ToDouble(convPrim<_,decimal> value)) + elif typeeq<'T, string> then convPrim<_,'U> (ParseDouble (convPrim<_,string> value)) + else UnaryOpDynamicImplTable.Invoke "op_Explicit" value + elif typeeq<'U, unativeint> then + if typeeq<'T, sbyte> then convPrim<_,'U> (# "conv.i" (convPrim<_,sbyte> value) : unativeint #) + elif typeeq<'T, byte> then convPrim<_,'U> (# "conv.u" (convPrim<_,byte> value) : unativeint #) + elif typeeq<'T, int16> then convPrim<_,'U> (# "conv.i" (convPrim<_,int16> value) : unativeint #) + elif typeeq<'T, uint16> then convPrim<_,'U> (# "conv.u" (convPrim<_,uint16> value) : unativeint #) + elif typeeq<'T, int32> then convPrim<_,'U> (# "conv.i" (convPrim<_,int32> value) : unativeint #) + elif typeeq<'T, uint32> then convPrim<_,'U> (# "conv.u" (convPrim<_,uint32> value) : unativeint #) + elif typeeq<'T, int64> then convPrim<_,'U> (# "conv.i" (convPrim<_,int64> value) : unativeint #) + elif typeeq<'T, uint64> then convPrim<_,'U> (# "conv.u" (convPrim<_,uint64> value) : unativeint #) + elif typeeq<'T, nativeint> then convPrim<_,'U> (# "" (convPrim<_,nativeint> value) : unativeint #) + elif typeeq<'T, unativeint> then convPrim<_,'U> (# "" (convPrim<_,unativeint> value) : unativeint #) + elif typeeq<'T, float> then convPrim<_,'U> (# "conv.u" (convPrim<_,float> value) : unativeint #) + elif typeeq<'T, float32> then convPrim<_,'U> (# "conv.u" (convPrim<_,float32> value) : unativeint #) + elif typeeq<'T, char> then convPrim<_,'U> (# "conv.u" (convPrim<_,char> value) : unativeint #) + elif typeeq<'T, string> then convPrim<_,'U> (ParseUIntPtr (convPrim<_,string> value)) + else UnaryOpDynamicImplTable.Invoke "op_Explicit" value + elif typeeq<'U, nativeint> then + if typeeq<'T, sbyte> then convPrim<_,'U> (# "conv.i" (convPrim<_,sbyte> value) : nativeint #) + elif typeeq<'T, byte> then convPrim<_,'U> (# "conv.u" (convPrim<_,byte> value) : nativeint #) + elif typeeq<'T, int16> then convPrim<_,'U> (# "conv.i" (convPrim<_,int16> value) : nativeint #) + elif typeeq<'T, uint16> then convPrim<_,'U> (# "conv.u" (convPrim<_,uint16> value) : nativeint #) + elif typeeq<'T, int32> then convPrim<_,'U> (# "conv.i" (convPrim<_,int32> value) : nativeint #) + elif typeeq<'T, uint32> then convPrim<_,'U> (# "conv.u" (convPrim<_,uint32> value) : nativeint #) + elif typeeq<'T, int64> then convPrim<_,'U> (# "conv.i" (convPrim<_,int64> value) : nativeint #) + elif typeeq<'T, uint64> then convPrim<_,'U> (# "conv.u" (convPrim<_,uint64> value) : nativeint #) + elif typeeq<'T, nativeint> then convPrim<_,'U> (# "" (convPrim<_,nativeint> value) : nativeint #) + elif typeeq<'T, unativeint> then convPrim<_,'U> (# "" (convPrim<_,unativeint> value) : nativeint #) + elif typeeq<'T, float> then convPrim<_,'U> (# "conv.i" (convPrim<_,float> value) : nativeint #) + elif typeeq<'T, float32> then convPrim<_,'U> (# "conv.i" (convPrim<_,float32> value) : nativeint #) + elif typeeq<'T, char> then convPrim<_,'U> (# "conv.u" (convPrim<_,char> value) : nativeint #) + elif typeeq<'T, string> then convPrim<_,'U> (ParseIntPtr (convPrim<_,string> value)) + else UnaryOpDynamicImplTable.Invoke "op_Explicit" value + elif typeeq<'U, char> then + if typeeq<'T, sbyte> then convPrim<_,'U> (# "conv.u2" (convPrim<_,sbyte> value) : char #) + elif typeeq<'T, byte> then convPrim<_,'U> (# "conv.u2" (convPrim<_,byte> value) : char #) + elif typeeq<'T, int16> then convPrim<_,'U> (# "conv.u2" (convPrim<_,int16> value) : char #) + elif typeeq<'T, uint16> then convPrim<_,'U> (# "conv.u2" (convPrim<_,uint16> value) : char #) + elif typeeq<'T, int32> then convPrim<_,'U> (# "conv.u2" (convPrim<_,int32> value) : char #) + elif typeeq<'T, uint32> then convPrim<_,'U> (# "conv.u2" (convPrim<_,uint32> value) : char #) + elif typeeq<'T, int64> then convPrim<_,'U> (# "conv.u2" (convPrim<_,int64> value) : char #) + elif typeeq<'T, uint64> then convPrim<_,'U> (# "conv.u2" (convPrim<_,uint64> value) : char #) + elif typeeq<'T, nativeint> then convPrim<_,'U> (# "conv.u2" (convPrim<_,nativeint> value) : char #) + elif typeeq<'T, unativeint> then convPrim<_,'U> (# "conv.u2" (convPrim<_,unativeint> value) : char #) + elif typeeq<'T, float> then convPrim<_,'U> (# "conv.u2" (convPrim<_,float> value) : char #) + elif typeeq<'T, float32> then convPrim<_,'U> (# "conv.u2" (convPrim<_,float32> value) : char #) + elif typeeq<'T, char> then convPrim<_,'U> (# "conv.u2" (convPrim<_,char> value) : char #) + elif typeeq<'T, string> then convPrim<_,'U> (System.Char.Parse (convPrim<_,string> value)) + else UnaryOpDynamicImplTable.Invoke "op_Explicit" value + elif typeeq<'U, decimal> then + if typeeq<'T, sbyte> then convPrim<_,'U> (Convert.ToDecimal (convPrim<_,sbyte> value)) + elif typeeq<'T, byte> then convPrim<_,'U> (Convert.ToDecimal (convPrim<_,byte> value)) + elif typeeq<'T, int16> then convPrim<_,'U> (Convert.ToDecimal (convPrim<_,int16> value)) + elif typeeq<'T, uint16> then convPrim<_,'U> (Convert.ToDecimal (convPrim<_,uint16> value)) + elif typeeq<'T, int32> then convPrim<_,'U> (Convert.ToDecimal (convPrim<_,int32> value)) + elif typeeq<'T, uint32> then convPrim<_,'U> (Convert.ToDecimal (convPrim<_,uint32> value)) + elif typeeq<'T, int64> then convPrim<_,'U> (Convert.ToDecimal (convPrim<_,int64> value)) + elif typeeq<'T, uint64> then convPrim<_,'U> (Convert.ToDecimal (convPrim<_,uint64> value)) + elif typeeq<'T, nativeint> then convPrim<_,'U> (Convert.ToDecimal (# "conv.i8" (convPrim<_,nativeint> value) : int64 #)) + elif typeeq<'T, unativeint> then convPrim<_,'U> (Convert.ToDecimal (# "conv.u8" (convPrim<_,unativeint> value) : uint64 #)) + elif typeeq<'T, float> then convPrim<_,'U> (Convert.ToDecimal (convPrim<_,float> value)) + elif typeeq<'T, float32> then convPrim<_,'U> (Convert.ToDecimal (convPrim<_,float32> value)) + elif typeeq<'T, char> then convPrim<_,'U> (Convert.ToDecimal (convPrim<_,char> value)) + elif typeeq<'T, decimal> then convPrim<'T,'U> value + elif typeeq<'T, string> then convPrim<_,'U> (Decimal.Parse(convPrim<_,string> value, NumberStyles.Float,CultureInfo.InvariantCulture)) + else UnaryOpDynamicImplTable.Invoke "op_Explicit" value + else + UnaryOpDynamicImplTable.Invoke "op_Explicit" value + + type OpLessThanInfo = class end + let LessThanDynamic<'T1, 'T2, 'U> (x: 'T1) (y: 'T2) : 'U = + if type2eq<'T1, 'T2, sbyte> && typeeq<'U, bool> then convPrim<_,'U> (# "clt" (convPrim<_,sbyte> x) (convPrim<_,sbyte> y) : bool #) + elif type2eq<'T1, 'T2, byte> && typeeq<'U, bool> then convPrim<_,'U> (# "clt.un" (convPrim<_,byte> x) (convPrim<_,byte> y) : bool #) + elif type2eq<'T1, 'T2, int16> && typeeq<'U, bool> then convPrim<_,'U> (# "clt" (convPrim<_,int16> x) (convPrim<_,int16> y) : bool #) + elif type2eq<'T1, 'T2, uint16> && typeeq<'U, bool> then convPrim<_,'U> (# "clt.un" (convPrim<_,uint16> x) (convPrim<_,uint16> y) : bool #) + elif type2eq<'T1, 'T2, int32> && typeeq<'U, bool> then convPrim<_,'U> (# "clt" (convPrim<_,int32> x) (convPrim<_,int32> y) : bool #) + elif type2eq<'T1, 'T2, uint32> && typeeq<'U, bool> then convPrim<_,'U> (# "clt.un" (convPrim<_,uint32> x) (convPrim<_,uint32> y) : bool #) + elif type2eq<'T1, 'T2, int64> && typeeq<'U, bool> then convPrim<_,'U> (# "clt" (convPrim<_,int64> x) (convPrim<_,int64> y) : bool #) + elif type2eq<'T1, 'T2, uint64> && typeeq<'U, bool> then convPrim<_,'U> (# "clt.un" (convPrim<_,uint64> x) (convPrim<_,uint64> y) : bool #) + elif type2eq<'T1, 'T2, nativeint> && typeeq<'U, bool> then convPrim<_,'U> (# "clt" (convPrim<_,nativeint> x) (convPrim<_,nativeint> y) : bool #) + elif type2eq<'T1, 'T2, unativeint> && typeeq<'U, bool> then convPrim<_,'U> (# "clt.un" (convPrim<_,unativeint> x) (convPrim<_,unativeint> y) : bool #) + elif type2eq<'T1, 'T2, float> && typeeq<'U, bool> then convPrim<_,'U> (# "clt" (convPrim<_,float> x) (convPrim<_,float> y) : bool #) + elif type2eq<'T1, 'T2, float32> && typeeq<'U, bool> then convPrim<_,'U> (# "clt" (convPrim<_,float32> x) (convPrim<_,float32> y) : bool #) + elif type2eq<'T1, 'T2, char> && typeeq<'U, bool> then convPrim<_,'U> (# "clt.un" (convPrim<_,char> x) (convPrim<_,char> y) : bool #) + elif type2eq<'T1, 'T2, decimal> && typeeq<'U, bool> then convPrim<_,'U> (Decimal.op_LessThan (convPrim<_,decimal> x, convPrim<_,decimal> y)) + elif type2eq<'T1, 'T2, string> && typeeq<'U, bool> then convPrim<_,'U> (# "clt" (String.CompareOrdinal (convPrim<_,string> x, convPrim<_,string> y)) 0 : bool #) + else BinaryOpDynamicImplTable.Invoke "op_LessThan" x y + + type OpGreaterThanInfo = class end + let GreaterThanDynamic<'T1, 'T2, 'U> (x: 'T1) (y: 'T2) : 'U = + if type2eq<'T1, 'T2, sbyte> && typeeq<'U, bool> then convPrim<_,'U> (# "cgt" (convPrim<_,sbyte> x) (convPrim<_,sbyte> y) : bool #) + elif type2eq<'T1, 'T2, byte> && typeeq<'U, bool> then convPrim<_,'U> (# "cgt.un" (convPrim<_,byte> x) (convPrim<_,byte> y) : bool #) + elif type2eq<'T1, 'T2, int16> && typeeq<'U, bool> then convPrim<_,'U> (# "cgt" (convPrim<_,int16> x) (convPrim<_,int16> y) : bool #) + elif type2eq<'T1, 'T2, uint16> && typeeq<'U, bool> then convPrim<_,'U> (# "cgt.un" (convPrim<_,uint16> x) (convPrim<_,uint16> y) : bool #) + elif type2eq<'T1, 'T2, int32> && typeeq<'U, bool> then convPrim<_,'U> (# "cgt" (convPrim<_,int32> x) (convPrim<_,int32> y) : bool #) + elif type2eq<'T1, 'T2, uint32> && typeeq<'U, bool> then convPrim<_,'U> (# "cgt.un" (convPrim<_,uint32> x) (convPrim<_,uint32> y) : bool #) + elif type2eq<'T1, 'T2, int64> && typeeq<'U, bool> then convPrim<_,'U> (# "cgt" (convPrim<_,int64> x) (convPrim<_,int64> y) : bool #) + elif type2eq<'T1, 'T2, uint64> && typeeq<'U, bool> then convPrim<_,'U> (# "cgt.un" (convPrim<_,uint64> x) (convPrim<_,uint64> y) : bool #) + elif type2eq<'T1, 'T2, nativeint> && typeeq<'U, bool> then convPrim<_,'U> (# "cgt" (convPrim<_,nativeint> x) (convPrim<_,nativeint> y) : bool #) + elif type2eq<'T1, 'T2, unativeint> && typeeq<'U, bool> then convPrim<_,'U> (# "cgt.un" (convPrim<_,unativeint> x) (convPrim<_,unativeint> y) : bool #) + elif type2eq<'T1, 'T2, float> && typeeq<'U, bool> then convPrim<_,'U> (# "cgt" (convPrim<_,float> x) (convPrim<_,float> y) : bool #) + elif type2eq<'T1, 'T2, float32> && typeeq<'U, bool> then convPrim<_,'U> (# "cgt" (convPrim<_,float32> x) (convPrim<_,float32> y) : bool #) + elif type2eq<'T1, 'T2, char> && typeeq<'U, bool> then convPrim<_,'U> (# "cgt.un" (convPrim<_,char> x) (convPrim<_,char> y) : bool #) + elif type2eq<'T1, 'T2, decimal> && typeeq<'U, bool> then convPrim<_,'U> (Decimal.op_GreaterThan (convPrim<_,decimal> x, convPrim<_,decimal> y)) + elif type2eq<'T1, 'T2, string> && typeeq<'U, bool> then convPrim<_,'U> (# "cgt" (String.CompareOrdinal (convPrim<_,string> x, convPrim<_,string> y)) 0 : bool #) + else BinaryOpDynamicImplTable.Invoke "op_GreaterThan" x y + + type OpLessThanOrEqualInfo = class end + let LessThanOrEqualDynamic<'T1, 'T2, 'U> (x: 'T1) (y: 'T2) : 'U = + if type2eq<'T1, 'T2, sbyte> && typeeq<'U, bool> then convPrim<_,'U> (not (# "cgt" (convPrim<_,sbyte> x) (convPrim<_,sbyte> y) : bool #)) + elif type2eq<'T1, 'T2, byte> && typeeq<'U, bool> then convPrim<_,'U> (not (# "cgt.un" (convPrim<_,byte> x) (convPrim<_,byte> y) : bool #)) + elif type2eq<'T1, 'T2, int16> && typeeq<'U, bool> then convPrim<_,'U> (not (# "cgt" (convPrim<_,int16> x) (convPrim<_,int16> y) : bool #)) + elif type2eq<'T1, 'T2, uint16> && typeeq<'U, bool> then convPrim<_,'U> (not (# "cgt.un" (convPrim<_,uint16> x) (convPrim<_,uint16> y) : bool #)) + elif type2eq<'T1, 'T2, int32> && typeeq<'U, bool> then convPrim<_,'U> (not (# "cgt" (convPrim<_,int32> x) (convPrim<_,int32> y) : bool #)) + elif type2eq<'T1, 'T2, uint32> && typeeq<'U, bool> then convPrim<_,'U> (not (# "cgt.un" (convPrim<_,uint32> x) (convPrim<_,uint32> y) : bool #)) + elif type2eq<'T1, 'T2, int64> && typeeq<'U, bool> then convPrim<_,'U> (not (# "cgt" (convPrim<_,int64> x) (convPrim<_,int64> y) : bool #)) + elif type2eq<'T1, 'T2, uint64> && typeeq<'U, bool> then convPrim<_,'U> (not (# "cgt.un" (convPrim<_,uint64> x) (convPrim<_,uint64> y) : bool #)) + elif type2eq<'T1, 'T2, nativeint> && typeeq<'U, bool> then convPrim<_,'U> (not (# "cgt" (convPrim<_,nativeint> x) (convPrim<_,nativeint> y) : bool #)) + elif type2eq<'T1, 'T2, unativeint> && typeeq<'U, bool> then convPrim<_,'U> (not (# "cgt.un" (convPrim<_,unativeint> x) (convPrim<_,unativeint> y) : bool #)) + elif type2eq<'T1, 'T2, float> && typeeq<'U, bool> then convPrim<_,'U> (not (# "cgt" (convPrim<_,float> x) (convPrim<_,float> y) : bool #)) + elif type2eq<'T1, 'T2, float32> && typeeq<'U, bool> then convPrim<_,'U> (not (# "cgt" (convPrim<_,float32> x) (convPrim<_,float32> y) : bool #)) + elif type2eq<'T1, 'T2, char> && typeeq<'U, bool> then convPrim<_,'U> (not (# "cgt.un" (convPrim<_,char> x) (convPrim<_,char> y) : bool #)) + elif type2eq<'T1, 'T2, decimal> && typeeq<'U, bool> then convPrim<_,'U> (Decimal.op_LessThanOrEqual (convPrim<_,decimal> x, convPrim<_,decimal> y)) + elif type2eq<'T1, 'T2, string> && typeeq<'U, bool> then convPrim<_,'U> (not (# "cgt" (String.CompareOrdinal (convPrim<_,string> x, convPrim<_,string> y)) 0 : bool #)) + else BinaryOpDynamicImplTable.Invoke "op_LessThanOrEqual" x y + + type OpGreaterThanOrEqualInfo = class end + let GreaterThanOrEqualDynamic<'T1, 'T2, 'U> (x: 'T1) (y: 'T2) : 'U = + if type2eq<'T1, 'T2, sbyte> && typeeq<'U, bool> then convPrim<_,'U> (not (# "clt" (convPrim<_,sbyte> x) (convPrim<_,sbyte> y) : bool #)) + elif type2eq<'T1, 'T2, byte> && typeeq<'U, bool> then convPrim<_,'U> (not (# "clt.un" (convPrim<_,byte> x) (convPrim<_,byte> y) : bool #)) + elif type2eq<'T1, 'T2, int16> && typeeq<'U, bool> then convPrim<_,'U> (not (# "clt" (convPrim<_,int16> x) (convPrim<_,int16> y) : bool #)) + elif type2eq<'T1, 'T2, uint16> && typeeq<'U, bool> then convPrim<_,'U> (not (# "clt.un" (convPrim<_,uint16> x) (convPrim<_,uint16> y) : bool #)) + elif type2eq<'T1, 'T2, int32> && typeeq<'U, bool> then convPrim<_,'U> (not (# "clt" (convPrim<_,int32> x) (convPrim<_,int32> y) : bool #)) + elif type2eq<'T1, 'T2, uint32> && typeeq<'U, bool> then convPrim<_,'U> (not (# "clt.un" (convPrim<_,uint32> x) (convPrim<_,uint32> y) : bool #)) + elif type2eq<'T1, 'T2, int64> && typeeq<'U, bool> then convPrim<_,'U> (not (# "clt" (convPrim<_,int64> x) (convPrim<_,int64> y) : bool #)) + elif type2eq<'T1, 'T2, uint64> && typeeq<'U, bool> then convPrim<_,'U> (not (# "clt.un" (convPrim<_,uint64> x) (convPrim<_,uint64> y) : bool #)) + elif type2eq<'T1, 'T2, nativeint> && typeeq<'U, bool> then convPrim<_,'U> (not (# "clt" (convPrim<_,nativeint> x) (convPrim<_,nativeint> y) : bool #)) + elif type2eq<'T1, 'T2, unativeint> && typeeq<'U, bool> then convPrim<_,'U> (not (# "clt.un" (convPrim<_,unativeint> x) (convPrim<_,unativeint> y) : bool #)) + elif type2eq<'T1, 'T2, float> && typeeq<'U, bool> then convPrim<_,'U> (not (# "clt" (convPrim<_,float> x) (convPrim<_,float> y) : bool #)) + elif type2eq<'T1, 'T2, float32> && typeeq<'U, bool> then convPrim<_,'U> (not (# "clt" (convPrim<_,float32> x) (convPrim<_,float32> y) : bool #)) + elif type2eq<'T1, 'T2, char> && typeeq<'U, bool> then convPrim<_,'U> (not (# "clt.un" (convPrim<_,char> x) (convPrim<_,char> y) : bool #)) + elif type2eq<'T1, 'T2, decimal> && typeeq<'U, bool> then convPrim<_,'U> (Decimal.op_GreaterThanOrEqual (convPrim<_,decimal> x, convPrim<_,decimal> y)) + elif type2eq<'T1, 'T2, string> && typeeq<'U, bool> then convPrim<_,'U> (not (# "clt" (String.CompareOrdinal (convPrim<_,string> x, convPrim<_,string> y)) 0 : bool #)) + else BinaryOpDynamicImplTable.Invoke "op_GreaterThanOrEqual" x y + + type OpEqualityInfo = class end + let EqualityDynamic<'T1, 'T2, 'U> (x: 'T1) (y: 'T2) : 'U = + if type2eq<'T1, 'T2, sbyte> && typeeq<'U, bool> then convPrim<_,'U> (# "ceq" (convPrim<_,sbyte> x) (convPrim<_,sbyte> y) : bool #) + elif type2eq<'T1, 'T2, byte> && typeeq<'U, bool> then convPrim<_,'U> (# "ceq" (convPrim<_,byte> x) (convPrim<_,byte> y) : bool #) + elif type2eq<'T1, 'T2, int16> && typeeq<'U, bool> then convPrim<_,'U> (# "ceq" (convPrim<_,int16> x) (convPrim<_,int16> y) : bool #) + elif type2eq<'T1, 'T2, uint16> && typeeq<'U, bool> then convPrim<_,'U> (# "ceq" (convPrim<_,uint16> x) (convPrim<_,uint16> y) : bool #) + elif type2eq<'T1, 'T2, int32> && typeeq<'U, bool> then convPrim<_,'U> (# "ceq" (convPrim<_,int32> x) (convPrim<_,int32> y) : bool #) + elif type2eq<'T1, 'T2, uint32> && typeeq<'U, bool> then convPrim<_,'U> (# "ceq" (convPrim<_,uint32> x) (convPrim<_,uint32> y) : bool #) + elif type2eq<'T1, 'T2, int64> && typeeq<'U, bool> then convPrim<_,'U> (# "ceq" (convPrim<_,int64> x) (convPrim<_,int64> y) : bool #) + elif type2eq<'T1, 'T2, uint64> && typeeq<'U, bool> then convPrim<_,'U> (# "ceq" (convPrim<_,uint64> x) (convPrim<_,uint64> y) : bool #) + elif type2eq<'T1, 'T2, nativeint> && typeeq<'U, bool> then convPrim<_,'U> (# "ceq" (convPrim<_,nativeint> x) (convPrim<_,nativeint> y) : bool #) + elif type2eq<'T1, 'T2, unativeint> && typeeq<'U, bool> then convPrim<_,'U> (# "ceq" (convPrim<_,unativeint> x) (convPrim<_,unativeint> y) : bool #) + elif type2eq<'T1, 'T2, float> && typeeq<'U, bool> then convPrim<_,'U> (# "ceq" (convPrim<_,float> x) (convPrim<_,float> y) : bool #) + elif type2eq<'T1, 'T2, float32> && typeeq<'U, bool> then convPrim<_,'U> (# "ceq" (convPrim<_,float32> x) (convPrim<_,float32> y) : bool #) + elif type2eq<'T1, 'T2, char> && typeeq<'U, bool> then convPrim<_,'U> (# "ceq" (convPrim<_,char> x) (convPrim<_,char> y) : bool #) + elif type2eq<'T1, 'T2, decimal> && typeeq<'U, bool> then convPrim<_,'U> (Decimal.op_Equality (convPrim<_,decimal> x, convPrim<_,decimal> y)) + elif type2eq<'T1, 'T2, string> && typeeq<'U, bool> then convPrim<_,'U> (String.Equals (convPrim<_,string> x, convPrim<_,string> y)) + else BinaryOpDynamicImplTable.Invoke "op_Equality" x y + + type OpInequalityInfo = class end + let InequalityDynamic<'T1, 'T2, 'U> (x: 'T1) (y: 'T2) : 'U = + if type2eq<'T1, 'T2, sbyte> && typeeq<'U, bool> then convPrim<_,'U> (not (# "ceq" (convPrim<_,sbyte> x) (convPrim<_,sbyte> y) : bool #)) + elif type2eq<'T1, 'T2, byte> && typeeq<'U, bool> then convPrim<_,'U> (not (# "ceq" (convPrim<_,byte> x) (convPrim<_,byte> y) : bool #)) + elif type2eq<'T1, 'T2, int16> && typeeq<'U, bool> then convPrim<_,'U> (not (# "ceq" (convPrim<_,int16> x) (convPrim<_,int16> y) : bool #)) + elif type2eq<'T1, 'T2, uint16> && typeeq<'U, bool> then convPrim<_,'U> (not (# "ceq" (convPrim<_,uint16> x) (convPrim<_,uint16> y) : bool #)) + elif type2eq<'T1, 'T2, int32> && typeeq<'U, bool> then convPrim<_,'U> (not (# "ceq" (convPrim<_,int32> x) (convPrim<_,int32> y) : bool #)) + elif type2eq<'T1, 'T2, uint32> && typeeq<'U, bool> then convPrim<_,'U> (not (# "ceq" (convPrim<_,uint32> x) (convPrim<_,uint32> y) : bool #)) + elif type2eq<'T1, 'T2, int64> && typeeq<'U, bool> then convPrim<_,'U> (not (# "ceq" (convPrim<_,int64> x) (convPrim<_,int64> y) : bool #)) + elif type2eq<'T1, 'T2, uint64> && typeeq<'U, bool> then convPrim<_,'U> (not (# "ceq" (convPrim<_,uint64> x) (convPrim<_,uint64> y) : bool #)) + elif type2eq<'T1, 'T2, nativeint> && typeeq<'U, bool> then convPrim<_,'U> (not (# "ceq" (convPrim<_,nativeint> x) (convPrim<_,nativeint> y) : bool #)) + elif type2eq<'T1, 'T2, unativeint> && typeeq<'U, bool> then convPrim<_,'U> (not (# "ceq" (convPrim<_,unativeint> x) (convPrim<_,unativeint> y) : bool #)) + elif type2eq<'T1, 'T2, float> && typeeq<'U, bool> then convPrim<_,'U> (not (# "ceq" (convPrim<_,float> x) (convPrim<_,float> y) : bool #)) + elif type2eq<'T1, 'T2, float32> && typeeq<'U, bool> then convPrim<_,'U> (not (# "ceq" (convPrim<_,float32> x) (convPrim<_,float32> y) : bool #)) + elif type2eq<'T1, 'T2, char> && typeeq<'U, bool> then convPrim<_,'U> (not (# "ceq" (convPrim<_,char> x) (convPrim<_,char> y) : bool #)) + elif type2eq<'T1, 'T2, decimal> && typeeq<'U, bool> then convPrim<_,'U> (Decimal.op_Inequality (convPrim<_,decimal> x, convPrim<_,decimal> y)) + elif type2eq<'T1, 'T2, string> && typeeq<'U, bool> then convPrim<_,'U> (not (String.Equals (convPrim<_,string> x, convPrim<_,string> y))) + else BinaryOpDynamicImplTable.Invoke "op_Inequality" x y + + type DivideByIntInfo = class end + let DivideByIntDynamic<'T> (x: 'T) (n: int) : 'T = + if typeeq<'T, float> then convPrim<_,'T> (# "div" (convPrim<_,float> x) (# "conv.r8" n : float #) : float #) + elif typeeq<'T, float32> then convPrim<_,'T> (# "div" (convPrim<_,float32> x) (# "conv.r4" n : float32 #) : float32 #) + elif typeeq<'T, decimal> then convPrim<_,'T> (Decimal.Divide(convPrim<_,decimal> x, Convert.ToDecimal(n))) + else BinaryOpDynamicImplTable.Invoke "DivideByInt" x n + + let inline DivideByInt< ^T when ^T : (static member DivideByInt : ^T * int -> ^T) > (x: ^T) (y: int) : ^T = + DivideByIntDynamic<'T> x y + when ^T : float = (# "div" x ((# "conv.r8" y : float #)) : float #) + when ^T : float32 = (# "div" x ((# "conv.r4" y : float32 #)) : float32 #) + when ^T : decimal = Decimal.Divide((# "" x : decimal #), Convert.ToDecimal(y)) + when ^T : ^T = (^T : (static member DivideByInt : ^T * int -> ^T) (x, y)) namespace Microsoft.FSharp.Core @@ -3004,6 +3503,7 @@ namespace Microsoft.FSharp.Collections // Lists //------------------------------------------------------------------------- + open System open System.Collections.Generic open System.Diagnostics open Microsoft.FSharp.Core @@ -3366,9 +3866,9 @@ namespace Microsoft.FSharp.Core [] let defaultValueArg arg defaultValue = match arg with ValueNone -> defaultValue | ValueSome v -> v - [] + [] let inline (~-) (n: ^T) : ^T = - (^T : (static member (~-) : ^T -> ^T) (n)) + UnaryNegationDynamic<(^T), (^T)> n when ^T : int32 = (# "neg" n : int32 #) when ^T : float = (# "neg" n : float #) when ^T : float32 = (# "neg" n : float32 #) @@ -3377,7 +3877,10 @@ namespace Microsoft.FSharp.Core when ^T : nativeint = (# "neg" n : nativeint #) when ^T : sbyte = (# "neg" n : sbyte #) when ^T : decimal = (# "" (System.Decimal.op_UnaryNegation((# "" n : decimal #))) : ^T #) - + // According to the somewhat subtle rules of static optimizations, + // this condition is used whenever ^T is resolved to a nominal type or witnesses are available + // That is, not in the generic implementation of '*' + when ^T : ^T = (^T : (static member (~-) : ^T -> ^T) (n)) let inline (+) (x: ^T) (y: ^U) : ^V = AdditionDynamic<(^T),(^U),(^V)> x y @@ -3396,15 +3899,13 @@ namespace Microsoft.FSharp.Core when ^T : byte and ^U : byte = (# "conv.u1" (# "add" x y : uint32 #) : byte #) when ^T : string and ^U : string = (# "" (System.String.Concat((# "" x : string #),(# "" y : string #))) : ^T #) when ^T : decimal and ^U : decimal = (# "" (System.Decimal.op_Addition((# "" x : decimal #),(# "" y : decimal #))) : ^V #) - // According to the somewhat subtle rules of static optimizations, - // this condition is used whenever ^T is resolved to a nominal type - // That is, not in the generic implementation of '+' + // this condition is used whenever ^T is resolved to a nominal type or witnesses are available when ^T : ^T = ((^T or ^U): (static member (+) : ^T * ^U -> ^V) (x,y)) - [] + [] let inline (-) (x: ^T) (y: ^U) : ^V = - ((^T or ^U): (static member (-) : ^T * ^U -> ^V) (x,y)) + SubtractionDynamic<(^T),(^U),(^V)> x y when ^T : int32 and ^U : int32 = (# "sub" x y : int32 #) when ^T : float and ^U : float = (# "sub" x y : float #) when ^T : float32 and ^U : float32 = (# "sub" x y : float32 #) @@ -3418,7 +3919,9 @@ namespace Microsoft.FSharp.Core when ^T : sbyte and ^U : sbyte = (# "conv.i1" (# "sub" x y : int32 #) : sbyte #) when ^T : byte and ^U : byte = (# "conv.u1" (# "sub" x y : uint32 #) : byte #) when ^T : decimal and ^U : decimal = (# "" (System.Decimal.op_Subtraction((# "" x : decimal #),(# "" y : decimal #))) : ^V #) - + // According to the somewhat subtle rules of static optimizations, + // this condition is used whenever ^T is resolved to a nominal type or witnesses are available + when ^T : ^T = ((^T or ^U): (static member (-) : ^T * ^U -> ^V) (x,y)) let inline ( * ) (x: ^T) (y: ^U) : ^V = MultiplyDynamic<(^T),(^U),(^V)> x y @@ -3436,13 +3939,12 @@ namespace Microsoft.FSharp.Core when ^T : byte and ^U : byte = (# "conv.u1" (# "mul" x y : uint32 #) : byte #) when ^T : decimal and ^U : decimal = (# "" (System.Decimal.op_Multiply((# "" x : decimal #),(# "" y : decimal #))) : ^V #) // According to the somewhat subtle rules of static optimizations, - // this condition is used whenever ^T is resolved to a nominal type - // That is, not in the generic implementation of '*' + // this condition is used whenever ^T is resolved to a nominal type or witnesses are available when ^T : ^T = ((^T or ^U): (static member (*) : ^T * ^U -> ^V) (x,y)) - [] + [] let inline ( / ) (x: ^T) (y: ^U) : ^V = - ((^T or ^U): (static member (/) : ^T * ^U -> ^V) (x,y)) + DivisionDynamic<(^T),(^U),(^V)> x y when ^T : int32 and ^U : int32 = (# "div" x y : int32 #) when ^T : float and ^U : float = (# "div" x y : float #) when ^T : float32 and ^U : float32 = (# "div" x y : float32 #) @@ -3456,10 +3958,13 @@ namespace Microsoft.FSharp.Core when ^T : sbyte and ^U : sbyte = (# "conv.i1" (# "div" x y : int32 #) : sbyte #) when ^T : byte and ^U : byte = (# "conv.u1" (# "div.un" x y : uint32 #) : byte #) when ^T : decimal and ^U : decimal = (# "" (System.Decimal.op_Division((# "" x : decimal #),(# "" y : decimal #))) : ^V #) + // According to the somewhat subtle rules of static optimizations, + // this condition is used whenever ^T is resolved to a nominal type or witnesses are available + when ^T : ^T = ((^T or ^U): (static member (/) : ^T * ^U -> ^V) (x,y)) - [] + [] let inline ( % ) (x: ^T) (y: ^U) : ^V = - ((^T or ^U): (static member (%) : ^T * ^U -> ^V) (x,y)) + ModulusDynamic<(^T),(^U),(^V)> x y when ^T : int32 and ^U : int32 = (# "rem" x y : int32 #) when ^T : float and ^U : float = (# "rem" x y : float #) when ^T : float32 and ^U : float32 = (# "rem" x y : float32 #) @@ -3473,10 +3978,13 @@ namespace Microsoft.FSharp.Core when ^T : sbyte and ^U : sbyte = (# "conv.i1" (# "rem" x y : int32 #) : sbyte #) when ^T : byte and ^U : byte = (# "conv.u1" (# "rem.un" x y : uint32 #) : byte #) when ^T : decimal and ^U : decimal = (# "" (System.Decimal.op_Modulus((# "" x : decimal #),(# "" y : decimal #))) : ^V #) + // According to the somewhat subtle rules of static optimizations, + // this condition is used whenever ^T is resolved to a nominal type or witnesses are available + when ^T : ^T = ((^T or ^U): (static member (%) : ^T * ^U -> ^V) (x,y)) - [] + [] let inline (~+) (value: ^T) : ^T = - (^T: (static member (~+) : ^T -> ^T) (value)) + value when ^T : int32 = value when ^T : float = value when ^T : float32 = value @@ -3490,12 +3998,11 @@ namespace Microsoft.FSharp.Core when ^T : sbyte = value when ^T : byte = value when ^T : decimal = value + when ^T : ^T = (^T: (static member (~+) : ^T -> ^T) (value)) - let inline mask (n:int) (m:int) = (# "and" n m : int #) - - [] + [] let inline (<<<) (value: ^T) (shift:int) : ^T = - (^T: (static member (<<<) : ^T * int -> ^T) (value,shift)) + LeftShiftDynamic<(^T),int,(^T)> value shift when ^T : int32 = (# "shl" value (mask shift 31) : int #) when ^T : uint32 = (# "shl" value (mask shift 31) : uint32 #) when ^T : int64 = (# "shl" value (mask shift 63) : int64 #) @@ -3506,10 +4013,13 @@ namespace Microsoft.FSharp.Core when ^T : uint16 = (# "conv.u2" (# "shl" value (mask shift 15) : uint32 #) : uint16 #) when ^T : sbyte = (# "conv.i1" (# "shl" value (mask shift 7 ) : int32 #) : sbyte #) when ^T : byte = (# "conv.u1" (# "shl" value (mask shift 7 ) : uint32 #) : byte #) + // According to the somewhat subtle rules of static optimizations, + // this condition is used whenever ^T is resolved to a nominal type or witnesses are available + when ^T : ^T = (^T: (static member (<<<) : ^T * int -> ^T) (value,shift)) - [] + [] let inline (>>>) (value: ^T) (shift:int) : ^T = - (^T: (static member (>>>) : ^T * int -> ^T) (value,shift)) + RightShiftDynamic<(^T),int,(^T)> value shift when ^T : int32 = (# "shr" value (mask shift 31) : int32 #) when ^T : uint32 = (# "shr.un" value (mask shift 31) : uint32 #) when ^T : int64 = (# "shr" value (mask shift 63) : int64 #) @@ -3520,10 +4030,13 @@ namespace Microsoft.FSharp.Core when ^T : uint16 = (# "conv.u2" (# "shr.un" value (mask shift 15) : uint32 #) : uint16 #) when ^T : sbyte = (# "conv.i1" (# "shr" value (mask shift 7 ) : int32 #) : sbyte #) when ^T : byte = (# "conv.u1" (# "shr.un" value (mask shift 7 ) : uint32 #) : byte #) + // According to the somewhat subtle rules of static optimizations, + // this condition is used whenever ^T is resolved to a nominal type or witnesses are available + when ^T : ^T = (^T: (static member (>>>) : ^T * int -> ^T) (value, shift)) - [] + [] let inline (&&&) (x: ^T) (y: ^T) : ^T = - (^T: (static member (&&&) : ^T * ^T -> ^T) (x,y)) + BitwiseAndDynamic<(^T),(^T),(^T)> x y when ^T : int32 = (# "and" x y : int32 #) when ^T : int64 = (# "and" x y : int64 #) when ^T : uint64 = (# "and" x y : uint64 #) @@ -3534,10 +4047,13 @@ namespace Microsoft.FSharp.Core when ^T : unativeint = (# "and" x y : unativeint #) when ^T : sbyte = (# "and" x y : sbyte #) when ^T : byte = (# "and" x y : byte #) + // According to the somewhat subtle rules of static optimizations, + // this condition is used whenever ^T is resolved to a nominal type or witnesses are available + when ^T : ^T = (^T: (static member (&&&) : ^T * ^T -> ^T) (x, y)) - [] + [] let inline (|||) (x: ^T) (y: ^T) : ^T = - (^T: (static member (|||) : ^T * ^T -> ^T) (x,y)) + BitwiseOrDynamic<(^T),(^T),(^T)> x y when ^T : int32 = (# "or" x y : int32 #) when ^T : int64 = (# "or" x y : int64 #) when ^T : uint64 = (# "or" x y : uint64 #) @@ -3548,10 +4064,13 @@ namespace Microsoft.FSharp.Core when ^T : unativeint = (# "or" x y : unativeint #) when ^T : sbyte = (# "or" x y : sbyte #) when ^T : byte = (# "or" x y : byte #) + // According to the somewhat subtle rules of static optimizations, + // this condition is used whenever ^T is resolved to a nominal type or witnesses are available + when ^T : ^T = (^T: (static member (|||) : ^T * ^T -> ^T) (x, y)) - [] + [] let inline (^^^) (x: ^T) (y: ^T) : ^T = - (^T: (static member (^^^) : ^T * ^T -> ^T) (x,y)) + ExclusiveOrDynamic<(^T),(^T),(^T)> x y when ^T : int32 = (# "xor" x y : int32 #) when ^T : int64 = (# "xor" x y : int64 #) when ^T : uint64 = (# "xor" x y : uint64 #) @@ -3562,10 +4081,13 @@ namespace Microsoft.FSharp.Core when ^T : unativeint = (# "xor" x y : unativeint #) when ^T : sbyte = (# "xor" x y : sbyte #) when ^T : byte = (# "xor" x y : byte #) + // According to the somewhat subtle rules of static optimizations, + // this condition is used whenever ^T is resolved to a nominal type or witnesses are available + when ^T : ^T = (^T: (static member (^^^) : ^T * ^T -> ^T) (x, y)) - [] + [] let inline (~~~) (value: ^T) : ^T = - (^T: (static member (~~~) : ^T -> ^T) (value)) + LogicalNotDynamic<(^T),(^T)> value when ^T : int32 = (# "not" value : int32 #) when ^T : int64 = (# "not" value : int64 #) when ^T : uint64 = (# "not" value : uint64 #) @@ -3576,6 +4098,9 @@ namespace Microsoft.FSharp.Core when ^T : uint16 = (# "conv.u2" (# "not" value : uint32 #) : uint16 #) when ^T : sbyte = (# "conv.i1" (# "not" value : int32 #) : sbyte #) when ^T : byte = (# "conv.u1" (# "not" value : uint32 #) : byte #) + // According to the somewhat subtle rules of static optimizations, + // this condition is used whenever ^T is resolved to a nominal type or witnesses are available + when ^T : ^T = (^T: (static member (~~~) : ^T -> ^T) (value)) let inline castToString (x:'T) = (# "" x : string #) // internal @@ -3604,21 +4129,11 @@ namespace Microsoft.FSharp.Core [] let exit (exitcode:int) = System.Environment.Exit(exitcode); failwith "System.Environment.Exit did not exit!" - let inline parseByte (s:string) = (# "conv.ovf.u1" (ParseUInt32 s) : byte #) - let inline ParseSByte (s:string) = (# "conv.ovf.i1" (ParseInt32 s) : sbyte #) - let inline ParseInt16 (s:string) = (# "conv.ovf.i2" (ParseInt32 s) : int16 #) - let inline ParseUInt16 (s:string) = (# "conv.ovf.u2" (ParseUInt32 s) : uint16 #) - let inline ParseIntPtr (s:string) = (# "conv.ovf.i" (ParseInt64 s) : nativeint #) - let inline ParseUIntPtr (s:string) = (# "conv.ovf.u" (ParseInt64 s) : unativeint #) - let inline ParseDouble (s:string) = Double.Parse(removeUnderscores s,NumberStyles.Float, CultureInfo.InvariantCulture) - let inline ParseSingle (s:string) = Single.Parse(removeUnderscores s,NumberStyles.Float, CultureInfo.InvariantCulture) - - - [] + [] [] let inline byte (value: ^T) = - (^T : (static member op_Explicit: ^T -> byte) (value)) - when ^T : string = parseByte (castToString value) + ExplicitDynamic<(^T), byte> value + when ^T : string = ParseByte (castToString value) when ^T : float = (# "conv.u1" value : byte #) when ^T : float32 = (# "conv.u1" value : byte #) when ^T : int64 = (# "conv.u1" value : byte #) @@ -3632,11 +4147,14 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.u1" value : byte #) when ^T : unativeint = (# "conv.u1" value : byte #) when ^T : byte = (# "conv.u1" value : byte #) - - [] + // According to the somewhat subtle rules of static optimizations, + // this condition is used whenever ^T is resolved to a nominal type or witnesses are available + when ^T : ^T = (^T : (static member op_Explicit: ^T -> byte) (value)) + + [] [] let inline sbyte (value: ^T) = - (^T : (static member op_Explicit: ^T -> sbyte) (value)) + ExplicitDynamic<(^T), sbyte> value when ^T : string = ParseSByte (castToString value) when ^T : float = (# "conv.i1" value : sbyte #) when ^T : float32 = (# "conv.i1" value : sbyte #) @@ -3651,11 +4169,14 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.i1" value : sbyte #) when ^T : unativeint = (# "conv.i1" value : sbyte #) when ^T : byte = (# "conv.i1" value : sbyte #) + // According to the somewhat subtle rules of static optimizations, + // this condition is used whenever ^T is resolved to a nominal type or witnesses are available + when ^T : ^T = (^T : (static member op_Explicit: ^T -> sbyte) (value)) - [] + [] [] let inline uint16 (value: ^T) = - (^T : (static member op_Explicit: ^T -> uint16) (value)) + ExplicitDynamic<(^T), uint16> value when ^T : string = ParseUInt16 (castToString value) when ^T : float = (# "conv.u2" value : uint16 #) when ^T : float32 = (# "conv.u2" value : uint16 #) @@ -3670,11 +4191,14 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.u2" value : uint16 #) when ^T : unativeint = (# "conv.u2" value : uint16 #) when ^T : byte = (# "conv.u2" value : uint16 #) + // According to the somewhat subtle rules of static optimizations, + // this condition is used whenever ^T is resolved to a nominal type or witnesses are available + when ^T : ^T = (^T : (static member op_Explicit: ^T -> uint16) (value)) - [] + [] [] let inline int16 (value: ^T) = - (^T : (static member op_Explicit: ^T -> int16) (value)) + ExplicitDynamic<(^T), int16> value when ^T : string = ParseInt16 (castToString value) when ^T : float = (# "conv.i2" value : int16 #) when ^T : float32 = (# "conv.i2" value : int16 #) @@ -3689,18 +4213,17 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.i2" value : int16 #) when ^T : unativeint = (# "conv.i2" value : int16 #) when ^T : byte = (# "conv.i2" value : int16 #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> int16) (value)) - [] + [] [] let inline uint32 (value: ^T) = - (^T : (static member op_Explicit: ^T -> uint32) (value)) + ExplicitDynamic<(^T), uint32> value when ^T : string = ParseUInt32 (castToString value) when ^T : float = (# "conv.u4" value : uint32 #) when ^T : float32 = (# "conv.u4" value : uint32 #) - when ^T : int64 = (# "conv.u4" value : uint32 #) when ^T : nativeint = (# "conv.u4" value : uint32 #) - // For integers shorter that 32 bits, we must first // sign-widen the signed integer to 32 bits, and then // "convert" from signed int32 to unsigned int32 @@ -3708,36 +4231,35 @@ namespace Microsoft.FSharp.Core when ^T : int32 = (# "" value : uint32 #) when ^T : int16 = (# "" value : uint32 #) when ^T : sbyte = (# "" value : uint32 #) - when ^T : uint64 = (# "conv.u4" value : uint32 #) when ^T : uint32 = (# "conv.u4" value : uint32 #) when ^T : uint16 = (# "conv.u4" value : uint32 #) when ^T : char = (# "conv.u4" value : uint32 #) when ^T : unativeint = (# "conv.u4" value : uint32 #) when ^T : byte = (# "conv.u4" value : uint32 #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> uint32) (value)) - [] + [] [] let inline int32 (value: ^T) = - (^T : (static member op_Explicit: ^T -> int32) (value)) + ExplicitDynamic<(^T), int32> value when ^T : string = ParseInt32 (castToString value) when ^T : float = (# "conv.i4" value : int32 #) when ^T : float32 = (# "conv.i4" value : int32 #) when ^T : int64 = (# "conv.i4" value : int32 #) when ^T : nativeint = (# "conv.i4" value : int32 #) - // For integers shorter that 32 bits, we sign-widen the signed integer to 32 bits // This is a no-op on IL stack (ECMA 335 Part III 1.5 Tables 8 & 9) when ^T : int32 = (# "" value : int32 #) when ^T : int16 = (# "" value : int32 #) when ^T : sbyte = (# "" value : int32 #) - when ^T : uint64 = (# "conv.i4" value : int32 #) when ^T : uint32 = (# "" value : int32 #) // Signed<->Unsigned conversion is a no-op on IL stack when ^T : uint16 = (# "conv.i4" value : int32 #) when ^T : char = (# "conv.i4" value : int32 #) when ^T : unativeint = (# "conv.i4" value : int32 #) when ^T : byte = (# "conv.i4" value : int32 #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> int32) (value)) [] let inline int value = int32 value @@ -3749,7 +4271,7 @@ namespace Microsoft.FSharp.Core let inline enum< ^T when ^T : enum > (value:int32) : ^T = EnumOfValue value [] - let ( |KeyValue| ) (keyValuePair : KeyValuePair<'T,'U>) = (keyValuePair.Key, keyValuePair.Value) + let (|KeyValue|) (keyValuePair : KeyValuePair<'T,'U>) = (keyValuePair.Key, keyValuePair.Value) [] let infinity = System.Double.PositiveInfinity @@ -3763,14 +4285,13 @@ namespace Microsoft.FSharp.Core [] let nanf = System.Single.NaN - [] + [] [] let inline uint64 (value: ^T) = - (^T : (static member op_Explicit: ^T -> uint64) (value)) + ExplicitDynamic<(^T), uint64> value when ^T : string = ParseUInt64 (castToString value) when ^T : float = (# "conv.u8" value : uint64 #) when ^T : float32 = (# "conv.u8" value : uint64 #) - // we must first sign-widen the signed integer to 64 bits, and then // "convert" from signed int64 to unsigned int64 // conv.i8 sign-widens the input, and on IL stack, @@ -3780,19 +4301,18 @@ namespace Microsoft.FSharp.Core when ^T : int16 = (# "conv.i8" value : uint64 #) when ^T : nativeint = (# "conv.i8" value : uint64 #) when ^T : sbyte = (# "conv.i8" value : uint64 #) - - when ^T : uint64 = (# "" value : uint64 #) when ^T : uint32 = (# "conv.u8" value : uint64 #) when ^T : uint16 = (# "conv.u8" value : uint64 #) when ^T : char = (# "conv.u8" value : uint64 #) when ^T : unativeint = (# "conv.u8" value : uint64 #) when ^T : byte = (# "conv.u8" value : uint64 #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> uint64) (value)) - [] + [] [] let inline int64 (value: ^T) = - (^T : (static member op_Explicit: ^T -> int64) (value)) + ExplicitDynamic<(^T), int64> value when ^T : string = ParseInt64 (castToString value) when ^T : float = (# "conv.i8" value : int64 #) when ^T : float32 = (# "conv.i8" value : int64 #) @@ -3801,7 +4321,6 @@ namespace Microsoft.FSharp.Core when ^T : int16 = (# "conv.i8" value : int64 #) when ^T : nativeint = (# "conv.i8" value : int64 #) when ^T : sbyte = (# "conv.i8" value : int64 #) - // When converting unsigned integer, we should zero-widen them, NOT sign-widen // No-op for uint64, conv.u8 for uint32, for smaller types conv.u8 and conv.i8 are identical. // For nativeint, conv.u8 works correctly both in 32 bit and 64 bit case. @@ -3811,11 +4330,12 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.u8" value : int64 #) when ^T : unativeint = (# "conv.u8" value : int64 #) when ^T : byte = (# "conv.u8" value : int64 #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> int64) (value)) - [] + [] [] let inline float32 (value: ^T) = - (^T : (static member op_Explicit: ^T -> float32) (value)) + ExplicitDynamic<(^T), float32> value when ^T : string = ParseSingle (castToString value) when ^T : float = (# "conv.r4" value : float32 #) // NOTE: float32 should convert its argument to 32-bit float even when applied to a higher precision float stored in a register. See devdiv2#49888. @@ -3831,11 +4351,12 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.r.un conv.r4" value : float32 #) when ^T : unativeint = (# "conv.r.un conv.r4" value : float32 #) when ^T : byte = (# "conv.r.un conv.r4" value : float32 #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> float32) (value)) - [] + [] [] let inline float (value: ^T) = - (^T : (static member op_Explicit: ^T -> float) (value)) + ExplicitDynamic<(^T), float> value when ^T : string = ParseDouble (castToString value) // NOTE: float should convert its argument to 64-bit float even when applied to a higher precision float stored in a register. See devdiv2#49888. when ^T : float = (# "conv.r8" value : float #) @@ -3851,12 +4372,13 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.r.un conv.r8" value : float #) when ^T : unativeint = (# "conv.r.un conv.r8" value : float #) when ^T : byte = (# "conv.r.un conv.r8" value : float #) - when ^T : decimal = (System.Convert.ToDouble((# "" value : decimal #))) + when ^T : decimal = (Convert.ToDouble((# "" value : decimal #))) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> float) (value)) - [] + [] [] let inline decimal (value: ^T) = - (^T : (static member op_Explicit: ^T -> decimal) (value)) + ExplicitDynamic<(^T), decimal> value when ^T : string = (System.Decimal.Parse(castToString value,NumberStyles.Float,CultureInfo.InvariantCulture)) when ^T : float = (System.Convert.ToDecimal((# "" value : float #))) when ^T : float32 = (System.Convert.ToDecimal((# "" value : float32 #))) @@ -3871,20 +4393,15 @@ namespace Microsoft.FSharp.Core when ^T : unativeint = (System.Convert.ToDecimal(uint64 (# "" value : unativeint #))) when ^T : byte = (System.Convert.ToDecimal((# "" value : byte #))) when ^T : decimal = (# "" value : decimal #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> decimal) (value)) - // Recall type names. - // Framework names: sbyte, byte, int16, uint16, int32, uint32, int64, uint64, single, double. - // C# names: sbyte, byte, short, ushort, int, uint, long, ulong, single, double. - // F# names: sbyte, byte, int16, uint16, int, uint32, int64, uint64, float32, float. - - [] + [] [] let inline unativeint (value: ^T) = - (^T : (static member op_Explicit: ^T -> unativeint) (value)) + ExplicitDynamic<(^T), unativeint> value when ^T : string = ParseUIntPtr (castToString value) when ^T : float = (# "conv.u" value : unativeint #) when ^T : float32 = (# "conv.u" value : unativeint #) - // Narrower signed types we sign-extend. // Same length signed types we leave as such (so -1 gets reinterpreted as unsigned MaxValue). // Wider signed types we truncate. @@ -3894,28 +4411,26 @@ namespace Microsoft.FSharp.Core when ^T : int16 = (# "conv.i" value : unativeint #) when ^T : nativeint = (# "" value : unativeint #) when ^T : sbyte = (# "conv.i" value : unativeint #) - when ^T : uint64 = (# "conv.u" value : unativeint #) when ^T : uint32 = (# "conv.u" value : unativeint #) when ^T : uint16 = (# "conv.u" value : unativeint #) when ^T : char = (# "conv.u" value : unativeint #) when ^T : unativeint = (# "" value : unativeint #) when ^T : byte = (# "conv.u" value : unativeint #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> unativeint) (value)) - [] + [] [] let inline nativeint (value: ^T) = - (^T : (static member op_Explicit: ^T -> nativeint) (value)) + ExplicitDynamic<(^T), nativeint> value when ^T : string = ParseIntPtr (castToString value) when ^T : float = (# "conv.i" value : nativeint #) when ^T : float32 = (# "conv.i" value : nativeint #) - when ^T : int64 = (# "conv.i" value : nativeint #) when ^T : int32 = (# "conv.i" value : nativeint #) when ^T : int16 = (# "conv.i" value : nativeint #) when ^T : nativeint = (# "conv.i" value : nativeint #) when ^T : sbyte = (# "conv.i" value : nativeint #) - // Narrower unsigned types we zero-extend. // Same length unsigned types we leave as such (so unsigned MaxValue (all-bits-set) gets reinterpreted as -1). // Wider unsigned types we truncate. @@ -3926,6 +4441,7 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.u" value : nativeint #) when ^T : unativeint = (# "" value : nativeint #) when ^T : byte = (# "conv.i" value : nativeint #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> nativeint) (value)) [] let inline string (value: ^T) = @@ -3946,10 +4462,10 @@ namespace Microsoft.FSharp.Core when ^T : unativeint = (# "" value : unativeint #).ToString() when ^T : byte = (# "" value : byte #).ToString("g",CultureInfo.InvariantCulture) - [] + [] [] let inline char (value: ^T) = - (^T : (static member op_Explicit: ^T -> char) (value)) + ExplicitDynamic<(^T), char> value when ^T : string = (System.Char.Parse(castToString value)) when ^T : float = (# "conv.u2" value : char #) when ^T : float32 = (# "conv.u2" value : char #) @@ -3964,12 +4480,12 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.u2" value : char #) when ^T : unativeint = (# "conv.u2" value : char #) when ^T : byte = (# "conv.u2" value : char #) - + when ^T : ^T = (^T : (static member op_Explicit: ^T -> char) (value)) module NonStructuralComparison = /// Static less-than with static optimizations for some well-known cases. let inline (<) (x:^T) (y:^U) = - ((^T or ^U): (static member (<) : ^T * ^U -> bool) (x,y)) + LessThanDynamic<(^T), (^U), bool> x y when ^T : bool = (# "clt" x y : bool #) when ^T : sbyte = (# "clt" x y : bool #) when ^T : int16 = (# "clt" x y : bool #) @@ -3986,10 +4502,11 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "clt" x y : bool #) when ^T : decimal = System.Decimal.op_LessThan ((# "" x:decimal #), (# "" y:decimal #)) when ^T : string = (# "clt" (System.String.CompareOrdinal((# "" x : string #),(# "" y : string #))) 0 : bool #) + when ^T : ^T = ((^T or ^U): (static member (<) : ^T * ^U -> bool) (x,y)) /// Static greater-than with static optimizations for some well-known cases. let inline (>) (x:^T) (y:^U) = - ((^T or ^U): (static member (>) : ^T * ^U -> bool) (x,y)) + GreaterThanDynamic<(^T), (^U), bool> x y when 'T : bool = (# "cgt" x y : bool #) when 'T : sbyte = (# "cgt" x y : bool #) when 'T : int16 = (# "cgt" x y : bool #) @@ -4006,10 +4523,11 @@ namespace Microsoft.FSharp.Core when 'T : char = (# "cgt" x y : bool #) when 'T : decimal = System.Decimal.op_GreaterThan ((# "" x:decimal #), (# "" y:decimal #)) when ^T : string = (# "cgt" (System.String.CompareOrdinal((# "" x : string #),(# "" y : string #))) 0 : bool #) + when ^T : ^T = ((^T or ^U): (static member (>) : ^T * ^U -> bool) (x,y)) /// Static less-than-or-equal with static optimizations for some well-known cases. let inline (<=) (x:^T) (y:^U) = - ((^T or ^U): (static member (<=) : ^T * ^U -> bool) (x,y)) + LessThanOrEqualDynamic<(^T), (^U), bool> x y when 'T : bool = not (# "cgt" x y : bool #) when 'T : sbyte = not (# "cgt" x y : bool #) when 'T : int16 = not (# "cgt" x y : bool #) @@ -4026,10 +4544,11 @@ namespace Microsoft.FSharp.Core when 'T : char = not (# "cgt" x y : bool #) when 'T : decimal = System.Decimal.op_LessThanOrEqual ((# "" x:decimal #), (# "" y:decimal #)) when ^T : string = not (# "cgt" (System.String.CompareOrdinal((# "" x : string #),(# "" y : string #))) 0 : bool #) + when ^T : ^T = ((^T or ^U): (static member (<=) : ^T * ^U -> bool) (x,y)) /// Static greater-than-or-equal with static optimizations for some well-known cases. let inline (>=) (x:^T) (y:^U) = - ((^T or ^U): (static member (>=) : ^T * ^U -> bool) (x,y)) + GreaterThanOrEqualDynamic<(^T), (^U), bool> x y when 'T : bool = not (# "clt" x y : bool #) when 'T : sbyte = not (# "clt" x y : bool #) when 'T : int16 = not (# "clt" x y : bool #) @@ -4046,11 +4565,11 @@ namespace Microsoft.FSharp.Core when 'T : char = not (# "clt" x y : bool #) when 'T : decimal = System.Decimal.op_GreaterThanOrEqual ((# "" x:decimal #), (# "" y:decimal #)) when ^T : string = not (# "clt" (System.String.CompareOrdinal((# "" x : string #),(# "" y : string #))) 0 : bool #) - + when ^T : ^T = ((^T or ^U): (static member (>=) : ^T * ^U -> bool) (x,y)) /// Static greater-than-or-equal with static optimizations for some well-known cases. let inline (=) (x:^T) (y:^T) = - (^T : (static member (=) : ^T * ^T -> bool) (x,y)) + EqualityDynamic<(^T), (^T), bool> x y when ^T : bool = (# "ceq" x y : bool #) when ^T : sbyte = (# "ceq" x y : bool #) when ^T : int16 = (# "ceq" x y : bool #) @@ -4065,11 +4584,12 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "ceq" x y : bool #) when ^T : nativeint = (# "ceq" x y : bool #) when ^T : unativeint = (# "ceq" x y : bool #) - when ^T : string = System.String.Equals((# "" x : string #),(# "" y : string #)) - when ^T : decimal = System.Decimal.op_Equality((# "" x:decimal #), (# "" y:decimal #)) + when ^T : string = String.Equals((# "" x : string #),(# "" y : string #)) + when ^T : decimal = Decimal.op_Equality((# "" x:decimal #), (# "" y:decimal #)) + when ^T : ^T = (^T : (static member (=) : ^T * ^T -> bool) (x,y)) let inline (<>) (x:^T) (y:^T) = - (^T : (static member (<>) : ^T * ^T -> bool) (x,y)) + InequalityDynamic<(^T), (^T), bool> x y when ^T : bool = not (# "ceq" x y : bool #) when ^T : sbyte = not (# "ceq" x y : bool #) when ^T : int16 = not (# "ceq" x y : bool #) @@ -4086,7 +4606,7 @@ namespace Microsoft.FSharp.Core when ^T : unativeint = not (# "ceq" x y : bool #) when ^T : string = not (System.String.Equals((# "" x : string #),(# "" y : string #))) when ^T : decimal = System.Decimal.op_Inequality((# "" x:decimal #), (# "" y:decimal #)) - + when ^T : ^T = (^T : (static member (<>) : ^T * ^T -> bool) (x,y)) // static comparison (ER mode) with static optimizations for some well-known cases [] @@ -4262,9 +4782,8 @@ namespace Microsoft.FSharp.Core // That is, not in the generic implementation of '+' when ^T : ^T = ((^T or ^U): (static member (+) : ^T * ^U -> ^V) (x,y)) - [] let inline (-) (x: ^T) (y: ^U) : ^V = - ((^T or ^U): (static member (-) : ^T * ^U -> ^V) (x,y)) + CheckedSubtractionDynamic<(^T),(^U),(^V)> x y when ^T : int32 and ^U : int32 = (# "sub.ovf" x y : int32 #) when ^T : float and ^U : float = (# "sub" x y : float #) when ^T : float32 and ^U : float32 = (# "sub" x y : float32 #) @@ -4278,10 +4797,11 @@ namespace Microsoft.FSharp.Core when ^T : sbyte and ^U : sbyte = (# "conv.ovf.i1" (# "sub.ovf" x y : int32 #) : sbyte #) when ^T : byte and ^U : byte = (# "conv.ovf.u1.un" (# "sub.ovf.un" x y : uint32 #) : byte #) when ^T : decimal and ^U : decimal = (# "" (System.Decimal.op_Subtraction((# "" x : decimal #),(# "" y : decimal #))) : ^V #) + when ^T : ^T = ((^T or ^U): (static member (-) : ^T * ^U -> ^V) (x,y)) - [] + [] let inline (~-) (value: ^T) : ^T = - (^T : (static member (~-) : ^T -> ^T) (value)) + CheckedUnaryNegationDynamic<(^T),(^T)> value when ^T : int32 = (# "sub.ovf" 0 value : int32 #) when ^T : float = (# "neg" value : float #) when ^T : float32 = (# "neg" value : float32 #) @@ -4290,6 +4810,7 @@ namespace Microsoft.FSharp.Core when ^T : nativeint = (# "sub.ovf" 0n value : nativeint #) when ^T : sbyte = (# "sub.ovf" 0y value : sbyte #) when ^T : decimal = (# "" (System.Decimal.op_UnaryNegation((# "" value : decimal #))) : ^T #) + when ^T : ^T = (^T : (static member (~-) : ^T -> ^T) (value)) let inline ( * ) (x: ^T) (y: ^U) : ^V = CheckedMultiplyDynamic<(^T),(^U),(^V)> x y @@ -4311,11 +4832,11 @@ namespace Microsoft.FSharp.Core // That is, not in the generic implementation of '*' when ^T : ^T = ((^T or ^U): (static member (*) : ^T * ^U -> ^V) (x,y)) - [] + [] [] let inline byte (value: ^T) = - (^T : (static member op_Explicit: ^T -> byte) (value)) - when ^T : string = parseByte (castToString value) + ExplicitDynamic<(^T),byte> value + when ^T : string = ParseByte (castToString value) when ^T : float = (# "conv.ovf.u1" value : byte #) when ^T : float32 = (# "conv.ovf.u1" value : byte #) when ^T : int64 = (# "conv.ovf.u1" value : byte #) @@ -4329,11 +4850,12 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.ovf.u1.un" value : byte #) when ^T : unativeint = (# "conv.ovf.u1.un" value : byte #) when ^T : byte = (# "conv.ovf.u1.un" value : byte #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> byte) (value)) - [] + [] [] let inline sbyte (value: ^T) = - (^T : (static member op_Explicit: ^T -> sbyte) (value)) + ExplicitDynamic<(^T),sbyte> value when ^T : string = ParseSByte (castToString value) when ^T : float = (# "conv.ovf.i1" value : sbyte #) when ^T : float32 = (# "conv.ovf.i1" value : sbyte #) @@ -4348,11 +4870,12 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.ovf.i1.un" value : sbyte #) when ^T : unativeint = (# "conv.ovf.i1.un" value : sbyte #) when ^T : byte = (# "conv.ovf.i1.un" value : sbyte #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> sbyte) (value)) - [] + [] [] let inline uint16 (value: ^T) = - (^T : (static member op_Explicit: ^T -> uint16) (value)) + ExplicitDynamic<(^T),uint16> value when ^T : string = ParseUInt16 (castToString value) when ^T : float = (# "conv.ovf.u2" value : uint16 #) when ^T : float32 = (# "conv.ovf.u2" value : uint16 #) @@ -4367,11 +4890,12 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.ovf.u2.un" value : uint16 #) when ^T : unativeint = (# "conv.ovf.u2.un" value : uint16 #) when ^T : byte = (# "conv.ovf.u2.un" value : uint16 #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> uint16) (value)) - [] + [] [] let inline char (value: ^T) = - (^T : (static member op_Explicit: ^T -> char) (value)) + ExplicitDynamic<(^T), char> value when ^T : string = (System.Char.Parse(castToString value)) when ^T : float = (# "conv.ovf.u2" value : char #) when ^T : float32 = (# "conv.ovf.u2" value : char #) @@ -4386,11 +4910,12 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.ovf.u2.un" value : char #) when ^T : unativeint = (# "conv.ovf.u2.un" value : char #) when ^T : byte = (# "conv.ovf.u2.un" value : char #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> char) (value)) - [] + [] [] let inline int16 (value: ^T) = - (^T : (static member op_Explicit: ^T -> int16) (value)) + ExplicitDynamic<(^T), int16> value when ^T : string = ParseInt16 (castToString value) when ^T : float = (# "conv.ovf.i2" value : int16 #) when ^T : float32 = (# "conv.ovf.i2" value : int16 #) @@ -4405,11 +4930,12 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.ovf.i2.un" value : int16 #) when ^T : unativeint = (# "conv.ovf.i2.un" value : int16 #) when ^T : byte = (# "conv.ovf.i2.un" value : int16 #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> int16) (value)) - [] + [] [] let inline uint32 (value: ^T) = - (^T : (static member op_Explicit: ^T -> uint32) (value)) + ExplicitDynamic<(^T), uint32> value when ^T : string = ParseUInt32 (castToString value) when ^T : float = (# "conv.ovf.u4" value : uint32 #) when ^T : float32 = (# "conv.ovf.u4" value : uint32 #) @@ -4424,11 +4950,12 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.ovf.u4.un" value : uint32 #) when ^T : unativeint = (# "conv.ovf.u4.un" value : uint32 #) when ^T : byte = (# "conv.ovf.u4.un" value : uint32 #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> uint32) (value)) - [] + [] [] let inline int32 (value: ^T) = - (^T : (static member op_Explicit: ^T -> int32) (value)) + ExplicitDynamic<(^T), int32> value when ^T : string = ParseInt32 (castToString value) when ^T : float = (# "conv.ovf.i4" value : int32 #) when ^T : float32 = (# "conv.ovf.i4" value : int32 #) @@ -4443,15 +4970,15 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.ovf.i4.un" value : int32 #) when ^T : unativeint = (# "conv.ovf.i4.un" value : int32 #) when ^T : byte = (# "conv.ovf.i4.un" value : int32 #) - + when ^T : ^T = (^T : (static member op_Explicit: ^T -> int32) (value)) [] let inline int value = int32 value - [] + [] [] let inline uint64 (value: ^T) = - (^T : (static member op_Explicit: ^T -> uint64) (value)) + ExplicitDynamic<(^T), uint64> value when ^T : string = ParseUInt64 (castToString value) when ^T : float = (# "conv.ovf.u8" value : uint64 #) when ^T : float32 = (# "conv.ovf.u8" value : uint64 #) @@ -4466,11 +4993,12 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.ovf.u8.un" value : uint64 #) when ^T : unativeint = (# "conv.ovf.u8.un" value : uint64 #) when ^T : byte = (# "conv.ovf.u8.un" value : uint64 #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> uint64) (value)) - [] + [] [] let inline int64 (value: ^T) = - (^T : (static member op_Explicit: ^T -> int64) (value)) + ExplicitDynamic<(^T), int64> value when ^T : string = ParseInt64 (castToString value) when ^T : float = (# "conv.ovf.i8" value : int64 #) when ^T : float32 = (# "conv.ovf.i8" value : int64 #) @@ -4485,11 +5013,12 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.ovf.i8.un" value : int64 #) when ^T : unativeint = (# "conv.ovf.i8.un" value : int64 #) when ^T : byte = (# "conv.ovf.i8.un" value : int64 #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> int64) (value)) - [] + [] [] let inline unativeint (value: ^T) = - (^T : (static member op_Explicit: ^T -> unativeint) (value)) + ExplicitDynamic<(^T), unativeint> value when ^T : string = ParseUIntPtr (castToString value) when ^T : float = (# "conv.ovf.u" value : unativeint #) when ^T : float32 = (# "conv.ovf.u" value : unativeint #) @@ -4504,11 +5033,12 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.ovf.u.un" value : unativeint #) when ^T : unativeint = (# "conv.ovf.u.un" value : unativeint #) when ^T : byte = (# "conv.ovf.u.un" value : unativeint #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> unativeint) (value)) - [] + [] [] let inline nativeint (value: ^T) = - (^T : (static member op_Explicit: ^T -> nativeint) (value)) + ExplicitDynamic<(^T), nativeint> value when ^T : string = ParseIntPtr (castToString value) when ^T : float = (# "conv.ovf.i" value : nativeint #) when ^T : float32 = (# "conv.ovf.i" value : nativeint #) @@ -4523,6 +5053,7 @@ namespace Microsoft.FSharp.Core when ^T : char = (# "conv.ovf.i.un" value : nativeint #) when ^T : unativeint = (# "conv.ovf.i.un" value : nativeint #) when ^T : byte = (# "conv.ovf.i.un" value : nativeint #) + when ^T : ^T = (^T : (static member op_Explicit: ^T -> nativeint) (value)) module OperatorIntrinsics = @@ -5402,7 +5933,7 @@ namespace Microsoft.FSharp.Core if len <= 0 then String.Empty else source.Substring(start, len) - [] + [] let inline absImpl (x: ^T) : ^T = (^T: (static member Abs : ^T -> ^T) (x)) when ^T : int32 = let x : int32 = retype x in System.Math.Abs(x) @@ -5419,61 +5950,61 @@ namespace Microsoft.FSharp.Core when ^T : sbyte = let x : sbyte = retype x in System.Math.Abs(x) when ^T : decimal = System.Math.Abs(retype x : decimal) - [] + [] let inline acosImpl(x: ^T) : ^T = (^T: (static member Acos : ^T -> ^T) (x)) when ^T : float = System.Math.Acos(retype x) when ^T : float32 = System.Math.Acos(toFloat (retype x)) |> toFloat32 - [] + [] let inline asinImpl(x: ^T) : ^T = (^T: (static member Asin : ^T -> ^T) (x)) when ^T : float = System.Math.Asin(retype x) when ^T : float32 = System.Math.Asin(toFloat (retype x)) |> toFloat32 - [] + [] let inline atanImpl(x: ^T) : ^T = (^T: (static member Atan : ^T -> ^T) (x)) when ^T : float = System.Math.Atan(retype x) when ^T : float32 = System.Math.Atan(toFloat (retype x)) |> toFloat32 - [] + [] let inline atan2Impl(x: ^T) (y: ^T) : 'U = (^T: (static member Atan2 : ^T * ^T -> 'U) (x,y)) when ^T : float = System.Math.Atan2(retype x, retype y) when ^T : float32 = System.Math.Atan2(toFloat (retype x), toFloat(retype y)) |> toFloat32 - [] + [] let inline ceilImpl(x: ^T) : ^T = (^T: (static member Ceiling : ^T -> ^T) (x)) when ^T : float = System.Math.Ceiling(retype x : float) when ^T : float32 = System.Math.Ceiling(toFloat (retype x)) |> toFloat32 - [] + [] let inline expImpl(x: ^T) : ^T = (^T: (static member Exp : ^T -> ^T) (x)) when ^T : float = System.Math.Exp(retype x) when ^T : float32 = System.Math.Exp(toFloat (retype x)) |> toFloat32 - [] + [] let inline floorImpl (x: ^T) : ^T = (^T: (static member Floor : ^T -> ^T) (x)) when ^T : float = System.Math.Floor(retype x : float) when ^T : float32 = System.Math.Floor(toFloat (retype x)) |> toFloat32 - [] + [] let inline truncateImpl (x: ^T) : ^T = (^T: (static member Truncate : ^T -> ^T) (x)) when ^T : float = System.Math.Truncate(retype x : float) when ^T : float32 = System.Math.Truncate(toFloat (retype x)) |> toFloat32 - [] + [] let inline roundImpl (x: ^T) : ^T = (^T: (static member Round : ^T -> ^T) (x)) when ^T : float = System.Math.Round(retype x : float) when ^T : float32 = System.Math.Round(toFloat (retype x)) |> toFloat32 - [] + [] let inline signImpl (x: ^T) : int = (^T: (member Sign : int) (x)) when ^T : int32 = System.Math.Sign(retype x : int32) @@ -5485,79 +6016,67 @@ namespace Microsoft.FSharp.Core when ^T : float32 = System.Math.Sign(toFloat (retype x)) when ^T : decimal = System.Math.Sign(retype x : decimal) - [] + [] let inline logImpl(x: ^T) : ^T = (^T: (static member Log : ^T -> ^T) (x)) when ^T : float = System.Math.Log(retype x) when ^T : float32 = System.Math.Log(toFloat (retype x)) |> toFloat32 - [] + [] let inline log10Impl(x: ^T) : ^T = (^T: (static member Log10 : ^T -> ^T) (x)) when ^T : float = System.Math.Log10(retype x) when ^T : float32 = System.Math.Log10(toFloat (retype x)) |> toFloat32 - [] + [] let inline sqrtImpl(x: ^T) : ^U = (^T: (static member Sqrt : ^T -> ^U) (x)) when ^T : float = System.Math.Sqrt(retype x : float) when ^T : float32 = System.Math.Sqrt(toFloat (retype x)) |> toFloat32 - [] + [] let inline cosImpl(x: ^T) : ^T = (^T: (static member Cos : ^T -> ^T) (x)) when ^T : float = System.Math.Cos(retype x) when ^T : float32 = System.Math.Cos(toFloat (retype x)) |> toFloat32 - [] + [] let inline coshImpl(x: ^T) : ^T = (^T: (static member Cosh : ^T -> ^T) (x)) when ^T : float = System.Math.Cosh(retype x) when ^T : float32 = System.Math.Cosh(toFloat (retype x)) |> toFloat32 - [] + [] let inline sinImpl(x: ^T) : ^T = (^T: (static member Sin : ^T -> ^T) (x)) when ^T : float = System.Math.Sin(retype x) when ^T : float32 = System.Math.Sin(toFloat (retype x)) |> toFloat32 - [] + [] let inline sinhImpl(x: ^T) : ^T = (^T: (static member Sinh : ^T -> ^T) (x)) when ^T : float = System.Math.Sinh(retype x) when ^T : float32 = System.Math.Sinh(toFloat (retype x)) |> toFloat32 - [] + [] let inline tanImpl(x: ^T) : ^T = (^T: (static member Tan : ^T -> ^T) (x)) when ^T : float = System.Math.Tan(retype x) when ^T : float32 = System.Math.Tan(toFloat (retype x)) |> toFloat32 - [] + [] let inline tanhImpl(x: ^T) : ^T = (^T: (static member Tanh : ^T -> ^T) (x)) when ^T : float = System.Math.Tanh(retype x) when ^T : float32 = System.Math.Tanh(toFloat (retype x)) |> toFloat32 - [] + [] let inline powImpl (x: ^T) (y: ^U) : ^T = (^T: (static member Pow : ^T * ^U -> ^T) (x,y)) when ^T : float = System.Math.Pow((retype x : float), (retype y: float)) when ^T : float32 = System.Math.Pow(toFloat (retype x), toFloat(retype y)) |> toFloat32 [] - let UnaryDynamicImpl nm : ('T -> 'U) = - let aty = typeof<'T> - let minfo = aty.GetMethod(nm, [| aty |]) - (fun x -> unboxPrim<_>(minfo.Invoke(null,[| box x|]))) - - let BinaryDynamicImpl nm : ('T -> 'U -> 'V) = - let aty = typeof<'T> - let bty = typeof<'U> - let minfo = aty.GetMethod(nm,[| aty;bty |]) - (fun x y -> unboxPrim<_>(minfo.Invoke(null,[| box x; box y|]))) - - [] type AbsDynamicImplTable<'T>() = static let result : ('T -> 'T) = let aty = typeof<'T> diff --git a/src/fsharp/FSharp.Core/prim-types.fsi b/src/fsharp/FSharp.Core/prim-types.fsi index afa0719602c..a523c03ec57 100644 --- a/src/fsharp/FSharp.Core/prim-types.fsi +++ b/src/fsharp/FSharp.Core/prim-types.fsi @@ -714,6 +714,9 @@ namespace Microsoft.FSharp.Core /// NoDynamicInvocationAttribute new : unit -> NoDynamicInvocationAttribute + [] + new : isLegacy: bool -> NoDynamicInvocationAttribute + /// This attribute is used to indicate that references to the elements of a module, record or union /// type require explicit qualified access. [] @@ -1079,6 +1082,101 @@ namespace Microsoft.FSharp.Core [] val CheckedMultiplyDynamic : x:'T1 -> y:'T2 -> 'U + /// A compiler intrinsic that implements dynamic invocations to the '-' operator. + [] + [] + val SubtractionDynamic : x:'T1 -> y:'T2 -> 'U + + /// A compiler intrinsic that implements dynamic invocations to the '/' operator. + [] + [] + val DivisionDynamic : x:'T1 -> y:'T2 -> 'U + + /// A compiler intrinsic that implements dynamic invocations to the unary '-' operator. + [] + [] + val UnaryNegationDynamic : value:'T -> 'U + + /// A compiler intrinsic that implements dynamic invocations to the '%' operator. + [] + [] + val ModulusDynamic : x:'T1 -> y:'T2 -> 'U + + /// A compiler intrinsic that implements dynamic invocations to the checked '-' operator. + [] + [] + val CheckedSubtractionDynamic : x:'T1 -> y:'T2 -> 'U + + /// A compiler intrinsic that implements dynamic invocations to the checked unary '-' operator. + [] + [] + val CheckedUnaryNegationDynamic : value:'T -> 'U + + /// A compiler intrinsic that implements dynamic invocations to the '<<<' operator. + [] + [] + val LeftShiftDynamic : value:'T1 -> shift:'T2 -> 'U + + /// A compiler intrinsic that implements dynamic invocations to the '>>>' operator. + [] + [] + val RightShiftDynamic : value:'T1 -> shift:'T2 -> 'U + + /// A compiler intrinsic that implements dynamic invocations to the '&&&' operator. + [] + [] + val BitwiseAndDynamic : x:'T1 -> y:'T2 -> 'U + + /// A compiler intrinsic that implements dynamic invocations to the '|||' operator. + [] + [] + val BitwiseOrDynamic : x:'T1 -> y:'T2 -> 'U + + /// A compiler intrinsic that implements dynamic invocations related to the '^^^' operator. + [] + [] + val ExclusiveOrDynamic : x:'T1 -> y:'T2 -> 'U + + /// A compiler intrinsic that implements dynamic invocations related to the '~~~' operator. + [] + [] + val LogicalNotDynamic : value:'T -> 'U + + /// A compiler intrinsic that implements dynamic invocations related to conversion operators. + [] + [] + val ExplicitDynamic : value:'T -> 'U + + /// A compiler intrinsic that implements dynamic invocations related to the '<' operator. + [] + [] + val LessThanDynamic : x:'T1 -> y:'T2 -> 'U + + /// A compiler intrinsic that implements dynamic invocations related to the '>' operator. + [] + [] + val GreaterThanDynamic : x:'T1 -> y:'T2 -> 'U + + /// A compiler intrinsic that implements dynamic invocations related to the '<=' operator. + [] + [] + val LessThanOrEqualDynamic : x:'T1 -> y:'T2 -> 'U + + /// A compiler intrinsic that implements dynamic invocations related to the '>=' operator. + [] + [] + val GreaterThanOrEqualDynamic : x:'T1 -> y:'T2 -> 'U + + /// A compiler intrinsic that implements dynamic invocations related to the '=' operator. + [] + [] + val EqualityDynamic : x:'T1 -> y:'T2 -> 'U + + /// A compiler intrinsic that implements dynamic invocations related to the '=' operator. + [] + [] + val InequalityDynamic : x:'T1 -> y:'T2 -> 'U + /// A compiler intrinsic that implements dynamic invocations for the DivideByInt primitive. [] val DivideByIntDynamic : x:'T -> y:int -> 'T @@ -2747,6 +2845,7 @@ namespace Microsoft.FSharp.Core /// input types the operation requires an appropriate static conversion method on the input type. /// The input value. /// The converted char. + [] [] val inline char : value:^T -> char when ^T : (static member op_Explicit : ^T -> char) and default ^T : int @@ -3669,14 +3768,14 @@ namespace Microsoft.FSharp.Core /// Overloaded unary negation (checks for overflow) /// The input value. /// The negated value. - [] + [] val inline ( ~- ) : value:^T -> ^T when ^T : (static member ( ~- ) : ^T -> ^T) and default ^T : int /// Overloaded subtraction operator (checks for overflow) /// The first value. /// The second value. /// The first value minus the second value. - [] + [] val inline ( - ) : x:^T1 -> y:^T2 -> ^T3 when (^T1 or ^T2) : (static member ( - ) : ^T1 * ^T2 -> ^T3) and default ^T2 : ^T3 and default ^T3 : ^T1 and default ^T3 : ^T2 and default ^T1 : ^T3 and default ^T1 : ^T2 and default ^T1 : int /// Overloaded addition operator (checks for overflow) @@ -3689,7 +3788,7 @@ namespace Microsoft.FSharp.Core /// The first value. /// The second value. /// The product of the two input values. - [] + [] val inline ( * ) : x:^T1 -> y:^T2 -> ^T3 when (^T1 or ^T2) : (static member ( * ) : ^T1 * ^T2 -> ^T3) and default ^T2 : ^T3 and default ^T3 : ^T1 and default ^T3 : ^T2 and default ^T1 : ^T3 and default ^T1 : ^T2 and default ^T1 : int /// Converts the argument to byte. This is a direct, checked conversion for all @@ -3698,7 +3797,7 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted byte - [] + [] [] val inline byte : value:^T -> byte when ^T : (static member op_Explicit : ^T -> byte) and default ^T : int @@ -3708,7 +3807,7 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted sbyte - [] + [] [] val inline sbyte : value:^T -> sbyte when ^T : (static member op_Explicit : ^T -> sbyte) and default ^T : int @@ -3718,7 +3817,7 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted int16 - [] + [] [] val inline int16 : value:^T -> int16 when ^T : (static member op_Explicit : ^T -> int16) and default ^T : int @@ -3728,7 +3827,7 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted uint16 - [] + [] [] val inline uint16 : value:^T -> uint16 when ^T : (static member op_Explicit : ^T -> uint16) and default ^T : int @@ -3738,7 +3837,7 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted int - [] + [] [] val inline int : value:^T -> int when ^T : (static member op_Explicit : ^T -> int) and default ^T : int @@ -3748,7 +3847,7 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted int32 - [] + [] [] val inline int32 : value:^T -> int32 when ^T : (static member op_Explicit : ^T -> int32) and default ^T : int @@ -3758,7 +3857,7 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted uint32 - [] + [] [] val inline uint32 : value:^T -> uint32 when ^T : (static member op_Explicit : ^T -> uint32) and default ^T : int @@ -3768,7 +3867,7 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted int64 - [] + [] [] val inline int64 : value:^T -> int64 when ^T : (static member op_Explicit : ^T -> int64) and default ^T : int @@ -3778,7 +3877,7 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted uint64 - [] + [] [] val inline uint64 : value:^T -> uint64 when ^T : (static member op_Explicit : ^T -> uint64) and default ^T : int @@ -3787,7 +3886,7 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted nativeint - [] + [] [] val inline nativeint : value:^T -> nativeint when ^T : (static member op_Explicit : ^T -> nativeint) and default ^T : int @@ -3796,7 +3895,7 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted unativeint - [] + [] [] val inline unativeint : value:^T -> unativeint when ^T : (static member op_Explicit : ^T -> unativeint) and default ^T : int @@ -3806,7 +3905,7 @@ namespace Microsoft.FSharp.Core /// appropriate static conversion method on the input type. /// The input value. /// The converted char - [] + [] [] val inline char : value:^T -> char when ^T : (static member op_Explicit : ^T -> char) and default ^T : int diff --git a/src/fsharp/FSharp.Core/quotations.fs b/src/fsharp/FSharp.Core/quotations.fs index 0f6f0a331ef..9f3d59caccf 100644 --- a/src/fsharp/FSharp.Core/quotations.fs +++ b/src/fsharp/FSharp.Core/quotations.fs @@ -164,6 +164,10 @@ and | NewObjectOp of ConstructorInfo | InstanceMethodCallOp of MethodInfo | StaticMethodCallOp of MethodInfo + /// A new Call node type in F# 5.0, storing extra information about witnesses + | InstanceMethodCallWOp of MethodInfo * MethodInfo * int + /// A new Call node type in F# 5.0, storing extra information about witnesses + | StaticMethodCallWOp of MethodInfo * MethodInfo * int | CoerceOp of Type | NewArrayOp of Type | NewDelegateOp of Type @@ -182,7 +186,7 @@ and | WithValueOp of obj * Type | DefaultValueOp of Type -and [] +and [] Expr(term:Tree, attribs: Expr list) = member x.Tree = term member x.CustomAttributes = attribs @@ -194,6 +198,30 @@ and [] match t1, t2 with // We special-case ValueOp to ensure that ValueWithName = Value | CombTerm(ValueOp(v1, ty1, _), []), CombTerm(ValueOp(v2, ty2, _), []) -> (v1 = v2) && (ty1 = ty2) + + // We strip off InstanceMethodCallWOp to ensure that CallWithWitness = Call + | CombTerm(InstanceMethodCallWOp(minfo1, _minfoW1, nWitnesses1), obj1::args1WithoutObj), _ -> + if nWitnesses1 <= args1WithoutObj.Length then + let args1WithoutWitnesses = List.skip nWitnesses1 args1WithoutObj + eq (CombTerm(InstanceMethodCallOp(minfo1), obj1::args1WithoutWitnesses)) t2 + else + false + + // We strip off InstanceMethodCallWOp to ensure that CallWithWitness = Call + | _, CombTerm(InstanceMethodCallWOp(minfo2, _minfoW2, nWitnesses2), obj2::args2WithoutObj) when nWitnesses2 <= args2WithoutObj.Length -> + let args2WithoutWitnesses = List.skip nWitnesses2 args2WithoutObj + eq t1 (CombTerm(InstanceMethodCallOp(minfo2), obj2::args2WithoutWitnesses)) + + // We strip off StaticMethodCallWOp to ensure that CallWithWitness = Call + | CombTerm(StaticMethodCallWOp(minfo1, _minfoW1, nWitnesses1), args1), _ when nWitnesses1 <= args1.Length -> + let argsWithoutWitnesses1 = List.skip nWitnesses1 args1 + eq (CombTerm(StaticMethodCallOp(minfo1), argsWithoutWitnesses1)) t2 + + // We strip off StaticMethodCallWOp to ensure that CallWithWitness = Call + | _, CombTerm(StaticMethodCallWOp(minfo2, _minfoW2, nWitnesses2), args2) when nWitnesses2 <= args2.Length -> + let argsWithoutWitnesses2 = List.skip nWitnesses2 args2 + eq t1 (CombTerm(StaticMethodCallOp(minfo2), argsWithoutWitnesses2)) + | CombTerm(c1, es1), CombTerm(c2, es2) -> c1 = c2 && es1.Length = es2.Length && (es1 = es2) | VarTerm v1, VarTerm v2 -> (v1 = v2) | LambdaTerm (v1, e1), LambdaTerm(v2, e2) -> (v1 = v2) && (e1 = e2) @@ -208,7 +236,9 @@ and [] override x.ToString() = x.ToString false member x.ToString full = - Microsoft.FSharp.Text.StructuredPrintfImpl.Display.layout_to_string Microsoft.FSharp.Text.StructuredPrintfImpl.FormatOptions.Default (x.GetLayout full) + Display.layout_to_string FormatOptions.Default (x.GetLayout(full)) + + member x.DebugText = x.ToString(false) member x.GetLayout long = let expr (e: Expr ) = e.GetLayout long @@ -250,17 +280,30 @@ and [] | CombTerm(ValueOp(v, _, Some nm), []) -> combL "ValueWithName" [objL v; wordL (tagLocal nm)] | CombTerm(ValueOp(v, _, None), []) -> combL "Value" [objL v] | CombTerm(WithValueOp(v, _), [defn]) -> combL "WithValue" [objL v; expr defn] - | CombTerm(InstanceMethodCallOp minfo, obj :: args) -> combL "Call" [someL obj; minfoL minfo; listL (exprs args)] - | CombTerm(StaticMethodCallOp minfo, args) -> combL "Call" [noneL; minfoL minfo; listL (exprs args)] - | CombTerm(InstancePropGetOp pinfo, (obj :: args)) -> combL "PropertyGet" [someL obj; pinfoL pinfo; listL (exprs args)] - | CombTerm(StaticPropGetOp pinfo, args) -> combL "PropertyGet" [noneL; pinfoL pinfo; listL (exprs args)] - | CombTerm(InstancePropSetOp pinfo, (obj :: args)) -> combL "PropertySet" [someL obj; pinfoL pinfo; listL (exprs args)] - | CombTerm(StaticPropSetOp pinfo, args) -> combL "PropertySet" [noneL; pinfoL pinfo; listL (exprs args)] - | CombTerm(InstanceFieldGetOp finfo, [obj]) -> combL "FieldGet" [someL obj; finfoL finfo] - | CombTerm(StaticFieldGetOp finfo, []) -> combL "FieldGet" [noneL; finfoL finfo] - | CombTerm(InstanceFieldSetOp finfo, [obj;v]) -> combL "FieldSet" [someL obj; finfoL finfo; expr v;] - | CombTerm(StaticFieldSetOp finfo, [v]) -> combL "FieldSet" [noneL; finfoL finfo; expr v;] - | CombTerm(CoerceOp ty, [arg]) -> combL "Coerce" [ expr arg; typeL ty] + + | CombTerm(InstanceMethodCallOp(minfo), obj::args) -> + combL "Call" [someL obj; minfoL minfo; listL (exprs args)] + + | CombTerm(StaticMethodCallOp(minfo), args) -> + combL "Call" [noneL; minfoL minfo; listL (exprs args)] + + | CombTerm(InstanceMethodCallWOp(minfo, _minfoW, nWitnesses), obj::argsWithoutObj) when nWitnesses <= argsWithoutObj.Length -> + let argsWithoutWitnesses = List.skip nWitnesses argsWithoutObj + combL "Call" [someL obj; minfoL minfo; listL (exprs argsWithoutWitnesses)] + + | CombTerm(StaticMethodCallWOp(minfo, _minfoW, nWitnesses), args) when nWitnesses <= args.Length -> + let argsWithoutWitnesses = List.skip nWitnesses args + combL "Call" [noneL; minfoL minfo; listL (exprs argsWithoutWitnesses)] + + | CombTerm(InstancePropGetOp(pinfo), (obj::args)) -> combL "PropertyGet" [someL obj; pinfoL pinfo; listL (exprs args)] + | CombTerm(StaticPropGetOp(pinfo), args) -> combL "PropertyGet" [noneL; pinfoL pinfo; listL (exprs args)] + | CombTerm(InstancePropSetOp(pinfo), (obj::args)) -> combL "PropertySet" [someL obj; pinfoL pinfo; listL (exprs args)] + | CombTerm(StaticPropSetOp(pinfo), args) -> combL "PropertySet" [noneL; pinfoL pinfo; listL (exprs args)] + | CombTerm(InstanceFieldGetOp(finfo), [obj]) -> combL "FieldGet" [someL obj; finfoL finfo] + | CombTerm(StaticFieldGetOp(finfo), []) -> combL "FieldGet" [noneL; finfoL finfo] + | CombTerm(InstanceFieldSetOp(finfo), [obj;v]) -> combL "FieldSet" [someL obj; finfoL finfo; expr v;] + | CombTerm(StaticFieldSetOp(finfo), [v]) -> combL "FieldSet" [noneL; finfoL finfo; expr v;] + | CombTerm(CoerceOp(ty), [arg]) -> combL "Coerce" [ expr arg; typeL ty] | CombTerm(NewObjectOp cinfo, args) -> combL "NewObject" ([ cinfoL cinfo ] @ exprs args) | CombTerm(DefaultValueOp ty, args) -> combL "DefaultValue" ([ typeL ty ] @ exprs args) | CombTerm(NewArrayOp ty, args) -> combL "NewArray" ([ typeL ty ] @ exprs args) @@ -273,6 +316,7 @@ and [] | CombTerm(TryFinallyOp, args) -> combL "TryFinally" (exprs args) | CombTerm(TryWithOp, [e1;Lambda(v1, e2);Lambda(v2, e3)]) -> combL "TryWith" [expr e1; varL v1; expr e2; varL v2; expr e3] | CombTerm(SequentialOp, args) -> combL "Sequential" (exprs args) + | CombTerm(NewDelegateOp ty, [e]) -> let nargs = (getDelegateInvoke ty).GetParameters().Length if nargs = 0 then @@ -510,7 +554,37 @@ module Patterns = let (|Call|_|) input = match input with | E(CombTerm(StaticMethodCallOp minfo, args)) -> Some(None, minfo, args) - | E(CombTerm(InstanceMethodCallOp minfo, (obj :: args))) -> Some(Some obj, minfo, args) + + | E(CombTerm(InstanceMethodCallOp minfo, (obj::args))) -> Some(Some(obj), minfo, args) + + // A StaticMethodCallWOp matches as if it were a StaticMethodCallOp + | E(CombTerm(StaticMethodCallWOp (minfo, _minfoW, nWitnesses), args)) when nWitnesses <= args.Length -> + Some(None, minfo, List.skip nWitnesses args) + + // A InstanceMethodCallWOp matches as if it were a InstanceMethodCallOp + | E(CombTerm(InstanceMethodCallWOp (minfo, _minfoW, nWitnesses), obj::argsWithoutObj)) when nWitnesses <= argsWithoutObj.Length -> + let argsWithoutWitnesses = List.skip nWitnesses argsWithoutObj + Some (Some obj, minfo, argsWithoutWitnesses) + + | _ -> None + + [] + let (|CallWithWitnesses|_|) input = + match input with + | E(CombTerm(StaticMethodCallWOp (minfo, minfoW, nWitnesses), args)) -> + if args.Length >= nWitnesses then + let witnessArgs, argsWithoutWitnesses = List.splitAt nWitnesses args + Some(None, minfo, minfoW, witnessArgs, argsWithoutWitnesses) + else + None + + | E(CombTerm(InstanceMethodCallWOp (minfo, minfoW, nWitnesses), obj::argsWithoutObj)) -> + if argsWithoutObj.Length >= nWitnesses then + let witnessArgs, argsWithoutWitnesses = List.splitAt nWitnesses argsWithoutObj + Some (Some obj, minfo, minfoW, witnessArgs, argsWithoutWitnesses) + else + None + | _ -> None let (|LetRaw|_|) input = @@ -586,7 +660,7 @@ module Patterns = let fty = ((typeOf f): Type) match fty.GetGenericArguments() with | [| _; b|] -> b - | _ -> raise <| System.InvalidOperationException (SR.GetString(SR.QillFormedAppOrLet)) + | _ -> invalidOp (SR.GetString(SR.QillFormedAppOrLet)) /// Returns type of the Raw quotation or fails if the quotation is ill formed /// if 'verify' is true, verifies all branches, otherwise ignores some of them when not needed @@ -621,6 +695,8 @@ module Patterns = | NewObjectOp ctor, _ -> ctor.DeclaringType | InstanceMethodCallOp minfo, _ -> minfo.ReturnType |> removeVoid | StaticMethodCallOp minfo, _ -> minfo.ReturnType |> removeVoid + | InstanceMethodCallWOp (_, minfoW, _), _ -> minfoW.ReturnType |> removeVoid + | StaticMethodCallWOp (_, minfoW, _), _ -> minfoW.ReturnType |> removeVoid | CoerceOp ty, _ -> ty | SequentialOp, [_;b] -> typeOf b | ForIntegerRangeLoopOp, _ -> typeof @@ -874,6 +950,15 @@ module Patterns = mkFEN (InstanceMethodCallOp minfo) (obj :: args) | true -> invalidArg "minfo" (SR.GetString(SR.QstaticWithReceiverObject)) + let mkInstanceMethodCallW (obj, minfo: MethodInfo, minfoW: MethodInfo, nWitnesses: int, args: Expr list) = + if Unchecked.defaultof = minfo then raise (new ArgumentNullException()) + checkArgs (minfoW.GetParameters()) args + match minfoW.IsStatic with + | false -> + checkObj minfo obj + mkFEN (InstanceMethodCallWOp (minfo, minfoW, nWitnesses)) (obj::args) + | true -> invalidArg "minfo" (SR.GetString(SR.QstaticWithReceiverObject)) + let mkStaticMethodCall (minfo:MethodInfo, args:list) = if Unchecked.defaultof = minfo then raise (new ArgumentNullException()) checkArgs (minfo.GetParameters()) args @@ -881,6 +966,13 @@ module Patterns = | true -> mkFEN (StaticMethodCallOp minfo) args | false -> invalidArg "minfo" (SR.GetString(SR.QnonStaticNoReceiverObject)) + let mkStaticMethodCallW (minfo: MethodInfo, minfoW: MethodInfo, nWitnesses: int, args: Expr list) = + if Unchecked.defaultof = minfo then raise (new ArgumentNullException()) + checkArgs (minfoW.GetParameters()) args + match minfo.IsStatic with + | true -> mkFEN (StaticMethodCallWOp (minfo, minfoW, nWitnesses)) args + | false -> invalidArg "minfo" (SR.GetString(SR.QnonStaticNoReceiverObject)) + let mkForLoop (v: Var, lowerBound, upperBound, body) = checkTypesSR (typeof) (typeOf lowerBound) "lowerBound" (SR.GetString(SR.QtmmLowerUpperBoundMustBeInt)) checkTypesSR (typeof) (typeOf upperBound) "upperBound" (SR.GetString(SR.QtmmLowerUpperBoundMustBeInt)) @@ -976,7 +1068,7 @@ module Patterns = res // return MethodInfo for (generic) type's (generic) method match List.tryFind select methInfos with - | None -> raise <| System.InvalidOperationException (SR.GetString SR.QcannotBindToMethod) + | None -> invalidOp (SR.GetString SR.QcannotBindToMethod) | Some methInfo -> methInfo let bindMethodHelper (parentT: Type, nm, marity, argtys, rty) = @@ -999,17 +1091,9 @@ module Patterns = let bindModuleProperty (ty: Type, nm) = match ty.GetProperty(nm, staticBindingFlags) with - | null -> raise <| System.InvalidOperationException (String.Format(SR.GetString(SR.QcannotBindProperty), nm, ty.ToString())) + | null -> invalidOp (String.Format(SR.GetString(SR.QcannotBindProperty), nm, ty.ToString())) | res -> res - // tries to locate unique function in a given type - // in case of multiple candidates returns None so bindModuleFunctionWithCallSiteArgs will be used for more precise resolution - let bindModuleFunction (ty: Type, nm) = - match ty.GetMethods staticBindingFlags |> Array.filter (fun mi -> mi.Name = nm) with - | [||] -> raise <| System.InvalidOperationException (String.Format(SR.GetString(SR.QcannotBindFunction), nm, ty.ToString())) - | [| res |] -> Some res - | _ -> None - let bindModuleFunctionWithCallSiteArgs (ty: Type, nm, argTypes: Type list, tyArgs: Type list) = let argTypes = List.toArray argTypes let tyArgs = List.toArray tyArgs @@ -1031,7 +1115,7 @@ module Patterns = let methodTyArgCount = if mi.IsGenericMethod then mi.GetGenericArguments().Length else 0 methodTyArgCount = tyArgs.Length ) - let fail() = raise <| System.InvalidOperationException (String.Format(SR.GetString(SR.QcannotBindFunction), nm, ty.ToString())) + let fail() = invalidOp (String.Format(SR.GetString(SR.QcannotBindFunction), nm, ty.ToString())) match candidates with | [||] -> fail() | [| solution |] -> solution @@ -1332,7 +1416,7 @@ module Patterns = elif a = "." then st.localAssembly else match System.Reflection.Assembly.Load a with - | null -> raise <| System.InvalidOperationException(String.Format(SR.GetString(SR.QfailedToBindAssembly), a.ToString())) + | null -> invalidOp(String.Format(SR.GetString(SR.QfailedToBindAssembly), a.ToString())) | assembly -> assembly let u_NamedType st = @@ -1389,7 +1473,7 @@ module Patterns = let n = tyargs.Length fun idx -> if idx < n then tyargs.[idx] - else raise <| System.InvalidOperationException (SR.GetString(SR.QtypeArgumentOutOfRange)) + else invalidOp (SR.GetString(SR.QtypeArgumentOutOfRange)) let envClosed (spliceTypes: Type[]) = { vars = Map.empty @@ -1461,13 +1545,39 @@ module Patterns = let case, i = u_tup2 u_UnionCaseInfo u_int st (fun tyargs -> getUnionCaseInfoField(case tyargs, i)) - and u_ModuleDefn st = + and u_ModuleDefn witnessInfo st = let (ty, nm, isProp) = u_tup3 u_NamedType u_string u_bool st if isProp then Unique(StaticPropGetOp(bindModuleProperty(ty, nm))) else - match bindModuleFunction(ty, nm) with - | Some mi -> Unique(StaticMethodCallOp mi) - | None -> Ambiguous(fun argTypes tyargs -> StaticMethodCallOp(bindModuleFunctionWithCallSiteArgs(ty, nm, argTypes, tyargs))) + let meths = ty.GetMethods staticBindingFlags |> Array.filter (fun mi -> mi.Name = nm) + match meths with + | [||] -> + invalidOp (String.Format(SR.GetString(SR.QcannotBindFunction), nm, ty.ToString())) + | [| minfo |] -> + match witnessInfo with + | None -> + Unique(StaticMethodCallOp(minfo)) + | Some (nmW, nWitnesses) -> + let methsW = ty.GetMethods(staticBindingFlags) |> Array.filter (fun mi -> mi.Name = nmW) + match methsW with + | [||] -> + invalidOp (String.Format(SR.GetString(SR.QcannotBindFunction), nmW, ty.ToString())) + | [| minfoW |] -> + Unique(StaticMethodCallWOp(minfo, minfoW, nWitnesses)) + | _ -> + Ambiguous(fun argTypes tyargs -> + let minfoW = bindModuleFunctionWithCallSiteArgs(ty, nm, argTypes, tyargs) + StaticMethodCallWOp(minfo, minfoW, nWitnesses)) + | _ -> + Ambiguous(fun argTypes tyargs -> + match witnessInfo with + | None -> + let minfo = bindModuleFunctionWithCallSiteArgs(ty, nm, argTypes, tyargs) + StaticMethodCallOp minfo + | Some (nmW, nWitnesses) -> + let minfo = bindModuleFunctionWithCallSiteArgs(ty, nm, List.skip nWitnesses argTypes, tyargs) + let minfoW = bindModuleFunctionWithCallSiteArgs(ty, nmW, argTypes, tyargs) + StaticMethodCallWOp(minfo, minfoW, nWitnesses)) and u_MethodInfoData st = u_tup5 u_NamedType (u_list u_dtype) u_dtype u_string u_int st @@ -1482,7 +1592,7 @@ module Patterns = let tag = u_byte_as_int st match tag with | 0 -> - match u_ModuleDefn st with + match u_ModuleDefn None st with | Unique(StaticMethodCallOp minfo) -> (minfo :> MethodBase) | Unique(StaticPropGetOp pinfo) -> (pinfo.GetGetMethod true :> MethodBase) | Ambiguous(_) -> raise (System.Reflection.AmbiguousMatchException()) @@ -1499,24 +1609,42 @@ module Patterns = let data = u_CtorInfoData st let cinfo = bindGenericCtor data (cinfo :> MethodBase) + | 3 -> + let methNameW = u_string st + let nWitnesses = u_int st + match u_ModuleDefn (Some (methNameW, nWitnesses)) st with + | Unique(StaticMethodCallOp(minfo)) -> (minfo :> MethodBase) + | Unique(StaticMethodCallWOp(_minfo, minfoW, _)) -> (minfoW :> MethodBase) + | Unique(StaticPropGetOp(pinfo)) -> (pinfo.GetGetMethod(true) :> MethodBase) + | Ambiguous(_) -> raise (System.Reflection.AmbiguousMatchException()) + | _ -> failwith "unreachable" | _ -> failwith "u_MethodBase" + and instModuleDefnOp r tyargs = + match r with + | StaticMethodCallOp(minfo) -> StaticMethodCallOp(instMeth(minfo, tyargs)) + | StaticMethodCallWOp(minfo, minfoW, n) -> StaticMethodCallWOp(instMeth(minfo, tyargs), instMeth(minfoW, tyargs), n) + // OK to throw away the tyargs here since this only non-generic values in modules get represented by static properties + | x -> x + and u_constSpec st = let tag = u_byte_as_int st if tag = 1 then - let bindModuleDefn r tyargs = - match r with - | StaticMethodCallOp minfo -> StaticMethodCallOp(instMeth(minfo, tyargs)) - // OK to throw away the tyargs here since this only non-generic values in modules get represented by static properties - | x -> x - match u_ModuleDefn st with - | Unique r -> Unique(bindModuleDefn r) - | Ambiguous f -> Ambiguous(fun argTypes tyargs -> bindModuleDefn (f argTypes tyargs) tyargs) + match u_ModuleDefn None st with + | Unique r -> Unique (instModuleDefnOp r) + | Ambiguous f -> Ambiguous (fun argTypes tyargs -> instModuleDefnOp (f argTypes tyargs) tyargs) + elif tag = 51 then + let nmW = u_string st + let nWitnesses = u_int st + match u_ModuleDefn (Some (nmW, nWitnesses)) st with + | Unique r -> Unique(instModuleDefnOp r) + | Ambiguous f -> Ambiguous(fun argTypes tyargs -> instModuleDefnOp (f argTypes tyargs) tyargs) else let constSpec = match tag with | 0 -> u_void st |> (fun () NoTyArgs -> IfThenElseOp) + // 1 taken above | 2 -> u_void st |> (fun () NoTyArgs -> LetRecOp) | 3 -> u_NamedType st |> (fun x tyargs -> NewRecordOp (mkNamedType (x, tyargs))) | 4 -> u_RecdField st |> (fun prop tyargs -> InstancePropGetOp(prop tyargs)) @@ -1564,6 +1692,16 @@ module Patterns = | 47 -> u_void st |> (fun () NoTyArgs -> TryFinallyOp) | 48 -> u_void st |> (fun () NoTyArgs -> TryWithOp) | 49 -> u_void st |> (fun () NoTyArgs -> VarSetOp) + | 50 -> + let m1 = u_MethodInfoData st + let m2 = u_MethodInfoData st + let n = u_int st + (fun tyargs -> + let minfo = bindMeth (m1, tyargs) + let minfoW = bindMeth (m2, tyargs) + if minfo.IsStatic then StaticMethodCallWOp(minfo, minfoW, n) + else InstanceMethodCallWOp(minfo, minfoW, n)) + // 51 taken above | _ -> failwithf "u_constSpec, unrecognized tag %d" tag Unique constSpec @@ -1672,6 +1810,7 @@ module Patterns = reflectedDefinitionTable.Add(key, Entry exprBuilder))) decodedTopResources.Add((assem, resourceName), 0) + /// Get the reflected definition at the given (always generic) instantiation let tryGetReflectedDefinition (methodBase: MethodBase, tyargs: Type []) = checkNonNull "methodBase" methodBase let data = @@ -1736,6 +1875,7 @@ module Patterns = Some(exprBuilder (envClosed tyargs)) | None -> None + /// Get the reflected definition at the generic instantiation let tryGetReflectedDefinitionInstantiated (methodBase: MethodBase) = checkNonNull "methodBase" methodBase match methodBase with @@ -1788,6 +1928,16 @@ type Expr with checkNonNull "methodInfo" methodInfo mkInstanceMethodCall (obj, methodInfo, arguments) + static member CallWithWitnesses (methodInfo: MethodInfo, methodInfoWithWitnesses: MethodInfo, witnessArguments, arguments) = + checkNonNull "methodInfo" methodInfo + checkNonNull "methodInfoWithWitnesses" methodInfoWithWitnesses + mkStaticMethodCallW (methodInfo, methodInfoWithWitnesses, List.length witnessArguments, witnessArguments@arguments) + + static member CallWithWitnesses (obj: Expr, methodInfo: MethodInfo, methodInfoWithWitnesses: MethodInfo, witnessArguments, arguments) = + checkNonNull "methodInfo" methodInfo + checkNonNull "methodInfoWithWitnesses" methodInfoWithWitnesses + mkInstanceMethodCallW (obj, methodInfo, methodInfoWithWitnesses, List.length witnessArguments, witnessArguments@arguments) + static member Coerce (source: Expr, target: Type) = checkNonNull "target" target mkCoerce (target, source) @@ -1913,7 +2063,6 @@ type Expr with checkNonNull "expressionType" expressionType mkValueWithDefn (value, expressionType, definition) - static member Var variable = mkVar variable @@ -2128,6 +2277,8 @@ module ExprShape = | DefaultValueOp ty, _ -> mkDefaultValue ty | StaticMethodCallOp minfo, _ -> mkStaticMethodCall(minfo, arguments) | InstanceMethodCallOp minfo, obj :: args -> mkInstanceMethodCall(obj, minfo, args) + | StaticMethodCallWOp (minfo, minfoW, n), _ -> mkStaticMethodCallW(minfo, minfoW, n, arguments) + | InstanceMethodCallWOp (minfo, minfoW, n), obj::args -> mkInstanceMethodCallW(obj, minfo, minfoW, n, args) | CoerceOp ty, [arg] -> mkCoerce(ty, arg) | NewArrayOp ty, _ -> mkNewArray(ty, arguments) | NewDelegateOp ty, [arg] -> mkNewDelegate(ty, arg) @@ -2144,8 +2295,7 @@ module ExprShape = | ValueOp(v, ty, None), [] -> mkValue(v, ty) | ValueOp(v, ty, Some nm), [] -> mkValueWithName(v, ty, nm) | WithValueOp(v, ty), [e] -> mkValueWithDefn(v, ty, e) - | _ -> raise <| System.InvalidOperationException (SR.GetString(SR.QillFormedAppOrLet)) - + | _ -> invalidOp (SR.GetString(SR.QillFormedAppOrLet)) EA(e.Tree, attrs) diff --git a/src/fsharp/FSharp.Core/quotations.fsi b/src/fsharp/FSharp.Core/quotations.fsi index a782140fe43..e51ed2bd747 100644 --- a/src/fsharp/FSharp.Core/quotations.fsi +++ b/src/fsharp/FSharp.Core/quotations.fsi @@ -99,6 +99,25 @@ type Expr = /// The resulting expression. static member Call : obj:Expr * methodInfo:MethodInfo * arguments:list -> Expr + /// Builds an expression that represents a call to an static method or module-bound function + /// The MethodInfo describing the method to call. + /// The additional MethodInfo describing the method to call, accepting witnesses. + /// The list of witnesses to the method. + /// The list of arguments to the method. + /// The resulting expression. + [] + static member CallWithWitnesses: methodInfo: MethodInfo * methodInfoWithWitnesses: MethodInfo * witnesses: Expr list * arguments: Expr list -> Expr + + /// Builds an expression that represents a call to an instance method associated with an object + /// The input object. + /// The description of the method to call. + /// The additional MethodInfo describing the method to call, accepting witnesses. + /// The list of witnesses to the method. + /// The list of arguments to the method. + /// The resulting expression. + [] + static member CallWithWitnesses: obj:Expr * methodInfo:MethodInfo * methodInfoWithWitnesses: MethodInfo * witnesses: Expr list * arguments:Expr list -> Expr + /// Builds an expression that represents the coercion of an expression to a type /// The expression to coerce. /// The target type. @@ -334,8 +353,6 @@ type Expr = /// The resulting expression. static member WithValue: value: obj * expressionType:Type * definition: Expr -> Expr - - /// Builds an expression that represents a variable /// The input variable. /// The resulting expression. @@ -455,6 +472,13 @@ module Patterns = [] val (|Call|_|) : input:Expr -> (Expr option * MethodInfo * Expr list) option + /// An active pattern to recognize expressions that represent calls to static and instance methods, and functions defined in modules, including witness arguments + /// The input expression to match against. + /// (Expr option * MethodInfo * MethodInfo * Expr list) option + [] + [] + val (|CallWithWitnesses|_|) : input:Expr -> (Expr option * MethodInfo * MethodInfo * Expr list * Expr list) option + /// An active pattern to recognize expressions that represent coercions from one type to another /// The input expression to match against. /// (Expr * Type) option @@ -654,7 +678,6 @@ module Patterns = [] val (|VarSet|_|) : input:Expr -> (Var * Expr) option - [] /// Contains a set of derived F# active patterns to analyze F# expression objects module DerivedPatterns = diff --git a/src/fsharp/FSharp.Core/reflect.fs b/src/fsharp/FSharp.Core/reflect.fs index 828fddac3d3..3f7c459be64 100644 --- a/src/fsharp/FSharp.Core/reflect.fs +++ b/src/fsharp/FSharp.Core/reflect.fs @@ -70,7 +70,7 @@ module internal Impl = match attrs with | null | [| |] -> None | [| res |] -> let a = (res :?> CompilationMappingAttribute) in Some (a.SourceConstructFlags, a.SequenceNumber, a.VariantNumber) - | _ -> raise <| System.InvalidOperationException (SR.GetString (SR.multipleCompilationMappings)) + | _ -> invalidOp (SR.GetString (SR.multipleCompilationMappings)) let findCompilationMappingAttribute (attrs: obj[]) = match tryFindCompilationMappingAttribute attrs with @@ -292,7 +292,7 @@ module internal Impl = else "New" + constrname match typ.GetMethod(methname, BindingFlags.Static ||| bindingFlags) with - | null -> raise <| System.InvalidOperationException (String.Format (SR.GetString (SR.constructorForUnionCaseNotFound), methname)) + | null -> invalidOp (String.Format (SR.GetString (SR.constructorForUnionCaseNotFound), methname)) | meth -> meth let getUnionCaseConstructor (typ: Type, tag: int, bindingFlags) = diff --git a/src/fsharp/FSharp.Core/seq.fs b/src/fsharp/FSharp.Core/seq.fs index 71f16b6fa2e..a37eca1349f 100644 --- a/src/fsharp/FSharp.Core/seq.fs +++ b/src/fsharp/FSharp.Core/seq.fs @@ -254,7 +254,7 @@ namespace Microsoft.FSharp.Collections setIndex 0 true else - if index = System.Int32.MaxValue then raise <| System.InvalidOperationException (SR.GetString(SR.enumerationPastIntMaxValue)) + if index = System.Int32.MaxValue then invalidOp (SR.GetString(SR.enumerationPastIntMaxValue)) if index = finalIndex then false else @@ -391,7 +391,7 @@ namespace Microsoft.FSharp.Collections member __.Current = match curr with | Some v -> v - | None -> raise <| System.InvalidOperationException (SR.GetString(SR.moveNextNotCalledOrFinished)) + | None -> invalidOp (SR.GetString(SR.moveNextNotCalledOrFinished)) interface System.Collections.IEnumerator with member x.Current = box (x :> IEnumerator<_>).Current diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index a49cdc742e6..4eb801df7e5 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -6,6 +6,7 @@ module internal FSharp.Compiler.IlxGen open System.IO open System.Reflection open System.Collections.Generic +open System.Collections.Immutable open Internal.Utilities open Internal.Utilities.Collections @@ -225,9 +226,9 @@ type cenv = /// The ImportMap for reading IL amap: ImportMap - /// A callback for TcVal in the typechecker. Used to generalize values when finding witnesses. + /// A callback for TcVal in the typechecker. Used to generalize values when finding witnesses. /// It is unfortunate this is needed but it is until we supply witnesses through the compilation. - TcVal: ConstraintSolver.TcValF + tcVal: ConstraintSolver.TcValF /// The TAST for the assembly being emitted viewCcu: CcuThunk @@ -690,10 +691,10 @@ type IlxClosureInfo = cloArityInfo: ArityInfo /// The formal return type - cloILFormalRetTy: ILType + ilCloFormalReturnTy: ILType /// An immutable array of free variable descriptions for the closure - cloILFreeVars: IlxClosureFreeVar[] + ilCloAllFreeVars: IlxClosureFreeVar[] /// The ILX specification for the closure cloSpec: IlxClosureSpec @@ -704,9 +705,13 @@ type IlxClosureInfo = /// The generic parameters for the closure, i.e. the type variables it captures cloILGenericParams: IL.ILGenericParameterDefs - /// The free variables for the closure, i.e. the values it captures + /// The captured variables for the closure cloFreeVars: Val list + cloFreeTyvars: Typars + + cloWitnessInfos: TraitWitnessInfos + /// ILX view of the lambdas for the closures ilCloLambdas: IlxClosureLambdas @@ -745,15 +750,15 @@ type ValStorage = /// Indicates the value is stored in a static field. | StaticField of ILFieldSpec * ValRef * (*hasLiteralAttr:*)bool * ILType * string * ILType * ILMethodRef * ILMethodRef * OptionalShadowLocal - /// Indicates the value is "stored" as a property that recomputes it each time it is referenced. Used for simple constants that do not cause initialization triggers + /// Indicates the value is represented as a property that recomputes it each time it is referenced. Used for simple constants that do not cause initialization triggers | StaticProperty of ILMethodSpec * OptionalShadowLocal - /// Indicates the value is "stored" as a IL static method (in a "main" class for a F# + /// Indicates the value is represented as an IL method (in a "main" class for a F# /// compilation unit, or as a member) according to its inferred or specified arity. - | Method of ValReprInfo * ValRef * ILMethodSpec * Range.range * ArgReprInfo list * TType list * ArgReprInfo + | Method of ValReprInfo * ValRef * ILMethodSpec * ILMethodSpec * Range.range * Typars * Typars * CurriedArgInfos * ArgReprInfo list * TraitWitnessInfos * TType list * ArgReprInfo /// Indicates the value is stored at the given position in the closure environment accessed via "ldarg 0" - | Env of ILType * int * ILFieldSpec * NamedLocalIlxClosureInfo ref option + | Env of ILType * ILFieldSpec * NamedLocalIlxClosureInfo ref option /// Indicates that the value is an argument of a method being generated | Arg of int @@ -801,9 +806,11 @@ and BranchCallItem = (TType * ArgReprInfo) list list * // Typars for F# method or value Typars * - // Typars for F# method or value + // num obj args in IL int * - // num obj args + // num witness args in IL + int * + // num actual args in IL int override __.ToString() = "" @@ -867,7 +874,10 @@ and IlxGenEnv = /// All values in scope valsInScope: ValMap> - /// For optimizing direct tail recursion to a loop - mark says where to branch to. Length is 0 or 1. + /// All witnesses in scope and their mapping to storage for the witness value. + witnessesInScope: TraitWitnessInfoHashMap + + /// For optimizing direct tail recursion to a loop - mark says where to branch to. Length is 0 or 1. /// REVIEW: generalize to arbitrary nested local loops?? innerVals: (ValRef * (BranchCallItem * Mark)) list @@ -942,7 +952,14 @@ let AddStorageForVal (g: TcGlobals) (v, s) eenv = else eenv -let AddStorageForLocalVals g vals eenv = List.foldBack (fun (v, s) acc -> AddStorageForVal g (v, notlazy s) acc) vals eenv +let AddStorageForLocalVals g vals eenv = + List.foldBack (fun (v, s) acc -> AddStorageForVal g (v, notlazy s) acc) vals eenv + +let AddStorageForLocalWitness eenv (w,s) = + { eenv with witnessesInScope = eenv.witnessesInScope.SetItem (w, s) } + +let AddStorageForLocalWitnesses witnesses eenv = + (eenv, witnesses) ||> List.fold AddStorageForLocalWitness //-------------------------------------------------------------------------- // Lookup eenv @@ -959,6 +976,11 @@ let StorageForVal g m v eenv = let StorageForValRef g m (v: ValRef) eenv = StorageForVal g m v.Deref eenv +let TryStorageForWitness eenv (w: TraitWitnessInfo) = + match eenv.witnessesInScope.TryGetValue w with + | true, storage -> Some storage + | _ -> None + let IsValRefIsDllImport g (vref: ValRef) = vref.Attribs |> HasFSharpAttributeOpt g g.attrib_DllImportAttribute @@ -966,9 +988,10 @@ let IsValRefIsDllImport g (vref: ValRef) = /// as a method. let GetMethodSpecForMemberVal amap g (memberInfo: ValMemberInfo) (vref: ValRef) = let m = vref.Range - let tps, curriedArgInfos, returnTy, retInfo = + let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal vref.Deref + let tps, witnessInfos, curriedArgInfos, returnTy, retInfo = assert(vref.ValReprInfo.IsSome) - GetTopValTypeInCompiledForm g (Option.get vref.ValReprInfo) vref.Type m + GetTopValTypeInCompiledForm g vref.ValReprInfo.Value numEnclosingTypars vref.Type m let tyenvUnderTypars = TypeReprEnv.ForTypars tps let flatArgInfos = List.concat curriedArgInfos let isCtor = (memberInfo.MemberFlags.MemberKind = MemberKind.Constructor) @@ -986,6 +1009,7 @@ let GetMethodSpecForMemberVal amap g (memberInfo: ValMemberInfo) (vref: ValRef) let ilTy = GenType amap m tyenvUnderTypars (mkAppTy parentTcref (List.map mkTyparTy ctps)) + let nm = vref.CompiledName g.CompilerGlobalState if isCompiledAsInstance || isCtor then // Find the 'this' argument type if any let thisTy, flatArgInfos = @@ -1015,16 +1039,30 @@ let GetMethodSpecForMemberVal amap g (memberInfo: ValMemberInfo) (vref: ValRef) let isSlotSig = memberInfo.MemberFlags.IsDispatchSlot || memberInfo.MemberFlags.IsOverrideOrExplicitImpl let ilMethodArgTys = GenParamTypes amap m tyenvUnderTypars isSlotSig methodArgTys let ilMethodInst = GenTypeArgs amap m tyenvUnderTypars (List.map mkTyparTy mtps) - let mspec = mkILInstanceMethSpecInTy (ilTy, vref.CompiledName g.CompilerGlobalState, ilMethodArgTys, ilActualRetTy, ilMethodInst) - - mspec, ctps, mtps, paramInfos, retInfo, methodArgTys + let mspec = mkILInstanceMethSpecInTy (ilTy, nm, ilMethodArgTys, ilActualRetTy, ilMethodInst) + let mspecW = + if not g.generateWitnesses || witnessInfos.IsEmpty then + mspec + else + let ilWitnessArgTys = GenTypes amap m tyenvUnderTypars (GenWitnessTys g witnessInfos) + let nmW = ExtraWitnessMethodName nm + mkILInstanceMethSpecInTy (ilTy, nmW, ilWitnessArgTys @ ilMethodArgTys, ilActualRetTy, ilMethodInst) + + mspec, mspecW, ctps, mtps, curriedArgInfos, paramInfos, retInfo, witnessInfos, methodArgTys else let methodArgTys, paramInfos = List.unzip flatArgInfos let ilMethodArgTys = GenParamTypes amap m tyenvUnderTypars false methodArgTys let ilMethodInst = GenTypeArgs amap m tyenvUnderTypars (List.map mkTyparTy mtps) - let mspec = mkILStaticMethSpecInTy (ilTy, vref.CompiledName g.CompilerGlobalState , ilMethodArgTys, ilActualRetTy, ilMethodInst) - - mspec, ctps, mtps, paramInfos, retInfo, methodArgTys + let mspec = mkILStaticMethSpecInTy (ilTy, nm, ilMethodArgTys, ilActualRetTy, ilMethodInst) + let mspecW = + if not g.generateWitnesses || witnessInfos.IsEmpty then + mspec + else + let ilWitnessArgTys = GenTypes amap m tyenvUnderTypars (GenWitnessTys g witnessInfos) + let nmW = ExtraWitnessMethodName nm + mkILStaticMethSpecInTy (ilTy, nmW, ilWitnessArgTys @ ilMethodArgTys, ilActualRetTy, ilMethodInst) + + mspec, mspecW, ctps, mtps, curriedArgInfos, paramInfos, retInfo, witnessInfos, methodArgTys /// Determine how a top-level value is represented, when representing as a field, by computing an ILFieldSpec let ComputeFieldSpecForVal(optIntraAssemblyInfo: IlxGenIntraAssemblyInfo option, isInteractive, g, ilTyForProperty, vspec: Val, nm, m, cloc, ilTy, ilGetterMethRef) = @@ -1061,15 +1099,16 @@ let ComputeStorageForFSharpValue amap (g:TcGlobals) cloc optIntraAssemblyInfo op /// Compute the representation information for an F#-declared member let ComputeStorageForFSharpMember amap g topValInfo memberInfo (vref: ValRef) m = - let mspec, _, _, paramInfos, retInfo, methodArgTys = GetMethodSpecForMemberVal amap g memberInfo vref - Method (topValInfo, vref, mspec, m, paramInfos, methodArgTys, retInfo) + let mspec, mspecW, ctps, mtps, curriedArgInfos, paramInfos, retInfo, witnessInfos, methodArgTys = GetMethodSpecForMemberVal amap g memberInfo vref + Method (topValInfo, vref, mspec, mspecW, m, ctps, mtps, curriedArgInfos, paramInfos, witnessInfos, methodArgTys, retInfo) /// Compute the representation information for an F#-declared function in a module or an F#-declared extension member. /// Note, there is considerable overlap with ComputeStorageForFSharpMember/GetMethodSpecForMemberVal and these could be /// rationalized. -let ComputeStorageForFSharpFunctionOrFSharpExtensionMember amap (g:TcGlobals) cloc topValInfo (vref: ValRef) m = +let ComputeStorageForFSharpFunctionOrFSharpExtensionMember amap (g: TcGlobals) cloc topValInfo (vref: ValRef) m = let nm = vref.CompiledName g.CompilerGlobalState - let (tps, curriedArgInfos, returnTy, retInfo) = GetTopValTypeInCompiledForm g topValInfo vref.Type m + let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal vref.Deref + let (tps, witnessInfos, curriedArgInfos, returnTy, retInfo) = GetTopValTypeInCompiledForm g topValInfo numEnclosingTypars vref.Type m let tyenvUnderTypars = TypeReprEnv.ForTypars tps let (methodArgTys, paramInfos) = curriedArgInfos |> List.concat |> List.unzip let ilMethodArgTys = GenParamTypes amap m tyenvUnderTypars false methodArgTys @@ -1077,7 +1116,13 @@ let ComputeStorageForFSharpFunctionOrFSharpExtensionMember amap (g:TcGlobals) cl let ilLocTy = mkILTyForCompLoc cloc let ilMethodInst = GenTypeArgs amap m tyenvUnderTypars (List.map mkTyparTy tps) let mspec = mkILStaticMethSpecInTy (ilLocTy, nm, ilMethodArgTys, ilRetTy, ilMethodInst) - Method (topValInfo, vref, mspec, m, paramInfos, methodArgTys, retInfo) + let mspecW = + if not g.generateWitnesses || witnessInfos.IsEmpty then + mspec + else + let ilWitnessArgTys = GenTypes amap m tyenvUnderTypars (GenWitnessTys g witnessInfos) + mkILStaticMethSpecInTy (ilLocTy, ExtraWitnessMethodName nm, (ilWitnessArgTys @ ilMethodArgTys), ilRetTy, ilMethodInst) + Method (topValInfo, vref, mspec, mspecW, m, [], tps, curriedArgInfos, paramInfos, witnessInfos, methodArgTys, retInfo) /// Determine if an F#-declared value, method or function is compiled as a method. let IsFSharpValCompiledAsMethod g (v: Val) = @@ -1823,7 +1868,9 @@ type CodeGenBuffer(m: range, res member cgbuf.mgbuf = mgbuf + member cgbuf.MethodName = methodName + member cgbuf.PreallocatedArgCount = alreadyUsedArgs member cgbuf.AllocLocal(ranges, ty, isFixed) = @@ -2259,8 +2306,8 @@ and GenExprAux (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = // application of local type functions with type parameters = measure types and body = local value - inline the body GenExpr cenv cgbuf eenv sp v sequel - | Expr.App (f,fty, tyargs, args, m) -> - GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel + | Expr.App (f, fty, tyargs, curriedArgs, m) -> + GenApp cenv cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel | Expr.Val (v, _, m) -> GenGetVal cenv cgbuf eenv (v, m) sequel @@ -3041,8 +3088,7 @@ and GenUntupledArgExpr cenv cgbuf eenv m argInfos expr sequel = GenBinding cenv cgbuf eenvinner bind let tys = destRefTupleTy g ty assert (tys.Length = numRequiredExprs) - // TODO - tupInfoRef - argInfos |> List.iteri (fun i _ -> GenGetTupleField cenv cgbuf eenvinner (tupInfoRef (* TODO *), loce, tys, i, m) Continue) + argInfos |> List.iteri (fun i _ -> GenGetTupleField cenv cgbuf eenvinner (tupInfoRef, loce, tys, i, m) Continue) GenSequel cenv eenv.cloc cgbuf sequel ) @@ -3051,51 +3097,110 @@ and GenUntupledArgExpr cenv cgbuf eenv m argInfos expr sequel = // Generate calls (try to detect direct calls) //-------------------------------------------------------------------------- -and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = +and GenWitnessArgFromInfo cenv cgbuf eenv m witnessInfo = + let g = cenv.g + let storage = TryStorageForWitness eenv witnessInfo + match storage with + | None -> + System.Diagnostics.Debug.Assert(false, "expected storage for witness") + | Some storage -> + let ty = GenWitnessTy g witnessInfo + GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv.amap m eenv.tyenv ty) storage None + +and GenWitnessArgsFromInfos cenv cgbuf eenv m witnessInfos = + let g = cenv.g + let inWitnessPassingScope = not eenv.witnessesInScope.IsEmpty + // Witness arguments are only generated in emitted 'inline' code where witness parameters are available. + if g.generateWitnesses && inWitnessPassingScope then + for witnessInfo in witnessInfos do + GenWitnessArgFromInfo cenv cgbuf eenv m witnessInfo + +and GenWitnessArgs cenv cgbuf eenv m tps tyargs = + let g = cenv.g + let inWitnessPassingScope = not eenv.witnessesInScope.IsEmpty + // Witness arguments are only generated in emitted 'inline' code where witness parameters are available. + if g.generateWitnesses && inWitnessPassingScope then + let mwitnesses = + ConstraintSolver.CodegenWitnessesForTyparInst cenv.tcVal g cenv.amap m tps tyargs + |> CommitOperationResult + + for witnessArg in mwitnesses do + match witnessArg with + | Choice1Of2 witnessInfo -> + GenWitnessArgFromInfo cenv cgbuf eenv m witnessInfo + | Choice2Of2 arg -> + GenExpr cenv cgbuf eenv SPSuppress arg Continue + +and GenApp (cenv: cenv) cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel = let g = cenv.g - match (f, tyargs, args) with - (* Look for tailcall to turn into branch *) + match (f, tyargs, curriedArgs) with + // Look for tailcall to turn into branch | (Expr.Val (v, _, _), _, _) when match ListAssoc.tryFind g.valRefEq v eenv.innerVals with | Some (kind, _) -> (not v.IsConstructor && - (* when branch-calling methods we must have the right type parameters *) + // when branch-calling methods we must have the right type parameters (match kind with | BranchCallClosure _ -> true - | BranchCallMethod (_, _, tps, _, _) -> + | BranchCallMethod (_, _, tps, _, _, _) -> (List.lengthsEqAndForall2 (fun ty tp -> typeEquiv g ty (mkTyparTy tp)) tyargs tps)) && - (* must be exact #args, ignoring tupling - we untuple if needed below *) + // must be exact #args, ignoring tupling - we untuple if needed below (let arityInfo = match kind with | BranchCallClosure arityInfo - | BranchCallMethod (arityInfo, _, _, _, _) -> arityInfo - arityInfo.Length = args.Length + | BranchCallMethod (arityInfo, _, _, _, _, _) -> arityInfo + arityInfo.Length = curriedArgs.Length ) && (* no tailcall out of exception handler, etc. *) (match sequelIgnoringEndScopesAndDiscard sequel with Return | ReturnVoid -> true | _ -> false)) | None -> false -> let (kind, mark) = ListAssoc.find g.valRefEq v eenv.innerVals // already checked above in when guard - let ntmargs = - match kind with - | BranchCallClosure arityInfo -> - let ntmargs = List.foldBack (+) arityInfo 0 - GenExprs cenv cgbuf eenv args - ntmargs - | BranchCallMethod (arityInfo, curriedArgInfos, _, ntmargs, numObjArgs) -> - assert (curriedArgInfos.Length = arityInfo.Length ) - assert (curriedArgInfos.Length = args.Length) - //assert (curriedArgInfos.Length = ntmargs ) - GenUntupledArgsDiscardingLoneUnit cenv cgbuf eenv m numObjArgs curriedArgInfos args - if v.IsExtensionMember then - match curriedArgInfos, args with - | [[]], [_] when numObjArgs = 0 -> (ntmargs-1) - | [[_];[]], [_;_] when numObjArgs = 1 -> (ntmargs-1) - | _ -> ntmargs - else ntmargs - - for i = ntmargs - 1 downto 0 do - CG.EmitInstrs cgbuf (pop 1) Push0 [ I_starg (uint16 (i+cgbuf.PreallocatedArgCount)) ] + + // Generate the arguments for the direct tail call. + // We push all the arguments on the IL stack then write them back to the argument slots using + // I_starg. This seems a little sloppy, we could generate-then-write for each of the arguments. + // + // The arguments pushed don't include the 'this' argument for a recursive closure call (in PreallocatedArgCount) + // The arguments _do_ include the 'this' argument for instance method calls. The arguments do _not_ include witness arguments. + match kind with + | BranchCallClosure arityInfo -> + GenExprs cenv cgbuf eenv curriedArgs + + let numArgs = List.sum arityInfo + + // TODO: witness argument generation for closures + for i = numArgs - 1 downto 0 do + CG.EmitInstrs cgbuf (pop 1) Push0 [ I_starg (uint16 (cgbuf.PreallocatedArgCount+i)) ] + + | BranchCallMethod (arityInfo, curriedArgInfos, _, numObjArgs, numWitnessArgs, numMethodArgs) -> + assert (curriedArgInfos.Length = arityInfo.Length ) + assert (curriedArgInfos.Length = curriedArgs.Length) + + //assert (curriedArgInfos.Length = numArgs ) + // NOTE: we are not generating the witness arguments here + GenUntupledArgsDiscardingLoneUnit cenv cgbuf eenv m numObjArgs curriedArgInfos curriedArgs + + // Extension methods with empty arguments are evidently not quite in sufficiently normalized form, + // so apply a fixup here. This feels like a mistake associated with BindUnitVars, where that is not triggering + // in this case. + let numArgs = + if v.IsExtensionMember then + match curriedArgInfos, curriedArgs with + // static extension method with empty arguments. + | [[]], [_] when numObjArgs = 0 -> 0 + // instance extension method with empty arguments. + | [[_];[]], [_;_] when numObjArgs = 1 -> 0 + | _ -> numMethodArgs + else numMethodArgs + + for i = numArgs - 1 downto 0 do + CG.EmitInstrs cgbuf (pop 1) Push0 [ I_starg (uint16 (cgbuf.PreallocatedArgCount+numObjArgs+numWitnessArgs+i)) ] + + // Note, we don't reassign the witness arguments as these wont' have changed, because the type parameters are identical + + for i = numObjArgs - 1 downto 0 do + CG.EmitInstrs cgbuf (pop 1) Push0 [ I_starg (uint16 (cgbuf.PreallocatedArgCount+i)) ] CG.EmitInstrs cgbuf (pop 0) Push0 [ I_br mark.CodeLabel ] @@ -3126,7 +3231,7 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = let storage = StorageForValRef g m vref eenv match storage with - | Method (_, _, mspec, _, _, _, _) -> + | Method (_, _, mspec, _, _, _, _, _, _, _, _, _) -> CG.EmitInstr cgbuf (pop 0) (Push [g.iltyp_RuntimeMethodHandle]) (I_ldtoken (ILToken.ILMethod mspec)) | _ -> errorR(Error(FSComp.SR.ilxgenUnexpectedArgumentToMethodHandleOfDuringCodegen(), m)) @@ -3153,28 +3258,33 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = when (let storage = StorageForValRef g m vref eenv match storage with - | Method (topValInfo, vref, _, _, _, _, _) -> + | Method (topValInfo, vref, _, _, _, _, _, _, _, _, _, _) -> (let tps, argtys, _, _ = GetTopValTypeInFSharpForm g topValInfo vref.Type m tps.Length = tyargs.Length && - argtys.Length <= args.Length) + argtys.Length <= curriedArgs.Length) | _ -> false) -> let storage = StorageForValRef g m vref eenv match storage with - | Method (topValInfo, vref, mspec, _, _, _, _) -> - let nowArgs, laterArgs = - let _, curriedArgInfos, _, _ = GetTopValTypeInFSharpForm g topValInfo vref.Type m - List.splitAt curriedArgInfos.Length args + | Method (topValInfo, vref, mspec, mspecW, _, ctps, mtps, curriedArgInfos, _, _, _, _) -> + + let nowArgs, laterArgs = List.splitAt curriedArgInfos.Length curriedArgs + + let actualRetTy = applyTys cenv.g vref.Type (tyargs, nowArgs) - let actualRetTy = applyTys g vref.Type (tyargs, nowArgs) - let _, curriedArgInfos, returnTy, _ = GetTopValTypeInCompiledForm g topValInfo vref.Type m + let _, witnessInfos, curriedArgInfos, returnTy, _ = GetTopValTypeInCompiledForm cenv.g topValInfo ctps.Length vref.Type m + + let mspec = + if not cenv.g.generateWitnesses || witnessInfos.IsEmpty then + mspec + else + mspecW let ilTyArgs = GenTypeArgs cenv.amap m eenv.tyenv tyargs - // For instance method calls chop off some type arguments, which are already - // carried by the class. Also work out if it's a virtual call. - let _, virtualCall, newobj, isSuperInit, isSelfInit, _, _, _ = GetMemberCallInfo g (vref, valUseFlags) in + // carried by the class. Also work out if it's a virtual call. + let _, virtualCall, newobj, isSuperInit, isSelfInit, _, _, _ = GetMemberCallInfo g (vref, valUseFlags) // numEnclILTypeArgs will include unit-of-measure args, unfortunately. For now, just cut-and-paste code from GetMemberCallInfo // @REVIEW: refactor this @@ -3226,6 +3336,12 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = if isSuperInit || isSelfInit then CG.EmitInstrs cgbuf (pop 0) (Push [mspec.DeclaringType ]) [ mkLdarg0 ] + if not cenv.g.generateWitnesses || witnessInfos.IsEmpty then + () // no witness args + else + let _ctyargs, mtyargs = List.splitAt ctps.Length tyargs + GenWitnessArgs cenv cgbuf eenv m mtps mtyargs + GenUntupledArgsDiscardingLoneUnit cenv cgbuf eenv m vref.NumObjArgs curriedArgInfos nowArgs // Generate laterArgs (for effects) and save @@ -3276,12 +3392,12 @@ and GenApp cenv cgbuf eenv (f, fty, tyargs, args, m) sequel = // In this case we can often generate a type-specific local expression for the value. // This reduces the number of dynamic type applications. | (Expr.Val (vref, _, _), _, _) -> - GenGetValRefAndSequel cenv cgbuf eenv m vref (Some (tyargs, args, m, sequel)) + GenGetValRefAndSequel cenv cgbuf eenv m vref (Some (tyargs, curriedArgs, m, sequel)) | _ -> (* worst case: generate a first-class function value and call *) GenExpr cenv cgbuf eenv SPSuppress f Continue - GenArgsAndIndirectCall cenv cgbuf eenv (fty, tyargs, args, m) sequel + GenCurriedArgsAndIndirectCall cenv cgbuf eenv (fty, tyargs, curriedArgs, m) sequel and CanTailcall (hasStructObjArg, ccallInfo, withinSEH, hasByrefArg, mustGenerateUnitAfterCall, isDllImport, isSelfInit, makesNoCriticalTailcalls, sequel) = @@ -3328,14 +3444,14 @@ and GenNamedLocalTyFuncCall cenv (cgbuf: CodeGenBuffer) eenv ty cloinfo tyargs m /// Generate an indirect call, converting to an ILX callfunc instruction -and GenArgsAndIndirectCall cenv cgbuf eenv (functy, tyargs, args, m) sequel = +and GenCurriedArgsAndIndirectCall cenv cgbuf eenv (functy, tyargs, curriedArgs, m) sequel = - // Generate the arguments to the indirect call - GenExprs cenv cgbuf eenv args - GenIndirectCall cenv cgbuf eenv (functy, tyargs, args, m) sequel + // Generate the curried arguments to the indirect call + GenExprs cenv cgbuf eenv curriedArgs + GenIndirectCall cenv cgbuf eenv (functy, tyargs, curriedArgs, m) sequel /// Generate an indirect call, converting to an ILX callfunc instruction -and GenIndirectCall cenv cgbuf eenv (functy, tyargs, args, m) sequel = +and GenIndirectCall cenv cgbuf eenv (functy, tyargs, curriedArgs, m) sequel = let g = cenv.g // Fold in the new types into the environment as we generate the formal types. @@ -3349,18 +3465,15 @@ and GenIndirectCall cenv cgbuf eenv (functy, tyargs, args, m) sequel = // This does two phases: REVIEW: the code is too complex for what it's achieving and should be rewritten let formalRetTy, appBuilder = - List.fold - (fun (formalFuncTy, sofar) _ -> - let dty, rty = destFunTy g formalFuncTy - (rty, (fun acc -> sofar (Apps_app(GenType cenv.amap m feenv dty, acc))))) - (formalFuncTy, id) - args + ((formalFuncTy, id), curriedArgs) ||> List.fold (fun (formalFuncTy, appBuilder) _ -> + let dty, rty = destFunTy cenv.g formalFuncTy + (rty, (fun acc -> appBuilder (Apps_app(GenType cenv.amap m feenv dty, acc))))) let ilxRetApps = Apps_done (GenType cenv.amap m feenv formalRetTy) List.foldBack (fun tyarg acc -> Apps_tyapp(GenType cenv.amap m eenv.tyenv tyarg, acc)) tyargs (appBuilder ilxRetApps) - let actualRetTy = applyTys g functy (tyargs, args) + let actualRetTy = applyTys g functy (tyargs, curriedArgs) let ilActualRetTy = GenType cenv.amap m eenv.tyenv actualRetTy // Check if any byrefs are involved to make sure we don't tailcall @@ -3377,7 +3490,7 @@ and GenIndirectCall cenv cgbuf eenv (functy, tyargs, args, m) sequel = // Generate the code code an ILX callfunc operation let instrs = EraseClosures.mkCallFunc g.ilxPubCloEnv (fun ty -> cgbuf.AllocLocal([], ty, false) |> uint16) eenv.tyenv.Count isTailCall ilxClosureApps - CG.EmitInstrs cgbuf (pop (1+args.Length)) (Push [ilActualRetTy]) instrs + CG.EmitInstrs cgbuf (pop (1+curriedArgs.Length)) (Push [ilActualRetTy]) instrs // Done compiling indirect call... GenSequel cenv eenv.cloc cgbuf sequel @@ -3823,7 +3936,7 @@ and GenQuotation cenv cgbuf eenv (ast, conv, m, ety) sequel = | Some res -> res | None -> try - let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, QuotationTranslator.IsReflectedDefinition.No) + let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, cenv.tcVal, QuotationTranslator.IsReflectedDefinition.No) let astSpec = QuotationTranslator.ConvExprPublic qscope ast let referencedTypeDefs, typeSplices, exprSplices = qscope.Close() referencedTypeDefs, List.map fst typeSplices, List.map fst exprSplices, astSpec @@ -3839,15 +3952,14 @@ and GenQuotation cenv cgbuf eenv (ast, conv, m, ety) sequel = let bytesExpr = Expr.Op (TOp.Bytes astSerializedBytes, [], [], m) let deserializeExpr = - match QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat g with - | QuotationTranslator.QuotationSerializationFormat.FSharp_40_Plus -> + let qf = QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat g + if qf.SupportsDeserializeEx then let referencedTypeDefExprs = List.map (mkILNonGenericBoxedTy >> mkTypeOfExpr cenv m) referencedTypeDefs let referencedTypeDefsExpr = mkArray (g.system_Type_ty, referencedTypeDefExprs, m) let spliceTypesExpr = mkArray (g.system_Type_ty, spliceTypeExprs, m) let spliceArgsExpr = mkArray (rawTy, spliceArgExprs, m) mkCallDeserializeQuotationFSharp40Plus g m someTypeInModuleExpr referencedTypeDefsExpr spliceTypesExpr spliceArgsExpr bytesExpr - - | QuotationTranslator.QuotationSerializationFormat.FSharp_20_Plus -> + else let mkList ty els = List.foldBack (mkCons g ty) els (mkNil g m ty) let spliceTypesExpr = mkList g.system_Type_ty spliceTypeExprs let spliceArgsExpr = mkList rawTy spliceArgExprs @@ -3917,9 +4029,28 @@ and MakeNotSupportedExnExpr cenv eenv (argExpr, m) = let mref = mkILCtorMethSpecForTy(ilty, [g.ilg.typ_String]).MethodRef Expr.Op (TOp.ILCall (false, false, false, true, NormalValUse, false, false, mref, [], [], [ety]), [], [argExpr], m) -and GenTraitCall cenv cgbuf eenv (traitInfo, argExprs, m) expr sequel = +and GenTraitCall (cenv: cenv) cgbuf eenv (traitInfo: TraitConstraintInfo, argExprs, m) expr sequel = let g = cenv.g - let minfoOpt = CommitOperationResult (ConstraintSolver.CodegenWitnessThatTypeSupportsTraitConstraint cenv.TcVal g cenv.amap m traitInfo argExprs) + let inWitnessPassingScope = not eenv.witnessesInScope.IsEmpty + let witness = + if g.generateWitnesses && inWitnessPassingScope then + TryStorageForWitness eenv traitInfo.TraitKey + else + None + + match witness with + | Some storage -> + + let ty = GenWitnessTy g traitInfo.TraitKey + let argExprs = if argExprs.Length = 0 then [ mkUnit g m ] else argExprs + GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv.amap m eenv.tyenv ty) storage (Some([], argExprs, m, sequel)) + + | None -> + + // If witnesses are available, we should now always find trait witnesses in scope + assert not inWitnessPassingScope + + let minfoOpt = CommitOperationResult (ConstraintSolver.CodegenWitnessForTraitConstraint cenv.tcVal g cenv.amap m traitInfo argExprs) match minfoOpt with | None -> let exnArg = mkString g m (FSComp.SR.ilDynamicInvocationNotSupported(traitInfo.MemberName)) @@ -3957,7 +4088,7 @@ and GenGetValAddr cenv cgbuf eenv (v: ValRef, m) sequel = let ilTy = if ilTy.IsNominal && ilTy.Boxity = ILBoxity.AsValue then ILType.Byref ilTy else ilTy EmitGetStaticFieldAddr cgbuf ilTy fspec - | Env (_, _, ilField, _) -> + | Env (_, ilField, _) -> CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref ilTy]) [ mkLdarg0; mkNormalLdflda ilField ] | Local (_, _, Some _) | StaticProperty _ | Method _ | Env _ | Null -> @@ -4209,16 +4340,14 @@ and GenObjectExpr cenv cgbuf eenvouter expr (baseType, baseValOpt, basecall, ove let cloinfo, _, eenvinner = GetIlxClosureInfo cenv m false [] eenvouter expr let cloAttribs = cloinfo.cloAttribs - let cloFreeVars = cloinfo.cloFreeVars let ilCloLambdas = cloinfo.ilCloLambdas let cloName = cloinfo.cloName - let ilxCloSpec = cloinfo.cloSpec - let ilCloFreeVars = cloinfo.cloILFreeVars + let ilCloAllFreeVars = cloinfo.ilCloAllFreeVars let ilCloGenericFormals = cloinfo.cloILGenericParams assert (isNil cloinfo.localTypeFuncDirectILGenericParams) let ilCloGenericActuals = cloinfo.cloSpec.GenericArgs - let ilCloRetTy = cloinfo.cloILFormalRetTy + let ilCloRetTy = cloinfo.ilCloFormalReturnTy let ilCloTypeRef = cloinfo.cloSpec.TypeRef let ilTyForOverriding = mkILBoxedTy ilCloTypeRef ilCloGenericActuals @@ -4245,13 +4374,11 @@ and GenObjectExpr cenv cgbuf eenvouter expr (baseType, baseValOpt, basecall, ove let attrs = GenAttrs cenv eenvinner cloAttribs let super = (if isInterfaceTy g baseType then g.ilg.typ_Object else ilCloRetTy) let interfaceTys = interfaceTys @ (if isInterfaceTy g baseType then [ilCloRetTy] else []) - let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, ilCloGenericFormals, attrs, ilCloFreeVars, ilCloLambdas, ilCtorBody, mdefs, mimpls, super, interfaceTys) + let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, ilCloGenericFormals, attrs, ilCloAllFreeVars, ilCloLambdas, ilCtorBody, mdefs, mimpls, super, interfaceTys) for cloTypeDef in cloTypeDefs do cgbuf.mgbuf.AddTypeDef(ilCloTypeRef, cloTypeDef, false, false, None) - CountClosure() - GenGetLocalVals cenv cgbuf eenvouter m cloFreeVars - CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ EraseClosures.mkTyOfLambdas g.ilxPubCloEnv ilCloLambdas]) (I_newobj (ilxCloSpec.Constructor, None)) + GenClosureAlloc cenv cgbuf eenvouter (cloinfo, m) GenSequel cenv eenvouter.cloc cgbuf sequel and GenSequenceExpr @@ -4269,7 +4396,7 @@ and GenSequenceExpr eenvouter |> AddStorageForLocalVals g (stateVars |> List.map (fun v -> v.Deref, Local(0, false, None))) // Get the free variables. Make a lambda to pretend that the 'nextEnumeratorValRef' is bound (it is an argument to GenerateNext) - let (cloAttribs, _, _, cloFreeTyvars, cloFreeVars, ilCloTypeRef: ILTypeRef, ilCloFreeVars, eenvinner) = + let (cloAttribs, _, _, cloFreeTyvars, cloWitnessInfos, cloFreeVars, ilCloTypeRef: ILTypeRef, ilCloAllFreeVars, eenvinner) = GetIlxClosureFreeVars cenv m [] eenvouter [] (mkLambda m nextEnumeratorValRef.Deref (generateNextExpr, g.int32_ty)) let ilCloSeqElemTy = GenType cenv.amap m eenvinner.tyenv seqElemTy @@ -4284,7 +4411,7 @@ and GenSequenceExpr // Create a new closure class with a single "MoveNext" method that implements the iterator. let ilCloTyInner = mkILFormalBoxedTy ilCloTypeRef ilCloGenericParams let ilCloLambdas = Lambdas_return ilCloRetTyInner - let cloref = IlxClosureRef(ilCloTypeRef, ilCloLambdas, ilCloFreeVars) + let cloref = IlxClosureRef(ilCloTypeRef, ilCloLambdas, ilCloAllFreeVars) let ilxCloSpec = IlxClosureSpec.Create(cloref, GenGenericArgs m eenvouter.tyenv cloFreeTyvars) let formalClospec = IlxClosureSpec.Create(cloref, mkILFormalGenericArgs 0 ilCloGenericParams) @@ -4293,13 +4420,14 @@ and GenSequenceExpr CodeGenMethod cenv cgbuf.mgbuf ([], "GetFreshEnumerator", eenvinner, 1, (fun cgbuf eenv -> + GenWitnessArgsFromInfos cenv cgbuf eenv m cloWitnessInfos for fv in cloFreeVars do - /// State variables always get zero-initialized + // State variables always get zero-initialized if stateVarsSet.Contains fv then GenDefaultValue cenv cgbuf eenv (fv.Type, m) else GenGetLocalVal cenv cgbuf eenv m fv None - CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ilCloRetTyInner]) (I_newobj (formalClospec.Constructor, None)) + CG.EmitInstr cgbuf (pop ilCloAllFreeVars.Length) (Push [ilCloRetTyInner]) (I_newobj (formalClospec.Constructor, None)) GenSequel cenv eenv.cloc cgbuf Return), m) mkILNonGenericVirtualMethod("GetFreshEnumerator", ILMemberAccess.Public, [], mkILReturn ilCloEnumeratorTy, MethodBody.IL mbody) @@ -4337,13 +4465,14 @@ and GenSequenceExpr let attrs = GenAttrs cenv eenvinner cloAttribs let cloMethods = [generateNextMethod; closeMethod; checkCloseMethod; lastGeneratedMethod; getFreshMethod] - let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, ilCloGenericParams, attrs, ilCloFreeVars, ilCloLambdas, ilCtorBody, cloMethods, [], ilCloBaseTy, []) + let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, ilCloGenericParams, attrs, ilCloAllFreeVars, ilCloLambdas, ilCtorBody, cloMethods, [], ilCloBaseTy, []) for cloTypeDef in cloTypeDefs do cgbuf.mgbuf.AddTypeDef(ilCloTypeRef, cloTypeDef, false, false, None) CountClosure() + GenWitnessArgsFromInfos cenv cgbuf eenvouter m cloWitnessInfos for fv in cloFreeVars do /// State variables always get zero-initialized if stateVarsSet.Contains fv then @@ -4351,16 +4480,16 @@ and GenSequenceExpr else GenGetLocalVal cenv cgbuf eenvouter m fv None - CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ilCloRetTyOuter]) (I_newobj (ilxCloSpec.Constructor, None)) + CG.EmitInstr cgbuf (pop ilCloAllFreeVars.Length) (Push [ilCloRetTyOuter]) (I_newobj (ilxCloSpec.Constructor, None)) GenSequel cenv eenvouter.cloc cgbuf sequel /// Generate the class for a closure type definition -and GenClosureTypeDefs cenv (tref: ILTypeRef, ilGenParams, attrs, ilCloFreeVars, ilCloLambdas, ilCtorBody, mdefs, mimpls, ext, ilIntfTys) = +and GenClosureTypeDefs cenv (tref: ILTypeRef, ilGenParams, attrs, ilCloAllFreeVars, ilCloLambdas, ilCtorBody, mdefs, mimpls, ext, ilIntfTys) = let g = cenv.g let cloInfo = - { cloFreeVars=ilCloFreeVars + { cloFreeVars=ilCloAllFreeVars cloStructure=ilCloLambdas cloCode=notlazy ilCtorBody } @@ -4449,12 +4578,12 @@ and GenLambdaClosure cenv (cgbuf: CodeGenBuffer) eenv isLocalTypeFunc thisVars e cgbuf.mgbuf.AddTypeDef(ilContractTypeRef, ilContractTypeDef, false, false, None) let ilCtorBody = mkILMethodBody (true, [], 8, nonBranchingInstrsToCode (mkCallBaseConstructor(ilContractTy, [])), None ) - let cloMethods = [ mkILGenericVirtualMethod("DirectInvoke", ILMemberAccess.Assembly, cloinfo.localTypeFuncDirectILGenericParams, [], mkILReturn (cloinfo.cloILFormalRetTy), MethodBody.IL ilCloBody) ] - let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, cloinfo.cloILGenericParams, [], cloinfo.cloILFreeVars, cloinfo.ilCloLambdas, ilCtorBody, cloMethods, [], ilContractTy, []) + let cloMethods = [ mkILGenericVirtualMethod("DirectInvoke", ILMemberAccess.Assembly, cloinfo.localTypeFuncDirectILGenericParams, [], mkILReturn (cloinfo.ilCloFormalReturnTy), MethodBody.IL ilCloBody) ] + let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, cloinfo.cloILGenericParams, [], cloinfo.ilCloAllFreeVars, cloinfo.ilCloLambdas, ilCtorBody, cloMethods, [], ilContractTy, []) cloTypeDefs else - GenClosureTypeDefs cenv (ilCloTypeRef, cloinfo.cloILGenericParams, [], cloinfo.cloILFreeVars, cloinfo.ilCloLambdas, ilCloBody, [], [], g.ilg.typ_Object, []) + GenClosureTypeDefs cenv (ilCloTypeRef, cloinfo.cloILGenericParams, [], cloinfo.ilCloAllFreeVars, cloinfo.ilCloLambdas, ilCloBody, [], [], g.ilg.typ_Object, []) CountClosure() for cloTypeDef in cloTypeDefs do cgbuf.mgbuf.AddTypeDef(ilCloTypeRef, cloTypeDef, false, false, None) @@ -4462,17 +4591,19 @@ and GenLambdaClosure cenv (cgbuf: CodeGenBuffer) eenv isLocalTypeFunc thisVars e | _ -> failwith "GenLambda: not a lambda" -and GenLambdaVal cenv (cgbuf: CodeGenBuffer) eenv (cloinfo, m) = +and GenClosureAlloc cenv (cgbuf: CodeGenBuffer) eenv (cloinfo, m) = let g = cenv.g + CountClosure() + GenWitnessArgsFromInfos cenv cgbuf eenv m cloinfo.cloWitnessInfos GenGetLocalVals cenv cgbuf eenv m cloinfo.cloFreeVars CG.EmitInstr cgbuf - (pop cloinfo.cloILFreeVars.Length) + (pop cloinfo.ilCloAllFreeVars.Length) (Push [EraseClosures.mkTyOfLambdas g.ilxPubCloEnv cloinfo.ilCloLambdas]) (I_newobj (cloinfo.cloSpec.Constructor, None)) and GenLambda cenv cgbuf eenv isLocalTypeFunc thisVars expr sequel = let cloinfo, m = GenLambdaClosure cenv cgbuf eenv isLocalTypeFunc thisVars expr - GenLambdaVal cenv cgbuf eenv (cloinfo, m) + GenClosureAlloc cenv cgbuf eenv (cloinfo, m) GenSequel cenv eenv.cloc cgbuf sequel and GenTypeOfVal cenv eenv (v: Val) = @@ -4482,7 +4613,7 @@ and GenFreevar cenv m eenvouter tyenvinner (fv: Val) = let g = cenv.g match StorageForVal cenv.g m fv eenvouter with // Local type functions - | Local(_, _, Some _) | Env(_, _, _, Some _) -> g.ilg.typ_Object + | Local(_, _, Some _) | Env(_, _, Some _) -> g.ilg.typ_Object #if DEBUG // Check for things that should never make it into the free variable set. Only do this in debug for performance reasons | (StaticField _ | StaticProperty _ | Method _ | Null) -> error(InternalError("GenFreevar: compiler error: unexpected unrealized value", fv.Range)) @@ -4563,26 +4694,59 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) eenvouter takenNames ex // Build the environment that is active inside the closure itself let eenvinner = eenvinner |> AddStorageForLocalVals g (thisVars |> List.map (fun v -> (v.Deref, Arg 0))) - let ilCloFreeVars = - let ilCloFreeVarNames = ChooseFreeVarNames takenNames (List.map nameOfVal cloFreeVars) - let ilCloFreeVars = (cloFreeVars, ilCloFreeVarNames) ||> List.map2 (fun fv nm -> mkILFreeVar (nm, fv.IsCompilerGenerated, GenFreevar cenv m eenvouter eenvinner.tyenv fv)) - ilCloFreeVars + // Work out if the closure captures any witnesses. + let cloWitnessInfos = + let inWitnessPassingScope = not eenvouter.witnessesInScope.IsEmpty + if g.generateWitnesses && inWitnessPassingScope then + GetTraitWitnessInfosOfTypars g 0 cloFreeTyvars // TODO: 0 may be wrong here + else + [] + + let ilCloWitnessFreeVars, ilCloWitnessStorage = + let names = + cloWitnessInfos + |> List.map (fun w -> String.uncapitalize w.MemberName) + |> ChooseFreeVarNames takenNames + (cloWitnessInfos, names) + ||> List.map2 (fun w nm -> + let ty = GenWitnessTy cenv.g w + let ilTy = GenType cenv.amap m eenvinner.tyenv ty + let ilFv = mkILFreeVar (nm, true, ilTy) + let storage = + let ilField = mkILFieldSpecInTy (ilCloTyInner, ilFv.fvName, ilFv.fvType) + Env(ilCloTyInner, ilField, None) + ilFv, (w, storage)) + |> List.unzip + + // Allocate storage in the environment for the witnesses + let eenvinner = eenvinner |> AddStorageForLocalWitnesses ilCloWitnessStorage - let ilCloFreeVarStorage = - (cloFreeVars, ilCloFreeVars) ||> List.mapi2 (fun i v fv -> + let ilCloFreeVars, ilCloFreeVarStorage = + let names = + cloFreeVars + |> List.map nameOfVal + |> ChooseFreeVarNames takenNames + + (cloFreeVars, names) + ||> List.map2 (fun fv nm -> let localCloInfo = - match StorageForVal g m v eenvouter with + match StorageForVal g m fv eenvouter with | Local(_, _, localCloInfo) - | Env(_, _, _, localCloInfo) -> localCloInfo + | Env(_, _, localCloInfo) -> localCloInfo | _ -> None - let ilField = mkILFieldSpecInTy (ilCloTyInner, fv.fvName, fv.fvType) + let ilFv = mkILFreeVar (nm, fv.IsCompilerGenerated, GenFreevar cenv m eenvouter eenvinner.tyenv fv) + let storage = + let ilField = mkILFieldSpecInTy (ilCloTyInner, ilFv.fvName, ilFv.fvType) + Env(ilCloTyInner, ilField, localCloInfo) + ilFv, (fv, storage)) + |> List.unzip - (v, Env(ilCloTyInner, i, ilField, localCloInfo))) + let ilCloAllFreeVars = Array.ofList (ilCloWitnessFreeVars @ ilCloFreeVars) let eenvinner = eenvinner |> AddStorageForLocalVals g ilCloFreeVarStorage // Return a various results - (cloAttribs, cloInternalFreeTyvars, cloContractFreeTyvars, cloFreeTyvars, cloFreeVars, ilCloTypeRef, Array.ofList ilCloFreeVars, eenvinner) + (cloAttribs, cloInternalFreeTyvars, cloContractFreeTyvars, cloFreeTyvars, cloWitnessInfos, cloFreeVars, ilCloTypeRef, ilCloAllFreeVars, eenvinner) and GetIlxClosureInfo cenv m isLocalTypeFunc thisVars eenvouter expr = @@ -4612,22 +4776,22 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc thisVars eenvouter expr = let takenNames = vs |> List.map (fun v -> v.CompiledName g.CompilerGlobalState) // Get the free variables and the information about the closure, add the free variables to the environment - let (cloAttribs, cloInternalFreeTyvars, cloContractFreeTyvars, _, cloFreeVars, ilCloTypeRef, ilCloFreeVars, eenvinner) = + let (cloAttribs, cloInternalFreeTyvars, cloContractFreeTyvars, cloFreeTyvars, cloWitnessInfos, cloFreeVars, ilCloTypeRef, ilCloAllFreeVars, eenvinner) = GetIlxClosureFreeVars cenv m thisVars eenvouter takenNames expr // Put the type and value arguments into the environment - let rec getClosureArgs eenv ntmargs tvsl (vs: Val list) = + let rec getClosureArgs eenv numArgs tvsl (vs: Val list) = match tvsl, vs with | tvs :: rest, _ -> let eenv = AddTyparsToEnv tvs eenv - let l, eenv = getClosureArgs eenv ntmargs rest vs + let l, eenv = getClosureArgs eenv numArgs rest vs let lambdas = (tvs, l) ||> List.foldBack (fun tv sofar -> Lambdas_forall(GenGenericParam cenv eenv tv, sofar)) lambdas, eenv | [], v :: rest -> let nm = v.CompiledName g.CompilerGlobalState let l, eenv = - let eenv = AddStorageForVal g (v, notlazy (Arg ntmargs)) eenv - getClosureArgs eenv (ntmargs+1) [] rest + let eenv = AddStorageForVal g (v, notlazy (Arg numArgs)) eenv + getClosureArgs eenv (numArgs+1) [] rest let lambdas = Lambdas_lambda (mkILParamNamed(nm, GenTypeOfVal cenv eenv v), l) lambdas, eenv | _ -> @@ -4688,7 +4852,7 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc thisVars eenvouter expr = let ilCloGenericFormals = ilContractGenericParams @ ilInternalGenericParams let ilCloGenericActuals = ilContractGenericActuals @ ilInternalGenericActuals - let ilDirectGenericParams, ilReturnTy, ilCloLambdas = + let ilDirectGenericParams, ilCloReturnTy, ilCloLambdas = if isLocalTypeFunc then let rec strip lambdas acc = match lambdas with @@ -4700,17 +4864,19 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc thisVars eenvouter expr = [], ilReturnTy, ilCloLambdas - let ilxCloSpec = IlxClosureSpec.Create(IlxClosureRef(ilCloTypeRef, ilCloLambdas, ilCloFreeVars), ilCloGenericActuals) + let ilxCloSpec = IlxClosureSpec.Create(IlxClosureRef(ilCloTypeRef, ilCloLambdas, ilCloAllFreeVars), ilCloGenericActuals) let cloinfo = { cloExpr=expr cloName=ilCloTypeRef.Name cloArityInfo =narginfo ilCloLambdas=ilCloLambdas - cloILFreeVars = ilCloFreeVars - cloILFormalRetTy=ilReturnTy + ilCloAllFreeVars = ilCloAllFreeVars + ilCloFormalReturnTy = ilCloReturnTy cloSpec = ilxCloSpec cloILGenericParams = ilCloGenericFormals cloFreeVars=cloFreeVars + cloFreeTyvars=cloFreeTyvars + cloWitnessInfos = cloWitnessInfos cloAttribs=cloAttribs localTypeFuncContractFreeTypars = cloContractFreeTyvars localTypeFuncInternalFreeTypars = cloInternalFreeTyvars @@ -4770,8 +4936,9 @@ and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod((TSlotSig(_, deleg // Work out the free type variables for the morphing thunk let takenNames = List.map nameOfVal tmvs - let (cloAttribs, _, _, cloFreeTyvars, cloFreeVars, ilDelegeeTypeRef, ilCloFreeVars, eenvinner) = + let (cloAttribs, _, _, cloFreeTyvars, cloWitnessInfos, cloFreeVars, ilDelegeeTypeRef, ilCloAllFreeVars, eenvinner) = GetIlxClosureFreeVars cenv m [] eenvouter takenNames expr + let ilDelegeeGenericParams = GenGenericParams cenv eenvinner cloFreeTyvars let ilDelegeeGenericActualsInner = mkILFormalGenericArgs 0 ilDelegeeGenericParams @@ -4801,15 +4968,18 @@ and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod((TSlotSig(_, deleg let ilCloLambdas = Lambdas_return ilCtxtDelTy let ilAttribs = GenAttrs cenv eenvinner cloAttribs - let cloTypeDefs = GenClosureTypeDefs cenv (ilDelegeeTypeRef, ilDelegeeGenericParams, ilAttribs, ilCloFreeVars, ilCloLambdas, ilCtorBody, [delegeeInvokeMeth], [], g.ilg.typ_Object, []) + let cloTypeDefs = GenClosureTypeDefs cenv (ilDelegeeTypeRef, ilDelegeeGenericParams, ilAttribs, ilCloAllFreeVars, ilCloLambdas, ilCtorBody, [delegeeInvokeMeth], [], g.ilg.typ_Object, []) for cloTypeDef in cloTypeDefs do cgbuf.mgbuf.AddTypeDef(ilDelegeeTypeRef, cloTypeDef, false, false, None) CountClosure() let ctxtGenericArgsForDelegee = GenGenericArgs m eenvouter.tyenv cloFreeTyvars - let ilxCloSpec = IlxClosureSpec.Create(IlxClosureRef(ilDelegeeTypeRef, ilCloLambdas, ilCloFreeVars), ctxtGenericArgsForDelegee) + let ilxCloSpec = IlxClosureSpec.Create(IlxClosureRef(ilDelegeeTypeRef, ilCloLambdas, ilCloAllFreeVars), ctxtGenericArgsForDelegee) + + GenWitnessArgsFromInfos cenv cgbuf eenvouter m cloWitnessInfos GenGetLocalVals cenv cgbuf eenvouter m cloFreeVars - CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [EraseClosures.mkTyOfLambdas g.ilxPubCloEnv ilCloLambdas]) (I_newobj (ilxCloSpec.Constructor, None)) + + CG.EmitInstr cgbuf (pop ilCloAllFreeVars.Length) (Push [EraseClosures.mkTyOfLambdas g.ilxPubCloEnv ilCloLambdas]) (I_newobj (ilxCloSpec.Constructor, None)) let ilDelegeeTyOuter = mkILBoxedTy ilDelegeeTypeRef ctxtGenericArgsForDelegee let ilDelegeeInvokeMethOuter = mkILNonGenericInstanceMethSpecInTy (ilDelegeeTyOuter, "Invoke", typesOfILParams ilDelegeeParams, ilDelegeeRet.Type) @@ -4820,9 +4990,26 @@ and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod((TSlotSig(_, deleg /// Generate statically-resolved conditionals used for type-directed optimizations. and GenStaticOptimization cenv cgbuf eenv (constraints, e2, e3, _m) sequel = + // Note: during IlxGen, even if answer is StaticOptimizationAnswer.Unknown we discard the static optimization + // This means 'when ^T : ^T' is discarded if not resolved. + // + // This doesn't apply when witnesses are available. In that case, "when ^T : ^T" is resolved as 'Yes', + // this is because all the uses of "when ^T : ^T" in FSharp.Core (e.g. for are for deciding between the + // witness-based implementation and the legacy dynamic implementation, e.g. + // + // let inline ( * ) (x: ^T) (y: ^U) : ^V = + // MultiplyDynamic<(^T),(^U),(^V)> x y + // ... + // when ^T : ^T = ((^T or ^U): (static member (*) : ^T * ^U -> ^V) (x,y)) + // + // When witnesses are not available we use the dynamic implementation. + let e = - if DecideStaticOptimizations cenv.g constraints = StaticOptimizationAnswer.Yes then e2 - else e3 + let inWitnessPassingScope = not eenv.witnessesInScope.IsEmpty + if DecideStaticOptimizations cenv.g constraints inWitnessPassingScope = StaticOptimizationAnswer.Yes then + e2 + else + e3 GenExpr cenv cgbuf eenv SPSuppress e sequel //------------------------------------------------------------------------- @@ -5225,7 +5412,7 @@ and GenLetRecBindings cenv (cgbuf: CodeGenBuffer) eenv (allBinds: Bindings, m) = clo.cloFreeVars |> List.iter (fun fv -> if Zset.contains fv forwardReferenceSet then match StorageForVal cenv.g m fv eenvclo with - | Env (_, _, ilField, _) -> fixups := (boundv, fv, (fun () -> GenLetRecFixup cenv cgbuf eenv (clo.cloSpec, access, ilField, exprForVal m fv, m))) :: !fixups + | Env (_, ilField, _) -> fixups := (boundv, fv, (fun () -> GenLetRecFixup cenv cgbuf eenv (clo.cloSpec, access, ilField, exprForVal m fv, m))) :: !fixups | _ -> error (InternalError("GenLetRec: " + fv.LogicalName + " was not in the environment", m)) ) | Expr.Val (vref, _, _) -> @@ -5328,18 +5515,24 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) star CommitStartScope cgbuf startScopeMarkOpt GenExpr cenv cgbuf eenv SPSuppress cctorBody discard - | Method (topValInfo, _, mspec, _, paramInfos, methodArgTys, retInfo) -> - let tps, ctorThisValOpt, baseValOpt, vsl, body', bodyty = IteratedAdjustArityOfLambda g cenv.amap topValInfo rhsExpr - let methodVars = List.concat vsl + | Method (topValInfo, _, mspec, mspecW, _, ctps, mtps, curriedArgInfos, paramInfos, witnessInfos, argTys, retInfo) -> + + let methLambdaTypars, methLambdaCtorThisValOpt, methLambdaBaseValOpt, methLambdaCurriedVars, methLambdaBody, methLambdaBodyTy = + IteratedAdjustArityOfLambda g cenv.amap topValInfo rhsExpr + + let methLambdaVars = List.concat methLambdaCurriedVars + CommitStartScope cgbuf startScopeMarkOpt - let ilxMethInfoArgs = - (vspec, mspec, access, paramInfos, retInfo, topValInfo, ctorThisValOpt, baseValOpt, tps, methodVars, methodArgTys, body', bodyty) // if we have any expression recursion depth, we should delay the generation of a method to prevent stack overflows - if cenv.exprRecursionDepth > 0 then - DelayGenMethodForBinding cenv cgbuf.mgbuf eenv ilxMethInfoArgs - else - GenMethodForBinding cenv cgbuf.mgbuf eenv ilxMethInfoArgs + let generator = if cenv.exprRecursionDepth > 0 then DelayGenMethodForBinding else GenMethodForBinding + generator cenv cgbuf.mgbuf eenv (vspec, mspec, false, access, ctps, mtps, [], curriedArgInfos, paramInfos, argTys, retInfo, topValInfo, methLambdaCtorThisValOpt, methLambdaBaseValOpt, methLambdaTypars, methLambdaVars, methLambdaBody, methLambdaBodyTy) + + // If generating witnesses, then generate the second entry point with additional arguments. + // Take a copy of the expression to ensure generated names are unique. + if cenv.g.generateWitnesses && not witnessInfos.IsEmpty then + let copyOfLambdaBody = copyExpr cenv.g CloneAll methLambdaBody + generator cenv cgbuf.mgbuf eenv (vspec, mspecW, true, access, ctps, mtps, witnessInfos, curriedArgInfos, paramInfos, argTys, retInfo, topValInfo, methLambdaCtorThisValOpt, methLambdaBaseValOpt, methLambdaTypars, methLambdaVars, copyOfLambdaBody, methLambdaBodyTy) | StaticProperty (ilGetterMethSpec, optShadowLocal) -> @@ -5615,64 +5808,74 @@ and GenParamAttribs cenv paramTy attribs = inFlag, outFlag, optionalFlag, defaultValue, Marshal, attribs /// Generate IL parameters -and GenParams cenv eenv (mspec: ILMethodSpec) (attribs: ArgReprInfo list) methodArgTys (implValsOpt: Val list option) = +and GenParams (cenv: cenv) eenv m (mspec: ILMethodSpec) witnessInfos (argInfos: ArgReprInfo list) methArgTys (implValsOpt: Val list option) = let g = cenv.g - let ilArgTys = mspec.FormalArgTypes - let argInfosAndTypes = - if List.length attribs = List.length ilArgTys then List.zip ilArgTys attribs - else ilArgTys |> List.map (fun ilArgTy -> ilArgTy, ValReprInfo.unnamedTopArg1) + let ilWitnessParams = GenWitnessParams cenv eenv m witnessInfos + let ilArgTys = mspec.FormalArgTypes |> List.skip witnessInfos.Length - let argInfosAndTypes = + let ilArgTysAndInfos = + if argInfos.Length = ilArgTys.Length then + List.zip ilArgTys argInfos + else + assert false + ilArgTys |> List.map (fun ilArgTy -> ilArgTy, ValReprInfo.unnamedTopArg1) + + let ilArgTysAndInfoAndVals = match implValsOpt with | Some implVals when (implVals.Length = ilArgTys.Length) -> - List.map2 (fun x y -> x, Some y) argInfosAndTypes implVals + List.map2 (fun x y -> x, Some y) ilArgTysAndInfos implVals | _ -> - List.map (fun x -> x, None) argInfosAndTypes - - (Set.empty, List.zip methodArgTys argInfosAndTypes) - ||> List.mapFold (fun takenNames (methodArgTy, ((ilArgTy, topArgInfo), implValOpt)) -> - let inFlag, outFlag, optionalFlag, defaultParamValue, Marshal, attribs = GenParamAttribs cenv methodArgTy topArgInfo.Attribs - - let idOpt = (match topArgInfo.Name with - | Some v -> Some v - | None -> match implValOpt with - | Some v -> Some v.Id - | None -> None) - - let nmOpt, takenNames = - match idOpt with - | Some id -> - let nm = - if takenNames.Contains(id.idText) then - // Ensure that we have an g.CompilerGlobalState - assert(g.CompilerGlobalState |> Option.isSome) - g.CompilerGlobalState.Value.NiceNameGenerator.FreshCompilerGeneratedName (id.idText, id.idRange) - else - id.idText - Some nm, takenNames.Add nm - | None -> - None, takenNames - - let ilAttribs = GenAttrs cenv eenv attribs - - let ilAttribs = - match GenReadOnlyAttributeIfNecessary g methodArgTy with - | Some attr -> ilAttribs @ [attr] - | None -> ilAttribs - - let param: ILParameter = - { Name=nmOpt - Type= ilArgTy - Default=defaultParamValue - Marshal=Marshal - IsIn=inFlag - IsOut=outFlag - IsOptional=optionalFlag - CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs ilAttribs) - MetadataIndex = NoMetadataIdx } - - param, takenNames) - |> fst + List.map (fun x -> x, None) ilArgTysAndInfos + + let ilParams, _ = + (Set.empty, List.zip methArgTys ilArgTysAndInfoAndVals) + ||> List.mapFold (fun takenNames (methodArgTy, ((ilArgTy, topArgInfo), implValOpt)) -> + let inFlag, outFlag, optionalFlag, defaultParamValue, Marshal, attribs = GenParamAttribs cenv methodArgTy topArgInfo.Attribs + + let idOpt = + match topArgInfo.Name with + | Some v -> Some v + | None -> + match implValOpt with + | Some v -> Some v.Id + | None -> None + + let nmOpt, takenNames = + match idOpt with + | Some id -> + let nm = + if takenNames.Contains(id.idText) then + // Ensure that we have an g.CompilerGlobalState + assert(g.CompilerGlobalState |> Option.isSome) + g.CompilerGlobalState.Value.NiceNameGenerator.FreshCompilerGeneratedName (id.idText, id.idRange) + else + id.idText + Some nm, takenNames.Add(nm) + | None -> + None, takenNames + + + let ilAttribs = GenAttrs cenv eenv attribs + + let ilAttribs = + match GenReadOnlyAttributeIfNecessary g methodArgTy with + | Some attr -> ilAttribs @ [attr] + | None -> ilAttribs + + let param : ILParameter = + { Name = nmOpt + Type = ilArgTy + Default = defaultParamValue + Marshal = Marshal + IsIn = inFlag + IsOut = outFlag + IsOptional = optionalFlag + CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs ilAttribs) + MetadataIndex = NoMetadataIdx } + + param, takenNames) + + ilWitnessParams @ ilParams /// Generate IL method return information and GenReturnInfo cenv eenv ilRetTy (retInfo: ArgReprInfo) : ILReturn = @@ -5713,42 +5916,52 @@ and GenEventForProperty cenv eenvForMeth (mspec: ILMethodSpec) (v: Val) ilAttrsT otherMethods= [], customAttrs = mkILCustomAttrs ilAttrsThatGoOnPrimaryItem) -and ComputeFlagFixupsForMemberBinding cenv (v: Val, memberInfo: ValMemberInfo) = - let g = cenv.g - if isNil memberInfo.ImplementedSlotSigs then - [fixupVirtualSlotFlags] - else - memberInfo.ImplementedSlotSigs |> List.map (fun slotsig -> - let oty = slotsig.ImplementedType - let otcref = tcrefOfAppTy g oty - let tcref = v.MemberApparentEntity - - let useMethodImpl = - // REVIEW: it would be good to get rid of this special casing of Compare and GetHashCode during code generation - isInterfaceTy g oty && - (let isCompare = - Option.isSome tcref.GeneratedCompareToValues && - (typeEquiv g oty g.mk_IComparable_ty || - tyconRefEq g g.system_GenericIComparable_tcref otcref) - - not isCompare) && - - (let isGenericEquals = - Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues && tyconRefEq g g.system_GenericIEquatable_tcref otcref - - not isGenericEquals) && - (let isStructural = - (Option.isSome tcref.GeneratedCompareToWithComparerValues && typeEquiv g oty g.mk_IStructuralComparable_ty) || - (Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues && typeEquiv g oty g.mk_IStructuralEquatable_ty) +and ComputeUseMethodImpl cenv (v: Val, slotsig: SlotSig) = + let oty = slotsig.ImplementedType + let otcref = tcrefOfAppTy cenv.g oty + let tcref = v.MemberApparentEntity + // REVIEW: it would be good to get rid of this special casing of Compare and GetHashCode during code generation + isInterfaceTy cenv.g oty && + (let isCompare = + Option.isSome tcref.GeneratedCompareToValues && + (typeEquiv cenv.g oty cenv.g.mk_IComparable_ty || + tyconRefEq cenv.g cenv.g.system_GenericIComparable_tcref otcref) + + not isCompare) && - not isStructural) + (let isGenericEquals = + Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues && tyconRefEq cenv.g cenv.g.system_GenericIEquatable_tcref otcref + + not isGenericEquals) && + (let isStructural = + (Option.isSome tcref.GeneratedCompareToWithComparerValues && typeEquiv cenv.g oty cenv.g.mk_IStructuralComparable_ty) || + (Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues && typeEquiv cenv.g oty cenv.g.mk_IStructuralEquatable_ty) - let nameOfOverridingMethod = GenNameOfOverridingMethod cenv (useMethodImpl, slotsig) + not isStructural) +and ComputeMethodImplNameFixupForMemberBinding cenv (v: Val, memberInfo: ValMemberInfo) = + if isNil memberInfo.ImplementedSlotSigs then + None + else + let slotsig = memberInfo.ImplementedSlotSigs |> List.last + let useMethodImpl = ComputeUseMethodImpl cenv (v, slotsig) + let nameOfOverridingMethod = GenNameOfOverridingMethod cenv (useMethodImpl, slotsig) + Some nameOfOverridingMethod + +and ComputeFlagFixupsForMemberBinding cenv (v: Val, memberInfo: ValMemberInfo) = + [ if isNil memberInfo.ImplementedSlotSigs then + yield fixupVirtualSlotFlags + else + for slotsig in memberInfo.ImplementedSlotSigs do + let useMethodImpl = ComputeUseMethodImpl cenv (v, slotsig) + if useMethodImpl then - fixupMethodImplFlags >> renameMethodDef nameOfOverridingMethod + yield fixupMethodImplFlags else - fixupVirtualSlotFlags >> renameMethodDef nameOfOverridingMethod) + yield fixupVirtualSlotFlags + match ComputeMethodImplNameFixupForMemberBinding cenv (v, memberInfo) with + | Some nm -> yield renameMethodDef nm + | None -> () ] and ComputeMethodImplAttribs cenv (_v: Val) attrs = let g = cenv.g @@ -5781,38 +5994,58 @@ and ComputeMethodImplAttribs cenv (_v: Val) attrs = and DelayGenMethodForBinding cenv mgbuf eenv ilxMethInfoArgs = cenv.delayedGenMethods.Enqueue (fun cenv -> GenMethodForBinding cenv mgbuf eenv ilxMethInfoArgs) -and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, topValInfo, ctorThisValOpt, baseValOpt, tps, methodVars, methodArgTys, body, returnTy) = +and GenMethodForBinding + cenv mgbuf eenv + (v: Val, mspec, hasWitnessArgs, access, ctps, mtps, witnessInfos, curriedArgInfos, paramInfos, argTys, retInfo, topValInfo, + ctorThisValOpt, baseValOpt, methLambdaTypars, methLambdaVars, methLambdaBody, returnTy) = let g = cenv.g let m = v.Range + let selfMethodVars, nonSelfMethodVars, compileAsInstance = match v.MemberInfo with | Some _ when ValSpecIsCompiledAsInstance g v -> - match methodVars with + match methLambdaVars with | [] -> error(InternalError("Internal error: empty argument list for instance method", v.Range)) | h :: t -> [h], t, true - | _ -> [], methodVars, false + | _ -> [], methLambdaVars, false - let nonUnitNonSelfMethodVars, body = BindUnitVars g (nonSelfMethodVars, paramInfos, body) - let nonUnitMethodVars = selfMethodVars@nonUnitNonSelfMethodVars - let cmtps, curriedArgInfos, _, _ = GetTopValTypeInCompiledForm g topValInfo v.Type v.Range + let nonUnitNonSelfMethodVars, body = BindUnitVars cenv.g (nonSelfMethodVars, paramInfos, methLambdaBody) let eenv = bindBaseOrThisVarOpt cenv eenv ctorThisValOpt let eenv = bindBaseOrThisVarOpt cenv eenv baseValOpt // The type parameters of the method's type are different to the type parameters // for the big lambda ("tlambda") of the implementation of the method. - let eenvUnderMethLambdaTypars = EnvForTypars tps eenv - let eenvUnderMethTypeTypars = EnvForTypars cmtps eenv + let eenvUnderMethLambdaTypars = EnvForTypars methLambdaTypars eenv + let eenvUnderMethTypeClassTypars = EnvForTypars ctps eenv + let eenvUnderMethTypeTypars = AddTyparsToEnv mtps eenvUnderMethTypeClassTypars // Add the arguments to the environment. We add an implicit 'this' argument to constructors let isCtor = v.IsConstructor + + let methLambdaWitnessInfos = + if hasWitnessArgs then + GetTraitWitnessInfosOfTypars cenv.g ctps.Length methLambdaTypars + else + [] + + // If this assert fails then there is a mismatch in the number of trait constraints on the method type and the number + // on the method implementation. + assert (methLambdaWitnessInfos.Length = witnessInfos.Length) + let eenvForMeth = let eenvForMeth = eenvUnderMethLambdaTypars - let numImplicitArgs = if isCtor then 1 else 0 - let eenvForMeth = AddStorageForLocalVals g (List.mapi (fun i v -> (v, Arg (numImplicitArgs+i))) nonUnitMethodVars) eenvForMeth + let numArgsUsed = 0 + let numArgsUsed = numArgsUsed + (if isCtor then 1 else 0) + let eenvForMeth = eenvForMeth |> AddStorageForLocalVals cenv.g (selfMethodVars |> List.mapi (fun i v -> (v, Arg (numArgsUsed+i)))) + let numArgsUsed = numArgsUsed + selfMethodVars.Length + let eenvForMeth = eenvForMeth |> AddStorageForLocalWitnesses (methLambdaWitnessInfos |> List.mapi (fun i w -> (w, Arg (numArgsUsed+i)))) + let numArgsUsed = numArgsUsed + methLambdaWitnessInfos.Length + let eenvForMeth = eenvForMeth |> AddStorageForLocalVals cenv.g (List.mapi (fun i v -> (v, Arg (numArgsUsed+i))) nonUnitNonSelfMethodVars) eenvForMeth - let tailCallInfo = [(mkLocalValRef v, BranchCallMethod (topValInfo.AritiesOfArgs, curriedArgInfos, tps, nonUnitMethodVars.Length, v.NumObjArgs))] + let tailCallInfo = + [(mkLocalValRef v, BranchCallMethod (topValInfo.AritiesOfArgs, curriedArgInfos, methLambdaTypars, selfMethodVars.Length, methLambdaWitnessInfos.Length, nonUnitNonSelfMethodVars.Length))] // Discard the result on a 'void' return type. For a constructor just return 'void' let sequel = @@ -5824,7 +6057,7 @@ and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, let hasPreserveSigNamedArg, ilMethodBody, hasDllImport = match TryFindFSharpAttributeOpt g g.attrib_DllImportAttribute v.Attribs with | Some (Attrib(_, _, [ AttribStringArg dll ], namedArgs, _, _, m)) -> - if not (isNil tps) then error(Error(FSComp.SR.ilSignatureForExternalFunctionContainsTypeParameters(), m)) + if not (isNil methLambdaTypars) then error(Error(FSComp.SR.ilSignatureForExternalFunctionContainsTypeParameters(), m)) let hasPreserveSigNamedArg, mbody = GenPInvokeMethod (v.CompiledName g.CompilerGlobalState, dll, namedArgs) hasPreserveSigNamedArg, mbody, true @@ -5833,10 +6066,13 @@ and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, | _ -> // Replace the body of ValInline.PseudoVal "must inline" methods with a 'throw' - // However still generate the code for reflection etc. + // For witness-passing methods, don't do this if `isLegacy` flag specified + // on the attribute. Older compilers let bodyExpr = - if HasFSharpAttribute g g.attrib_NoDynamicInvocationAttribute v.Attribs then - let exnArg = mkString g m (FSComp.SR.ilDynamicInvocationNotSupported(v.CompiledName g.CompilerGlobalState)) + let attr = TryFindFSharpBoolAttributeAssumeFalse cenv.g cenv.g.attrib_NoDynamicInvocationAttribute v.Attribs + if (not hasWitnessArgs && attr.IsSome) || + (hasWitnessArgs && attr = Some false) then + let exnArg = mkString cenv.g m (FSComp.SR.ilDynamicInvocationNotSupported(v.CompiledName g.CompilerGlobalState)) let exnExpr = MakeNotSupportedExnExpr cenv eenv (exnArg, m) mkThrow m returnTy exnExpr else @@ -5877,105 +6113,107 @@ and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, [ yield! GenAttrs cenv eenv attrs yield! GenCompilationArgumentCountsAttr cenv v ] - let ilTypars = GenGenericParams cenv eenvUnderMethLambdaTypars tps - let ilParams = GenParams cenv eenv mspec paramInfos methodArgTys (Some nonUnitNonSelfMethodVars) - let ilReturn = GenReturnInfo cenv eenv mspec.FormalReturnType retInfo + let ilTypars = GenGenericParams cenv eenvUnderMethLambdaTypars methLambdaTypars + let ilParams = GenParams cenv eenvUnderMethTypeTypars m mspec witnessInfos paramInfos argTys (Some nonUnitNonSelfMethodVars) + let ilReturn = GenReturnInfo cenv eenvUnderMethTypeTypars mspec.FormalReturnType retInfo let methName = mspec.Name let tref = mspec.MethodRef.DeclaringTypeRef - let EmitTheMethodDef (mdef: ILMethodDef) = - // Does the function have an explicit [] attribute? - let isExplicitEntryPoint = HasFSharpAttribute g g.attrib_EntryPointAttribute attrs - - let mdef = - mdef - .WithSecurity(not (List.isEmpty securityAttributes)) - .WithPInvoke(hasDllImport) - .WithPreserveSig(hasPreserveSigImplFlag || hasPreserveSigNamedArg) - .WithSynchronized(hasSynchronizedImplFlag) - .WithNoInlining(hasNoInliningFlag) - .WithAggressiveInlining(hasAggressiveInliningImplFlag) - .With(isEntryPoint=isExplicitEntryPoint, securityDecls=secDecls) - - let mdef = - if // operator names - mdef.Name.StartsWithOrdinal("op_") || - // active pattern names - mdef.Name.StartsWithOrdinal("|") || - // event add/remove method - v.val_flags.IsGeneratedEventVal then - mdef.WithSpecialName - else - mdef - CountMethodDef() - mgbuf.AddMethodDef(tref, mdef) - - match v.MemberInfo with // don't generate unimplemented abstracts | Some memberInfo when memberInfo.MemberFlags.IsDispatchSlot && not memberInfo.IsImplemented -> // skipping unimplemented abstract method () - | Some memberInfo when not v.IsExtensionMember -> - - let ilMethTypars = ilTypars |> List.drop mspec.DeclaringType.GenericArgs.Length - if memberInfo.MemberFlags.MemberKind = MemberKind.Constructor then - assert (isNil ilMethTypars) - let mdef = mkILCtor (access, ilParams, ilMethodBody) - let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) - EmitTheMethodDef mdef - - elif memberInfo.MemberFlags.MemberKind = MemberKind.ClassConstructor then - assert (isNil ilMethTypars) - let mdef = mkILClassCtor ilMethodBody - let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) - EmitTheMethodDef mdef - - // Generate virtual/override methods + method-impl information if needed - else - let mdef = - if not compileAsInstance then - mkILStaticMethod (ilMethTypars, v.CompiledName g.CompilerGlobalState, access, ilParams, ilReturn, ilMethodBody) - elif (memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) || - memberInfo.MemberFlags.IsOverrideOrExplicitImpl then + // compiling CLIEvent properties + | Some memberInfo + when not v.IsExtensionMember && + (match memberInfo.MemberFlags.MemberKind with + | (MemberKind.PropertySet | MemberKind.PropertyGet) -> CompileAsEvent cenv.g v.Attribs + | _ -> false) -> - let flagFixups = ComputeFlagFixupsForMemberBinding cenv (v, memberInfo) - let mdef = mkILGenericVirtualMethod (v.CompiledName g.CompilerGlobalState, ILMemberAccess.Public, ilMethTypars, ilParams, ilReturn, ilMethodBody) - let mdef = List.fold (fun mdef f -> f mdef) mdef flagFixups + let useMethodImpl = + if compileAsInstance && + ((memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) || + memberInfo.MemberFlags.IsOverrideOrExplicitImpl) then - // fixup can potentially change name of reflected definition that was already recorded - patch it if necessary - mgbuf.ReplaceNameOfReflectedDefinition(v, mdef.Name) - mdef - else - mkILGenericNonVirtualMethod (v.CompiledName g.CompilerGlobalState, access, ilMethTypars, ilParams, ilReturn, ilMethodBody) + let useMethodImpl = memberInfo.ImplementedSlotSigs |> List.exists (fun slotsig -> ComputeUseMethodImpl cenv (v, slotsig)) + + let nameOfOverridingMethod = + match ComputeMethodImplNameFixupForMemberBinding cenv (v, memberInfo) with + | None -> mspec.Name + | Some nm -> nm + + // Fixup can potentially change name of reflected definition that was already recorded - patch it if necessary + mgbuf.ReplaceNameOfReflectedDefinition(v, nameOfOverridingMethod) + useMethodImpl + else + false - let isAbstract = - memberInfo.MemberFlags.IsDispatchSlot && - let tcref = v.MemberApparentEntity - not tcref.Deref.IsFSharpDelegateTycon + // skip method generation for compiling the property as a .NET event + // Instead emit the pseudo-property as an event. + // on't do this if it's a private method impl. + if not useMethodImpl then + let edef = GenEventForProperty cenv eenvForMeth mspec v ilAttrsThatGoOnPrimaryItem m returnTy + mgbuf.AddEventDef(tref, edef) - let mdef = - if mdef.IsVirtual then - mdef.WithFinal(memberInfo.MemberFlags.IsFinal).WithAbstract(isAbstract) - else mdef + | _ -> + + let mdef = + match v.MemberInfo with + | Some memberInfo when not v.IsExtensionMember -> + + let ilMethTypars = ilTypars |> List.drop mspec.DeclaringType.GenericArgs.Length + if memberInfo.MemberFlags.MemberKind = MemberKind.Constructor then + assert (isNil ilMethTypars) + let mdef = mkILCtor (access, ilParams, ilMethodBody) + let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) + mdef + + elif memberInfo.MemberFlags.MemberKind = MemberKind.ClassConstructor then + assert (isNil ilMethTypars) + let mdef = mkILClassCtor ilMethodBody + let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) + mdef + + // Generate virtual/override methods + method-impl information if needed + else + let mdef = + if not compileAsInstance then + mkILStaticMethod (ilMethTypars, mspec.Name, access, ilParams, ilReturn, ilMethodBody) + + elif (memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) || + memberInfo.MemberFlags.IsOverrideOrExplicitImpl then - match memberInfo.MemberFlags.MemberKind with + let flagFixups = ComputeFlagFixupsForMemberBinding cenv (v, memberInfo) + let mdef = mkILGenericVirtualMethod (mspec.Name, ILMemberAccess.Public, ilMethTypars, ilParams, ilReturn, ilMethodBody) + let mdef = List.fold (fun mdef f -> f mdef) mdef flagFixups + + // fixup can potentially change name of reflected definition that was already recorded - patch it if necessary + mgbuf.ReplaceNameOfReflectedDefinition(v, mdef.Name) + mdef + else + mkILGenericNonVirtualMethod (mspec.Name, access, ilMethTypars, ilParams, ilReturn, ilMethodBody) + + let isAbstract = + memberInfo.MemberFlags.IsDispatchSlot && + let tcref = v.MemberApparentEntity + not tcref.Deref.IsFSharpDelegateTycon + + let mdef = + if mdef.IsVirtual then + mdef.WithFinal(memberInfo.MemberFlags.IsFinal).WithAbstract(isAbstract) + else mdef + + match memberInfo.MemberFlags.MemberKind with - | (MemberKind.PropertySet | MemberKind.PropertyGet) -> - if not (isNil ilMethTypars) then - error(InternalError("A property may not be more generic than the enclosing type - constrain the polymorphism in the expression", v.Range)) + | (MemberKind.PropertySet | MemberKind.PropertyGet) -> + if not (isNil ilMethTypars) then + error(InternalError("A property may not be more generic than the enclosing type - constrain the polymorphism in the expression", v.Range)) - // Check if we're compiling the property as a .NET event - if CompileAsEvent g v.Attribs then + // Check if we're compiling the property as a .NET event + assert not (CompileAsEvent cenv.g v.Attribs) - // Emit the pseudo-property as an event, but not if its a private method impl - if mdef.Access <> ILMemberAccess.Private then - let edef = GenEventForProperty cenv eenvForMeth mspec v ilAttrsThatGoOnPrimaryItem m returnTy - mgbuf.AddEventDef(tref, edef) - // The method def is dropped on the floor here - - else // Emit the property, but not if its a private method impl if mdef.Access <> ILMemberAccess.Private then let vtyp = ReturnTypeOfPropertyVal g v @@ -5986,26 +6224,54 @@ and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, // Add the special name flag for all properties let mdef = mdef.WithSpecialName.With(customAttrs= mkILCustomAttrs ((GenAttrs cenv eenv attrsAppliedToGetterOrSetter) @ sourceNameAttribs @ ilAttrsCompilerGenerated)) - EmitTheMethodDef mdef - | _ -> - let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) - EmitTheMethodDef mdef + mdef - | _ -> - let mdef = mkILStaticMethod (ilTypars, methName, access, ilParams, ilReturn, ilMethodBody) + | _ -> + let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) + mdef - // For extension properties, also emit attrsAppliedToGetterOrSetter on the getter or setter method - let ilAttrs = - match v.MemberInfo with - | Some memberInfo when v.IsExtensionMember -> - match memberInfo.MemberFlags.MemberKind with - | (MemberKind.PropertySet | MemberKind.PropertyGet) -> ilAttrsThatGoOnPrimaryItem @ GenAttrs cenv eenv attrsAppliedToGetterOrSetter - | _ -> ilAttrsThatGoOnPrimaryItem - | _ -> ilAttrsThatGoOnPrimaryItem - - let ilCustomAttrs = mkILCustomAttrs (ilAttrs @ sourceNameAttribs @ ilAttrsCompilerGenerated) - let mdef = mdef.With(customAttrs= ilCustomAttrs) - EmitTheMethodDef mdef + | _ -> + let mdef = mkILStaticMethod (ilTypars, methName, access, ilParams, ilReturn, ilMethodBody) + + // For extension properties, also emit attrsAppliedToGetterOrSetter on the getter or setter method + let ilAttrs = + match v.MemberInfo with + | Some memberInfo when v.IsExtensionMember -> + match memberInfo.MemberFlags.MemberKind with + | (MemberKind.PropertySet | MemberKind.PropertyGet) -> ilAttrsThatGoOnPrimaryItem @ GenAttrs cenv eenv attrsAppliedToGetterOrSetter + | _ -> ilAttrsThatGoOnPrimaryItem + | _ -> ilAttrsThatGoOnPrimaryItem + + let ilCustomAttrs = mkILCustomAttrs (ilAttrs @ sourceNameAttribs @ ilAttrsCompilerGenerated) + let mdef = mdef.With(customAttrs= ilCustomAttrs) + mdef + + // Does the function have an explicit [] attribute? + let isExplicitEntryPoint = HasFSharpAttribute cenv.g cenv.g.attrib_EntryPointAttribute attrs + + let mdef = + mdef + .WithSecurity(not (List.isEmpty securityAttributes)) + .WithPInvoke(hasDllImport) + .WithPreserveSig(hasPreserveSigImplFlag || hasPreserveSigNamedArg) + .WithSynchronized(hasSynchronizedImplFlag) + .WithNoInlining(hasNoInliningFlag) + .WithAggressiveInlining(hasAggressiveInliningImplFlag) + .With(isEntryPoint=isExplicitEntryPoint, securityDecls=secDecls) + + let mdef = + if // operator names + mdef.Name.StartsWithOrdinal("op_") || + // active pattern names + mdef.Name.StartsWithOrdinal("|") || + // event add/remove method + v.val_flags.IsGeneratedEventVal then + mdef.WithSpecialName + else + mdef + CountMethodDef() + mgbuf.AddMethodDef(tref, mdef) + and GenPInvokeMethod (nm, dll, namedArgs) = let decoder = AttributeDecoder namedArgs @@ -6044,7 +6310,7 @@ and GenBindings cenv cgbuf eenv binds = List.iter (GenBinding cenv cgbuf eenv) b and GenSetVal cenv cgbuf eenv (vref, e, m) sequel = let storage = StorageForValRef cenv.g m vref eenv match storage with - | Env (ilCloTy, _, _, _) -> + | Env (ilCloTy, _, _) -> CG.EmitInstr cgbuf (pop 0) (Push [ilCloTy]) mkLdarg0 | _ -> () @@ -6052,9 +6318,9 @@ and GenSetVal cenv cgbuf eenv (vref, e, m) sequel = GenSetStorage vref.Range cgbuf storage GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel -and GenGetValRefAndSequel cenv cgbuf eenv m (v: ValRef) fetchSequel = +and GenGetValRefAndSequel cenv cgbuf eenv m (v: ValRef) storeSequel = let ty = v.Type - GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv.amap m eenv.tyenv ty) (StorageForValRef cenv.g m v eenv) fetchSequel + GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv.amap m eenv.tyenv ty) (StorageForValRef cenv.g m v eenv) storeSequel and GenGetVal cenv cgbuf eenv (v: ValRef, m) sequel = GenGetValRefAndSequel cenv cgbuf eenv m v None @@ -6113,7 +6379,7 @@ and GenSetStorage m cgbuf storage = | StaticProperty (ilGetterMethSpec, _) -> error(Error(FSComp.SR.ilStaticMethodIsNotLambda(ilGetterMethSpec.Name), m)) - | Method (_, _, mspec, m, _, _, _) -> + | Method (_, _, mspec, _, m, _, _, _, _, _, _, _) -> error(Error(FSComp.SR.ilStaticMethodIsNotLambda(mspec.Name), m)) | Null -> @@ -6122,23 +6388,28 @@ and GenSetStorage m cgbuf storage = | Arg _ -> error(Error(FSComp.SR.ilMutableVariablesCannotEscapeMethod(), m)) - | Env (_, _, ilField, _) -> + | Env (_, ilField, _) -> // Note: ldarg0 has already been emitted in GenSetVal CG.EmitInstr cgbuf (pop 2) Push0 (mkNormalStfld ilField) and CommitGetStorageSequel cenv cgbuf eenv m ty localCloInfo storeSequel = match localCloInfo, storeSequel with - | Some {contents =NamedLocalIlxClosureInfoGenerator _cloinfo}, _ -> error(InternalError("Unexpected generator", m)) + | Some {contents =NamedLocalIlxClosureInfoGenerator _cloinfo}, _ -> + error(InternalError("Unexpected generator", m)) + | Some {contents =NamedLocalIlxClosureInfoGenerated cloinfo}, Some (tyargs, args, m, sequel) when not (isNil tyargs) -> let actualRetTy = GenNamedLocalTyFuncCall cenv cgbuf eenv ty cloinfo tyargs m CommitGetStorageSequel cenv cgbuf eenv m actualRetTy None (Some ([], args, m, sequel)) + | _, None -> () + | _, Some ([], [], _, sequel) -> GenSequel cenv eenv.cloc cgbuf sequel + | _, Some (tyargs, args, m, sequel) -> - GenArgsAndIndirectCall cenv cgbuf eenv (ty, tyargs, args, m) sequel + GenCurriedArgsAndIndirectCall cenv cgbuf eenv (ty, tyargs, args, m) sequel -and GenGetStorageAndSequel cenv cgbuf eenv m (ty, ilTy) storage storeSequel = +and GenGetStorageAndSequel (cenv: cenv) cgbuf eenv m (ty, ilTy) storage storeSequel = let g = cenv.g match storage with | Local (idx, _, localCloInfo) -> @@ -6157,7 +6428,7 @@ and GenGetStorageAndSequel cenv cgbuf eenv m (ty, ilTy) storage storeSequel = CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (I_call (Normalcall, ilGetterMethSpec, None)) CommitGetStorageSequel cenv cgbuf eenv m ty None storeSequel - | Method (topValInfo, vref, mspec, _, _, _, _) -> + | Method (topValInfo, vref, _, _, _, _, _, _, _, _, _, _) -> // Get a toplevel value as a first-class value. // We generate a lambda expression and that simply calls // the toplevel method. However we optimize the case where we are @@ -6173,8 +6444,8 @@ and GenGetStorageAndSequel cenv cgbuf eenv m (ty, ilTy) storage storeSequel = GenLambda cenv cgbuf eenv false [] expr Continue | Some (tyargs', args, m, sequel) -> let specializedExpr = - if isNil args && isNil tyargs' then failwith ("non-lambda at use of method " + mspec.Name) - MakeApplicationAndBetaReduce g (expr, exprty, [tyargs'], args, m) + if isNil args && isNil tyargs' then failwith ("non-lambda at use of method " + vref.LogicalName) + MakeApplicationAndBetaReduce cenv.g (expr, exprty, [tyargs'], args, m) GenExpr cenv cgbuf eenv SPSuppress specializedExpr sequel | Null -> @@ -6185,7 +6456,7 @@ and GenGetStorageAndSequel cenv cgbuf eenv m (ty, ilTy) storage storeSequel = CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdarg (uint16 i)) CommitGetStorageSequel cenv cgbuf eenv m ty None storeSequel - | Env (_, _, ilField, localCloInfo) -> + | Env (_, ilField, localCloInfo) -> // Note: ldarg 0 is emitted in 'cu_erase' erasure of the ldenv instruction CG.EmitInstrs cgbuf (pop 0) (Push [ilTy]) [ mkLdarg0; mkNormalLdfld ilField ] CommitGetStorageSequel cenv cgbuf eenv m ty localCloInfo storeSequel @@ -6193,11 +6464,11 @@ and GenGetStorageAndSequel cenv cgbuf eenv m (ty, ilTy) storage storeSequel = and GenGetLocalVals cenv cgbuf eenvouter m fvs = List.iter (fun v -> GenGetLocalVal cenv cgbuf eenvouter m v None) fvs -and GenGetLocalVal cenv cgbuf eenv m (vspec: Val) fetchSequel = - GenGetStorageAndSequel cenv cgbuf eenv m (vspec.Type, GenTypeOfVal cenv eenv vspec) (StorageForVal cenv.g m vspec eenv) fetchSequel +and GenGetLocalVal cenv cgbuf eenv m (vspec: Val) storeSequel = + GenGetStorageAndSequel cenv cgbuf eenv m (vspec.Type, GenTypeOfVal cenv eenv vspec) (StorageForVal cenv.g m vspec eenv) storeSequel -and GenGetLocalVRef cenv cgbuf eenv m (vref: ValRef) fetchSequel = - GenGetStorageAndSequel cenv cgbuf eenv m (vref.Type, GenTypeOfVal cenv eenv vref.Deref) (StorageForValRef cenv.g m vref eenv) fetchSequel +and GenGetLocalVRef cenv cgbuf eenv m (vref: ValRef) storeSequel = + GenGetStorageAndSequel cenv cgbuf eenv m (vref.Type, GenTypeOfVal cenv eenv vref.Deref) (StorageForValRef cenv.g m vref eenv) storeSequel and GenStoreVal cenv cgbuf eenv m (vspec: Val) = GenSetStorage vspec.Range cgbuf (StorageForVal cenv.g m vspec eenv) @@ -6254,7 +6525,7 @@ and AllocStorageForBinds cenv cgbuf scopeMarks eenv binds = | Some repr -> match repr with | Local(_, _, Some g) - | Env(_, _, _, Some g) -> + | Env(_, _, Some g) -> match !g with | NamedLocalIlxClosureInfoGenerator f -> g := NamedLocalIlxClosureInfoGenerated (f eenv) | NamedLocalIlxClosureInfoGenerated _ -> () @@ -6416,7 +6687,7 @@ and GenAttr amap g eenv (Attrib(_, k, args, props, _, _, _)) = | ILAttrib mref -> mkILMethSpec(mref, AsObject, [], []) | FSAttrib vref -> assert(vref.IsMember) - let mspec, _, _, _, _, _ = GetMethodSpecForMemberVal amap g (Option.get vref.MemberInfo) vref + let mspec, _, _, _, _, _, _, _, _ = GetMethodSpecForMemberVal amap g (Option.get vref.MemberInfo) vref mspec let ilArgs = List.map2 (fun (AttribExpr(_, vexpr)) ty -> GenAttribArg amap g eenv vexpr ty) args mspec.FormalArgTypes mkILCustomAttribMethRef g.ilg (mspec, ilArgs, props) @@ -6734,6 +7005,24 @@ and GenFieldInit m c = | ConstToILFieldInit fieldInit -> fieldInit | _ -> error(Error(FSComp.SR.ilTypeCannotBeUsedForLiteralField(), m)) +and GenWitnessParams cenv eenv m (witnessInfos: TraitWitnessInfos) = + ((Set.empty, 0), witnessInfos) ||> List.mapFold (fun (used,i) witnessInfo -> + let ty = GenWitnessTy cenv.g witnessInfo + let nm = String.uncapitalize witnessInfo.MemberName + let nm = if used.Contains nm then nm + string i else nm + let ilParam = + { Name=Some nm + Type= GenType cenv.amap m eenv.tyenv ty + Default=None + Marshal=None + IsIn=false + IsOut=false + IsOptional=false + CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs []) + MetadataIndex = NoMetadataIdx }: ILParameter + ilParam, (used.Add nm, i + 1)) + |> fst + and GenAbstractBinding cenv eenv tref (vref: ValRef) = assert(vref.IsMember) let g = cenv.g @@ -6746,11 +7035,15 @@ and GenAbstractBinding cenv eenv tref (vref: ValRef) = [ yield! GenAttrs cenv eenv attribs yield! GenCompilationArgumentCountsAttr cenv vref.Deref ] - let mspec, ctps, mtps, argInfos, retInfo, methodArgTys = GetMethodSpecForMemberVal cenv.amap g memberInfo vref + let mspec, _mspecW, ctps, mtps, _curriedArgInfos, argInfos, retInfo, witnessInfos, methArgTys = + GetMethodSpecForMemberVal cenv.amap cenv.g memberInfo vref + + assert witnessInfos.IsEmpty + let eenvForMeth = EnvForTypars (ctps@mtps) eenv let ilMethTypars = GenGenericParams cenv eenvForMeth mtps let ilReturn = GenReturnInfo cenv eenvForMeth mspec.FormalReturnType retInfo - let ilParams = GenParams cenv eenvForMeth mspec argInfos methodArgTys None + let ilParams = GenParams cenv eenvForMeth m mspec [] argInfos methArgTys None let compileAsInstance = ValRefIsCompiledAsInstanceMember g vref let mdef = mkILGenericVirtualMethod (vref.CompiledName g.CompilerGlobalState, ILMemberAccess.Public, ilMethTypars, ilParams, ilReturn, MethodBody.Abstract) @@ -6796,7 +7089,7 @@ and GenToStringMethod cenv eenv ilThisTy m = let g = cenv.g [ match (eenv.valsInScope.TryFind g.sprintf_vref.Deref, eenv.valsInScope.TryFind g.new_format_vref.Deref) with - | Some(Lazy(Method(_, _, sprintfMethSpec, _, _, _, _))), Some(Lazy(Method(_, _, newFormatMethSpec, _, _, _, _))) -> + | Some(Lazy(Method(_, _, sprintfMethSpec, _, _, _, _, _, _, _, _, _))), Some(Lazy(Method(_, _, newFormatMethSpec, _, _, _, _, _, _, _, _, _))) -> // The type returned by the 'sprintf' call let funcTy = EraseClosures.mkILFuncTy g.ilxPubCloEnv ilThisTy g.ilg.typ_String // Give the instantiation of the printf format object, i.e. a Format`5 object compatible with StringFormat @@ -7127,7 +7420,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let (|Lazy|) (x: Lazy<_>) = x.Force() match (eenv.valsInScope.TryFind g.sprintf_vref.Deref, eenv.valsInScope.TryFind g.new_format_vref.Deref) with - | Some(Lazy(Method(_, _, sprintfMethSpec, _, _, _, _))), Some(Lazy(Method(_, _, newFormatMethSpec, _, _, _, _))) -> + | Some(Lazy(Method(_, _, sprintfMethSpec, _, _, _, _, _, _, _, _, _))), Some(Lazy(Method(_, _, newFormatMethSpec, _, _, _, _, _, _, _, _, _))) -> // The type returned by the 'sprintf' call let funcTy = EraseClosures.mkILFuncTy g.ilxPubCloEnv ilThisTy g.ilg.typ_String // Give the instantiation of the printf format object, i.e. a Format`5 object compatible with StringFormat @@ -7571,12 +7864,13 @@ let CodegenAssembly cenv eenv mgbuf fileImpls = // structures representing the contents of the module. //------------------------------------------------------------------------- -let GetEmptyIlxGenEnv (ilg: ILGlobals) ccu = +let GetEmptyIlxGenEnv (g: TcGlobals) ccu = let thisCompLoc = CompLocForCcu ccu { tyenv=TypeReprEnv.Empty cloc = thisCompLoc valsInScope=ValMap<_>.Empty - someTypeInThisAssembly=ilg.typ_Object (* dummy value *) + witnessesInScope = EmptyTraitWitnessInfoHashMap g + someTypeInThisAssembly= g.ilg.typ_Object // dummy value isFinalFile = false letBoundVars=[] liveLocals=IntMap.empty() @@ -7619,7 +7913,8 @@ let GenerateCode (cenv, anonTypeTable, eenv, TypedAssemblyAfterOptimization file match reflectedDefinitions with | [] -> [] | _ -> - let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, QuotationTranslator.IsReflectedDefinition.Yes) + // TODO: generate witness parameters for reflected definitions + let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, cenv.tcVal, QuotationTranslator.IsReflectedDefinition.Yes) let defns = reflectedDefinitions |> List.choose (fun ((methName, v), e) -> try @@ -7629,12 +7924,12 @@ let GenerateCode (cenv, anonTypeTable, eenv, TypedAssemblyAfterOptimization file with | QuotationTranslator.InvalidQuotedTerm e -> warning e; None) - let referencedTypeDefs, freeTypes, spliceArgExprs = qscope.Close() + let referencedTypeDefs, typeSplices, exprSplices = qscope.Close() - for (_freeType, m) in freeTypes do + for (_typeSplice, m) in typeSplices do error(InternalError("A free type variable was detected in a reflected definition", m)) - for (_spliceArgExpr, m) in spliceArgExprs do + for (_exprSplice, m) in exprSplices do error(Error(FSComp.SR.ilReflectedDefinitionsCannotUseSliceOperator(), m)) let defnsResourceBytes = defns |> QuotationPickler.PickleDefns @@ -7755,7 +8050,7 @@ let ClearGeneratedValue (ctxt: ExecutionContext) (g: TcGlobals) eenv (v: Val) = type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: ConstraintSolver.TcValF, ccu: CcuThunk) = // The incremental state held by the ILX code generator - let mutable ilxGenEnv = GetEmptyIlxGenEnv tcGlobals.ilg ccu + let mutable ilxGenEnv = GetEmptyIlxGenEnv tcGlobals ccu let anonTypeTable = AnonTypeGenerationTable() let intraAssemblyInfo = { StaticFieldInfo = new Dictionary<_, _>(HashIdentity.Structural) } let casApplied = new Dictionary() @@ -7773,7 +8068,7 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: Constrai member __.GenerateCode (codeGenOpts, typedAssembly, assemAttribs, moduleAttribs) = let cenv: cenv = { g=tcGlobals - TcVal = tcVal + tcVal = tcVal viewCcu = ccu ilUnitTy = None amap = amap diff --git a/src/fsharp/LanguageFeatures.fs b/src/fsharp/LanguageFeatures.fs index 05572cfb9e9..83172b8605b 100644 --- a/src/fsharp/LanguageFeatures.fs +++ b/src/fsharp/LanguageFeatures.fs @@ -31,6 +31,7 @@ type LanguageFeature = | AndBang | NullableOptionalInterop | DefaultInterfaceMemberConsumption + | WitnessPassing /// LanguageVersion management type LanguageVersion (specifiedVersionAsString) = @@ -67,6 +68,7 @@ type LanguageVersion (specifiedVersionAsString) = LanguageFeature.AndBang, previewVersion LanguageFeature.NullableOptionalInterop, previewVersion LanguageFeature.DefaultInterfaceMemberConsumption, previewVersion + LanguageFeature.WitnessPassing, previewVersion ] let specified = @@ -135,6 +137,7 @@ type LanguageVersion (specifiedVersionAsString) = | LanguageFeature.AndBang -> FSComp.SR.featureAndBang() | LanguageFeature.NullableOptionalInterop -> FSComp.SR.featureNullableOptionalInterop() | LanguageFeature.DefaultInterfaceMemberConsumption -> FSComp.SR.featureDefaultInterfaceMemberConsumption() + | LanguageFeature.WitnessPassing -> FSComp.SR.featureWitnessPassing() /// Get a version string associated with the given feature. member _.GetFeatureVersionString feature = diff --git a/src/fsharp/LanguageFeatures.fsi b/src/fsharp/LanguageFeatures.fsi index fd367388bdd..5eb13e885a9 100644 --- a/src/fsharp/LanguageFeatures.fsi +++ b/src/fsharp/LanguageFeatures.fsi @@ -19,6 +19,7 @@ type LanguageFeature = | AndBang | NullableOptionalInterop | DefaultInterfaceMemberConsumption + | WitnessPassing /// LanguageVersion management type LanguageVersion = diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index 2883a525167..5641a09297b 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -1821,19 +1821,22 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = | FSAnonRecdFieldSln(anonInfo, tinst, i) -> Choice3Of5 (anonInfo, tinst, i) + | ClosedExprSln expr -> + Choice4Of5 expr + | BuiltInSln -> Choice5Of5 () - | ClosedExprSln expr -> - Choice4Of5 expr match sln with | Choice1Of5(minfo, methArgTys) -> let argExprs = - // FIX for #421894 - typechecker assumes that coercion can be applied for the trait calls arguments but codegen doesn't emit coercion operations + // FIX for #421894 - typechecker assumes that coercion can be applied for the trait + // calls arguments but codegen doesn't emit coercion operations // result - generation of non-verifiable code // fix - apply coercion for the arguments (excluding 'receiver' argument in instance calls) - // flatten list of argument types (looks like trait calls with curried arguments are not supported so we can just convert argument list in straightforward way) + // flatten list of argument types (looks like trait calls with curried arguments are not supported so + // we can just convert argument list in straight-forward way) let argTypes = minfo.GetParamTypes(amap, m, methArgTys) |> List.concat @@ -1854,13 +1857,12 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = if minfo.IsStruct && minfo.IsInstance && (match argExprs with [] -> false | h :: _ -> not (isByrefTy g (tyOfExpr g h))) then let h, t = List.headAndTail argExprs let wrap, h', _readonly, _writeonly = mkExprAddrOfExpr g true false PossiblyMutates h None m - Some (wrap (Expr.Op (TOp.TraitCall (traitInfo), [], (h' :: t), m))) + Some (wrap (Expr.Op (TOp.TraitCall traitInfo, [], (h' :: t), m))) else Some (MakeMethInfoCall amap m minfo methArgTys argExprs ) | Choice2Of5 (tinst, rfref, isSet) -> match isSet, rfref.RecdField.IsStatic, argExprs.Length with - // static setter | true, true, 1 -> Some (mkStaticRecdFieldSet (rfref, tinst, argExprs.[0], m)) @@ -1878,14 +1880,15 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = // static getter | false, true, 0 -> - Some (mkStaticRecdFieldGet (rfref, tinst, m)) + Some (mkStaticRecdFieldGet (rfref, tinst, m)) // instance getter | false, false, 1 -> - if rfref.Tycon.IsStructOrEnumTycon && isByrefTy g (tyOfExpr g argExprs.[0]) then - Some (mkRecdFieldGetViaExprAddr (argExprs.[0], rfref, tinst, m)) - else - Some (mkRecdFieldGet g (argExprs.[0], rfref, tinst, m)) + if rfref.Tycon.IsStructOrEnumTycon && isByrefTy g (tyOfExpr g argExprs.[0]) then + Some (mkRecdFieldGetViaExprAddr (argExprs.[0], rfref, tinst, m)) + else + Some (mkRecdFieldGet g (argExprs.[0], rfref, tinst, m)) + | _ -> None | Choice3Of5 (anonInfo, tinst, i) -> @@ -1895,8 +1898,34 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = else Some (mkAnonRecdFieldGet g (anonInfo, argExprs.[0], tinst, i, m)) - | Choice4Of5 expr -> + | Choice4Of5 expr -> Some (MakeApplicationAndBetaReduce g (expr, tyOfExpr g expr, [], argExprs, m)) - | Choice5Of5 () -> - None + | Choice5Of5 () -> + match traitInfo.Solution with + | None -> None // the trait has been generalized + | Some _-> + // For these operators, the witness is just a call to the coresponding FSharp.Core operator + match g.tryMakeOperatorAsBuiltInWitnessInfo isStringTy isArrayTy traitInfo argExprs with + | Some (info, tyargs, actualArgExprs) -> + tryMkCallCoreFunctionAsBuiltInWitness g info tyargs actualArgExprs m + | None -> + // For all other built-in operators, the witness is a call to the coresponding BuiltInWitnesses operator + // These are called as F# methods not F# functions + tryMkCallBuiltInWitness g traitInfo argExprs m + +/// Generate a lambda expression for the given solved trait. +let GenWitnessExprLambda amap g m (traitInfo: TraitConstraintInfo) = + let witnessInfo = traitInfo.TraitKey + let argtysl = GenWitnessArgTys g witnessInfo + let vse = argtysl |> List.mapiSquared (fun i j ty -> mkCompGenLocal m ("arg" + string i + "_" + string j) ty) + let vsl = List.mapSquared fst vse + match GenWitnessExpr amap g m traitInfo (List.concat (List.mapSquared snd vse)) with + | Some expr -> + Choice2Of2 (mkMemberLambdas m [] None None vsl (expr, tyOfExpr g expr)) + | None -> + Choice1Of2 witnessInfo + +/// Generate the arguments passed for a set of (solved) traits in non-generic code +let GenWitnessArgs amap g m (traitInfos: TraitConstraintInfo list) = + [ for traitInfo in traitInfos -> GenWitnessExprLambda amap g m traitInfo ] diff --git a/src/fsharp/MethodOverrides.fs b/src/fsharp/MethodOverrides.fs index 629a5435d0f..676a69e38ff 100644 --- a/src/fsharp/MethodOverrides.fs +++ b/src/fsharp/MethodOverrides.fs @@ -114,7 +114,7 @@ module DispatchSlotChecking = /// Get the override info for a value being used to implement a dispatch slot. let GetTypeMemberOverrideInfo g reqdTy (overrideBy: ValRef) = - let _, argInfos, retTy, _ = GetTypeOfMemberInMemberForm g overrideBy + let _, _, argInfos, retTy, _ = GetTypeOfMemberInMemberForm g overrideBy let nm = overrideBy.LogicalName let argTys = argInfos |> List.mapSquared fst @@ -153,7 +153,7 @@ module DispatchSlotChecking = /// Get the override information for an object expression method being used to implement dispatch slots let GetObjectExprOverrideInfo g amap (implty, id: Ident, memberFlags, ty, arityInfo, bindingAttribs, rhsExpr) = // Dissect the type - let tps, argInfos, retTy, _ = GetMemberTypeInMemberForm g memberFlags arityInfo ty id.idRange + let tps, _, argInfos, retTy, _ = GetMemberTypeInMemberForm g memberFlags arityInfo 0 ty id.idRange let argTys = argInfos |> List.mapSquared fst // Dissect the implementation let _, ctorThisValOpt, baseValOpt, vsl, rhsExpr, _ = destTopLambda g amap arityInfo (rhsExpr, ty) diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index 84b2904ad52..6b4f1609462 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -669,7 +669,7 @@ module private PrintTypes = PrintIL.layoutILTypeRef denv tref ++ argsL | FSAttrib vref -> // REVIEW: this is not trimming "Attribute" - let _, _, rty, _ = GetTypeOfMemberInMemberForm denv.g vref + let _, _, _, rty, _ = GetTypeOfMemberInMemberForm denv.g vref let rty = GetFSharpViewOfReturnType denv.g rty let tcref = tcrefOfAppTy denv.g rty layoutTyconRef denv tcref ++ argsL @@ -717,7 +717,7 @@ module private PrintTypes = PrintIL.layoutILType denv [] ty ++ argsL /// Layout '[]' above another block - and layoutAttribs denv ty kind attrs restL = + and layoutAttribs denv isValue ty kind attrs restL = if denv.showAttributes then // Don't display DllImport attributes in generated signatures @@ -735,8 +735,9 @@ module private PrintTypes = | _ -> squareAngleL (sepListL (rightL (tagPunctuation ";")) (List.map (layoutAttrib denv) attrs)) @@ restL - elif isStructRecordOrUnionTyconTy denv.g ty || - ((isUnionTy denv.g ty || isRecdTy denv.g ty) && HasFSharpAttribute denv.g denv.g.attrib_StructAttribute attrs) then + elif not isValue && + (isStructRecordOrUnionTyconTy denv.g ty || + ((isUnionTy denv.g ty || isRecdTy denv.g ty) && HasFSharpAttribute denv.g denv.g.attrib_StructAttribute attrs)) then squareAngleL (wordL (tagClass "Struct")) @@ restL else match kind with @@ -1345,7 +1346,7 @@ module private PrintTastMemberOrVals = prettyTyparInst, resL | Some _ -> prettyLayoutOfMember denv typarInst v - prettyTyparInst, layoutAttribs denv v.Type TyparKind.Type v.Attribs vL + prettyTyparInst, layoutAttribs denv true v.Type TyparKind.Type v.Attribs vL let prettyLayoutOfValOrMemberNoInst denv v = prettyLayoutOfValOrMember denv emptyTyparInst v |> snd @@ -1950,7 +1951,7 @@ module private TastDefinitionPrinting = | Some a -> (lhsL ^^ WordL.equals) --- (layoutType { denv with shortTypeNames = false } a) - layoutAttribs denv ty tycon.TypeOrMeasureKind tycon.Attribs reprL + layoutAttribs denv false ty tycon.TypeOrMeasureKind tycon.Attribs reprL // Layout: exception definition let layoutExnDefn denv (exnc: Entity) = diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index f1c86005ad7..ff3d998f013 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -135,16 +135,33 @@ type ValInfos(entries) = t.Add (vref.Deref, (vref, x)) t) - // The compiler ValRef's into fslib stored in env.fs break certain invariants that hold elsewhere, + // The compiler's ValRef's in TcGlobals.fs that refer to things in FSharp.Core break certain invariants that hold elsewhere, // because they dereference to point to Val's from signatures rather than Val's from implementations. - // Thus a backup alternative resolution technique is needed for these. + // Thus a backup alternative resolution technique is needed for these when processing the FSharp.Core implementation files + // holding these items. This resolution must be able to distinguish between overloaded methods, so we use + // XmlDocSigOfVal as a cheap hack to get a unique item of data for a value. let valInfosForFslib = - lazy ( - let dict = Dictionary<_, _>() + LazyWithContext<_, TcGlobals>.Create ((fun g -> + let dict = + Dictionary<(ValRef * ValLinkageFullKey), (ValRef * ValInfo)> + (HashIdentity.FromFunctions + (fun (_: ValRef, k: ValLinkageFullKey) -> hash k.PartialKey) + (fun (v1, k1) (v2, k2) -> + k1.PartialKey = k2.PartialKey && + // dismbiguate overloads, somewhat low-perf but only use for a handful of overloads in FSharp.Core + match k1.TypeForLinkage, k2.TypeForLinkage with + | Some _, Some _ -> + let sig1 = XmlDocSigOfVal g true "" v1.Deref + let sig2 = XmlDocSigOfVal g true "" v2.Deref + (sig1 = sig2) + | None, None -> true + | _ -> false)) for (vref, _x) as p in entries do - let vkey = vref.Deref.GetLinkagePartialKey() + let vkey = (vref, vref.Deref.GetLinkageFullKey()) + if dict.ContainsKey vkey then + failwithf "dictionary already contains key %A" vkey dict.Add(vkey, p) |> ignore - dict) + dict), id) member x.Entries = valInfoTable.Force().Values @@ -154,7 +171,8 @@ type ValInfos(entries) = member x.TryFind (v: ValRef) = valInfoTable.Force().TryFind v.Deref - member x.TryFindForFslib (v: ValRef) = valInfosForFslib.Force().TryGetValue(v.Deref.GetLinkagePartialKey()) + member x.TryFindForFslib (g, vref: ValRef) = + valInfosForFslib.Force(g).TryGetValue((vref, vref.Deref.GetLinkageFullKey())) type ModuleInfo = { ValInfos: ValInfos @@ -621,7 +639,7 @@ let GetInfoForNonLocalVal cenv env (vref: ValRef) = //dprintn ("\n\n*** Optimization info for value "+n+" from module "+(full_name_of_nlpath smv)+" not found, module contains values: "+String.concat ", " (NameMap.domainL structInfo.ValInfos)) //System.Diagnostics.Debug.Assert(false, sprintf "Break for module %s, value %s" (full_name_of_nlpath smv) n) if cenv.g.compilingFslib then - match structInfo.ValInfos.TryFindForFslib vref with + match structInfo.ValInfos.TryFindForFslib (cenv.g, vref) with | true, ninfo -> snd ninfo | _ -> UnknownValInfo else @@ -2421,7 +2439,7 @@ and OptimizeWhileLoop cenv env (spWhile, marker, e1, e2, m) = and OptimizeTraitCall cenv env (traitInfo, args, m) = // Resolve the static overloading early (during the compulsory rewrite phase) so we can inline. - match ConstraintSolver.CodegenWitnessThatTypeSupportsTraitConstraint cenv.TcVal cenv.g cenv.amap m traitInfo args with + match ConstraintSolver.CodegenWitnessForTraitConstraint cenv.TcVal cenv.g cenv.amap m traitInfo args with | OkResult (_, Some expr) -> OptimizeExpr cenv env expr @@ -2957,7 +2975,6 @@ and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = let expr2 = mkMemberLambdas m tps ctorThisValOpt None vsl (bodyR, bodyty) CurriedLambdaValue (lambdaId, arities, bsize, expr2, ety) - let estimatedSize = match vspec with | Some v when v.IsCompiledAsTopLevel -> methodDefnTotalSize diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index 711bae6cbbc..5b61f1e3bd7 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -214,9 +214,12 @@ type cenv = isInternalTestSpanStackReferring: bool // outputs - mutable usesQuotations : bool + mutable usesQuotations: bool - mutable entryPointGiven: bool } + mutable entryPointGiven: bool + + /// Callback required for quotation generation + tcVal: ConstraintSolver.TcValF } override x.ToString() = "" @@ -971,9 +974,9 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi if cenv.reportErrors then cenv.usesQuotations <- true - // Translate to quotation data + // Translate the quotation to quotation data try - let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, QuotationTranslator.IsReflectedDefinition.No) + let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, cenv.tcVal, QuotationTranslator.IsReflectedDefinition.No) let qdata = QuotationTranslator.ConvExprPublic qscope ast let typeDefs, spliceTypes, spliceExprs = qscope.Close() match savedConv.Value with @@ -1749,15 +1752,16 @@ and CheckBinding cenv env alwaysCheckNoReraise context (TBind(v, bindRhs, _) as match v.ReflectedDefinition with | None -> v.SetValDefn bindRhs | Some _ -> () + // Run the conversion process over the reflected definition to report any errors in the // front end rather than the back end. We currently re-run this during ilxgen.fs but there's // no real need for that except that it helps us to bundle all reflected definitions up into // one blob for pickling to the binary format try - let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, QuotationTranslator.IsReflectedDefinition.Yes) + let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, cenv.tcVal, QuotationTranslator.IsReflectedDefinition.Yes) let methName = v.CompiledName g.CompilerGlobalState QuotationTranslator.ConvReflectedDefinition qscope methName v bindRhs |> ignore - + let _, _, exprSplices = qscope.Close() if not (isNil exprSplices) then errorR(Error(FSComp.SR.chkReflectedDefCantSplice(), v.Range)) @@ -2293,7 +2297,7 @@ and CheckModuleSpec cenv env x = let env = { env with reflect = env.reflect || HasFSharpAttribute cenv.g cenv.g.attrib_ReflectedDefinitionAttribute mspec.Attribs } CheckDefnInModule cenv env rhs -let CheckTopImpl (g, amap, reportErrors, infoReader, internalsVisibleToPaths, viewCcu, denv, mexpr, extraAttribs, (isLastCompiland: bool*bool), isInternalTestSpanStackReferring) = +let CheckTopImpl (g, amap, reportErrors, infoReader, internalsVisibleToPaths, viewCcu, tcVal, denv, mexpr, extraAttribs, (isLastCompiland: bool*bool), isInternalTestSpanStackReferring) = let cenv = { g =g reportErrors=reportErrors @@ -2309,6 +2313,7 @@ let CheckTopImpl (g, amap, reportErrors, infoReader, internalsVisibleToPaths, vi viewCcu= viewCcu isLastCompiland=isLastCompiland isInternalTestSpanStackReferring = isInternalTestSpanStackReferring + tcVal = tcVal entryPointGiven=false} // Certain type equality checks go faster if these TyconRefs are pre-resolved. @@ -2336,6 +2341,6 @@ let CheckTopImpl (g, amap, reportErrors, infoReader, internalsVisibleToPaths, vi CheckModuleExpr cenv env mexpr CheckAttribs cenv env extraAttribs - if cenv.usesQuotations && QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat g = QuotationTranslator.QuotationSerializationFormat.FSharp_20_Plus then + if cenv.usesQuotations && not (QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat(g).SupportsDeserializeEx) then viewCcu.UsesFSharp20PlusQuotations <- true cenv.entryPointGiven, cenv.anonRecdTypes diff --git a/src/fsharp/PostInferenceChecks.fsi b/src/fsharp/PostInferenceChecks.fsi index 312da640278..95647603e56 100644 --- a/src/fsharp/PostInferenceChecks.fsi +++ b/src/fsharp/PostInferenceChecks.fsi @@ -18,6 +18,7 @@ val CheckTopImpl: infoReader: InfoReader * internalsVisibleToPaths: CompilationPath list * viewCcu: CcuThunk * + tcValF: ConstraintSolver.TcValF * denv: DisplayEnv * mexpr: ModuleOrNamespaceExprWithSig * extraAttribs: Attribs * (bool * bool) * diff --git a/src/fsharp/PrettyNaming.fs b/src/fsharp/PrettyNaming.fs index dc3ca573ac2..89c841ea40b 100755 --- a/src/fsharp/PrettyNaming.fs +++ b/src/fsharp/PrettyNaming.fs @@ -713,6 +713,7 @@ let computeMangledNameWithoutDefaultArgValues(nm, staticArgs, defaultArgValues) let outArgCompilerGeneratedName = "outArg" +let ExtraWitnessMethodName nm = nm + "$W" /// Reuses generated union case field name objects for common field numbers let mkUnionCaseFieldName = diff --git a/src/fsharp/QuotationPickler.fs b/src/fsharp/QuotationPickler.fs index 0929b14f6c5..a99ad7298a3 100644 --- a/src/fsharp/QuotationPickler.fs +++ b/src/fsharp/QuotationPickler.fs @@ -51,6 +51,7 @@ type CombOp = | AppOp | CondOp | ModuleValueOp of NamedTypeData * string * bool + | ModuleValueWOp of NamedTypeData * string * bool * string * int | LetRecOp | LetRecCombOp | LetOp @@ -80,6 +81,7 @@ type CombOp = | FieldGetOp of NamedTypeData * string | CtorCallOp of CtorData | MethodCallOp of MethodData + | MethodCallWOp of MethodData * MethodData * int | CoerceOp | NewArrayOp | DelegateOp @@ -97,7 +99,6 @@ type CombOp = | TryFinallyOp | TryWithOp - /// Represents specifications of a subset of F# expressions type ExprData = | AttrExpr of ExprData * ExprData list @@ -123,7 +124,11 @@ let mkQuoteRaw40 (a) = QuoteRawExpr (a) let mkCond (x1, x2, x3) = CombExpr(CondOp, [], [x1;x2;x3]) -let mkModuleValueApp (tcref, nm, isProp, tyargs, args: ExprData list list) = CombExpr(ModuleValueOp(tcref, nm, isProp), tyargs, List.concat args) +let mkModuleValueApp (tcref, nm, isProp, tyargs, args: ExprData list) = + CombExpr(ModuleValueOp(tcref, nm, isProp), tyargs, args) + +let mkModuleValueWApp (tcref, nm, isProp, nmW, nWitnesses, tyargs, args: ExprData list) = + CombExpr(ModuleValueWOp(tcref, nm, isProp, nmW, nWitnesses), tyargs, args) let mkTuple (ty, x) = CombExpr(TupleMkOp, [ty], x) @@ -221,6 +226,8 @@ let mkCtorCall (d, tyargs, args) = CombExpr(CtorCallOp(d), tyargs, args) let mkMethodCall (d, tyargs, args) = CombExpr(MethodCallOp(d), tyargs, args) +let mkMethodCallW (d1, d2, d3, tyargs, args) = CombExpr(MethodCallWOp(d1, d2, d3), tyargs, args) + let mkAttributedExpression(e, attr) = AttrExpr(e, [attr]) let isAttributedExpression e = match e with AttrExpr(_, _) -> true | _ -> false @@ -458,6 +465,18 @@ let p_CombOp x st = | TryFinallyOp -> p_byte 47 st | TryWithOp -> p_byte 48 st | ExprSetOp -> p_byte 49 st + | MethodCallWOp (a, b, c) -> + p_byte 50 st + p_MethodData a st + p_MethodData b st + p_int c st + | ModuleValueWOp (x, y, z, nmW, nWitnesses) -> + p_byte 51 st + p_string nmW st + p_int nWitnesses st + p_NamedType x st + p_string y st + p_bool z st let rec p_expr x st = match x with @@ -476,7 +495,7 @@ type ModuleDefnData = IsProperty: bool } type MethodBaseData = - | ModuleDefn of ModuleDefnData + | ModuleDefn of ModuleDefnData * (string * int) option | Method of MethodData | Ctor of CtorData @@ -484,11 +503,18 @@ let pickle = pickle_obj p_expr let p_MethodBase x st = match x with - | ModuleDefn md -> + | ModuleDefn (md, None) -> p_byte 0 st p_NamedType md.Module st p_string md.Name st p_bool md.IsProperty st + | ModuleDefn (md, Some (nmW, nWitnesses)) -> + p_byte 3 st + p_string nmW st + p_int nWitnesses st + p_NamedType md.Module st + p_string md.Name st + p_bool md.IsProperty st | Method md -> p_byte 1 st p_MethodData md st diff --git a/src/fsharp/QuotationPickler.fsi b/src/fsharp/QuotationPickler.fsi index f5a408e7d6f..0767709238d 100644 --- a/src/fsharp/QuotationPickler.fsi +++ b/src/fsharp/QuotationPickler.fsi @@ -47,7 +47,7 @@ type ModuleDefnData = IsProperty: bool } type MethodBaseData = - | ModuleDefn of ModuleDefnData + | ModuleDefn of ModuleDefnData * (string * int) option | Method of MethodData | Ctor of CtorData @@ -61,7 +61,8 @@ val mkLambda : VarData * ExprData -> ExprData val mkQuote : ExprData -> ExprData val mkQuoteRaw40 : ExprData -> ExprData // only available for FSharp.Core 4.4.0.0+ val mkCond : ExprData * ExprData * ExprData -> ExprData -val mkModuleValueApp : NamedTypeData * string * bool * TypeData list * ExprData list list -> ExprData +val mkModuleValueApp : NamedTypeData * string * bool * TypeData list * ExprData list -> ExprData +val mkModuleValueWApp : NamedTypeData * string * bool * string * int * TypeData list * ExprData list -> ExprData val mkLetRec : (VarData * ExprData) list * ExprData -> ExprData val mkLet : (VarData * ExprData) * ExprData -> ExprData val mkRecdMk : NamedTypeData * TypeData list * ExprData list -> ExprData @@ -106,6 +107,8 @@ val mkFieldGet : NamedTypeData * string * TypeData list * ExprData list -> ExprD val mkFieldSet : NamedTypeData * string * TypeData list * ExprData list -> ExprData val mkCtorCall : CtorData * TypeData list * ExprData list -> ExprData val mkMethodCall : MethodData * TypeData list * ExprData list -> ExprData +val mkMethodCallW : MethodData * MethodData * int * TypeData list * ExprData list -> ExprData + val mkAttributedExpression : ExprData * ExprData -> ExprData val pickle : (ExprData -> byte[]) val isAttributedExpression : ExprData -> bool diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index f7b37607275..1bcbfd3cc8f 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -18,6 +18,7 @@ open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TcGlobals open System.Collections.Generic +open System.Collections.Immutable module QP = FSharp.Compiler.QuotationPickler @@ -30,14 +31,19 @@ type IsReflectedDefinition = [] type QuotationSerializationFormat = - /// Indicates that type references are emitted as integer indexes into a supplied table - | FSharp_40_Plus - | FSharp_20_Plus + { + /// Indicates that witness parameters are recorded + SupportsWitnesses: bool + + /// Indicates that type references are emitted as integer indexes into a supplied table + SupportsDeserializeEx: bool + } type QuotationGenerationScope = { g: TcGlobals amap: Import.ImportMap scope: CcuThunk + tcVal : ConstraintSolver.TcValF // Accumulate the references to type definitions referencedTypeDefs: ResizeArray referencedTypeDefsTable: Dictionary @@ -49,10 +55,11 @@ type QuotationGenerationScope = quotationFormat : QuotationSerializationFormat mutable emitDebugInfoInQuotations : bool } - static member Create (g: TcGlobals, amap, scope, isReflectedDefinition) = + static member Create (g: TcGlobals, amap, scope, tcVal, isReflectedDefinition) = { g = g scope = scope amap = amap + tcVal = tcVal referencedTypeDefs = new ResizeArray<_>() referencedTypeDefsTable = new Dictionary<_, _>() typeSplices = new ResizeArray<_>() @@ -67,22 +74,28 @@ type QuotationGenerationScope = cenv.exprSplices |> ResizeArray.toList static member ComputeQuotationFormat g = - let deserializeExValRef = ValRefForIntrinsic g.deserialize_quoted_FSharp_40_plus_info - if deserializeExValRef.TryDeref.IsSome then - QuotationSerializationFormat.FSharp_40_Plus - else - QuotationSerializationFormat.FSharp_20_Plus + { SupportsDeserializeEx = (ValRefForIntrinsic g.deserialize_quoted_FSharp_40_plus_info).TryDeref.IsSome + SupportsWitnesses = (ValRefForIntrinsic g.call_with_witnesses_info).TryDeref.IsSome } type QuotationTranslationEnv = { /// Map from Val to binding index vs: ValMap - nvs: int + numValsInScope: int /// Map from typar stamps to binding index tyvs: StampMap + /// Indicates this is a witness arg we we disable further generation of witnesses + isWitness: bool + + /// All witnesses in scope and their mapping to lambda variables. + // + // Note: this uses an immutable HashMap/Dictionary with an IEqualityComparer that captures TcGlobals, see + // the point where the empty initial object is created. + witnessesInScope: TraitWitnessInfoHashMap + // Map for values bound by the // 'let v = isinst e in .... if nonnull v then ...v .... ' // construct arising out the compilation of pattern matching. We decode these back to the form @@ -92,10 +105,12 @@ type QuotationTranslationEnv = substVals: ValMap } - static member Empty = + static member CreateEmpty g = { vs = ValMap<_>.Empty - nvs = 0 + numValsInScope = 0 tyvs = Map.empty + isWitness = false + witnessesInScope = EmptyTraitWitnessInfoHashMap g isinstVals = ValMap<_>.Empty substVals = ValMap<_>.Empty } @@ -103,16 +118,26 @@ type QuotationTranslationEnv = let idx = env.tyvs.Count { env with tyvs = env.tyvs.Add(v.Stamp, idx ) } + member env.BindWitnessInfo (witnessInfo: TraitWitnessInfo) = + let argIdx = env.numValsInScope + { env with + witnessesInScope = env.witnessesInScope.Add(witnessInfo, argIdx) + numValsInScope = env.numValsInScope + 1 } + member env.BindTypars vs = - (env, vs) ||> List.fold (fun env v -> env.BindTypar v) // fold left-to-right because indexes are left-to-right + (env, vs) ||> List.fold (fun env v -> env.BindTypar v) + + member env.BindWitnessInfos witnessInfos = + (env, witnessInfos) ||> List.fold (fun env v -> env.BindWitnessInfo v) let BindFormalTypars (env: QuotationTranslationEnv) vs = { env with tyvs = Map.empty }.BindTypars vs let BindVal env v = + let n = env.numValsInScope { env with - vs = env.vs.Add v env.nvs - nvs = env.nvs + 1 } + vs = env.vs.Add v n + numValsInScope = env.numValsInScope + 1 } let BindIsInstVal env v (ty, e) = { env with isinstVals = env.isinstVals.Add v (ty, e) } @@ -120,7 +145,7 @@ let BindIsInstVal env v (ty, e) = let BindSubstVal env v e = { env with substVals = env.substVals.Add v e } -let BindVals env vs = List.fold BindVal env vs // fold left-to-right because indexes are left-to-right +let BindVals env vs = List.fold BindVal env vs let BindFlatVals env vs = List.fold BindVal env vs // fold left-to-right because indexes are left-to-right @@ -208,6 +233,27 @@ let rec EmitDebugInfoIfNecessary cenv env m astExpr : QP.ExprData = and ConvExpr cenv env (expr : Expr) = EmitDebugInfoIfNecessary cenv env expr.Range (ConvExprCore cenv env expr) +and GetWitnessArgs cenv (env : QuotationTranslationEnv) m tps tyargs = + let g = cenv.g + if g.generateWitnesses && not env.isWitness then + let witnessExprs = + ConstraintSolver.CodegenWitnessesForTyparInst cenv.tcVal g cenv.amap m tps tyargs + |> CommitOperationResult + let env = { env with isWitness = true } + witnessExprs |> List.map (fun arg -> + match arg with + | Choice1Of2 witnessInfo -> + if env.witnessesInScope.ContainsKey witnessInfo then + let witnessArgIdx = env.witnessesInScope.[witnessInfo] + QP.mkVar witnessArgIdx + else + System.Diagnostics.Debug.Assert(false, "unexpected missing witness representation") + QP.mkVar 0 + | Choice2Of2 arg -> + ConvExpr cenv env arg) + else + [] + and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.ExprData = let expr = DetectAndOptimizeForExpression cenv.g OptimizeIntRangesOnly expr @@ -243,18 +289,19 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let (numEnclTypeArgs, _, isNewObj, valUseFlags, isSelfInit, takesInstanceArg, isPropGet, isPropSet) = GetMemberCallInfo cenv.g (vref, vFlags) - let isMember, tps, curriedArgInfos, retTy = + let isMember, tps, witnessInfos, curriedArgInfos, retTy = match vref.MemberInfo with | Some _ when not vref.IsExtensionMember -> // This is an application of a member method // We only count one argument block for these. - let tps, curriedArgInfos, retTy, _ = GetTypeOfIntrinsicMemberInCompiledForm cenv.g vref - true, tps, curriedArgInfos, retTy + let tps, witnessInfos, curriedArgInfos, retTy, _ = GetTypeOfIntrinsicMemberInCompiledForm cenv.g vref + true, tps, witnessInfos, curriedArgInfos, retTy | _ -> // This is an application of a module value or extension member let arities = arityOfVal vref.Deref - let tps, curriedArgInfos, retTy, _ = GetTopValTypeInCompiledForm cenv.g arities vref.Type m - false, tps, curriedArgInfos, retTy + let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal vref.Deref + let tps, witnessInfos, curriedArgInfos, retTy, _ = GetTopValTypeInCompiledForm cenv.g arities numEnclosingTypars vref.Type m + false, tps, witnessInfos, curriedArgInfos, retTy // Compute the object arguments as they appear in a compiled call // Strip off the object argument, if any. The curriedArgInfos are already adjusted to compiled member form @@ -302,26 +349,29 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. else tryDestRefTupleExpr arg)) if verboseCReflect then - dprintfn "vref.DisplayName = %A, after unit adjust, #untupledCurriedArgs = %A, #curriedArgInfos = %d" vref.DisplayName (List.map List.length untupledCurriedArgs) curriedArgInfos.Length + dprintfn "vref.DisplayName = %A , after unit adjust, #untupledCurriedArgs = %A, #curriedArgInfos = %d" vref.DisplayName (List.map List.length untupledCurriedArgs) curriedArgInfos.Length + + let witnessArgTys = GenWitnessTys cenv.g witnessInfos + let witnessArgs = GetWitnessArgs cenv env m tps tyargs + let subCall = if isMember then - // This is an application of a member method - // We only count one argument block for these. - let callArgs = (objArgs :: untupledCurriedArgs) |> List.concat let parentTyconR = ConvTyconRef cenv vref.TopValDeclaringEntity m let isNewObj = isNewObj || valUseFlags || isSelfInit // The signature types are w.r.t. to the formal context let envinner = BindFormalTypars env tps let argTys = curriedArgInfos |> List.concat |> List.map fst + let witnessArgTypesR = ConvTypes cenv envinner m witnessArgTys let methArgTypesR = ConvTypes cenv envinner m argTys let methRetTypeR = ConvReturnType cenv envinner m retTy let methName = vref.CompiledName cenv.g.CompilerGlobalState let numGenericArgs = tyargs.Length - numEnclTypeArgs - ConvObjectModelCall cenv env m (isPropGet, isPropSet, isNewObj, parentTyconR, methArgTypesR, methRetTypeR, methName, tyargs, numGenericArgs, callArgs) + ConvObjectModelCall cenv env m (isPropGet, isPropSet, isNewObj, parentTyconR, witnessArgTypesR, methArgTypesR, methRetTypeR, methName, tyargs, numGenericArgs, objArgs, witnessArgs, untupledCurriedArgs) else // This is an application of the module value. - ConvModuleValueApp cenv env m vref tyargs untupledCurriedArgs + ConvModuleValueApp cenv env m vref tyargs witnessArgs untupledCurriedArgs + match curriedArgs, curriedArgInfos with // static member and module value unit argument elimination | [arg: Expr], [[]] -> @@ -384,7 +434,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. | Expr.Quote (ast, _, _, _, ety) -> // F# 2.0-3.1 had a bug with nested 'raw' quotations. F# 4.0 + FSharp.Core 4.4.0.0+ allows us to do the right thing. - if cenv.quotationFormat = QuotationSerializationFormat.FSharp_40_Plus && + if cenv.quotationFormat.SupportsDeserializeEx && // Look for a 'raw' quotation tyconRefEq cenv.g (tcrefOfAppTy cenv.g ety) cenv.g.raw_expr_tcr then @@ -421,7 +471,6 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let argsR = ConvExprs cenv env args QP.mkUnion(tcR, s, tyargsR, argsR) - | TOp.Tuple tupInfo, tyargs, _ -> let tyR = ConvType cenv env m (mkAnyTupledTy cenv.g tupInfo tyargs) let argsR = ConvExprs cenv env args @@ -588,7 +637,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let isPropGet = isProp && methName.StartsWithOrdinal("get_") let isPropSet = isProp && methName.StartsWithOrdinal("set_") let tyargs = (enclTypeArgs@methTypeArgs) - ConvObjectModelCall cenv env m (isPropGet, isPropSet, isNewObj, parentTyconR, methArgTypesR, methRetTypeR, methName, tyargs, methTypeArgs.Length, callArgs) + ConvObjectModelCall cenv env m (isPropGet, isPropSet, isNewObj, parentTyconR, [], methArgTypesR, methRetTypeR, methName, tyargs, methTypeArgs.Length, [], [], [callArgs]) | TOp.TryFinally _, [_resty], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], e2, _, _)] -> QP.mkTryFinally(ConvExpr cenv env e1, ConvExpr cenv env e2) @@ -601,10 +650,10 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. QP.mkTryWith(ConvExpr cenv env e1, vfR, ConvExpr cenv envf ef, vhR, ConvExpr cenv envh eh) | TOp.Bytes bytes, [], [] -> - ConvExpr cenv env (Expr.Op (TOp.Array, [cenv.g.byte_ty], List.ofArray (Array.map (mkByte cenv.g m) bytes), m)) + ConvExpr cenv env (Expr.Op (TOp.Array, [cenv.g.byte_ty], List.ofArray (Array.map (mkByte cenv.g m) bytes), m)) | TOp.UInt16s arr, [], [] -> - ConvExpr cenv env (Expr.Op (TOp.Array, [cenv.g.uint16_ty], List.ofArray (Array.map (mkUInt16 cenv.g m) arr), m)) + ConvExpr cenv env (Expr.Op (TOp.Array, [cenv.g.uint16_ty], List.ofArray (Array.map (mkUInt16 cenv.g m) arr), m)) | TOp.UnionCaseProof _, _, [e] -> ConvExpr cenv env e // Note: we erase the union case proof conversions when converting to quotations @@ -621,8 +670,39 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. | TOp.RefAddrGet _, _, _ -> wfail(Error(FSComp.SR.crefQuotationsCantRequireByref(), m)) - | TOp.TraitCall (_ss), _, _ -> - wfail(Error(FSComp.SR.crefQuotationsCantCallTraitMembers(), m)) + | TOp.TraitCall traitInfo, _, args -> + let g = cenv.g + let inWitnessPassingScope = not env.witnessesInScope.IsEmpty + let witnessArgInfo = + if g.generateWitnesses && inWitnessPassingScope then + match env.witnessesInScope.TryGetValue traitInfo.TraitKey with + | true, storage -> Some storage + | _ -> None // failwithf "no storage for witness %s found in scope" w.MemberName + else + None + + match witnessArgInfo with + | Some witnessArgIdx -> + + let witnessR = QP.mkVar witnessArgIdx + let args = if args.Length = 0 then [ mkUnit g m ] else args + let argsR = ConvExprs cenv env args + (witnessR, argsR) ||> List.fold (fun fR argR -> QP.mkApp (fR, argR)) + + | None -> + // If witnesses are available, we should now always find trait witnesses in scope + assert not inWitnessPassingScope + + let minfoOpt = + if g.generateWitnesses then + ConstraintSolver.CodegenWitnessForTraitConstraint cenv.tcVal g cenv.amap m traitInfo args |> CommitOperationResult + else + None + match minfoOpt with + | None -> + wfail(Error(FSComp.SR.crefQuotationsCantCallTraitMembers(), m)) + | Some expr -> + ConvExpr cenv env expr | _ -> wfail(InternalError( "Unexpected expression shape", m)) @@ -718,46 +798,80 @@ and ConvLValueExprCore cenv env expr = and ConvObjectModelCall cenv env m callInfo = EmitDebugInfoIfNecessary cenv env m (ConvObjectModelCallCore cenv env m callInfo) -and ConvObjectModelCallCore cenv env m (isPropGet, isPropSet, isNewObj, parentTyconR, methArgTypesR, methRetTypeR, methName, tyargs, numGenericArgs, callArgs) = +and ConvObjectModelCallCore cenv env m (isPropGet, isPropSet, isNewObj, parentTyconR, witnessArgTypesR, methArgTypesR, methRetTypeR, methName, tyargs, numGenericArgs, objArgs, witnessArgsR, untupledCurriedArgs) = let tyargsR = ConvTypes cenv env m tyargs - let callArgsR = ConvLValueArgs cenv env callArgs + let tupledCurriedArgs = untupledCurriedArgs |> List.concat + let allArgsR = + match objArgs with + | [ obj ] -> ConvLValueExpr cenv env obj :: (witnessArgsR @ ConvExprs cenv env tupledCurriedArgs) + | [] -> witnessArgsR @ ConvLValueArgs cenv env tupledCurriedArgs + | _ -> failwith "unreachable" if isPropGet || isPropSet then + assert witnessArgTypesR.IsEmpty let propName = ChopPropertyName methName if isPropGet then - QP.mkPropGet( (parentTyconR, propName, methRetTypeR, methArgTypesR), tyargsR, callArgsR) + QP.mkPropGet( (parentTyconR, propName, methRetTypeR, methArgTypesR), tyargsR, allArgsR) else let args, propTy = List.frontAndBack methArgTypesR - QP.mkPropSet( (parentTyconR, propName, propTy, args), tyargsR, callArgsR) + QP.mkPropSet( (parentTyconR, propName, propTy, args), tyargsR, allArgsR) elif isNewObj then + assert witnessArgTypesR.IsEmpty let ctorR : QuotationPickler.CtorData = { ctorParent = parentTyconR ctorArgTypes = methArgTypesR } - QP.mkCtorCall(ctorR, tyargsR, callArgsR) + QP.mkCtorCall(ctorR, tyargsR, allArgsR) + + elif witnessArgTypesR.IsEmpty then - else let methR : QuotationPickler.MethodData = { methParent = parentTyconR methArgTypes = methArgTypesR methRetType = methRetTypeR methName = methName numGenericArgs = numGenericArgs } - QP.mkMethodCall(methR, tyargsR, callArgsR) -and ConvModuleValueApp cenv env m (vref: ValRef) tyargs (args: Expr list list) = - EmitDebugInfoIfNecessary cenv env m (ConvModuleValueAppCore cenv env m vref tyargs args) + QP.mkMethodCall(methR, tyargsR, allArgsR) + + else -and ConvModuleValueAppCore cenv env m (vref: ValRef) tyargs (args: Expr list list) = + // The old method entry point + let methR: QuotationPickler.MethodData = + { methParent = parentTyconR + methArgTypes = methArgTypesR + methRetType = methRetTypeR + methName = methName + numGenericArgs = numGenericArgs } + + // The witness-passing method entry point + let methWR: QuotationPickler.MethodData = + { methParent = parentTyconR + methArgTypes = witnessArgTypesR @ methArgTypesR + methRetType = methRetTypeR + methName = ExtraWitnessMethodName methName + numGenericArgs = numGenericArgs } + + QP.mkMethodCallW(methR, methWR, List.length witnessArgTypesR, tyargsR, allArgsR) + +and ConvModuleValueApp cenv env m (vref:ValRef) tyargs witnessArgs (args: Expr list list) = + EmitDebugInfoIfNecessary cenv env m (ConvModuleValueAppCore cenv env m vref tyargs witnessArgs args) + +and ConvModuleValueAppCore cenv env m (vref: ValRef) tyargs witnessArgsR (curriedArgs: Expr list list) = match vref.DeclaringEntity with - | ParentNone -> failwith "ConvModuleValueApp" + | ParentNone -> failwith "ConvModuleValueAppCore" | Parent(tcref) -> let isProperty = IsCompiledAsStaticProperty cenv.g vref.Deref let tcrefR = ConvTyconRef cenv tcref m let tyargsR = ConvTypes cenv env m tyargs let nm = vref.CompiledName cenv.g.CompilerGlobalState - let argsR = List.map (ConvExprs cenv env) args - QP.mkModuleValueApp(tcrefR, nm, isProperty, tyargsR, argsR) + let uncurriedArgsR = ConvExprs cenv env (List.concat curriedArgs) + let allArgsR = witnessArgsR @ uncurriedArgsR + let nWitnesses = witnessArgsR.Length + if nWitnesses = 0 then + QP.mkModuleValueApp(tcrefR, nm, isProperty, tyargsR, allArgsR) + else + QP.mkModuleValueWApp(tcrefR, nm, isProperty, ExtraWitnessMethodName nm, nWitnesses, tyargsR, allArgsR) and ConvExprs cenv env args = List.map (ConvExpr cenv env) args @@ -785,10 +899,14 @@ and private ConvValRefCore holeOk cenv env m (vref: ValRef) tyargs = // References to local values are embedded by value if not holeOk then wfail(Error(FSComp.SR.crefNoSetOfHole(), m)) let idx = cenv.exprSplices.Count - cenv.exprSplices.Add((mkCallLiftValueWithName cenv.g m vty v.LogicalName (exprForValRef m vref), m)) + let liftExpr = mkCallLiftValueWithName cenv.g m vty v.LogicalName (exprForValRef m vref) + cenv.exprSplices.Add((liftExpr, m)) QP.mkHole(ConvType cenv env m vty, idx) + | Parent _ -> - ConvModuleValueApp cenv env m vref tyargs [] + // First-class use or use of type function + let witnessArgs = GetWitnessArgs cenv env m vref.Typars tyargs + ConvModuleValueApp cenv env m vref tyargs witnessArgs [] and ConvUnionCaseRef cenv (ucref: UnionCaseRef) m = let ucgtypR = ConvTyconRef cenv ucref.TyconRef m @@ -987,8 +1105,7 @@ and ConvILTypeRefUnadjusted cenv m (tr: ILTypeRef) = ConvILTypeRef cenv trefAdjusted and ConvILTypeRef cenv (tr: ILTypeRef) = - match cenv.quotationFormat with - | QuotationSerializationFormat.FSharp_40_Plus -> + if cenv.quotationFormat.SupportsDeserializeEx then let idx = match cenv.referencedTypeDefsTable.TryGetValue tr with | true, idx -> idx @@ -999,7 +1116,7 @@ and ConvILTypeRef cenv (tr: ILTypeRef) = idx QP.Idx idx - | QuotationSerializationFormat.FSharp_20_Plus -> + else let assemblyRef = match tr.Scope with | ILScopeRef.Local -> "." @@ -1059,7 +1176,7 @@ and ConvReturnType cenv envinner m retTy = | Some ty -> ConvType cenv envinner m ty let ConvExprPublic cenv e = - let env = QuotationTranslationEnv.Empty + let env = QuotationTranslationEnv.CreateEmpty(cenv.g) let astExpr = let astExpr = ConvExpr cenv env e // always emit debug info for the top level expression @@ -1077,7 +1194,7 @@ let ConvMethodBase cenv env (methName, v: Val) = | Some vspr when not v.IsExtensionMember -> let vref = mkLocalValRef v - let tps, argInfos, retTy, _ = GetTypeOfMemberInMemberForm cenv.g vref + let tps, witnessInfos, argInfos, retTy, _ = GetTypeOfMemberInMemberForm cenv.g vref let numEnclTypeArgs = vref.MemberApparentEntity.TyparsNoRange.Length let argTys = argInfos |> List.concat |> List.map fst @@ -1085,44 +1202,54 @@ let ConvMethodBase cenv env (methName, v: Val) = // The signature types are w.r.t. to the formal context let envinner = BindFormalTypars env tps + let witnessArgTysR = ConvTypes cenv envinner m (GenWitnessTys cenv.g witnessInfos) let methArgTypesR = ConvTypes cenv envinner m argTys let methRetTypeR = ConvReturnType cenv envinner m retTy let numGenericArgs = tps.Length-numEnclTypeArgs if isNewObj then - QP.MethodBaseData.Ctor - { ctorParent = parentTyconR - ctorArgTypes = methArgTypesR } + assert witnessArgTysR.IsEmpty + QP.MethodBaseData.Ctor + { ctorParent = parentTyconR + ctorArgTypes = methArgTypesR } else - QP.MethodBaseData.Method + QP.MethodBaseData.Method { methParent = parentTyconR - methArgTypes = methArgTypesR + methArgTypes = witnessArgTysR @ methArgTypesR methRetType = methRetTypeR methName = methName numGenericArgs=numGenericArgs } | _ when v.IsExtensionMember -> - let tps, argInfos, retTy, _ = GetTopValTypeInCompiledForm cenv.g v.ValReprInfo.Value v.Type v.Range + let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal v + let tps, witnessInfos, argInfos, retTy, _ = GetTopValTypeInCompiledForm cenv.g v.ValReprInfo.Value numEnclosingTypars v.Type v.Range let argTys = argInfos |> List.concat |> List.map fst let envinner = BindFormalTypars env tps + let witnessArgTysR = ConvTypes cenv envinner m (GenWitnessTys cenv.g witnessInfos) let methArgTypesR = ConvTypes cenv envinner m argTys let methRetTypeR = ConvReturnType cenv envinner m retTy let numGenericArgs = tps.Length QP.MethodBaseData.Method { methParent = parentTyconR - methArgTypes = methArgTypesR + methArgTypes = witnessArgTysR @ methArgTypesR methRetType = methRetTypeR methName = methName numGenericArgs=numGenericArgs } - | _ -> + | _ -> + let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal v + let tps, witnessInfos, _argInfos, _retTy, _ = GetTopValTypeInCompiledForm cenv.g v.ValReprInfo.Value numEnclosingTypars v.Type v.Range + let envinner = BindFormalTypars env tps + let witnessArgTysR = ConvTypes cenv envinner m (GenWitnessTys cenv.g witnessInfos) + let nWitnesses = witnessArgTysR.Length + let witnessData = (if nWitnesses = 0 then None else Some (ExtraWitnessMethodName methName, nWitnesses)) QP.MethodBaseData.ModuleDefn - { Name = methName - Module = parentTyconR - IsProperty = IsCompiledAsStaticProperty cenv.g v } + ({ Name = methName + Module = parentTyconR + IsProperty = IsCompiledAsStaticProperty cenv.g v }, witnessData) let ConvReflectedDefinition cenv methName v e = let g = cenv.g @@ -1131,9 +1258,12 @@ let ConvReflectedDefinition cenv methName v e = match e with | Expr.TyLambda (_, tps, body, _, _) -> tps, body, applyForallTy g ety (List.map mkTyparTy tps) | _ -> [], e, ety - let env = QuotationTranslationEnv.Empty + let env = QuotationTranslationEnv.CreateEmpty(g) let env = env.BindTypars tps + let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal v + let witnessInfos = GetTraitWitnessInfosOfTypars g numEnclosingTypars tps let astExpr = + let env = env.BindWitnessInfos witnessInfos let astExpr = ConvExpr cenv env taue // always emit debug info for ReflectedDefinition expression let old = cenv.emitDebugInfoInQuotations @@ -1143,5 +1273,17 @@ let ConvReflectedDefinition cenv methName v e = finally cenv.emitDebugInfoInQuotations <- old + // Add on fake lambdas for implicit arguments for witnesses + let astExprWithWitnessLambdas = + List.foldBack + (fun witnessInfo e -> + let ty = GenWitnessTy g witnessInfo + let tyR = ConvType cenv env v.DefinitionRange ty + let vR = QuotationPickler.freshVar (witnessInfo.MemberName, tyR, false) + QuotationPickler.mkLambda (vR, e)) + witnessInfos + astExpr + let mbaseR = ConvMethodBase cenv env (methName, v) - mbaseR, astExpr + mbaseR, astExprWithWitnessLambdas + diff --git a/src/fsharp/QuotationTranslator.fsi b/src/fsharp/QuotationTranslator.fsi index d7fcb7a999b..f3d9a7b7575 100755 --- a/src/fsharp/QuotationTranslator.fsi +++ b/src/fsharp/QuotationTranslator.fsi @@ -20,14 +20,18 @@ type IsReflectedDefinition = [] type QuotationSerializationFormat = - /// Indicates that type references are emitted as integer indexes into a supplied table - | FSharp_40_Plus - | FSharp_20_Plus + { + /// Indicates that witness parameters are recorded + SupportsWitnesses: bool + + /// Indicates that type references are emitted as integer indexes into a supplied table + SupportsDeserializeEx: bool + } [] type QuotationGenerationScope = - static member Create: TcGlobals * ImportMap * CcuThunk * IsReflectedDefinition -> QuotationGenerationScope - member Close: unit -> ILTypeRef list * (TType * range) list * (Expr * range) list + static member Create: TcGlobals * ImportMap * CcuThunk * ConstraintSolver.TcValF * IsReflectedDefinition -> QuotationGenerationScope + member Close: unit -> ILTypeRef list * (TType * range) list * (Expr * range) list static member ComputeQuotationFormat : TcGlobals -> QuotationSerializationFormat val ConvExprPublic : QuotationGenerationScope -> Expr -> QuotationPickler.ExprData diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index 68ef24cb764..e07f9026061 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -356,7 +356,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d // A table of all intrinsics that the compiler cares about let v_knownIntrinsics = Dictionary<(string*string), ValRef>(HashIdentity.Structural) - let makeIntrinsicValRef (enclosingEntity, logicalName, memberParentName, compiledNameOpt, typars, (argtys, rty)) = + let makeIntrinsicValRefGeneral isKnown (enclosingEntity, logicalName, memberParentName, compiledNameOpt, typars, (argtys, rty)) = let ty = mkForallTyIfNeeded typars (mkIteratedFunTy (List.map mkSmallRefTupledTy argtys) rty) let isMember = Option.isSome memberParentName let argCount = if isMember then List.sum (List.map List.length argtys) else 0 @@ -364,9 +364,12 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= argCount }, linkageType) let vref = IntrinsicValRef(enclosingEntity, logicalName, isMember, ty, key) let compiledName = defaultArg compiledNameOpt logicalName - v_knownIntrinsics.Add((enclosingEntity.LastItemMangledName, compiledName), ValRefForIntrinsic vref) + if isKnown then + v_knownIntrinsics.Add((enclosingEntity.LastItemMangledName, compiledName), ValRefForIntrinsic vref) vref + let makeIntrinsicValRef info = makeIntrinsicValRefGeneral true info + let makeOtherIntrinsicValRef info = makeIntrinsicValRefGeneral false info let v_IComparer_ty = mkSysNonGenericTy sysCollections "IComparer" let v_IEqualityComparer_ty = mkSysNonGenericTy sysCollections "IEqualityComparer" @@ -713,6 +716,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d let v_new_decimal_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "MakeDecimal" , None , None , [], ([[v_int_ty]; [v_int_ty]; [v_int_ty]; [v_bool_ty]; [v_byte_ty]], v_decimal_ty)) let v_deserialize_quoted_FSharp_20_plus_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "Deserialize" , Some "Expr" , None , [], ([[v_system_Type_ty ;mkListTy v_system_Type_ty ;mkListTy mkRawQuotedExprTy ; mkArrayType 1 v_byte_ty]], mkRawQuotedExprTy )) let v_deserialize_quoted_FSharp_40_plus_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "Deserialize40" , Some "Expr" , None , [], ([[v_system_Type_ty ;mkArrayType 1 v_system_Type_ty; mkArrayType 1 v_system_Type_ty; mkArrayType 1 mkRawQuotedExprTy; mkArrayType 1 v_byte_ty]], mkRawQuotedExprTy )) + let v_call_with_witnesses_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "CallWithWitnesses" , Some "Expr" , None , [], ([[v_system_Reflection_MethodInfo_ty; v_system_Reflection_MethodInfo_ty; mkListTy mkRawQuotedExprTy; mkListTy mkRawQuotedExprTy]], mkRawQuotedExprTy)) let v_cast_quotation_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "Cast" , Some "Expr" , None , [vara], ([[mkRawQuotedExprTy]], mkQuotedExprTy varaTy)) let v_lift_value_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "Value" , Some "Expr" , None , [vara], ([[varaTy]], mkRawQuotedExprTy)) let v_lift_value_with_name_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "ValueWithName" , Some "Expr" , None , [vara], ([[varaTy; v_string_ty]], mkRawQuotedExprTy)) @@ -1422,6 +1426,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d member __.deserialize_quoted_FSharp_20_plus_info = v_deserialize_quoted_FSharp_20_plus_info member __.deserialize_quoted_FSharp_40_plus_info = v_deserialize_quoted_FSharp_40_plus_info + member __.call_with_witnesses_info = v_call_with_witnesses_info member __.cast_quotation_info = v_cast_quotation_info member __.lift_value_info = v_lift_value_info member __.lift_value_with_name_info = v_lift_value_with_name_info @@ -1457,9 +1462,16 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d // Note that the suppression checks for the precise name of the type // so the lowercase versions are visible member __.suppressed_types = v_suppressed_types + /// Are we assuming all code gen is for F# interactive, with no static linking member __.isInteractive=isInteractive + /// Indicates if we are generating witness arguments for SRTP constraints. Only done if the FSharp.Core + /// supports witness arguments. + member g.generateWitnesses = + compilingFslib || + ((ValRefForIntrinsic g.call_with_witnesses_info).TryDeref.IsSome && langVersion.SupportsFeature LanguageFeature.WitnessPassing) + member __.FindSysTyconRef path nm = findSysTyconRef path nm member __.TryFindSysTyconRef path nm = tryFindSysTyconRef path nm member __.FindSysILTypeRef nm = findSysILTypeRef nm @@ -1496,6 +1508,84 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d member __.CompilerGeneratedAttribute = mkCompilerGeneratedAttribute () + /// Find an FSharp.Core LaguagePrimitives dynamic function that corresponds to a trait witness, e.g. + /// AdditionDynamic for op_Addition. Also work out the type instantiation of the dynamic function. + member __.makeBuiltInWitnessInfo (t: TraitConstraintInfo) = + let memberName = + let nm = t.MemberName + let coreName = + if nm.StartsWith "op_" then nm.[3..] + elif nm = "get_Zero" then "GenericZero" + elif nm = "get_One" then "GenericOne" + else nm + coreName + "Dynamic" + let gtps, argTys, retTy, tinst = + match memberName, t.ArgumentTypes, t.ReturnType with + | ("AdditionDynamic" | "MultiplyDynamic" | "SubtractionDynamic"| "DivisionDynamic" | "ModulusDynamic" | "CheckedAdditionDynamic" | "CheckedMultiplyDynamic" | "CheckedSubtractionDynamic" | "LeftShiftDynamic" | "RightShiftDynamic" | "BitwiseAndDynamic" | "BitwiseOrDynamic" | "ExclusiveOrDynamic" | "LessThanDynamic" | "GreaterThanDynamic" | "LessThanOrEqualDynamic" | "GreaterThanOrEqualDynamic" | "EqualityDynamic" | "InequalityDynamic"), + [ arg0Ty; arg1Ty ], + Some retTy -> + [vara; varb; varc], [ varaTy; varbTy ], varcTy, [ arg0Ty; arg1Ty; retTy ] + | ("UnaryNegationDynamic" | "CheckedUnaryNegationDynamic" | "LogicalNotDynamic" | "ExplicitDynamic"), + [ arg0Ty ], + Some retTy -> + [vara; varb ], [ varaTy ], varbTy, [ arg0Ty; retTy ] + | "DivideByIntDynamic", [arg0Ty; _], _ -> + [vara], [ varaTy; v_int32_ty ], varaTy, [ arg0Ty ] + | ("GenericZeroDynamic" | "GenericOneDynamic"), [], Some retTy -> + [vara], [ ], varaTy, [ retTy ] + | _ -> failwithf "unknown builtin witness '%s'" memberName + let vref = makeOtherIntrinsicValRef (fslib_MFLanguagePrimitives_nleref, memberName, None, None, gtps, (List.map List.singleton argTys, retTy)) + vref, tinst + + /// Find an FSharp.Core operator that corresponds to a trait witness + member g.tryMakeOperatorAsBuiltInWitnessInfo isStringTy isArrayTy (t: TraitConstraintInfo) argExprs = + + match t.MemberName, t.ArgumentTypes, t.ReturnType, argExprs with + | "get_Sign", [aty], _, (objExpr :: _) -> + // Call Operators.sign + let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, "sign", None, Some "Sign", [vara], ([[varaTy]], v_int32_ty)) + let tyargs = [aty] + Some (info, tyargs, [objExpr]) + | "Sqrt", [aty], Some bty, [_] -> + // Call Operators.sqrt + let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, "sqrt", None, Some "Sqrt", [vara; varb], ([[varaTy]], varbTy)) + let tyargs = [aty; bty] + Some (info, tyargs, argExprs) + | "Pow", [aty;bty], _, [_;_] -> + // Call Operators.(**) + let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, "op_Exponentiation", None, None, [vara; varb], ([[varaTy]; [varbTy]], varaTy)) + let tyargs = [aty;bty] + Some (info, tyargs, argExprs) + | "Atan2", [aty;_], Some bty, [_;_] -> + // Call Operators.atan2 + let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, "atan2", None, Some "Atan2", [vara; varb], ([[varaTy]; [varaTy]], varbTy)) + let tyargs = [aty;bty] + Some (info, tyargs, argExprs) + | "get_Zero", _, Some aty, [_] -> + // Call LanguagePrimitives.GenericZero + let info = makeOtherIntrinsicValRef (fslib_MFLanguagePrimitives_nleref, "GenericZero", None, None, [vara], ([], varaTy)) + let tyargs = [aty] + Some (info, tyargs, []) + | "get_One", _, Some aty, [_] -> + // Call LanguagePrimitives.GenericOne + let info = makeOtherIntrinsicValRef (fslib_MFLanguagePrimitives_nleref, "GenericOne", None, None, [vara], ([], varaTy)) + let tyargs = [aty] + Some (info, tyargs, []) + | ("Abs" | "Sin" | "Cos" | "Tan" | "Sinh" | "Cosh" | "Tanh" | "Atan" | "Acos" | "Asin" | "Exp" | "Ceiling" | "Floor" | "Round" | "Truncate" | "Log10"| "Log"), [aty], _, [_] -> + // Call corresponding Operators.* + let nm = t.MemberName + let lower = if nm = "Ceiling" then "ceil" else nm.ToLowerInvariant() + let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, lower, None, Some nm, [vara], ([[varaTy]], varaTy)) + let tyargs = [aty] + Some (info, tyargs, argExprs) + | "get_Item", [arrTy; _], Some rty, [_; _] when isArrayTy g arrTy -> + Some (g.array_get_info, [rty], argExprs) + | "set_Item", [arrTy; _; ety], _, [_; _; _] when isArrayTy g arrTy -> + Some (g.array_set_info, [ety], argExprs) + | "get_Item", [sty; _; _], _, [_; _] when isStringTy g sty -> + Some (g.getstring_info, [], argExprs) + | _ -> + None member __.eraseClassUnionDef = EraseUnions.mkClassUnionDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addPropertyNeverAttrs, addFieldGeneratedAttrs, addFieldNeverAttrs, mkDebuggerTypeProxyAttribute) ilg #if DEBUG diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 2cb72a3047b..6888dbdcf9e 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -4408,8 +4408,8 @@ and TcPseudoMemberSpec cenv newOk env synTypes tpenv memSpfn m = | [ValSpecResult(_, _, id, _, _, memberConstraintTy, partialValReprInfo, _)] -> let memberConstraintTypars, _ = tryDestForallTy cenv.g memberConstraintTy let topValInfo = TranslatePartialArity memberConstraintTypars partialValReprInfo - let _, curriedArgInfos, returnTy, _ = GetTopValTypeInCompiledForm cenv.g topValInfo memberConstraintTy m - //if curriedArgInfos.Length > 1 then error(Error(FSComp.SR.tcInvalidConstraint(), m)) + let _, _, curriedArgInfos, returnTy, _ = GetTopValTypeInCompiledForm cenv.g topValInfo 0 memberConstraintTy m + //if curriedArgInfos.Length > 1 then error(Error(FSComp.SR.tcInvalidConstraint(), m)) let argTys = List.concat curriedArgInfos let argTys = List.map fst argTys let logicalCompiledName = ComputeLogicalName id memberFlags @@ -13225,7 +13225,7 @@ module IncrClassChecking = InVar isCtorArg | topValInfo -> //dprintfn "Representing %s as a method %s" v.LogicalName name - let tps, argInfos, _, _ = GetTopValTypeInCompiledForm g topValInfo v.Type v.Range + let tps, _, argInfos, _, _ = GetTopValTypeInCompiledForm g topValInfo 0 v.Type v.Range let valSynInfo = SynValInfo(argInfos |> List.mapSquared (fun (_, argInfo) -> SynArgInfo([], false, argInfo.Name)), SynInfo.unnamedRetVal) let memberFlags = (if isStatic then StaticMemberFlags else NonVirtualMemberFlags) MemberKind.Member @@ -13243,6 +13243,7 @@ module IncrClassChecking = let (ValReprInfo(tpNames, args, ret)) = topValInfo let topValInfo = ValReprInfo(tpNames, ValReprInfo.selfMetadata :: args, ret) tauTy, topValInfo + // Add the enclosing type parameters on to the function let topValInfo = let (ValReprInfo(tpNames, args, ret)) = topValInfo @@ -16262,7 +16263,7 @@ module EstablishTypeDefinitionCores = noAbstractClassAttributeCheck() noFieldsCheck userFields let ty', _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner tpenv ty - let _, curriedArgInfos, returnTy, _ = GetTopValTypeInCompiledForm g (arity |> TranslateTopValSynInfo m (TcAttributes cenv envinner) |> TranslatePartialArity []) ty' m + let _, _, curriedArgInfos, returnTy, _ = GetTopValTypeInCompiledForm cenv.g (arity |> TranslateTopValSynInfo m (TcAttributes cenv envinner) |> TranslatePartialArity []) 0 ty' m if curriedArgInfos.Length < 1 then error(Error(FSComp.SR.tcInvalidDelegateSpecification(), m)) if curriedArgInfos.Length > 1 then error(Error(FSComp.SR.tcDelegatesCannotBeCurried(), m)) let ttps = thisTyconRef.Typars m @@ -18072,10 +18073,10 @@ let TypeCheckOneImplFile try let reportErrors = not (checkForErrors()) - + let tcVal = LightweightTcValForUsingInBuildMethodCall g PostTypeCheckSemanticChecks.CheckTopImpl (g, cenv.amap, reportErrors, cenv.infoReader, - env.eInternalsVisibleCompPaths, cenv.topCcu, envAtEnd.DisplayEnv, + env.eInternalsVisibleCompPaths, cenv.topCcu, tcVal, envAtEnd.DisplayEnv, implFileExprAfterSig, extraAttribs, isLastCompiland, isInternalTestSpanStackReferring) diff --git a/src/fsharp/TypedTree.fs b/src/fsharp/TypedTree.fs index 8b12eb84295..e8f31eb4788 100644 --- a/src/fsharp/TypedTree.fs +++ b/src/fsharp/TypedTree.fs @@ -2296,7 +2296,22 @@ type TyparConstraint = override x.ToString() = sprintf "%+A" x -/// Represents the specification of a member constraint that must be solved +[] +type TraitWitnessInfo = + | TraitWitnessInfo of TTypes * string * MemberFlags * TTypes * TType option + + /// Get the member name associated with the member constraint. + member x.MemberName = (let (TraitWitnessInfo(_, b, _, _, _)) = x in b) + + /// Get the return type recorded in the member constraint. + member x.ReturnType = (let (TraitWitnessInfo(_, _, _, _, ty)) = x in ty) + + [] + member x.DebugText = x.ToString() + + override x.ToString() = "TTrait(" + x.MemberName + ")" + +/// The specification of a member constraint that must be solved [] type TraitConstraintInfo = @@ -2304,10 +2319,17 @@ type TraitConstraintInfo = /// to store the inferred solution of the constraint. | TTrait of tys: TTypes * memberName: string * _memFlags: MemberFlags * argTys: TTypes * returnTy: TType option * solution: TraitConstraintSln option ref + /// Get the key associated with the member constraint. + member x.TraitKey = (let (TTrait(a, b, c, d, e, _)) = x in TraitWitnessInfo(a, b, c, d, e)) + /// Get the member name associated with the member constraint. member x.MemberName = (let (TTrait(_, nm, _, _, _, _)) = x in nm) - /// Get the argument types required of a member in order to solve the constraint + /// Get the member flags associated with the member constraint. + member x.MemberFlags = (let (TTrait(_, _, flags, _, _, _)) = x in flags) + + /// Get the argument types recorded in the member constraint. This includes the object instance type for + /// instance members. member x.ArgumentTypes = (let (TTrait(_, _, _, argtys, _, _)) = x in argtys) /// Get the return type recorded in the member constraint. diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 513727bf1c2..9042e45633a 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -3,7 +3,8 @@ /// Defines derived expression manipulation and construction functions. module internal FSharp.Compiler.TypedTreeOps -open System.Collections.Generic +open System.Collections.Generic +open System.Collections.Immutable open Internal.Utilities open FSharp.Compiler @@ -911,6 +912,13 @@ let rec traitsAEquivAux erasureFlag g aenv traitInfo1 traitInfo2 = returnTypesAEquivAux erasureFlag g aenv rty rty2 && List.lengthsEqAndForall2 (typeAEquivAux erasureFlag g aenv) argtys argtys2 +and traitKeysAEquivAux erasureFlag g aenv (TraitWitnessInfo(tys1, nm, mf1, argtys, rty)) (TraitWitnessInfo(tys2, nm2, mf2, argtys2, rty2)) = + mf1 = mf2 && + nm = nm2 && + ListSet.equals (typeAEquivAux erasureFlag g aenv) tys1 tys2 && + returnTypesAEquivAux erasureFlag g aenv rty rty2 && + List.lengthsEqAndForall2 (typeAEquivAux erasureFlag g aenv) argtys argtys2 + and returnTypesAEquivAux erasureFlag g aenv rty rty2 = match rty, rty2 with | None, None -> true @@ -1026,6 +1034,7 @@ and typeEquivAux erasureFlag g ty1 ty2 = typeAEquivAux erasureFlag g TypeEquivEn let typeAEquiv g aenv ty1 ty2 = typeAEquivAux EraseNone g aenv ty1 ty2 let typeEquiv g ty1 ty2 = typeEquivAux EraseNone g ty1 ty2 let traitsAEquiv g aenv t1 t2 = traitsAEquivAux EraseNone g aenv t1 t2 +let traitKeysAEquiv g aenv t1 t2 = traitKeysAEquivAux EraseNone g aenv t1 t2 let typarConstraintsAEquiv g aenv c1 c2 = typarConstraintsAEquivAux EraseNone g aenv c1 c2 let typarsAEquiv g aenv d1 d2 = typarsAEquivAux EraseNone g aenv d1 d2 let returnTypesAEquiv g aenv t1 t2 = returnTypesAEquivAux EraseNone g aenv t1 t2 @@ -1554,8 +1563,11 @@ let tryDestRefTupleTy g ty = if isRefTupleTy g ty then destRefTupleTy g ty else [ty] type UncurriedArgInfos = (TType * ArgReprInfo) list + type CurriedArgInfos = (TType * ArgReprInfo) list list +type TraitWitnessInfos = TraitWitnessInfo list + // A 'tau' type is one with its type parameters stripped off let GetTopTauTypeInFSharpForm g (curriedArgInfos: ArgReprInfo list list) tau m = let nArgInfos = curriedArgInfos.Length @@ -2259,8 +2271,35 @@ let checkMemberVal membInfo arity m = let checkMemberValRef (vref: ValRef) = checkMemberVal vref.MemberInfo vref.ValReprInfo vref.Range -let GetTopValTypeInCompiledForm g topValInfo ty m = +/// Get information about the trait constraints for a set of typars. +/// Put these in canonical order. +let GetTraitConstraintInfosOfTypars g (tps: Typars) = + [ for tp in tps do + for cx in tp.Constraints do + match cx with + | TyparConstraint.MayResolveMember(traitInfo, _) -> yield traitInfo + | _ -> () ] + |> ListSet.setify (traitsAEquiv g TypeEquivEnv.Empty) + |> List.sortBy (fun traitInfo -> traitInfo.MemberName, traitInfo.ArgumentTypes.Length) + +/// Get information about the runtime witnesses needed for a set of generalized typars +let GetTraitWitnessInfosOfTypars g numParentTypars tps = + let tps = tps |> List.drop numParentTypars + let cxs = GetTraitConstraintInfosOfTypars g tps + cxs |> List.map (fun cx -> cx.TraitKey) + +/// Count the number of type parameters on the enclosing type +let CountEnclosingTyparsOfActualParentOfVal (v: Val) = + match v.ValReprInfo with + | None -> 0 + | Some _ -> + if v.IsExtensionMember then 0 + elif not v.IsMember then 0 + else v.MemberApparentEntity.TyparsNoRange.Length + +let GetTopValTypeInCompiledForm g topValInfo numEnclosingTypars ty m = let tps, paramArgInfos, rty, retInfo = GetTopValTypeInFSharpForm g topValInfo ty m + let witnessInfos = GetTraitWitnessInfosOfTypars g numEnclosingTypars tps // TODO: parentTypars // Eliminate lone single unit arguments let paramArgInfos = match paramArgInfos, topValInfo.ArgInfos with @@ -2275,7 +2314,7 @@ let GetTopValTypeInCompiledForm g topValInfo ty m = | _ -> paramArgInfos let rty = if isUnitTy g rty then None else Some rty - (tps, paramArgInfos, rty, retInfo) + (tps, witnessInfos, paramArgInfos, rty, retInfo) // Pull apart the type for an F# value that represents an object model method // and see the "member" form for the type, i.e. @@ -2285,8 +2324,9 @@ let GetTopValTypeInCompiledForm g topValInfo ty m = // This is used not only for the compiled form - it's also used for all type checking and object model // logic such as determining if abstract methods have been implemented or not, and how // many arguments the method takes etc. -let GetMemberTypeInMemberForm g memberFlags topValInfo ty m = +let GetMemberTypeInMemberForm g memberFlags topValInfo numEnclosingTypars ty m = let tps, paramArgInfos, rty, retInfo = GetMemberTypeInFSharpForm g memberFlags topValInfo ty m + let witnessInfos = GetTraitWitnessInfosOfTypars g numEnclosingTypars tps // Eliminate lone single unit arguments let paramArgInfos = match paramArgInfos, topValInfo.ArgInfos with @@ -2301,12 +2341,13 @@ let GetMemberTypeInMemberForm g memberFlags topValInfo ty m = | _ -> paramArgInfos let rty = if isUnitTy g rty then None else Some rty - (tps, paramArgInfos, rty, retInfo) + (tps, witnessInfos, paramArgInfos, rty, retInfo) let GetTypeOfMemberInMemberForm g (vref: ValRef) = //assert (not vref.IsExtensionMember) let membInfo, topValInfo = checkMemberValRef vref - GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo vref.Type vref.Range + let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal vref.Deref + GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo numEnclosingTypars vref.Type vref.Range let GetTypeOfMemberInFSharpForm g (vref: ValRef) = let membInfo, topValInfo = checkMemberValRef vref @@ -2343,7 +2384,8 @@ let PartitionValRefTypars g (vref: ValRef) = PartitionValTypars g vref.Deref /// Get the arguments for an F# value that represents an object model method let ArgInfosOfMemberVal g (v: Val) = let membInfo, topValInfo = checkMemberVal v.MemberInfo v.ValReprInfo v.Range - let _, arginfos, _, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo v.Type v.Range + let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal v + let _, _, arginfos, _, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo numEnclosingTypars v.Type v.Range arginfos let ArgInfosOfMember g (vref: ValRef) = @@ -2361,13 +2403,15 @@ let ReturnTypeOfPropertyVal g (v: Val) = let membInfo, topValInfo = checkMemberVal v.MemberInfo v.ValReprInfo v.Range match membInfo.MemberFlags.MemberKind with | MemberKind.PropertySet -> - let _, arginfos, _, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo v.Type v.Range + let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal v + let _, _, arginfos, _, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo numEnclosingTypars v.Type v.Range if not arginfos.IsEmpty && not arginfos.Head.IsEmpty then arginfos.Head |> List.last |> fst else error(Error(FSComp.SR.tastValueDoesNotHaveSetterType(), v.Range)) | MemberKind.PropertyGet -> - let _, _, rty, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo v.Type v.Range + let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal v + let _, _, _, rty, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo numEnclosingTypars v.Type v.Range GetFSharpViewOfReturnType g rty | _ -> error(InternalError("ReturnTypeOfPropertyVal", v.Range)) @@ -2380,7 +2424,8 @@ let ArgInfosOfPropertyVal g (v: Val) = | MemberKind.PropertyGet -> ArgInfosOfMemberVal g v |> List.concat | MemberKind.PropertySet -> - let _, arginfos, _, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo v.Type v.Range + let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal v + let _, _, arginfos, _, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo numEnclosingTypars v.Type v.Range if not arginfos.IsEmpty && not arginfos.Head.IsEmpty then arginfos.Head |> List.frontAndBack |> fst else @@ -4861,8 +4906,12 @@ type StaticOptimizationAnswer = | No = -1y | Unknown = 0y -let decideStaticOptimizationConstraint g c = +let decideStaticOptimizationConstraint g c haveWitnesses = match c with + // When witnesses are available in generic code during codegen, "when ^T : ^T" resolves StaticOptimizationAnswer.Yes + // This doesn't apply to "when 'T : 'T" use for "FastGenericEqualityComparer" and others. + | TTyconEqualsTycon (a, b) when haveWitnesses && typeEquiv g a b && (match tryDestTyparTy g a with ValueSome tp -> tp.StaticReq = TyparStaticReq.HeadTypeStaticReq | _ -> false) -> + StaticOptimizationAnswer.Yes | TTyconEqualsTycon (a, b) -> // Both types must be nominal for a definite result let rec checkTypes a b = @@ -4898,17 +4947,17 @@ let decideStaticOptimizationConstraint g c = | ValueSome tcref1 -> if tcref1.IsStructOrEnumTycon then StaticOptimizationAnswer.Yes else StaticOptimizationAnswer.No | ValueNone -> StaticOptimizationAnswer.Unknown -let rec DecideStaticOptimizations g cs = +let rec DecideStaticOptimizations g cs haveWitnesses = match cs with | [] -> StaticOptimizationAnswer.Yes | h :: t -> - let d = decideStaticOptimizationConstraint g h + let d = decideStaticOptimizationConstraint g h haveWitnesses if d = StaticOptimizationAnswer.No then StaticOptimizationAnswer.No - elif d = StaticOptimizationAnswer.Yes then DecideStaticOptimizations g t + elif d = StaticOptimizationAnswer.Yes then DecideStaticOptimizations g t haveWitnesses else StaticOptimizationAnswer.Unknown let mkStaticOptimizationExpr g (cs, e1, e2, m) = - let d = DecideStaticOptimizations g cs in + let d = DecideStaticOptimizations g cs false if d = StaticOptimizationAnswer.No then e2 elif d = StaticOptimizationAnswer.Yes then e1 else Expr.StaticOptimization (cs, e1, e2, m) @@ -6916,6 +6965,25 @@ let mkCallNewDecimal (g: TcGlobals) m (e1, e2, e3, e4, e5) = mkApps g (typedExpr let mkCallNewFormat (g: TcGlobals) m aty bty cty dty ety e1 = mkApps g (typedExprForIntrinsic g m g.new_format_info, [[aty;bty;cty;dty;ety]], [ e1 ], m) +let tryMkCallBuiltInWitness (g: TcGlobals) traitInfo argExprs m = + let info, tinst = g.makeBuiltInWitnessInfo traitInfo + let vref = ValRefForIntrinsic info + match vref.TryDeref with + | ValueSome v -> + let f = exprForValRef m vref + mkApps g ((f, v.Type), [tinst], argExprs, m) |> Some + | ValueNone -> + None + +let tryMkCallCoreFunctionAsBuiltInWitness (g: TcGlobals) info tyargs argExprs m = + let vref = ValRefForIntrinsic info + match vref.TryDeref with + | ValueSome v -> + let f = exprForValRef m vref + mkApps g ((f, v.Type), [tyargs], argExprs, m) |> Some + | ValueNone -> + None + let TryEliminateDesugaredConstants g m c = match c with | Const.Decimal d -> @@ -7783,9 +7851,34 @@ let LinearizeTopMatch g parent = function //--------------------------------------------------------------------------- -// XmlDoc signatures +// Witnesses //--------------------------------------------------------------------------- +let GenWitnessArgTys (g: TcGlobals) (traitInfo: TraitWitnessInfo) = + let (TraitWitnessInfo(_tys, _nm, _memFlags, argtys, _rty)) = traitInfo + let argtys = if argtys.IsEmpty then [g.unit_ty] else argtys + let argtysl = List.map List.singleton argtys + argtysl + //match tys with + //| _ when not memFlags.IsInstance -> argtysl + //| [ty] -> [ty] :: argtysl + //| [_; _] -> [g.obj_ty] :: argtysl + //| _ -> failwith "unexpected empty type support for trait constraint" + +let GenWitnessTy (g: TcGlobals) (traitInfo: TraitWitnessInfo) = + let rty = match traitInfo.ReturnType with None -> g.unit_ty | Some ty -> ty + let argtysl = GenWitnessArgTys g traitInfo + mkMethodTy g argtysl rty + +let GenWitnessTys (g: TcGlobals) (cxs: TraitWitnessInfos) = + if g.generateWitnesses then + cxs |> List.map (GenWitnessTy g) + else + [] + +//--------------------------------------------------------------------------- +// XmlDoc signatures +//--------------------------------------------------------------------------- let commaEncs strs = String.concat "," strs let angleEnc str = "{" + str + "}" @@ -7865,9 +7958,9 @@ and tyargsEnc g (gtpsType, gtpsMethod) args = | [a] when (match (stripTyEqns g a) with TType_measure _ -> true | _ -> false) -> "" // float should appear as just "float" in the generated .XML xmldoc file | _ -> angleEnc (commaEncs (List.map (typeEnc g (gtpsType, gtpsMethod)) args)) -let XmlDocArgsEnc g (gtpsType, gtpsMethod) argTs = - if isNil argTs then "" - else "(" + String.concat "," (List.map (typeEnc g (gtpsType, gtpsMethod)) argTs) + ")" +let XmlDocArgsEnc g (gtpsType, gtpsMethod) argTys = + if isNil argTys then "" + else "(" + String.concat "," (List.map (typeEnc g (gtpsType, gtpsMethod)) argTys) + ")" let buildAccessPath (cp: CompilationPath option) = match cp with @@ -7877,8 +7970,8 @@ let buildAccessPath (cp: CompilationPath option) = | None -> "Extension Type" let prependPath path name = if path = "" then name else path + "." + name -let XmlDocSigOfVal g path (v: Val) = - let parentTypars, methTypars, argInfos, prefix, path, name = +let XmlDocSigOfVal g full path (v: Val) = + let parentTypars, methTypars, cxs, argInfos, rty, prefix, path, name = // CLEANUP: this is one of several code paths that treat module values and members // separately when really it would be cleaner to make sure GetTopValTypeInFSharpForm, GetMemberTypeInFSharpForm etc. @@ -7886,8 +7979,9 @@ let XmlDocSigOfVal g path (v: Val) = match v.MemberInfo with | Some membInfo when not v.IsExtensionMember -> - (* Methods, Properties etc. *) - let tps, argInfos, _, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags (Option.get v.ValReprInfo) v.Type v.Range + // Methods, Properties etc. + let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal v + let tps, witnessInfos, argInfos, rty, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags (Option.get v.ValReprInfo) numEnclosingTypars v.Type v.Range let prefix, name = match membInfo.MemberFlags.MemberKind with | MemberKind.ClassConstructor @@ -7901,18 +7995,22 @@ let XmlDocSigOfVal g path (v: Val) = match PartitionValTypars g v with | Some(_, memberParentTypars, memberMethodTypars, _, _) -> memberParentTypars, memberMethodTypars | None -> [], tps - parentTypars, methTypars, argInfos, prefix, path, name + parentTypars, methTypars, witnessInfos, argInfos, rty, prefix, path, name | _ -> // Regular F# values and extension members let w = arityOfVal v - let tps, argInfos, _, _ = GetTopValTypeInCompiledForm g w v.Type v.Range + let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal v + let tps, witnessInfos, argInfos, rty, _ = GetTopValTypeInCompiledForm g w numEnclosingTypars v.Type v.Range let name = v.CompiledName g.CompilerGlobalState let prefix = if w.NumCurriedArgs = 0 && isNil tps then "P:" else "M:" - [], tps, argInfos, prefix, path, name - let argTs = argInfos |> List.concat |> List.map fst - let args = XmlDocArgsEnc g (parentTypars, methTypars) argTs + [], tps, witnessInfos, argInfos, rty, prefix, path, name + + let witnessArgTys = GenWitnessTys g cxs + let argTys = argInfos |> List.concat |> List.map fst + let argTys = witnessArgTys @ argTys @ (match rty with Some t when full -> [t] | _ -> []) + let args = XmlDocArgsEnc g (parentTypars, methTypars) argTys let arity = List.length methTypars in (* C# XML doc adds `` to *generic* member names *) let genArity = if arity=0 then "" else sprintf "``%d" arity prefix + prependPath path name + genArity + args @@ -8328,7 +8426,9 @@ and rewriteExprStructure env expr = else Expr.App (f0', f0ty, tyargs, args', m) | Expr.Quote (ast, {contents=Some(typeDefs, argTypes, argExprs, data)}, isFromQueryExpression, m, ty) -> - Expr.Quote ((if env.IsUnderQuotations then RewriteExpr env ast else ast), {contents=Some(typeDefs, argTypes, rewriteExprs env argExprs, data)}, isFromQueryExpression, m, ty) + Expr.Quote ((if env.IsUnderQuotations then RewriteExpr env ast else ast), + {contents=Some(typeDefs, argTypes, rewriteExprs env argExprs, data)}, + isFromQueryExpression, m, ty) | Expr.Quote (ast, {contents=None}, isFromQueryExpression, m, ty) -> Expr.Quote ((if env.IsUnderQuotations then RewriteExpr env ast else ast), {contents=None}, isFromQueryExpression, m, ty) @@ -8786,7 +8886,7 @@ let EvalLiteralExprOrAttribArg g x = let GetTypeOfIntrinsicMemberInCompiledForm g (vref: ValRef) = assert (not vref.IsExtensionMember) let membInfo, topValInfo = checkMemberValRef vref - let tps, argInfos, rty, retInfo = GetTypeOfMemberInMemberForm g vref + let tps, cxs, argInfos, rty, retInfo = GetTypeOfMemberInMemberForm g vref let argInfos = // Check if the thing is really an instance member compiled as a static member // If so, the object argument counts as a normal argument in the compiled form @@ -8798,7 +8898,7 @@ let GetTypeOfIntrinsicMemberInCompiledForm g (vref: ValRef) = argInfos | h :: _ -> h :: argInfos else argInfos - tps, argInfos, rty, retInfo + tps, cxs, argInfos, rty, retInfo //-------------------------------------------------------------------------- @@ -9100,6 +9200,19 @@ let CombineCcuContentFragments m l = CombineModuleOrNamespaceTypeList [] m l +/// An immutable mappping from witnesses to some data. +/// +/// Note: this uses an immutable HashMap/Dictionary with an IEqualityComparer that captures TcGlobals, see EmptyTraitWitnessInfoHashMap +type TraitWitnessInfoHashMap<'T> = ImmutableDictionary + +/// Create an empty immutable mapping from witnesses to some data +let EmptyTraitWitnessInfoHashMap g : TraitWitnessInfoHashMap<'T> = + ImmutableDictionary.Create( + { new IEqualityComparer<_> with + member __.Equals(a, b) = traitKeysAEquiv g TypeEquivEnv.Empty a b + member __.GetHashCode(a) = hash a.MemberName + }) + let (|WhileExpr|_|) expr = match expr with | Expr.Op (TOp.While (sp1, sp2), _, [Expr.Lambda (_, _, _, [_gv], guardExpr, _, _);Expr.Lambda (_, _, _, [_bv], bodyExpr, _, _)], m) -> diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index dce873e1a8c..0912493f5b3 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -18,6 +18,7 @@ open FSharp.Compiler.SyntaxTree open FSharp.Compiler.TypedTree open FSharp.Compiler.TcGlobals open FSharp.Compiler.XmlDoc +open System.Collections.Immutable type Erasure = EraseAll | EraseMeasures | EraseNone @@ -714,6 +715,8 @@ type UncurriedArgInfos = (TType * ArgReprInfo) list type CurriedArgInfos = UncurriedArgInfos list +type TraitWitnessInfos = TraitWitnessInfo list + val destTopForallTy : TcGlobals -> ValReprInfo -> TType -> Typars * TType val GetTopTauTypeInFSharpForm : TcGlobals -> ArgReprInfo list list -> TType -> range -> CurriedArgInfos * TType @@ -724,7 +727,7 @@ val IsCompiledAsStaticProperty : TcGlobals -> Val -> bool val IsCompiledAsStaticPropertyWithField : TcGlobals -> Val -> bool -val GetTopValTypeInCompiledForm : TcGlobals -> ValReprInfo -> TType -> range -> Typars * CurriedArgInfos * TType option * ArgReprInfo +val GetTopValTypeInCompiledForm : TcGlobals -> ValReprInfo -> int -> TType -> range -> Typars * TraitWitnessInfos * CurriedArgInfos * TType option * ArgReprInfo val GetFSharpViewOfReturnType : TcGlobals -> TType option -> TType @@ -820,6 +823,10 @@ val traitsAEquivAux : Erasure -> TcGlobals -> TypeEquivEnv -> TraitCon val traitsAEquiv : TcGlobals -> TypeEquivEnv -> TraitConstraintInfo -> TraitConstraintInfo -> bool +val traitKeysAEquivAux : Erasure -> TcGlobals -> TypeEquivEnv -> TraitWitnessInfo -> TraitWitnessInfo -> bool + +val traitKeysAEquiv : TcGlobals -> TypeEquivEnv -> TraitWitnessInfo -> TraitWitnessInfo -> bool + val typarConstraintsAEquivAux : Erasure -> TcGlobals -> TypeEquivEnv -> TyparConstraint -> TyparConstraint -> bool val typarConstraintsAEquiv : TcGlobals -> TypeEquivEnv -> TyparConstraint -> TyparConstraint -> bool @@ -875,11 +882,11 @@ val normalizeMeasure : TcGlobals -> Measure -> Measure val GetTypeOfMemberInFSharpForm : TcGlobals -> ValRef -> Typars * CurriedArgInfos * TType * ArgReprInfo -val GetTypeOfMemberInMemberForm : TcGlobals -> ValRef -> Typars * CurriedArgInfos * TType option * ArgReprInfo +val GetTypeOfMemberInMemberForm : TcGlobals -> ValRef -> Typars * TraitWitnessInfos * CurriedArgInfos * TType option * ArgReprInfo -val GetTypeOfIntrinsicMemberInCompiledForm : TcGlobals -> ValRef -> Typars * CurriedArgInfos * TType option * ArgReprInfo +val GetTypeOfIntrinsicMemberInCompiledForm : TcGlobals -> ValRef -> Typars * TraitWitnessInfos * CurriedArgInfos * TType option * ArgReprInfo -val GetMemberTypeInMemberForm : TcGlobals -> MemberFlags -> ValReprInfo -> TType -> range -> Typars * CurriedArgInfos * TType option * ArgReprInfo +val GetMemberTypeInMemberForm : TcGlobals -> MemberFlags -> ValReprInfo -> int -> TType -> range -> Typars * TraitWitnessInfos * CurriedArgInfos * TType option * ArgReprInfo /// Returns (parentTypars,memberParentTypars,memberMethodTypars,memberToParentInst,tinst) val PartitionValTyparsForApparentEnclosingType : TcGlobals -> Val -> (Typars * Typars * Typars * TyparInst * TType list) option @@ -890,6 +897,9 @@ val PartitionValTypars : TcGlobals -> Val -> (Typars * Typars * Typars * TyparIn /// Returns (parentTypars,memberParentTypars,memberMethodTypars,memberToParentInst,tinst) val PartitionValRefTypars : TcGlobals -> ValRef -> (Typars * Typars * Typars * TyparInst * TType list) option +/// Count the number of type parameters on the enclosing type +val CountEnclosingTyparsOfActualParentOfVal: Val -> int + val ReturnTypeOfPropertyVal : TcGlobals -> Val -> TType val ArgInfosOfPropertyVal : TcGlobals -> Val -> UncurriedArgInfos @@ -1997,6 +2007,12 @@ val mkStaticCall_String_Concat4 : TcGlobals -> range -> Expr -> Expr -> Expr -> val mkStaticCall_String_Concat_Array : TcGlobals -> range -> Expr -> Expr +/// Use a witness in BuiltInWitnesses +val tryMkCallBuiltInWitness : TcGlobals -> TraitConstraintInfo -> Expr list -> range -> Expr option + +/// Use an operator as a witness +val tryMkCallCoreFunctionAsBuiltInWitness : TcGlobals -> IntrinsicValRef -> TType list -> Expr list -> range -> Expr option + //------------------------------------------------------------------------- // operations primarily associated with the optimization to fix // up loops to generate .NET code that does not include array bound checks @@ -2168,7 +2184,7 @@ val buildAccessPath : CompilationPath option -> string val XmlDocArgsEnc : TcGlobals -> Typars * Typars -> TType list -> string -val XmlDocSigOfVal : TcGlobals -> string -> Val -> string +val XmlDocSigOfVal : TcGlobals -> full: bool -> string -> Val -> string val XmlDocSigOfUnionCase : (string list -> string) @@ -2191,7 +2207,7 @@ type StaticOptimizationAnswer = | No = -1y | Unknown = 0y -val DecideStaticOptimizations : TcGlobals -> StaticOptimization list -> StaticOptimizationAnswer +val DecideStaticOptimizations : TcGlobals -> StaticOptimization list -> haveWitnesses: bool -> StaticOptimizationAnswer val mkStaticOptimizationExpr : TcGlobals -> StaticOptimization list * Expr * Expr * range -> Expr @@ -2323,6 +2339,24 @@ val isThreadOrContextStatic: TcGlobals -> Attrib list -> bool val mkUnitDelayLambda: TcGlobals -> range -> Expr -> Expr +val GenWitnessArgTys: TcGlobals -> TraitWitnessInfo -> TType list list + +val GenWitnessTys: TcGlobals -> TraitWitnessInfos -> TType list + +val GenWitnessTy: TcGlobals -> TraitWitnessInfo -> TType + +val GetTraitConstraintInfosOfTypars: TcGlobals -> Typars -> TraitConstraintInfo list + +val GetTraitWitnessInfosOfTypars: TcGlobals -> numParentTypars: int -> typars: Typars -> TraitWitnessInfos + +/// An immutable mappping from witnesses to some data. +/// +/// Note: this uses an immutable HashMap/Dictionary with an IEqualityComparer that captures TcGlobals, see EmptyTraitWitnessInfoHashMap +type TraitWitnessInfoHashMap<'T> = ImmutableDictionary + +/// Create an empty immutable mapping from witnesses to some data +val EmptyTraitWitnessInfoHashMap: TcGlobals -> TraitWitnessInfoHashMap<'T> + /// Match expressions that are an application of a particular F# function value val (|ValApp|_|) : TcGlobals -> ValRef -> Expr -> (TypeInst * Exprs * range) option diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 628120aa723..01a73dc6d06 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -341,7 +341,7 @@ module XmlDocWriter = let computeXmlDocSigs (tcGlobals, generatedCcu: CcuThunk) = (* the xmlDocSigOf* functions encode type into string to be used in "id" *) let g = tcGlobals - let doValSig ptext (v: Val) = if (hasDoc v.XmlDoc) then v.XmlDocSig <- XmlDocSigOfVal g ptext v + let doValSig ptext (v: Val) = if hasDoc v.XmlDoc then v.XmlDocSig <- XmlDocSigOfVal g false ptext v let doTyconSig ptext (tc: Tycon) = if (hasDoc tc.XmlDoc) then tc.XmlDocSig <- XmlDocSigOfTycon [ptext; tc.CompiledName] for vref in tc.MembersOfFSharpTyconSorted do @@ -904,10 +904,10 @@ module MainModuleBuilder = |> List.map (fun (referencedTypeDefs, reflectedDefinitionBytes) -> let reflectedDefinitionResourceName = QuotationPickler.SerializedReflectedDefinitionsResourceNameBase+"-"+assemblyName+"-"+string(newUnique())+"-"+string(hash reflectedDefinitionBytes) let reflectedDefinitionAttrs = - match QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat tcGlobals with - | QuotationTranslator.QuotationSerializationFormat.FSharp_40_Plus -> + let qf = QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat tcGlobals + if qf.SupportsDeserializeEx then [ mkCompilationMappingAttrForQuotationResource tcGlobals (reflectedDefinitionResourceName, referencedTypeDefs) ] - | QuotationTranslator.QuotationSerializationFormat.FSharp_20_Plus -> + else [ ] let reflectedDefinitionResource = { Name=reflectedDefinitionResourceName diff --git a/src/fsharp/infos.fs b/src/fsharp/infos.fs index e511470475e..e0fafcab49d 100755 --- a/src/fsharp/infos.fs +++ b/src/fsharp/infos.fs @@ -439,7 +439,7 @@ let MakeSlotSig (nm, ty, ctps, mtps, paraml, retTy) = copySlotSig (TSlotSig(nm, /// - the return type of the method /// - the actual type arguments of the enclosing type. let private AnalyzeTypeOfMemberVal isCSharpExt g (ty, vref: ValRef) = - let memberAllTypars, _, retTy, _ = GetTypeOfMemberInMemberForm g vref + let memberAllTypars, _, _, retTy, _ = GetTypeOfMemberInMemberForm g vref if isCSharpExt || vref.IsExtensionMember then [], memberAllTypars, retTy, [] else @@ -449,13 +449,15 @@ let private AnalyzeTypeOfMemberVal isCSharpExt g (ty, vref: ValRef) = /// Get the object type for a member value which is an extension method (C#-style or F#-style) let private GetObjTypeOfInstanceExtensionMethod g (vref: ValRef) = - let _, curriedArgInfos, _, _ = GetTopValTypeInCompiledForm g vref.ValReprInfo.Value vref.Type vref.Range + let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal vref.Deref + let _, _, curriedArgInfos, _, _ = GetTopValTypeInCompiledForm g vref.ValReprInfo.Value numEnclosingTypars vref.Type vref.Range curriedArgInfos.Head.Head |> fst -/// Get the object type for a member value which is a C#-style extension method +/// Get the object type for a member value, which might be a C#-style extension method let private GetArgInfosOfMember isCSharpExt g (vref: ValRef) = if isCSharpExt then - let _, curriedArgInfos, _, _ = GetTopValTypeInCompiledForm g vref.ValReprInfo.Value vref.Type vref.Range + let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal vref.Deref + let _, _, curriedArgInfos, _, _ = GetTopValTypeInCompiledForm g vref.ValReprInfo.Value numEnclosingTypars vref.Type vref.Range [ curriedArgInfos.Head.Tail ] else ArgInfosOfMember g vref @@ -1511,7 +1513,8 @@ type MethInfo = | ValInRecScope false -> error(Error((FSComp.SR.InvalidRecursiveReferenceToAbstractSlot()), m)) | _ -> () - let allTyparsFromMethod, _, retTy, _ = GetTypeOfMemberInMemberForm g vref + let allTyparsFromMethod, _, _, retTy, _ = GetTypeOfMemberInMemberForm g vref + // A slot signature is w.r.t. the type variables of the type it is associated with. // So we have to rename from the member type variables to the type variables of the type. let formalEnclosingTypars = x.ApparentEnclosingTyconRef.Typars m diff --git a/src/fsharp/symbols/SymbolHelpers.fs b/src/fsharp/symbols/SymbolHelpers.fs index e717ac5d5a2..4999a7eafb8 100644 --- a/src/fsharp/symbols/SymbolHelpers.fs +++ b/src/fsharp/symbols/SymbolHelpers.fs @@ -538,7 +538,7 @@ module internal SymbolHelpers = ap + sep + vref.TopValDeclaringEntity.CompiledName else ap - v.XmlDocSig <- XmlDocSigOfVal g path v + v.XmlDocSig <- XmlDocSigOfVal g false path v Some (ccuFileName, v.XmlDocSig) let GetXmlDocSigOfRecdFieldInfo (rfinfo: RecdFieldInfo) = @@ -591,7 +591,7 @@ module internal SymbolHelpers = let ccuFileName = vref.nlr.Ccu.FileName let v = vref.Deref if v.XmlDocSig = "" && v.HasDeclaringEntity then - v.XmlDocSig <- XmlDocSigOfVal g vref.TopValDeclaringEntity.CompiledRepresentationForNamedType.Name v + v.XmlDocSig <- XmlDocSigOfVal g false vref.TopValDeclaringEntity.CompiledRepresentationForNamedType.Name v Some (ccuFileName, v.XmlDocSig) else None diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs index e496f677f6c..70c18372541 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs @@ -2751,6 +2751,169 @@ Microsoft.FSharp.Reflection.UnionCaseInfo: System.String ToString() Microsoft.FSharp.Reflection.UnionCaseInfo: System.String get_Name() Microsoft.FSharp.Reflection.UnionCaseInfo: System.Type DeclaringType Microsoft.FSharp.Reflection.UnionCaseInfo: System.Type get_DeclaringType() +Microsoft.FSharp.Collections.ArrayModule: T Average$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,T]], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], T[]) +Microsoft.FSharp.Collections.ArrayModule: T Sum$W[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], T[]) +Microsoft.FSharp.Collections.ArrayModule: TResult AverageBy$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[TResult,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[T,TResult], T[]) +Microsoft.FSharp.Collections.ArrayModule: TResult SumBy$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[TResult,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[T,TResult], T[]) +Microsoft.FSharp.Collections.ComparisonIdentity: System.Collections.Generic.IComparer`1[T] NonStructural$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]]) +Microsoft.FSharp.Collections.HashIdentity: System.Collections.Generic.IEqualityComparer`1[T] NonStructural$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]]) +Microsoft.FSharp.Collections.ListModule: T Average$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,T]], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], Microsoft.FSharp.Collections.FSharpList`1[T]) +Microsoft.FSharp.Collections.ListModule: T Sum$W[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], Microsoft.FSharp.Collections.FSharpList`1[T]) +Microsoft.FSharp.Collections.ListModule: TResult AverageBy$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[TResult,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[T,TResult], Microsoft.FSharp.Collections.FSharpList`1[T]) +Microsoft.FSharp.Collections.ListModule: TResult SumBy$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[TResult,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[T,TResult], Microsoft.FSharp.Collections.FSharpList`1[T]) +Microsoft.FSharp.Collections.SeqModule: T Average$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,T]], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], System.Collections.Generic.IEnumerable`1[T]) +Microsoft.FSharp.Collections.SeqModule: T Sum$W[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], System.Collections.Generic.IEnumerable`1[T]) +Microsoft.FSharp.Collections.SeqModule: TResult AverageBy$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[TResult,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[T,TResult], System.Collections.Generic.IEnumerable`1[T]) +Microsoft.FSharp.Collections.SeqModule: TResult SumBy$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[TResult,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[T,TResult], System.Collections.Generic.IEnumerable`1[T]) +Microsoft.FSharp.Core.ExtraTopLevelOperators+Checked: Byte ToByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Byte], T) +Microsoft.FSharp.Core.ExtraTopLevelOperators+Checked: SByte ToSByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.SByte], T) +Microsoft.FSharp.Core.ExtraTopLevelOperators: Byte ToByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Byte], T) +Microsoft.FSharp.Core.ExtraTopLevelOperators: Double ToDouble$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Double], T) +Microsoft.FSharp.Core.ExtraTopLevelOperators: SByte ToSByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.SByte], T) +Microsoft.FSharp.Core.ExtraTopLevelOperators: Single ToSingle$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Single], T) +Microsoft.FSharp.Core.LanguagePrimitives: T DivideByInt$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,T]], T, Int32) +Microsoft.FSharp.Core.LanguagePrimitives: T GenericOne$W[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T]) +Microsoft.FSharp.Core.LanguagePrimitives: T GenericZero$W[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T]) +Microsoft.FSharp.Core.LanguagePrimitives: TResult CheckedSubtractionDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult CheckedUnaryNegationDynamic[T,TResult](T) +Microsoft.FSharp.Core.LanguagePrimitives: TResult DivisionDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult ModulusDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult BitwiseAndDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult ExclusiveOrDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult BitwiseOrDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult EqualityDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult ExplicitDynamic[T,TResult](T) +Microsoft.FSharp.Core.LanguagePrimitives: TResult GreaterThanDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult GreaterThanOrEqualDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult InequalityDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult LeftShiftDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult LessThanDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult LessThanOrEqualDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult LogicalNotDynamic[T,TResult](T) +Microsoft.FSharp.Core.LanguagePrimitives: TResult RightShiftDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult SubtractionDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult UnaryNegationDynamic[T,TResult](T) +Microsoft.FSharp.Core.NoDynamicInvocationAttribute: Void .ctor(Boolean) +Microsoft.FSharp.Core.Operators+Checked: Byte ToByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Byte], T) +Microsoft.FSharp.Core.Operators+Checked: Char ToChar$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Char], T) +Microsoft.FSharp.Core.Operators+Checked: Int16 ToInt16$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int16], T) +Microsoft.FSharp.Core.Operators+Checked: Int32 ToInt32$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int32], T) +Microsoft.FSharp.Core.Operators+Checked: Int32 ToInt$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int32], T) +Microsoft.FSharp.Core.Operators+Checked: Int64 ToInt64$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int64], T) +Microsoft.FSharp.Core.Operators+Checked: IntPtr ToIntPtr$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.IntPtr], T) +Microsoft.FSharp.Core.Operators+Checked: SByte ToSByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.SByte], T) +Microsoft.FSharp.Core.Operators+Checked: T op_UnaryNegation$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators+Checked: T3 op_Addition$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, T2) +Microsoft.FSharp.Core.Operators+Checked: T3 op_Multiply$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, T2) +Microsoft.FSharp.Core.Operators+Checked: T3 op_Subtraction$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, T2) +Microsoft.FSharp.Core.Operators+Checked: UInt16 ToUInt16$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt16], T) +Microsoft.FSharp.Core.Operators+Checked: UInt32 ToUInt32$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt32], T) +Microsoft.FSharp.Core.Operators+Checked: UInt64 ToUInt64$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt64], T) +Microsoft.FSharp.Core.Operators+Checked: UIntPtr ToUIntPtr$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UIntPtr], T) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: Boolean op_Equality$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]], T, T) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: Boolean op_GreaterThanOrEqual$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[TResult,System.Boolean]], T, TResult) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: Boolean op_GreaterThan$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[TResult,System.Boolean]], T, TResult) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: Boolean op_Inequality$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]], T, T) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: Boolean op_LessThanOrEqual$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[TResult,System.Boolean]], T, TResult) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: Boolean op_LessThan$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[TResult,System.Boolean]], T, TResult) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: Int32 Compare$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]], T, T) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: T Max$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]], T, T) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: T Min$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]], T, T) +Microsoft.FSharp.Core.Operators: Byte ToByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Byte], T) +Microsoft.FSharp.Core.Operators: Char ToChar$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Char], T) +Microsoft.FSharp.Core.Operators: Double ToDouble$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Double], T) +Microsoft.FSharp.Core.Operators: Int16 ToInt16$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int16], T) +Microsoft.FSharp.Core.Operators: Int32 Sign$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int32], T) +Microsoft.FSharp.Core.Operators: Int32 ToInt32$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int32], T) +Microsoft.FSharp.Core.Operators: Int32 ToInt$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int32], T) +Microsoft.FSharp.Core.Operators: Int64 ToInt64$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int64], T) +Microsoft.FSharp.Core.Operators: IntPtr ToIntPtr$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.IntPtr], T) +Microsoft.FSharp.Core.Operators: SByte ToSByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.SByte], T) +Microsoft.FSharp.Core.Operators: Single ToSingle$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Single], T) +Microsoft.FSharp.Core.Operators: System.Collections.Generic.IEnumerable`1[T] op_RangeStep$W[T,TStep](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TStep], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[TStep,T]], T, TStep, T) +Microsoft.FSharp.Core.Operators: System.Collections.Generic.IEnumerable`1[T] op_Range$W[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], T, T) +Microsoft.FSharp.Core.Operators: System.Decimal ToDecimal$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Decimal], T) +Microsoft.FSharp.Core.Operators: T Abs$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Acos$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Asin$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Atan$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Ceiling$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Cos$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Cosh$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Exp$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Floor$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Log10$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Log$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T PowInteger$W[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], T, Int32) +Microsoft.FSharp.Core.Operators: T Round$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Sin$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Sinh$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Tan$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Tanh$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Truncate$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T op_BitwiseAnd$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], T, T) +Microsoft.FSharp.Core.Operators: T op_BitwiseOr$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], T, T) +Microsoft.FSharp.Core.Operators: T op_ExclusiveOr$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], T, T) +Microsoft.FSharp.Core.Operators: T op_Exponentiation$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[TResult,T]], T, TResult) +Microsoft.FSharp.Core.Operators: T op_LeftShift$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,T]], T, Int32) +Microsoft.FSharp.Core.Operators: T op_LogicalNot$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T op_RightShift$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,T]], T, Int32) +Microsoft.FSharp.Core.Operators: T op_UnaryNegation$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T op_UnaryPlus$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T2 Atan2$W[T1,T2](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T1,T2]], T1, T1) +Microsoft.FSharp.Core.Operators: T3 op_Addition$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, T2) +Microsoft.FSharp.Core.Operators: T3 op_Division$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, T2) +Microsoft.FSharp.Core.Operators: T3 op_Modulus$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, T2) +Microsoft.FSharp.Core.Operators: T3 op_Multiply$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, T2) +Microsoft.FSharp.Core.Operators: T3 op_Subtraction$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, T2) +Microsoft.FSharp.Core.Operators: TResult Sqrt$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[T,TResult], T) +Microsoft.FSharp.Core.Operators: UInt32 ToUInt$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt32], T) +Microsoft.FSharp.Core.Operators: UInt16 ToUInt16$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt16], T) +Microsoft.FSharp.Core.Operators: UInt32 ToUInt32$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt32], T) +Microsoft.FSharp.Core.Operators: UInt64 ToUInt64$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt64], T) +Microsoft.FSharp.Core.Operators: UIntPtr ToUIntPtr$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UIntPtr], T) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Byte] ToByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Byte], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Byte] ToUInt8$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Byte], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Char] ToChar$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Char], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Decimal] ToDecimal$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Decimal], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Double] ToDouble$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Double], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Double] ToFloat$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Double], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Int16] ToInt16$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int16], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Int32] ToInt32$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int32], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Int32] ToInt$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int32], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Int64] ToInt64$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int64], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.IntPtr] ToIntPtr$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.IntPtr], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.SByte] ToInt8$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.SByte], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.SByte] ToSByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.SByte], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Single] ToFloat32$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Single], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Single] ToSingle$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Single], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.UInt16] ToUInt16$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt16], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.UInt32] ToUInt32$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt32], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.UInt32] ToUInt$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt32], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.UInt64] ToUInt64$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt64], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.UIntPtr] ToUIntPtr$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UIntPtr], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_DivideQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_MinusQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_MultiplyQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_PercentQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_PlusQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkDivideQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkDivide$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], T2) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkMinusQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkMinus$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], T2) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkMultiplyQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkMultiply$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], T2) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkPercentQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkPercent$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], T2) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkPlusQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkPlus$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], T2) +Microsoft.FSharp.Linq.QueryBuilder: System.Nullable`1[TValue] AverageByNullable$W[T,Q,TValue](Microsoft.FSharp.Core.FSharpFunc`2[TValue,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,TValue]], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TValue], Microsoft.FSharp.Core.FSharpFunc`2[TValue,Microsoft.FSharp.Core.FSharpFunc`2[TValue,TValue]], Microsoft.FSharp.Linq.QuerySource`2[T,Q], Microsoft.FSharp.Core.FSharpFunc`2[T,System.Nullable`1[TValue]]) +Microsoft.FSharp.Linq.QueryBuilder: System.Nullable`1[TValue] SumByNullable$W[T,Q,TValue](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TValue], Microsoft.FSharp.Core.FSharpFunc`2[TValue,Microsoft.FSharp.Core.FSharpFunc`2[TValue,TValue]], Microsoft.FSharp.Linq.QuerySource`2[T,Q], Microsoft.FSharp.Core.FSharpFunc`2[T,System.Nullable`1[TValue]]) +Microsoft.FSharp.Linq.QueryBuilder: TValue AverageBy$W[T,Q,TValue](Microsoft.FSharp.Core.FSharpFunc`2[TValue,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,TValue]], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TValue], Microsoft.FSharp.Core.FSharpFunc`2[TValue,Microsoft.FSharp.Core.FSharpFunc`2[TValue,TValue]], Microsoft.FSharp.Linq.QuerySource`2[T,Q], Microsoft.FSharp.Core.FSharpFunc`2[T,TValue]) +Microsoft.FSharp.Linq.QueryBuilder: TValue SumBy$W[T,Q,TValue](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TValue], Microsoft.FSharp.Core.FSharpFunc`2[TValue,Microsoft.FSharp.Core.FSharpFunc`2[TValue,TValue]], Microsoft.FSharp.Linq.QuerySource`2[T,Q], Microsoft.FSharp.Core.FSharpFunc`2[T,TValue]) +Microsoft.FSharp.Quotations.FSharpExpr: Microsoft.FSharp.Quotations.FSharpExpr CallWithWitnesses(Microsoft.FSharp.Quotations.FSharpExpr, System.Reflection.MethodInfo, System.Reflection.MethodInfo, Microsoft.FSharp.Collections.FSharpList`1[Microsoft.FSharp.Quotations.FSharpExpr], Microsoft.FSharp.Collections.FSharpList`1[Microsoft.FSharp.Quotations.FSharpExpr]) +Microsoft.FSharp.Quotations.FSharpExpr: Microsoft.FSharp.Quotations.FSharpExpr CallWithWitnesses(System.Reflection.MethodInfo, System.Reflection.MethodInfo, Microsoft.FSharp.Collections.FSharpList`1[Microsoft.FSharp.Quotations.FSharpExpr], Microsoft.FSharp.Collections.FSharpList`1[Microsoft.FSharp.Quotations.FSharpExpr]) +Microsoft.FSharp.Quotations.PatternsModule: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`5[Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Quotations.FSharpExpr],System.Reflection.MethodInfo,System.Reflection.MethodInfo,Microsoft.FSharp.Collections.FSharpList`1[Microsoft.FSharp.Quotations.FSharpExpr],Microsoft.FSharp.Collections.FSharpList`1[Microsoft.FSharp.Quotations.FSharpExpr]]] CallWithWitnessesPattern(Microsoft.FSharp.Quotations.FSharpExpr) " #if DEBUG let expected = diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs index e2bc4a25a85..413b90b7173 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs @@ -2751,6 +2751,169 @@ Microsoft.FSharp.Reflection.UnionCaseInfo: System.String ToString() Microsoft.FSharp.Reflection.UnionCaseInfo: System.String get_Name() Microsoft.FSharp.Reflection.UnionCaseInfo: System.Type DeclaringType Microsoft.FSharp.Reflection.UnionCaseInfo: System.Type get_DeclaringType() +Microsoft.FSharp.Collections.ArrayModule: T Average$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,T]], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], T[]) +Microsoft.FSharp.Collections.ArrayModule: T Sum$W[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], T[]) +Microsoft.FSharp.Collections.ArrayModule: TResult AverageBy$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[TResult,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[T,TResult], T[]) +Microsoft.FSharp.Collections.ArrayModule: TResult SumBy$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[TResult,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[T,TResult], T[]) +Microsoft.FSharp.Collections.ComparisonIdentity: System.Collections.Generic.IComparer`1[T] NonStructural$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]]) +Microsoft.FSharp.Collections.HashIdentity: System.Collections.Generic.IEqualityComparer`1[T] NonStructural$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]]) +Microsoft.FSharp.Collections.ListModule: T Average$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,T]], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], Microsoft.FSharp.Collections.FSharpList`1[T]) +Microsoft.FSharp.Collections.ListModule: T Sum$W[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], Microsoft.FSharp.Collections.FSharpList`1[T]) +Microsoft.FSharp.Collections.ListModule: TResult AverageBy$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[TResult,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[T,TResult], Microsoft.FSharp.Collections.FSharpList`1[T]) +Microsoft.FSharp.Collections.ListModule: TResult SumBy$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[TResult,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[T,TResult], Microsoft.FSharp.Collections.FSharpList`1[T]) +Microsoft.FSharp.Collections.SeqModule: T Average$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,T]], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], System.Collections.Generic.IEnumerable`1[T]) +Microsoft.FSharp.Collections.SeqModule: T Sum$W[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], System.Collections.Generic.IEnumerable`1[T]) +Microsoft.FSharp.Collections.SeqModule: TResult AverageBy$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[TResult,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[T,TResult], System.Collections.Generic.IEnumerable`1[T]) +Microsoft.FSharp.Collections.SeqModule: TResult SumBy$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TResult], Microsoft.FSharp.Core.FSharpFunc`2[TResult,Microsoft.FSharp.Core.FSharpFunc`2[TResult,TResult]], Microsoft.FSharp.Core.FSharpFunc`2[T,TResult], System.Collections.Generic.IEnumerable`1[T]) +Microsoft.FSharp.Core.ExtraTopLevelOperators+Checked: Byte ToByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Byte], T) +Microsoft.FSharp.Core.ExtraTopLevelOperators+Checked: SByte ToSByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.SByte], T) +Microsoft.FSharp.Core.ExtraTopLevelOperators: Byte ToByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Byte], T) +Microsoft.FSharp.Core.ExtraTopLevelOperators: Double ToDouble$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Double], T) +Microsoft.FSharp.Core.ExtraTopLevelOperators: SByte ToSByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.SByte], T) +Microsoft.FSharp.Core.ExtraTopLevelOperators: Single ToSingle$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Single], T) +Microsoft.FSharp.Core.LanguagePrimitives: T DivideByInt$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,T]], T, Int32) +Microsoft.FSharp.Core.LanguagePrimitives: T GenericOne$W[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T]) +Microsoft.FSharp.Core.LanguagePrimitives: T GenericZero$W[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T]) +Microsoft.FSharp.Core.LanguagePrimitives: TResult CheckedSubtractionDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult CheckedUnaryNegationDynamic[T,TResult](T) +Microsoft.FSharp.Core.LanguagePrimitives: TResult DivisionDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult ModulusDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult BitwiseAndDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult ExclusiveOrDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult BitwiseOrDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult EqualityDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult ExplicitDynamic[T,TResult](T) +Microsoft.FSharp.Core.LanguagePrimitives: TResult GreaterThanDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult GreaterThanOrEqualDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult InequalityDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult LeftShiftDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult LessThanDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult LessThanOrEqualDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult LogicalNotDynamic[T,TResult](T) +Microsoft.FSharp.Core.LanguagePrimitives: TResult RightShiftDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult SubtractionDynamic[T1,T2,TResult](T1, T2) +Microsoft.FSharp.Core.LanguagePrimitives: TResult UnaryNegationDynamic[T,TResult](T) +Microsoft.FSharp.Core.NoDynamicInvocationAttribute: Void .ctor(Boolean) +Microsoft.FSharp.Core.Operators+Checked: Byte ToByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Byte], T) +Microsoft.FSharp.Core.Operators+Checked: Char ToChar$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Char], T) +Microsoft.FSharp.Core.Operators+Checked: Int16 ToInt16$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int16], T) +Microsoft.FSharp.Core.Operators+Checked: Int32 ToInt32$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int32], T) +Microsoft.FSharp.Core.Operators+Checked: Int32 ToInt$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int32], T) +Microsoft.FSharp.Core.Operators+Checked: Int64 ToInt64$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int64], T) +Microsoft.FSharp.Core.Operators+Checked: IntPtr ToIntPtr$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.IntPtr], T) +Microsoft.FSharp.Core.Operators+Checked: SByte ToSByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.SByte], T) +Microsoft.FSharp.Core.Operators+Checked: T op_UnaryNegation$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators+Checked: T3 op_Addition$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, T2) +Microsoft.FSharp.Core.Operators+Checked: T3 op_Multiply$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, T2) +Microsoft.FSharp.Core.Operators+Checked: T3 op_Subtraction$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, T2) +Microsoft.FSharp.Core.Operators+Checked: UInt16 ToUInt16$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt16], T) +Microsoft.FSharp.Core.Operators+Checked: UInt32 ToUInt32$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt32], T) +Microsoft.FSharp.Core.Operators+Checked: UInt64 ToUInt64$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt64], T) +Microsoft.FSharp.Core.Operators+Checked: UIntPtr ToUIntPtr$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UIntPtr], T) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: Boolean op_Equality$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]], T, T) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: Boolean op_GreaterThanOrEqual$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[TResult,System.Boolean]], T, TResult) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: Boolean op_GreaterThan$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[TResult,System.Boolean]], T, TResult) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: Boolean op_Inequality$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]], T, T) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: Boolean op_LessThanOrEqual$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[TResult,System.Boolean]], T, TResult) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: Boolean op_LessThan$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[TResult,System.Boolean]], T, TResult) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: Int32 Compare$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]], T, T) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: T Max$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]], T, T) +Microsoft.FSharp.Core.Operators+NonStructuralComparison: T Min$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,System.Boolean]], T, T) +Microsoft.FSharp.Core.Operators: Byte ToByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Byte], T) +Microsoft.FSharp.Core.Operators: Char ToChar$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Char], T) +Microsoft.FSharp.Core.Operators: Double ToDouble$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Double], T) +Microsoft.FSharp.Core.Operators: Int16 ToInt16$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int16], T) +Microsoft.FSharp.Core.Operators: Int32 Sign$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int32], T) +Microsoft.FSharp.Core.Operators: Int32 ToInt32$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int32], T) +Microsoft.FSharp.Core.Operators: Int32 ToInt$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int32], T) +Microsoft.FSharp.Core.Operators: Int64 ToInt64$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int64], T) +Microsoft.FSharp.Core.Operators: IntPtr ToIntPtr$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.IntPtr], T) +Microsoft.FSharp.Core.Operators: SByte ToSByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.SByte], T) +Microsoft.FSharp.Core.Operators: Single ToSingle$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Single], T) +Microsoft.FSharp.Core.Operators: System.Collections.Generic.IEnumerable`1[T] op_RangeStep$W[T,TStep](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TStep], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[TStep,T]], T, TStep, T) +Microsoft.FSharp.Core.Operators: System.Collections.Generic.IEnumerable`1[T] op_Range$W[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], T, T) +Microsoft.FSharp.Core.Operators: System.Decimal ToDecimal$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Decimal], T) +Microsoft.FSharp.Core.Operators: T Abs$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Acos$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Asin$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Atan$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Ceiling$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Cos$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Cosh$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Exp$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Floor$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Log10$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Log$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T PowInteger$W[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,T], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], T, Int32) +Microsoft.FSharp.Core.Operators: T Round$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Sin$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Sinh$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Tan$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Tanh$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T Truncate$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T op_BitwiseAnd$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], T, T) +Microsoft.FSharp.Core.Operators: T op_BitwiseOr$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], T, T) +Microsoft.FSharp.Core.Operators: T op_ExclusiveOr$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[T,T]], T, T) +Microsoft.FSharp.Core.Operators: T op_Exponentiation$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[TResult,T]], T, TResult) +Microsoft.FSharp.Core.Operators: T op_LeftShift$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,T]], T, Int32) +Microsoft.FSharp.Core.Operators: T op_LogicalNot$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T op_RightShift$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,T]], T, Int32) +Microsoft.FSharp.Core.Operators: T op_UnaryNegation$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T op_UnaryPlus$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,T], T) +Microsoft.FSharp.Core.Operators: T2 Atan2$W[T1,T2](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T1,T2]], T1, T1) +Microsoft.FSharp.Core.Operators: T3 op_Addition$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, T2) +Microsoft.FSharp.Core.Operators: T3 op_Division$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, T2) +Microsoft.FSharp.Core.Operators: T3 op_Modulus$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, T2) +Microsoft.FSharp.Core.Operators: T3 op_Multiply$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, T2) +Microsoft.FSharp.Core.Operators: T3 op_Subtraction$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, T2) +Microsoft.FSharp.Core.Operators: TResult Sqrt$W[T,TResult](Microsoft.FSharp.Core.FSharpFunc`2[T,TResult], T) +Microsoft.FSharp.Core.Operators: UInt32 ToUInt$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt32], T) +Microsoft.FSharp.Core.Operators: UInt16 ToUInt16$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt16], T) +Microsoft.FSharp.Core.Operators: UInt32 ToUInt32$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt32], T) +Microsoft.FSharp.Core.Operators: UInt64 ToUInt64$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt64], T) +Microsoft.FSharp.Core.Operators: UIntPtr ToUIntPtr$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UIntPtr], T) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Byte] ToByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Byte], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Byte] ToUInt8$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Byte], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Char] ToChar$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Char], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Decimal] ToDecimal$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Decimal], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Double] ToDouble$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Double], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Double] ToFloat$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Double], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Int16] ToInt16$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int16], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Int32] ToInt32$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int32], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Int32] ToInt$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int32], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Int64] ToInt64$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int64], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.IntPtr] ToIntPtr$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.IntPtr], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.SByte] ToInt8$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.SByte], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.SByte] ToSByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.SByte], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Single] ToFloat32$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Single], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.Single] ToSingle$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Single], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.UInt16] ToUInt16$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt16], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.UInt32] ToUInt32$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt32], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.UInt32] ToUInt$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt32], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.UInt64] ToUInt64$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UInt64], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableModule: System.Nullable`1[System.UIntPtr] ToUIntPtr$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.UIntPtr], System.Nullable`1[T]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_DivideQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_MinusQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_MultiplyQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_PercentQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_PlusQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], T1, System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkDivideQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkDivide$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], T2) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkMinusQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkMinus$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], T2) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkMultiplyQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkMultiply$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], T2) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkPercentQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkPercent$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], T2) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkPlusQmark$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], System.Nullable`1[T2]) +Microsoft.FSharp.Linq.NullableOperators: System.Nullable`1[T3] op_QmarkPlus$W[T1,T2,T3](Microsoft.FSharp.Core.FSharpFunc`2[T1,Microsoft.FSharp.Core.FSharpFunc`2[T2,T3]], System.Nullable`1[T1], T2) +Microsoft.FSharp.Linq.QueryBuilder: System.Nullable`1[TValue] AverageByNullable$W[T,Q,TValue](Microsoft.FSharp.Core.FSharpFunc`2[TValue,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,TValue]], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TValue], Microsoft.FSharp.Core.FSharpFunc`2[TValue,Microsoft.FSharp.Core.FSharpFunc`2[TValue,TValue]], Microsoft.FSharp.Linq.QuerySource`2[T,Q], Microsoft.FSharp.Core.FSharpFunc`2[T,System.Nullable`1[TValue]]) +Microsoft.FSharp.Linq.QueryBuilder: System.Nullable`1[TValue] SumByNullable$W[T,Q,TValue](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TValue], Microsoft.FSharp.Core.FSharpFunc`2[TValue,Microsoft.FSharp.Core.FSharpFunc`2[TValue,TValue]], Microsoft.FSharp.Linq.QuerySource`2[T,Q], Microsoft.FSharp.Core.FSharpFunc`2[T,System.Nullable`1[TValue]]) +Microsoft.FSharp.Linq.QueryBuilder: TValue AverageBy$W[T,Q,TValue](Microsoft.FSharp.Core.FSharpFunc`2[TValue,Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,TValue]], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TValue], Microsoft.FSharp.Core.FSharpFunc`2[TValue,Microsoft.FSharp.Core.FSharpFunc`2[TValue,TValue]], Microsoft.FSharp.Linq.QuerySource`2[T,Q], Microsoft.FSharp.Core.FSharpFunc`2[T,TValue]) +Microsoft.FSharp.Linq.QueryBuilder: TValue SumBy$W[T,Q,TValue](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,TValue], Microsoft.FSharp.Core.FSharpFunc`2[TValue,Microsoft.FSharp.Core.FSharpFunc`2[TValue,TValue]], Microsoft.FSharp.Linq.QuerySource`2[T,Q], Microsoft.FSharp.Core.FSharpFunc`2[T,TValue]) +Microsoft.FSharp.Quotations.FSharpExpr: Microsoft.FSharp.Quotations.FSharpExpr CallWithWitnesses(Microsoft.FSharp.Quotations.FSharpExpr, System.Reflection.MethodInfo, System.Reflection.MethodInfo, Microsoft.FSharp.Collections.FSharpList`1[Microsoft.FSharp.Quotations.FSharpExpr], Microsoft.FSharp.Collections.FSharpList`1[Microsoft.FSharp.Quotations.FSharpExpr]) +Microsoft.FSharp.Quotations.FSharpExpr: Microsoft.FSharp.Quotations.FSharpExpr CallWithWitnesses(System.Reflection.MethodInfo, System.Reflection.MethodInfo, Microsoft.FSharp.Collections.FSharpList`1[Microsoft.FSharp.Quotations.FSharpExpr], Microsoft.FSharp.Collections.FSharpList`1[Microsoft.FSharp.Quotations.FSharpExpr]) +Microsoft.FSharp.Quotations.PatternsModule: Microsoft.FSharp.Core.FSharpOption`1[System.Tuple`5[Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Quotations.FSharpExpr],System.Reflection.MethodInfo,System.Reflection.MethodInfo,Microsoft.FSharp.Collections.FSharpList`1[Microsoft.FSharp.Quotations.FSharpExpr],Microsoft.FSharp.Collections.FSharpList`1[Microsoft.FSharp.Quotations.FSharpExpr]]] CallWithWitnessesPattern(Microsoft.FSharp.Quotations.FSharpExpr) " #if DEBUG let expected = diff --git a/tests/fsharp/core/quotes/test.fsx b/tests/fsharp/core/quotes/test.fsx index 8be5e210971..6a8bdb5d185 100644 --- a/tests/fsharp/core/quotes/test.fsx +++ b/tests/fsharp/core/quotes/test.fsx @@ -3161,6 +3161,681 @@ module TestMatchBang = (Ok ()) testSimpleMatchBang() + +#if LANGVERSION_PREVIEW +module WitnessTests = + open FSharp.Data.UnitSystems.SI.UnitSymbols + + test "check CallWithWitness" + (<@ 1 + 1 @> + |> function + | CallWithWitnesses(None, minfo1, minfo2, witnessArgs, args) -> + minfo1.Name = "op_Addition" && + minfo1.GetParameters().Length = 2 && + minfo2.Name = "op_Addition$W" && + minfo2.GetParameters().Length = 3 && + (printfn "checking witnessArgs.Length = %d... args.Length"; true) && + witnessArgs.Length = 1 && + (printfn "checking args.Length = %d... args.Length"; true) && + args.Length = 2 && + (printfn "checking witnessArgs is a Lambda..."; true) && + (match witnessArgs with [ Lambda _ ] -> true | _ -> false) && + (printfn "checking witnessArg is the expected call..."; true) && + (match witnessArgs with [ Lambda (v1A, Lambda (v2A, Call(None, m, [ Patterns.Var v1B; Patterns.Var v2B]))) ] when m.Name = "op_Addition" && v1A = v1B && v2A = v2B -> true | _ -> false) + (printfn "checking witnessArg is not a CalWithWitnesses..."; true) && + (match witnessArgs with [ Lambda (v1A, Lambda (v2A, CallWithWitnesses _)) ] -> false | _ -> true) && + (printfn "checking args..."; true) && + (match args with [ Int32 _; Int32 _ ] -> true | _ -> false) + | _ -> false) + + test "check CallWithWitness (DateTime + TimeSpan)" + (<@ System.DateTime.Now + System.TimeSpan.Zero @> + |> function + | CallWithWitnesses(None, minfo1, minfo2, witnessArgs, args) -> + minfo1.Name = "op_Addition" && + (printfn "checking minfo1.GetParameters().Length..."; true) && + minfo1.GetParameters().Length = 2 && + minfo2.Name = "op_Addition$W" && + (printfn "checking minfo2.GetParameters().Length..."; true) && + minfo2.GetParameters().Length = 3 && + (printfn "checking witnessArgs.Length..."; true) && + witnessArgs.Length = 1 && + (printfn "checking witnessArg is the expected call, witnessArgs = %A" witnessArgs; true) && + (match witnessArgs with + | [ Lambda (v1A, Lambda (v2A, Call(None, m, [Patterns.Var v1B; Patterns.Var v2B]))) ] + when m.Name = "op_Addition" + && m.GetParameters().[0].ParameterType.Name = "DateTime" + && m.GetParameters().[1].ParameterType.Name = "TimeSpan" + && v1A = v1B + && v2A = v2B -> true + | _ -> false) + (printfn "checking witnessArg is not a CallWithWitnesses, witnessArgs = %A" witnessArgs; true) && + (match witnessArgs with [ Lambda (v1A, Lambda (v2A, CallWithWitnesses args)) ] -> printfn "unexpected! %A" args; false | _ -> true) && + args.Length = 2 && + (printfn "checking args..."; true) && + (match args with [ _; _ ] -> true | _ -> false) && + (match witnessArgs with [ Lambda _ ] -> true | _ -> false) + | CallWithWitnesses _ -> + printfn "no object" + false + | _ -> + printfn "incorrect node" + false) + + test "check Call (DateTime + TimeSpan)" + (<@ System.DateTime.Now + System.TimeSpan.Zero @> + |> function + | Call(None, minfo1, args) -> + minfo1.Name = "op_Addition" && + (printfn "checking minfo1.GetParameters().Length..."; true) && + minfo1.GetParameters().Length = 2 && + //minfo2.GetParameters().[0].Name = "op_Addition" && + args.Length = 2 && + (match args with [ _; _ ] -> true | _ -> false) + | _ -> false) + + type C() = + static member inline StaticAdd (x, y) = x + y + member inline __.InstanceAdd (x, y) = x + y + + test "check CallWithWitness (DateTime + TimeSpan) using static member" + (<@ C.StaticAdd(System.DateTime.Now, System.TimeSpan.Zero) @> + |> function + | CallWithWitnesses(None, minfo1, minfo2, witnessArgs, args) -> + minfo1.IsStatic && + minfo1.Name = "StaticAdd" && + (printfn "checking minfo1.GetParameters().Length..."; true) && + minfo1.GetParameters().Length = 2 && + minfo2.IsStatic && + minfo2.Name = "StaticAdd$W" && + (printfn "checking minfo2.GetParameters().Length = %d..." (minfo2.GetParameters().Length); true) && + minfo2.GetParameters().Length = 3 && + (printfn "checking witnessArgs.Length..."; true) && + witnessArgs.Length = 1 && + (printfn "checking args.Length..."; true) && + args.Length = 2 && + (printfn "witnessArgs..."; true) && + (match witnessArgs with [ Lambda _ ] -> true | _ -> false) && + (printfn "args..."; true) && + (match args with [ _; _ ] -> true | _ -> false) + | CallWithWitnesses(None, minfo1, minfo2, witnessArgs, args) -> + printfn "no object..." + false + | _ -> false) + + test "check CallWithWitness (DateTime + TimeSpan) using instance member" + (<@ C().InstanceAdd(System.DateTime.Now, System.TimeSpan.Zero) @> + |> function + | CallWithWitnesses(Some _obj, minfo1, minfo2, witnessArgs, args) -> + not minfo1.IsStatic && + minfo1.Name = "InstanceAdd" && + (printfn "checking minfo1.GetParameters().Length..."; true) && + minfo1.GetParameters().Length = 2 && + not minfo2.IsStatic && + minfo2.Name = "InstanceAdd$W" && + (printfn "checking minfo2.GetParameters().Length = %d..." (minfo2.GetParameters().Length); true) && + minfo2.GetParameters().Length = 3 && + (printfn "checking witnessArgs.Length..."; true) && + witnessArgs.Length = 1 && + (printfn "checking args.Length..."; true) && + args.Length = 2 && + (printfn "witnessArgs..."; true) && + (match witnessArgs with [ Lambda _ ] -> true | _ -> false) && + (printfn "args..."; true) && + (match args with [ _; _ ] -> true | _ -> false) + | CallWithWitnesses(None, minfo1, minfo2, witnessArgs, args) -> + printfn "no object..." + false + | _ -> false) + + test "check CallWithWitnesses all operators)" + (let tests = + [ <@@ sin 1.0 @@>, true + <@@ sin 1.0f @@>, true + <@@ sign 1.0f @@>, true + <@@ sqrt 1.0f @@>, true + <@@ 2.0f ** 2.0f @@>, true + <@@ atan2 3.0 4.0 @@>, true + <@@ 1.0f + 4.0f @@>, true + <@@ 1.0f - 4.0f @@>, true + <@@ 1.0f * 4.0f @@>, true + <@@ 1.0M * 4.0M @@>, true + <@@ 1.0f / 4.0f @@>, true + <@@ 1 % 4 @@>, true + <@@ -(4.0M) @@>, true + + <@@ 1y <<< 3 @@>, true + <@@ 1uy <<< 3 @@>, true + <@@ 1s <<< 3 @@>, true + <@@ 1us <<< 3 @@>, true + <@@ 1 <<< 3 @@>, true + <@@ 1u <<< 3 @@>, true + <@@ 1L <<< 3 @@>, true + <@@ 1UL <<< 3 @@>, true + <@@ LanguagePrimitives.GenericOne <<< 3 @@>, false + <@@ LanguagePrimitives.GenericOne <<< 3 @@>, false + + <@@ 1y >>> 3 @@>, true + <@@ 1uy >>> 3 @@>, true + <@@ 1s >>> 3 @@>, true + <@@ 1us >>> 3 @@>, true + <@@ 1 >>> 3 @@>, true + <@@ 1u >>> 3 @@>, true + <@@ 1L >>> 3 @@>, true + <@@ 1UL >>> 3 @@>, true + <@@ LanguagePrimitives.GenericOne >>> 3 @@>, false + <@@ LanguagePrimitives.GenericOne >>> 3 @@>, false + + <@@ 1y &&& 3y @@>, true + <@@ 1uy &&& 3uy @@>, true + <@@ 1s &&& 3s @@>, true + <@@ 1us &&& 3us @@>, true + <@@ 1 &&& 3 @@>, true + <@@ 1u &&& 3u @@>, true + <@@ 1L &&& 3L @@>, true + <@@ 1UL &&& 3UL @@>, true + <@@ LanguagePrimitives.GenericOne &&& LanguagePrimitives.GenericOne @@>, false + <@@ LanguagePrimitives.GenericOne &&& LanguagePrimitives.GenericOne @@>, false + + <@@ 1y ||| 3y @@>, true + <@@ 1uy ||| 3uy @@>, true + <@@ 1s ||| 3s @@>, true + <@@ 1us ||| 3us @@>, true + <@@ 1 ||| 3 @@>, true + <@@ 1u ||| 3u @@>, true + <@@ 1L ||| 3L @@>, true + <@@ 1UL ||| 3UL @@>, true + <@@ LanguagePrimitives.GenericOne ||| LanguagePrimitives.GenericOne @@>, false + <@@ LanguagePrimitives.GenericOne ||| LanguagePrimitives.GenericOne @@>, false + + <@@ 1y ^^^ 3y @@>, true + <@@ 1uy ^^^ 3uy @@>, true + <@@ 1s ^^^ 3s @@>, true + <@@ 1us ^^^ 3us @@>, true + <@@ 1 ^^^ 3 @@>, true + <@@ 1u ^^^ 3u @@>, true + <@@ 1L ^^^ 3L @@>, true + <@@ 1UL ^^^ 3UL @@>, true + <@@ LanguagePrimitives.GenericOne ^^^ LanguagePrimitives.GenericOne @@>, false + <@@ LanguagePrimitives.GenericOne ^^^ LanguagePrimitives.GenericOne @@>, false + + <@@ ~~~3y @@>, true + <@@ ~~~3uy @@>, true + <@@ ~~~3s @@>, true + <@@ ~~~3us @@>, true + <@@ ~~~3 @@>, true + <@@ ~~~3u @@>, true + <@@ ~~~3L @@>, true + <@@ ~~~3UL @@>, true + <@@ ~~~LanguagePrimitives.GenericOne @@>, false + <@@ ~~~LanguagePrimitives.GenericOne @@>, false + + <@@ byte 3uy @@>, true + <@@ byte 3y @@>, true + <@@ byte 3s @@>, true + <@@ byte 3us @@>, true + <@@ byte 3 @@>, true + <@@ byte 3u @@>, true + <@@ byte 3L @@>, true + <@@ byte 3UL @@>, true + <@@ byte 3.0f @@>, true + <@@ byte 3.0 @@>, true + <@@ byte LanguagePrimitives.GenericOne @@>, false + <@@ byte LanguagePrimitives.GenericOne @@>, false + <@@ byte 3.0M @@>, true + <@@ byte "3" @@>, false + + <@@ sbyte 3uy @@>, true + <@@ sbyte 3y @@>, true + <@@ sbyte 3s @@>, true + <@@ sbyte 3us @@>, true + <@@ sbyte 3 @@>, true + <@@ sbyte 3u @@>, true + <@@ sbyte 3L @@>, true + <@@ sbyte 3UL @@>, true + <@@ sbyte 3.0f @@>, true + <@@ sbyte 3.0 @@>, true + <@@ sbyte LanguagePrimitives.GenericOne @@>, false + <@@ sbyte LanguagePrimitives.GenericOne @@>, false + <@@ sbyte 3.0M @@>, true + <@@ sbyte "3" @@>, false + + <@@ int16 3uy @@>, true + <@@ int16 3y @@>, true + <@@ int16 3s @@>, true + <@@ int16 3us @@>, true + <@@ int16 3 @@>, true + <@@ int16 3u @@>, true + <@@ int16 3L @@>, true + <@@ int16 3UL @@>, true + <@@ int16 3.0f @@>, true + <@@ int16 3.0 @@>, true + <@@ int16 LanguagePrimitives.GenericOne @@>, false + <@@ int16 LanguagePrimitives.GenericOne @@>, false + <@@ int16 3.0M @@>, true + <@@ int16 "3" @@>, false + + <@@ uint16 3uy @@>, true + <@@ uint16 3y @@>, true + <@@ uint16 3s @@>, true + <@@ uint16 3us @@>, true + <@@ uint16 3 @@>, true + <@@ uint16 3u @@>, true + <@@ uint16 3L @@>, true + <@@ uint16 3UL @@>, true + <@@ uint16 3.0f @@>, true + <@@ uint16 3.0 @@>, true + <@@ uint16 LanguagePrimitives.GenericOne @@>, false + <@@ uint16 LanguagePrimitives.GenericOne @@>, false + <@@ uint16 3.0M @@>, true + <@@ uint16 "3" @@>, false + + <@@ int32 3uy @@>, true + <@@ int32 3y @@>, true + <@@ int32 3s @@>, true + <@@ int32 3us @@>, true + <@@ int32 3 @@>, true + <@@ int32 3u @@>, true + <@@ int32 3L @@>, true + <@@ int32 3UL @@>, true + <@@ int32 3.0f @@>, true + <@@ int32 3.0 @@>, true + <@@ int32 LanguagePrimitives.GenericOne @@>, false + <@@ int32 LanguagePrimitives.GenericOne @@>, false + <@@ int32 3.0M @@>, true + <@@ int32 "3" @@>, false + + <@@ uint32 3uy @@>, true + <@@ uint32 3y @@>, true + <@@ uint32 3s @@>, true + <@@ uint32 3us @@>, true + <@@ uint32 3 @@>, true + <@@ uint32 3u @@>, true + <@@ uint32 3L @@>, true + <@@ uint32 3UL @@>, true + <@@ uint32 3.0f @@>, true + <@@ uint32 3.0 @@>, true + <@@ uint32 LanguagePrimitives.GenericOne @@>, false + <@@ uint32 LanguagePrimitives.GenericOne @@>, false + <@@ uint32 3.0M @@>, true + <@@ uint32 "3" @@>, false + + <@@ int64 3uy @@>, true + <@@ int64 3y @@>, true + <@@ int64 3s @@>, true + <@@ int64 3us @@>, true + <@@ int64 3 @@>, true + <@@ int64 3u @@>, true + <@@ int64 3L @@>, true + <@@ int64 3UL @@>, true + <@@ int64 3.0f @@>, true + <@@ int64 3.0 @@>, true + <@@ int64 LanguagePrimitives.GenericOne @@>, false + <@@ int64 LanguagePrimitives.GenericOne @@>, false + <@@ int64 3.0M @@>, true + <@@ int64 "3" @@>, false + + <@@ uint64 3uy @@>, true + <@@ uint64 3y @@>, true + <@@ uint64 3s @@>, true + <@@ uint64 3us @@>, true + <@@ uint64 3 @@>, true + <@@ uint64 3u @@>, true + <@@ uint64 3L @@>, true + <@@ uint64 3UL @@>, true + <@@ uint64 3.0f @@>, true + <@@ uint64 3.0 @@>, true + <@@ uint64 LanguagePrimitives.GenericOne @@>, false + <@@ uint64 LanguagePrimitives.GenericOne @@>, false + <@@ uint64 3.0M @@>, true + <@@ uint64 "3" @@>, false + + <@@ nativeint 3uy @@>, true + <@@ nativeint 3y @@>, true + <@@ nativeint 3s @@>, true + <@@ nativeint 3us @@>, true + <@@ nativeint 3 @@>, true + <@@ nativeint 3u @@>, true + <@@ nativeint 3L @@>, true + <@@ nativeint 3UL @@>, true + <@@ nativeint 3.0f @@>, true + <@@ nativeint 3.0 @@>, true + <@@ nativeint LanguagePrimitives.GenericOne @@>, false + <@@ nativeint LanguagePrimitives.GenericOne @@>, false + //<@@ nativeint 3.0M @@>, false + //<@@ nativeint "3" @@>, false + + <@@ unativeint 3uy @@>, true + <@@ unativeint 3y @@>, true + <@@ unativeint 3s @@>, true + <@@ unativeint 3us @@>, true + <@@ unativeint 3 @@>, true + <@@ unativeint 3u @@>, true + <@@ unativeint 3L @@>, true + <@@ unativeint 3UL @@>, true + <@@ unativeint 3.0f @@>, true + <@@ unativeint 3.0 @@>, true + <@@ unativeint LanguagePrimitives.GenericOne @@>, false + <@@ unativeint LanguagePrimitives.GenericOne @@>, false + //<@@ unativeint 3.0M @@>, true + //<@@ unativeint "3" @@>, true + + <@@ LanguagePrimitives.GenericZero @@>, true + <@@ LanguagePrimitives.GenericZero @@>, true + <@@ LanguagePrimitives.GenericZero @@>, true + <@@ LanguagePrimitives.GenericZero @@>, true + <@@ LanguagePrimitives.GenericZero @@>, true + <@@ LanguagePrimitives.GenericZero @@>, true + <@@ LanguagePrimitives.GenericOne @@>, true + <@@ LanguagePrimitives.GenericOne @@>, true + <@@ LanguagePrimitives.GenericOne @@>, true + <@@ LanguagePrimitives.GenericOne @@>, true + <@@ LanguagePrimitives.GenericOne @@>, true + <@@ LanguagePrimitives.GenericOne @@>, true + <@@ List.sum [ 1; 2 ] @@>, true + <@@ List.sum [ 1.0f; 2.0f ] @@>, true + <@@ List.sum [ 1.0; 2.0 ] @@>, true + <@@ List.sum [ 1.0M; 2.0M ] @@>, true + <@@ List.average [ 1.0; 2.0 ] @@>, true + <@@ List.average [ 1.0f; 2.0f ] @@>, true + <@@ List.average [ 1.0M; 2.0M ] @@>, true + ] + + tests |> List.forall (fun (test, canEval) -> + if canEval then + printfn "--> checking we can evaluate %A" test + FSharp.Linq.RuntimeHelpers.LeafExpressionConverter.EvaluateQuotation test |> ignore + printfn "<-- evaluated!" + else + printfn "skipping evaluation of %A because LinqExpressionConverter can't handle it" test + printfn "checking %A" test + match test with + | CallWithWitnesses(None, minfo1, minfo2, witnessArgs, args) -> + minfo1.IsStatic && + minfo2.IsStatic && + minfo2.Name = minfo1.Name + "$W" && + (* + (printfn "checking minfo2.GetParameters().Length = %d..." (minfo2.GetParameters().Length); true) && + minfo2.GetParameters().Length = 3 && + (printfn "checking witnessArgs.Length..."; true) && + witnessArgs.Length = 1 && + (printfn "checking args.Length..."; true) && + args.Length = 2 && + (printfn "witnessArgs..."; true) && + (match witnessArgs with [ Lambda _ ] -> true | _ -> false) && + (printfn "args..."; true) && + (match args with [ _; _ ] -> true | _ -> false) + *) + true + | _ -> false)) + +module MoreWitnessTests = + + open System.Runtime.CompilerServices + open System.IO + + // TODO - ths fails + [] + module Tests = + let inline f0 (x: 'T) : (unit -> 'T) list = + [] + + let inline f (x: 'T) : (unit -> 'T) list = + [(fun () -> x + x)] + + type C() = + member inline __.F(x: 'T) = x + x + + [] + module M = + + type C with + member inline __.F2(x: 'T) = x + x + static member inline F2Static(x: 'T) = x + x + + [] + type FileExt = + [] + static member CreateDirectory(fileInfo: FileInfo) = + Directory.CreateDirectory fileInfo.Directory.FullName + + [] + static member inline F3(s: string, x: 'T) = + x + x + + [] + static member inline F4(s: string, x1: 'T, x2: 'T) = + x1 + x2 + + + [] + module Usage = + let q0 = <@ f0 3 @> + let q1 = <@ f 3 @> + let q2 = <@ C().F(3) @> + let q3 = <@ C().F2(3) @> + let q4 = <@ C.F2Static(3) @> + let q5 = <@ "".F3(3) @> + let q6 = <@ "".F4(3, 4) @> + + check "wekncjeck1" (q0.ToString()) "Call (None, f0, [Value (3)])" + check "wekncjeck2" (q1.ToString()) "Call (None, f, [Value (3)])" + check "wekncjeck3" (q2.ToString()) "Call (Some (NewObject (C)), F, [Value (3)])" + check "wekncjeck4" (q3.ToString()) "Call (None, C.F2, [NewObject (C), Value (3)])" + check "wekncjeck5" (q4.ToString()) "Call (None, C.F2Static.Static, [Value (3)])" + check "wekncjeck6" (q5.ToString()) "Call (None, F3, [Value (\"\"), Value (3)])" + check "wekncjeck7" (q6.ToString()) "Call (None, F4, [Value (\"\"), Value (3), Value (4)])" + + check "ewlknweknl1" (FSharp.Linq.RuntimeHelpers.LeafExpressionConverter.EvaluateQuotation q0) (box ([] : (unit -> int) list)) + check "ewlknweknl2" (match FSharp.Linq.RuntimeHelpers.LeafExpressionConverter.EvaluateQuotation q1 with :? ((unit -> int) list) as x -> x.[0] ()) 6 + check "ewlknweknl3" (match FSharp.Linq.RuntimeHelpers.LeafExpressionConverter.EvaluateQuotation q2 with :? int as x -> x) 6 + check "ewlknweknl4" (match FSharp.Linq.RuntimeHelpers.LeafExpressionConverter.EvaluateQuotation q3 with :? int as x -> x) 6 + check "ewlknweknl5" (match FSharp.Linq.RuntimeHelpers.LeafExpressionConverter.EvaluateQuotation q4 with :? int as x -> x) 6 + check "ewlknweknl6" (match FSharp.Linq.RuntimeHelpers.LeafExpressionConverter.EvaluateQuotation q5 with :? int as x -> x) 6 + check "ewlknweknl7" (match FSharp.Linq.RuntimeHelpers.LeafExpressionConverter.EvaluateQuotation q6 with :? int as x -> x) 7 + +// Check we can take ReflectedDefinition of things involving witness and trait calls +module QuotationsOfGenericCodeWithWitnesses = + [] + let inline f1 (x: ^T) = x + x // ( ^T : (static member Foo: int -> int) (3)) + + match <@ f1 1 @> with + | Quotations.Patterns.Call(_, mi, _) -> + let mi1 = mi.GetGenericMethodDefinition() + let q1 = Quotations.Expr.TryGetReflectedDefinition(mi1) + check "vwehwevrwv" q1 None + | q -> report_failure (sprintf "gfwhoewvioh - unexpected %A" q) + + + match <@ f1 1 @> with + | Quotations.Patterns.CallWithWitnesses(_, mi, minfoWithWitnesses, _, _) -> + let q2 = Quotations.Expr.TryGetReflectedDefinition(minfoWithWitnesses) + + match q2 with + | Some (Lambda (witnessArgVar, Lambda(v, CallWithWitnesses(None, mi, minfoWithWitnesses, [Var witnessArgVar2], [a2;b2])))) -> + + check "cewlkjwvw0a" witnessArgVar.Name "op_Addition" + check "cewlkjwvw0b" witnessArgVar.Type (typeof int -> int>) + check "cewlkjwvw1a" witnessArgVar2.Name "op_Addition" + check "cewlkjwvw1b" witnessArgVar2.Type (typeof int -> int>) + check "cewlkjwvw2" minfoWithWitnesses.Name "op_Addition$W" + check "vjnvwiowve" a2 b2 + check "cewlkjwvw0" witnessArgVar witnessArgVar2 + + | q -> report_failure (sprintf "gfwhoewvioh32 - unexpected %A" q) + + | q -> report_failure (sprintf "gfwhoewvioh37 - unexpected %A" q) + + + type C() = + static member Foo (x:int) = x + + [] + let inline f3 (x: ^T) = + ( ^T : (static member Foo: int -> int) (3)) + + match <@ f3 (C()) @> with + | Quotations.Patterns.Call(_, mi, _) -> + let mi3 = mi.GetGenericMethodDefinition() + let q3 = Quotations.Expr.TryGetReflectedDefinition(mi3) + check "fekjevwlw" q3 None + | q -> report_failure (sprintf "3kjhhjkkjhe9 - %A unexpected" q) + + match <@ f3 (C()) @> with + | Quotations.Patterns.CallWithWitnesses(_, mi, miw, [w4], _) -> + let q4 = Quotations.Expr.TryGetReflectedDefinition(miw) + + check "vwroirvjkn" miw.Name "f3$W" + + match q4 with + | Some (Lambda(witnessArgVar, Lambda(v, Application(Var witnessArgVar2, Int32 3)))) -> + check "vwehjrwlkj0" witnessArgVar.Name "Foo" + check "vwehjrwlkj1" witnessArgVar.Type (typeof int>) + check "vwehjrwlkj2" witnessArgVar2.Name "Foo" + check "vwehjrwlkj3" witnessArgVar2 witnessArgVar + | _ -> report_failure (sprintf "3kjhhjkkjhe1 - %A unexpected" q4) + + match w4 with + | Lambda(v, Call(None, miFoo, [Var v2])) -> + check "vewhjwveoi1" miFoo.Name "Foo" + check "vewhjwveoi2" v v2 + | _ -> report_failure (sprintf "3kjhhjkkjhe2 - %A unexpected" w4) + + | q -> report_failure (sprintf "3kjhhjkkjhe0 - %A unexpected" q) + +/// Check we can take quotations of implicit operator trait calls + +module QuotationOfConcreteTraitCalls = + + type Foo(s: string) = + member _.S = s + static member (?) (foo : Foo, name : string) = foo.S + name + static member (++) (foo : Foo, name : string) = foo.S + name + static member (?<-) (foo : Foo, name : string, v : string) = () + + let foo = Foo("hello, ") + + // Desugared form is ok, but ? desugars to a method with constraints which aren't allowed in quotes + let q1 = <@ Foo.op_Dynamic(foo, "uhh") @> + let q2 = <@ foo ? uhh @> + + let q3 = <@ Foo.op_DynamicAssignment(foo, "uhh", "hm") @> + let q4 = <@ foo ? uhh <- "hm" @> + let q5 = <@ foo ++ "uhh" @> + + let cleanup (s:string) = s.Replace(" ","").Replace("\n","").Replace("\r","") + check "wekncjeck112a" (cleanup (sprintf "%0A" q1)) "Call(None,op_Dynamic,[PropertyGet(None,foo,[]),Value(\"uhh\")])" + check "wekncjeck112b" (cleanup (sprintf "%0A" q2)) "Application(Application(Lambda(arg0,Lambda(arg1,Call(None,op_Dynamic,[arg0,arg1]))),PropertyGet(None,foo,[])),Value(\"uhh\"))" + check "wekncjeck112c" (cleanup (sprintf "%0A" q3)) "Call(None,op_DynamicAssignment,[PropertyGet(None,foo,[]),Value(\"uhh\"),Value(\"hm\")])" + check "wekncjeck112d" (cleanup (sprintf "%0A" q4)) "Application(Application(Application(Lambda(arg0,Lambda(arg1,Lambda(arg2,Call(None,op_DynamicAssignment,[arg0,arg1,arg2])))),PropertyGet(None,foo,[])),Value(\"uhh\")),Value(\"hm\"))" + check "wekncjeck112e" (cleanup (sprintf "%0A" q5)) "Application(Application(Lambda(arg0,Lambda(arg1,Call(None,op_PlusPlus,[arg0,arg1]))),PropertyGet(None,foo,[])),Value(\"uhh\"))" + + // Let bound functions handle this ok + let (?) o s = + printfn "%s" s + + // No error here because it binds to the let bound version + let q8 = <@ foo ? uhh @> + +// Check we can take ReflectedDefinition of things involving multiple implicit witnesses and trait calls +module QuotationsOfGenericCodeWithMultipleWitnesses = + + // This has three type paramters and two witnesses, one for + and one for - + [] + let inline f1 x y z = (x + y) - z + + match <@ f1 1 2 3 @> with + | Quotations.Patterns.Call(_, mi, _) -> + let q1 = Quotations.Expr.TryGetReflectedDefinition(mi) + check "vwehwevrwv" q1 None + | q -> report_failure (sprintf "gfwhoewvioh - unexpected %A" q) + + match <@ f1 1 2 3 @> with + | Quotations.Patterns.CallWithWitnesses(_, mi, minfoWithWitnesses, _, _) -> + let q2 = Quotations.Expr.TryGetReflectedDefinition(minfoWithWitnesses) + + match q2 with + | Some (Lambda (witnessArgVarAdd, + Lambda (witnessArgVarSub, + Lambda(xVar, + Lambda(yVar, + Lambda(zVar, + CallWithWitnesses(None, mi1, minfoWithWitnesses1, [Var witnessArgVarSub2], + [CallWithWitnesses(None, mi2, minfoWithWitnesses2, [Var witnessArgVarAdd2], + [Var xVar2; Var yVar2]); + Var zVar2]))))))) -> + + check "cewlkjwv54" witnessArgVarAdd.Name "op_Addition" + check "cewlkjwv55" witnessArgVarSub.Name "op_Subtraction" + check "cewlkjwv56" witnessArgVarAdd.Type (typeof int -> int>) + check "cewlkjwv57" witnessArgVarSub.Type (typeof int -> int>) + check "cewlkjwv58" witnessArgVarAdd witnessArgVarAdd2 + check "cewlkjwv59" witnessArgVarSub witnessArgVarSub2 + check "cewlkjwv60" xVar xVar2 + check "cewlkjwv61" yVar yVar2 + check "cewlkjwv62" zVar zVar2 + + | q -> report_failure (sprintf "gfwhoewvioh32 - unexpected %A" q) + + | q -> report_failure (sprintf "gfwhoewvioh37 - unexpected %A" q) + +// Like QuotationsOfGenericCodeWithMultipleWitnesses but with implementation code the other way around +module QuotationsOfGenericCodeWithMultipleWitnesses2 = + + [] + let inline f1 x y z = (x - y) + z + + match <@ f1 1 2 3 @> with + | Quotations.Patterns.Call(_, mi, _) -> + let q1 = Quotations.Expr.TryGetReflectedDefinition(mi) + check "xvwehwevrwv" q1 None + | q -> report_failure (sprintf "xgfwhoewvioh - unexpected %A" q) + + match <@ f1 1 2 3 @> with + | Quotations.Patterns.CallWithWitnesses(_, mi, minfoWithWitnesses, _, _) -> + let q2 = Quotations.Expr.TryGetReflectedDefinition(minfoWithWitnesses) + + match q2 with + | Some (Lambda (witnessArgVarAdd, + Lambda (witnessArgVarSub, + Lambda(xVar, + Lambda(yVar, + Lambda(zVar, + CallWithWitnesses(None, mi1, minfoWithWitnesses1, [Var witnessArgVarAdd2], + [CallWithWitnesses(None, mi2, minfoWithWitnesses2, [Var witnessArgVarSub2], + [Var xVar2; Var yVar2]); + Var zVar2]))))))) -> + + check "xcewlkjwv54" witnessArgVarAdd.Name "op_Addition" + check "xcewlkjwv55" witnessArgVarSub.Name "op_Subtraction" + check "xcewlkjwv56" witnessArgVarAdd.Type (typeof int -> int>) + check "xcewlkjwv57" witnessArgVarSub.Type (typeof int -> int>) + check "xcewlkjwv58" witnessArgVarAdd witnessArgVarAdd2 + check "xcewlkjwv59" witnessArgVarSub witnessArgVarSub2 + check "xcewlkjwv60" xVar xVar2 + check "xcewlkjwv61" yVar yVar2 + check "xcewlkjwv62" zVar zVar2 + + | q -> report_failure (sprintf "xgfwhoewvioh32 - unexpected %A" q) + + | q -> report_failure (sprintf "xgfwhoewvioh37 - unexpected %A" q) + + +module TestOuterConstrainedClass = + // This example where there is an outer constrained class caused numerous failures + // because it was trying to pass witnesses for the constraint in the type + // + // No witnesses are passed for these + type hoop< ^a when ^a : (static member (+) : ^a * ^a -> ^a) > = + { Group1 : ^a + Group2 : ^a } + static member inline (+) (x, y) = x.Group1 + y.Group2 + //member inline this.Sum = this.Group1 + this.Group2 + + let z = { Group1 = 1; Group2 = 2 } + { Group1 = 2; Group2 = 3 } // ok + + +#endif module TestAssemblyAttributes = let attributes = System.Reflection.Assembly.GetExecutingAssembly().GetCustomAttributes(false) @@ -3174,8 +3849,8 @@ let aa = stdout.WriteLine "Test Passed" System.IO.File.WriteAllText("test.ok","ok") exit 0 - | _ -> - stdout.WriteLine "Test Failed" + | errs -> + printfn "Test Failed, errors = %A" errs exit 1 #endif diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index 9e8ae88e623..703d10e8e90 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -964,7 +964,7 @@ module CoreTests = csc cfg """/nologo /target:library /out:cslib.dll""" ["cslib.cs"] - fsc cfg "%s -o:test.exe -r cslib.dll -g" cfg.fsc_flags ["test.fsx"] + fsc cfg "%s --define:LANGVERSION_PREVIEW --langversion:preview -o:test.exe -r cslib.dll -g" cfg.fsc_flags ["test.fsx"] peverify cfg "test.exe" diff --git a/tests/fsharpqa/Source/Conformance/Expressions/ExpressionQuotations/Regressions/env.lst b/tests/fsharpqa/Source/Conformance/Expressions/ExpressionQuotations/Regressions/env.lst index b3340008f23..591171d0080 100644 --- a/tests/fsharpqa/Source/Conformance/Expressions/ExpressionQuotations/Regressions/env.lst +++ b/tests/fsharpqa/Source/Conformance/Expressions/ExpressionQuotations/Regressions/env.lst @@ -40,7 +40,7 @@ SOURCE=EnumFromCSQuote01.fs SCFLAGS="-r:SimpleEnum.dll" PRECMD="\$CSC_PIPE /t:library SimpleEnum.cs" # EnumFromCSQuote01.fs SOURCE=QuoteDynamic01.fs # QuoteDynamic01.fs - SOURCE=E_QuoteDynamic01.fs SCFLAGS="--test:ErrorRanges" # E_QuoteDynamic01.fs + SOURCE=E_QuoteDynamic01.fs SCFLAGS="--langversion:4.6 --test:ErrorRanges" # E_QuoteDynamic01.fs SOURCE=ReflectedDefinitionConstructor01.fs # ReflectedDefinitionConstructor01.fs SOURCE=ReflectedDefinitionConstructor02.fs # ReflectedDefinitionConstructor02.fs diff --git a/tests/fsharpqa/Source/Printing/Quotation01.fs b/tests/fsharpqa/Source/Printing/Quotation01.fs index c34e1e78fbb..8519d0eeee5 100644 --- a/tests/fsharpqa/Source/Printing/Quotation01.fs +++ b/tests/fsharpqa/Source/Printing/Quotation01.fs @@ -1,7 +1,5 @@ // #NoMT #Printing // Regression test for FSHARP1.0:524 -//val it : Quotations.Expr = Value \(1\) {CustomAttributes = \[||\]; -// Raw = \.\.\.; -// Type = System\.Int32;} +//val it : Quotations.Expr = Value \(1\) <@ 1 @>;; exit 0;; From 9754e4b3ab43b6e340bb0050eea169f6838557e6 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 17 Apr 2020 19:38:21 +0100 Subject: [PATCH 03/14] fix build --- src/fsharp/fsc.fs | 6 +++--- src/fsharp/infos.fs | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 628120aa723..82faf0b59fc 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -904,10 +904,10 @@ module MainModuleBuilder = |> List.map (fun (referencedTypeDefs, reflectedDefinitionBytes) -> let reflectedDefinitionResourceName = QuotationPickler.SerializedReflectedDefinitionsResourceNameBase+"-"+assemblyName+"-"+string(newUnique())+"-"+string(hash reflectedDefinitionBytes) let reflectedDefinitionAttrs = - match QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat tcGlobals with - | QuotationTranslator.QuotationSerializationFormat.FSharp_40_Plus -> + let qf = QuotationTranslator.QuotationGenerationScope.ComputeQuotationFormat tcGlobals + if qf.SupportsDeserializeEx then [ mkCompilationMappingAttrForQuotationResource tcGlobals (reflectedDefinitionResourceName, referencedTypeDefs) ] - | QuotationTranslator.QuotationSerializationFormat.FSharp_20_Plus -> + else [ ] let reflectedDefinitionResource = { Name=reflectedDefinitionResourceName diff --git a/src/fsharp/infos.fs b/src/fsharp/infos.fs index e511470475e..d2e27611f9d 100755 --- a/src/fsharp/infos.fs +++ b/src/fsharp/infos.fs @@ -452,7 +452,7 @@ let private GetObjTypeOfInstanceExtensionMethod g (vref: ValRef) = let _, curriedArgInfos, _, _ = GetTopValTypeInCompiledForm g vref.ValReprInfo.Value vref.Type vref.Range curriedArgInfos.Head.Head |> fst -/// Get the object type for a member value which is a C#-style extension method +/// Get the object type for a member value, which might be a C#-style extension method let private GetArgInfosOfMember isCSharpExt g (vref: ValRef) = if isCSharpExt then let _, curriedArgInfos, _, _ = GetTopValTypeInCompiledForm g vref.ValReprInfo.Value vref.Type vref.Range From 5ed3392a80ac88bb8f82a920ace5d656ff1fe199 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sat, 18 Apr 2020 00:03:42 +0100 Subject: [PATCH 04/14] cleanup for feature/witness-passing --- src/fsharp/IlxGen.fs | 54 ++++++++++++++++++------------- src/fsharp/MethodCalls.fs | 25 +++++++------- src/fsharp/Optimizer.fs | 4 +-- src/fsharp/PostInferenceChecks.fs | 2 +- src/fsharp/QuotationTranslator.fs | 10 +++--- 5 files changed, 53 insertions(+), 42 deletions(-) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 9c97cd1d365..be61821291e 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -5809,7 +5809,10 @@ and ComputeMethodImplAttribs cenv (_v: Val) attrs = and DelayGenMethodForBinding cenv mgbuf eenv ilxMethInfoArgs = cenv.delayedGenMethods.Enqueue (fun cenv -> GenMethodForBinding cenv mgbuf eenv ilxMethInfoArgs) -and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, topValInfo, ctorThisValOpt, baseValOpt, methLambdaTypars, methLambdaVars, methodArgTys, body, returnTy) = +and GenMethodForBinding + cenv mgbuf eenv + (v: Val, mspec, access, paramInfos, retInfo, topValInfo, + ctorThisValOpt, baseValOpt, methLambdaTypars, methLambdaVars, argTys, body, returnTy) = let g = cenv.g let m = v.Range @@ -5908,7 +5911,7 @@ and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, yield! GenCompilationArgumentCountsAttr cenv v ] let ilTypars = GenGenericParams cenv eenvUnderMethLambdaTypars methLambdaTypars - let ilParams = GenParams cenv eenv mspec paramInfos methodArgTys (Some nonUnitNonSelfMethodVars) + let ilParams = GenParams cenv eenv mspec paramInfos argTys (Some nonUnitNonSelfMethodVars) let ilReturn = GenReturnInfo cenv eenv mspec.FormalReturnType retInfo let methName = mspec.Name let tref = mspec.MethodRef.DeclaringTypeRef @@ -5950,7 +5953,8 @@ and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, if not useMethodImpl then let edef = GenEventForProperty cenv eenvForMeth mspec v ilAttrsThatGoOnPrimaryItem m returnTy mgbuf.AddEventDef(tref, edef) - | _ -> + + | _ -> let mdef = match v.MemberInfo with @@ -6018,6 +6022,7 @@ and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, // Add the special name flag for all properties let mdef = mdef.WithSpecialName.With(customAttrs= mkILCustomAttrs ((GenAttrs cenv eenv attrsAppliedToGetterOrSetter) @ sourceNameAttribs @ ilAttrsCompilerGenerated)) mdef + | _ -> let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) mdef @@ -6053,11 +6058,11 @@ and GenMethodForBinding cenv mgbuf eenv (v, mspec, access, paramInfos, retInfo, let mdef = if // operator names - mdef.Name.StartsWithOrdinal("op_") || - // active pattern names - mdef.Name.StartsWithOrdinal("|") || - // event add/remove method - v.val_flags.IsGeneratedEventVal then + mdef.Name.StartsWithOrdinal("op_") || + // active pattern names + mdef.Name.StartsWithOrdinal("|") || + // event add/remove method + v.val_flags.IsGeneratedEventVal then mdef.WithSpecialName else mdef @@ -6109,9 +6114,9 @@ and GenSetVal cenv cgbuf eenv (vref, e, m) sequel = GenSetStorage vref.Range cgbuf storage GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel -and GenGetValRefAndSequel cenv cgbuf eenv m (v: ValRef) fetchSequel = +and GenGetValRefAndSequel cenv cgbuf eenv m (v: ValRef) storeSequel = let ty = v.Type - GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv.amap m eenv.tyenv ty) (StorageForValRef cenv.g m v eenv) fetchSequel + GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv.amap m eenv.tyenv ty) (StorageForValRef cenv.g m v eenv) storeSequel and GenGetVal cenv cgbuf eenv (v: ValRef, m) sequel = GenGetValRefAndSequel cenv cgbuf eenv m v None @@ -6185,17 +6190,22 @@ and GenSetStorage m cgbuf storage = and CommitGetStorageSequel cenv cgbuf eenv m ty localCloInfo storeSequel = match localCloInfo, storeSequel with - | Some {contents =NamedLocalIlxClosureInfoGenerator _cloinfo}, _ -> error(InternalError("Unexpected generator", m)) + | Some {contents =NamedLocalIlxClosureInfoGenerator _cloinfo}, _ -> + error(InternalError("Unexpected generator", m)) + | Some {contents =NamedLocalIlxClosureInfoGenerated cloinfo}, Some (tyargs, args, m, sequel) when not (isNil tyargs) -> let actualRetTy = GenNamedLocalTyFuncCall cenv cgbuf eenv ty cloinfo tyargs m CommitGetStorageSequel cenv cgbuf eenv m actualRetTy None (Some ([], args, m, sequel)) + | _, None -> () + | _, Some ([], [], _, sequel) -> GenSequel cenv eenv.cloc cgbuf sequel + | _, Some (tyargs, args, m, sequel) -> GenCurriedArgsAndIndirectCall cenv cgbuf eenv (ty, tyargs, args, m) sequel -and GenGetStorageAndSequel cenv cgbuf eenv m (ty, ilTy) storage storeSequel = +and GenGetStorageAndSequel (cenv: cenv) cgbuf eenv m (ty, ilTy) storage storeSequel = let g = cenv.g match storage with | Local (idx, _, localCloInfo) -> @@ -6250,11 +6260,11 @@ and GenGetStorageAndSequel cenv cgbuf eenv m (ty, ilTy) storage storeSequel = and GenGetLocalVals cenv cgbuf eenvouter m fvs = List.iter (fun v -> GenGetLocalVal cenv cgbuf eenvouter m v None) fvs -and GenGetLocalVal cenv cgbuf eenv m (vspec: Val) fetchSequel = - GenGetStorageAndSequel cenv cgbuf eenv m (vspec.Type, GenTypeOfVal cenv eenv vspec) (StorageForVal cenv.g m vspec eenv) fetchSequel +and GenGetLocalVal cenv cgbuf eenv m (vspec: Val) storeSequel = + GenGetStorageAndSequel cenv cgbuf eenv m (vspec.Type, GenTypeOfVal cenv eenv vspec) (StorageForVal cenv.g m vspec eenv) storeSequel -and GenGetLocalVRef cenv cgbuf eenv m (vref: ValRef) fetchSequel = - GenGetStorageAndSequel cenv cgbuf eenv m (vref.Type, GenTypeOfVal cenv eenv vref.Deref) (StorageForValRef cenv.g m vref eenv) fetchSequel +and GenGetLocalVRef cenv cgbuf eenv m (vref: ValRef) storeSequel = + GenGetStorageAndSequel cenv cgbuf eenv m (vref.Type, GenTypeOfVal cenv eenv vref.Deref) (StorageForValRef cenv.g m vref eenv) storeSequel and GenStoreVal cenv cgbuf eenv m (vspec: Val) = GenSetStorage vspec.Range cgbuf (StorageForVal cenv.g m vspec eenv) @@ -7628,12 +7638,12 @@ let CodegenAssembly cenv eenv mgbuf fileImpls = // structures representing the contents of the module. //------------------------------------------------------------------------- -let GetEmptyIlxGenEnv (ilg: ILGlobals) ccu = +let GetEmptyIlxGenEnv (g: TcGlobals) ccu = let thisCompLoc = CompLocForCcu ccu { tyenv=TypeReprEnv.Empty cloc = thisCompLoc valsInScope=ValMap<_>.Empty - someTypeInThisAssembly=ilg.typ_Object (* dummy value *) + someTypeInThisAssembly= g.ilg.typ_Object (* dummy value *) isFinalFile = false letBoundVars=[] liveLocals=IntMap.empty() @@ -7686,12 +7696,12 @@ let GenerateCode (cenv, anonTypeTable, eenv, TypedAssemblyAfterOptimization file with | QuotationTranslator.InvalidQuotedTerm e -> warning e; None) - let referencedTypeDefs, freeTypes, spliceArgExprs = qscope.Close() + let referencedTypeDefs, typeSplices, exprSplices = qscope.Close() - for (_freeType, m) in freeTypes do + for (_typeSplice, m) in typeSplices do error(InternalError("A free type variable was detected in a reflected definition", m)) - for (_spliceArgExpr, m) in spliceArgExprs do + for (_exprSplice, m) in exprSplices do error(Error(FSComp.SR.ilReflectedDefinitionsCannotUseSliceOperator(), m)) let defnsResourceBytes = defns |> QuotationPickler.PickleDefns @@ -7812,7 +7822,7 @@ let ClearGeneratedValue (ctxt: ExecutionContext) (g: TcGlobals) eenv (v: Val) = type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: ConstraintSolver.TcValF, ccu: CcuThunk) = // The incremental state held by the ILX code generator - let mutable ilxGenEnv = GetEmptyIlxGenEnv tcGlobals.ilg ccu + let mutable ilxGenEnv = GetEmptyIlxGenEnv tcGlobals ccu let anonTypeTable = AnonTypeGenerationTable() let intraAssemblyInfo = { StaticFieldInfo = new Dictionary<_, _>(HashIdentity.Structural) } let casApplied = new Dictionary() diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index 2883a525167..5cfcaa8de02 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -1821,19 +1821,21 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = | FSAnonRecdFieldSln(anonInfo, tinst, i) -> Choice3Of5 (anonInfo, tinst, i) - | BuiltInSln -> - Choice5Of5 () - | ClosedExprSln expr -> Choice4Of5 expr + + | BuiltInSln -> + Choice5Of5 () match sln with | Choice1Of5(minfo, methArgTys) -> let argExprs = - // FIX for #421894 - typechecker assumes that coercion can be applied for the trait calls arguments but codegen doesn't emit coercion operations + // FIX for #421894 - typechecker assumes that coercion can be applied for the trait + // calls arguments but codegen doesn't emit coercion operations // result - generation of non-verifiable code // fix - apply coercion for the arguments (excluding 'receiver' argument in instance calls) - // flatten list of argument types (looks like trait calls with curried arguments are not supported so we can just convert argument list in straightforward way) + // flatten list of argument types (looks like trait calls with curried arguments are not supported so + // we can just convert argument list in straight-forward way) let argTypes = minfo.GetParamTypes(amap, m, methArgTys) |> List.concat @@ -1854,13 +1856,12 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = if minfo.IsStruct && minfo.IsInstance && (match argExprs with [] -> false | h :: _ -> not (isByrefTy g (tyOfExpr g h))) then let h, t = List.headAndTail argExprs let wrap, h', _readonly, _writeonly = mkExprAddrOfExpr g true false PossiblyMutates h None m - Some (wrap (Expr.Op (TOp.TraitCall (traitInfo), [], (h' :: t), m))) + Some (wrap (Expr.Op (TOp.TraitCall traitInfo, [], (h' :: t), m))) else Some (MakeMethInfoCall amap m minfo methArgTys argExprs ) | Choice2Of5 (tinst, rfref, isSet) -> match isSet, rfref.RecdField.IsStatic, argExprs.Length with - // static setter | true, true, 1 -> Some (mkStaticRecdFieldSet (rfref, tinst, argExprs.[0], m)) @@ -1878,14 +1879,14 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = // static getter | false, true, 0 -> - Some (mkStaticRecdFieldGet (rfref, tinst, m)) + Some (mkStaticRecdFieldGet (rfref, tinst, m)) // instance getter | false, false, 1 -> - if rfref.Tycon.IsStructOrEnumTycon && isByrefTy g (tyOfExpr g argExprs.[0]) then - Some (mkRecdFieldGetViaExprAddr (argExprs.[0], rfref, tinst, m)) - else - Some (mkRecdFieldGet g (argExprs.[0], rfref, tinst, m)) + if rfref.Tycon.IsStructOrEnumTycon && isByrefTy g (tyOfExpr g argExprs.[0]) then + Some (mkRecdFieldGetViaExprAddr (argExprs.[0], rfref, tinst, m)) + else + Some (mkRecdFieldGet g (argExprs.[0], rfref, tinst, m)) | _ -> None | Choice3Of5 (anonInfo, tinst, i) -> diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index c246dfac66e..1b6d8fc209c 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -154,7 +154,8 @@ type ValInfos(entries) = member x.TryFind (v: ValRef) = valInfoTable.Force().TryFind v.Deref - member x.TryFindForFslib (v: ValRef) = valInfosForFslib.Force().TryGetValue(v.Deref.GetLinkagePartialKey()) + member x.TryFindForFslib (v: ValRef) = + valInfosForFslib.Force().TryGetValue(v.Deref.GetLinkagePartialKey()) type ModuleInfo = { ValInfos: ValInfos @@ -2956,7 +2957,6 @@ and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = else let expr2 = mkMemberLambdas m tps ctorThisValOpt None vsl (bodyR, bodyty) CurriedLambdaValue (lambdaId, arities, bsize, expr2, ety) - let estimatedSize = match vspec with diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index dbfad70ed9f..b03db035cf9 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -214,7 +214,7 @@ type cenv = isInternalTestSpanStackReferring: bool // outputs - mutable usesQuotations : bool + mutable usesQuotations: bool mutable entryPointGiven: bool } diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index 7c930de439c..0249d8ccc99 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -1094,11 +1094,11 @@ let ConvMethodBase cenv env (methName, v: Val) = ctorArgTypes = methArgTypesR } else QP.MethodBaseData.Method - { methParent = parentTyconR - methArgTypes = methArgTypesR - methRetType = methRetTypeR - methName = methName - numGenericArgs=numGenericArgs } + { methParent = parentTyconR + methArgTypes = methArgTypesR + methRetType = methRetTypeR + methName = methName + numGenericArgs=numGenericArgs } | _ when v.IsExtensionMember -> From 71521e46327609480beb5cbb890c66cbea4f4fc1 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 20 Apr 2020 14:21:30 +0100 Subject: [PATCH 05/14] simplify code --- src/fsharp/IlxGen.fs | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 4eb801df7e5..a42f4db0101 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -6044,7 +6044,7 @@ and GenMethodForBinding let eenvForMeth = eenvForMeth |> AddStorageForLocalVals cenv.g (List.mapi (fun i v -> (v, Arg (numArgsUsed+i))) nonUnitNonSelfMethodVars) eenvForMeth - let tailCallInfo = + let tailCallInfo = [(mkLocalValRef v, BranchCallMethod (topValInfo.AritiesOfArgs, curriedArgInfos, methLambdaTypars, selfMethodVars.Length, methLambdaWitnessInfos.Length, nonUnitNonSelfMethodVars.Length))] // Discard the result on a 'void' return type. For a constructor just return 'void' @@ -6138,7 +6138,7 @@ and GenMethodForBinding memberInfo.MemberFlags.IsOverrideOrExplicitImpl) then let useMethodImpl = memberInfo.ImplementedSlotSigs |> List.exists (fun slotsig -> ComputeUseMethodImpl cenv (v, slotsig)) - + let nameOfOverridingMethod = match ComputeMethodImplNameFixupForMemberBinding cenv (v, memberInfo) with | None -> mspec.Name @@ -6157,10 +6157,10 @@ and GenMethodForBinding let edef = GenEventForProperty cenv eenvForMeth mspec v ilAttrsThatGoOnPrimaryItem m returnTy mgbuf.AddEventDef(tref, edef) - | _ -> - + | _ -> + let mdef = - match v.MemberInfo with + match v.MemberInfo with | Some memberInfo when not v.IsExtensionMember -> let ilMethTypars = ilTypars |> List.drop mspec.DeclaringType.GenericArgs.Length @@ -6197,7 +6197,7 @@ and GenMethodForBinding let isAbstract = memberInfo.MemberFlags.IsDispatchSlot && - let tcref = v.MemberApparentEntity + let tcref = v.MemberApparentEntity not tcref.Deref.IsFSharpDelegateTycon let mdef = @@ -6207,7 +6207,7 @@ and GenMethodForBinding match memberInfo.MemberFlags.MemberKind with - | (MemberKind.PropertySet | MemberKind.PropertyGet) -> + | (MemberKind.PropertySet | MemberKind.PropertyGet) -> if not (isNil ilMethTypars) then error(InternalError("A property may not be more generic than the enclosing type - constrain the polymorphism in the expression", v.Range)) @@ -6238,7 +6238,7 @@ and GenMethodForBinding match v.MemberInfo with | Some memberInfo when v.IsExtensionMember -> match memberInfo.MemberFlags.MemberKind with - | (MemberKind.PropertySet | MemberKind.PropertyGet) -> ilAttrsThatGoOnPrimaryItem @ GenAttrs cenv eenv attrsAppliedToGetterOrSetter + | (MemberKind.PropertySet | MemberKind.PropertyGet) -> ilAttrsThatGoOnPrimaryItem @ GenAttrs cenv eenv attrsAppliedToGetterOrSetter | _ -> ilAttrsThatGoOnPrimaryItem | _ -> ilAttrsThatGoOnPrimaryItem @@ -6247,7 +6247,7 @@ and GenMethodForBinding mdef // Does the function have an explicit [] attribute? - let isExplicitEntryPoint = HasFSharpAttribute cenv.g cenv.g.attrib_EntryPointAttribute attrs + let isExplicitEntryPoint = HasFSharpAttribute g g.attrib_EntryPointAttribute attrs let mdef = mdef @@ -6271,7 +6271,6 @@ and GenMethodForBinding mdef CountMethodDef() mgbuf.AddMethodDef(tref, mdef) - and GenPInvokeMethod (nm, dll, namedArgs) = let decoder = AttributeDecoder namedArgs @@ -7913,7 +7912,6 @@ let GenerateCode (cenv, anonTypeTable, eenv, TypedAssemblyAfterOptimization file match reflectedDefinitions with | [] -> [] | _ -> - // TODO: generate witness parameters for reflected definitions let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, cenv.tcVal, QuotationTranslator.IsReflectedDefinition.Yes) let defns = reflectedDefinitions |> List.choose (fun ((methName, v), e) -> From 937f4b3e1314be1f546fd51dcfbfdf123a4724e8 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 27 Apr 2020 13:53:13 +0100 Subject: [PATCH 06/14] remove NoDynamicInvocation attribute from signature files --- src/fsharp/FSharp.Core/nativeptr.fsi | 11 ----------- src/fsharp/FSharp.Core/prim-types.fsi | 20 -------------------- 2 files changed, 31 deletions(-) diff --git a/src/fsharp/FSharp.Core/nativeptr.fsi b/src/fsharp/FSharp.Core/nativeptr.fsi index db6a6d9e2f0..b60a9323f54 100644 --- a/src/fsharp/FSharp.Core/nativeptr.fsi +++ b/src/fsharp/FSharp.Core/nativeptr.fsi @@ -12,7 +12,6 @@ namespace Microsoft.FSharp.NativeInterop module NativePtr = [] - [] [] /// Returns a typed native pointer for a given machine address. /// The pointer address. @@ -20,7 +19,6 @@ namespace Microsoft.FSharp.NativeInterop val inline ofNativeInt : address:nativeint -> nativeptr<'T> [] - [] [] /// Returns an untyped native pointer for a given typed pointer. /// The pointer address. @@ -28,7 +26,6 @@ namespace Microsoft.FSharp.NativeInterop val inline toVoidPtr : address:nativeptr<'T> -> voidptr [] - [] [] /// Returns a typed native pointer for a untyped native pointer. /// The untyped pointer. @@ -36,7 +33,6 @@ namespace Microsoft.FSharp.NativeInterop val inline ofVoidPtr : voidptr -> nativeptr<'T> [] - [] [] /// Returns a machine address for a given typed native pointer. /// The input pointer. @@ -45,7 +41,6 @@ namespace Microsoft.FSharp.NativeInterop [] - [] [] /// Returns a typed native pointer by adding index * sizeof<'T> to the /// given input pointer. @@ -55,7 +50,6 @@ namespace Microsoft.FSharp.NativeInterop val inline add : address:nativeptr<'T> -> index:int -> nativeptr<'T> [] - [] [] /// Dereferences the typed native pointer computed by adding index * sizeof<'T> to the /// given input pointer. @@ -65,7 +59,6 @@ namespace Microsoft.FSharp.NativeInterop val inline get : address:nativeptr<'T> -> index:int -> 'T [] - [] [] /// Dereferences the given typed native pointer. /// The input pointer. @@ -73,7 +66,6 @@ namespace Microsoft.FSharp.NativeInterop val inline read : address:nativeptr<'T> -> 'T [] - [] [] /// Assigns the value into the memory location referenced by the given typed native pointer. /// The input pointer. @@ -81,7 +73,6 @@ namespace Microsoft.FSharp.NativeInterop val inline write : address:nativeptr<'T> -> value:'T -> unit [] - [] [] /// Assigns the value into the memory location referenced by the typed native /// pointer computed by adding index * sizeof<'T> to the given input pointer. @@ -94,7 +85,6 @@ namespace Microsoft.FSharp.NativeInterop /// The number of objects of type T to allocate. /// A typed pointer to the allocated memory. [] - [] [] val inline stackalloc : count:int -> nativeptr<'T> @@ -102,6 +92,5 @@ namespace Microsoft.FSharp.NativeInterop /// The input pointer. /// The managed pointer. [] - [] [] val inline toByRef : nativeptr<'T> -> byref<'T> diff --git a/src/fsharp/FSharp.Core/prim-types.fsi b/src/fsharp/FSharp.Core/prim-types.fsi index a523c03ec57..2fdd5233db5 100644 --- a/src/fsharp/FSharp.Core/prim-types.fsi +++ b/src/fsharp/FSharp.Core/prim-types.fsi @@ -1243,13 +1243,11 @@ namespace Microsoft.FSharp.Core /// Address-of. Uses of this value may result in the generation of unverifiable code. /// The input object. /// The managed pointer. - [] val inline ( ~& ) : obj:'T -> byref<'T> /// Address-of. Uses of this value may result in the generation of unverifiable code. /// The input object. /// The unmanaged pointer. - [] val inline ( ~&& ) : obj:'T -> nativeptr<'T> //------------------------------------------------------------------------- @@ -2262,14 +2260,12 @@ namespace Microsoft.FSharp.Core /// Rethrows an exception. This should only be used when handling an exception /// The result value. - [] [] [] val inline rethrow : unit -> 'T /// Rethrows an exception. This should only be used when handling an exception /// The result value. - [] [] val inline reraise : unit -> 'T @@ -2845,7 +2841,6 @@ namespace Microsoft.FSharp.Core /// input types the operation requires an appropriate static conversion method on the input type. /// The input value. /// The converted char. - [] [] val inline char : value:^T -> char when ^T : (static member op_Explicit : ^T -> char) and default ^T : int @@ -3768,14 +3763,12 @@ namespace Microsoft.FSharp.Core /// Overloaded unary negation (checks for overflow) /// The input value. /// The negated value. - [] val inline ( ~- ) : value:^T -> ^T when ^T : (static member ( ~- ) : ^T -> ^T) and default ^T : int /// Overloaded subtraction operator (checks for overflow) /// The first value. /// The second value. /// The first value minus the second value. - [] val inline ( - ) : x:^T1 -> y:^T2 -> ^T3 when (^T1 or ^T2) : (static member ( - ) : ^T1 * ^T2 -> ^T3) and default ^T2 : ^T3 and default ^T3 : ^T1 and default ^T3 : ^T2 and default ^T1 : ^T3 and default ^T1 : ^T2 and default ^T1 : int /// Overloaded addition operator (checks for overflow) @@ -3788,7 +3781,6 @@ namespace Microsoft.FSharp.Core /// The first value. /// The second value. /// The product of the two input values. - [] val inline ( * ) : x:^T1 -> y:^T2 -> ^T3 when (^T1 or ^T2) : (static member ( * ) : ^T1 * ^T2 -> ^T3) and default ^T2 : ^T3 and default ^T3 : ^T1 and default ^T3 : ^T2 and default ^T1 : ^T3 and default ^T1 : ^T2 and default ^T1 : int /// Converts the argument to byte. This is a direct, checked conversion for all @@ -3797,7 +3789,6 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted byte - [] [] val inline byte : value:^T -> byte when ^T : (static member op_Explicit : ^T -> byte) and default ^T : int @@ -3807,7 +3798,6 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted sbyte - [] [] val inline sbyte : value:^T -> sbyte when ^T : (static member op_Explicit : ^T -> sbyte) and default ^T : int @@ -3817,7 +3807,6 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted int16 - [] [] val inline int16 : value:^T -> int16 when ^T : (static member op_Explicit : ^T -> int16) and default ^T : int @@ -3827,7 +3816,6 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted uint16 - [] [] val inline uint16 : value:^T -> uint16 when ^T : (static member op_Explicit : ^T -> uint16) and default ^T : int @@ -3837,7 +3825,6 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted int - [] [] val inline int : value:^T -> int when ^T : (static member op_Explicit : ^T -> int) and default ^T : int @@ -3847,7 +3834,6 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted int32 - [] [] val inline int32 : value:^T -> int32 when ^T : (static member op_Explicit : ^T -> int32) and default ^T : int @@ -3857,7 +3843,6 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted uint32 - [] [] val inline uint32 : value:^T -> uint32 when ^T : (static member op_Explicit : ^T -> uint32) and default ^T : int @@ -3867,7 +3852,6 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted int64 - [] [] val inline int64 : value:^T -> int64 when ^T : (static member op_Explicit : ^T -> int64) and default ^T : int @@ -3877,7 +3861,6 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted uint64 - [] [] val inline uint64 : value:^T -> uint64 when ^T : (static member op_Explicit : ^T -> uint64) and default ^T : int @@ -3886,7 +3869,6 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted nativeint - [] [] val inline nativeint : value:^T -> nativeint when ^T : (static member op_Explicit : ^T -> nativeint) and default ^T : int @@ -3895,7 +3877,6 @@ namespace Microsoft.FSharp.Core /// static conversion method on the input type. /// The input value. /// The converted unativeint - [] [] val inline unativeint : value:^T -> unativeint when ^T : (static member op_Explicit : ^T -> unativeint) and default ^T : int @@ -3905,7 +3886,6 @@ namespace Microsoft.FSharp.Core /// appropriate static conversion method on the input type. /// The input value. /// The converted char - [] [] val inline char : value:^T -> char when ^T : (static member op_Explicit : ^T -> char) and default ^T : int From 832baf17aec5c201cff7eeb6761eb23cc5aaa3c8 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 6 May 2020 00:13:26 +0100 Subject: [PATCH 07/14] fix quotations in inline code that pass witness args --- .../FSharp.Compiler.Private.fsproj | 4 +- src/fsharp/FindUnsolved.fs | 3 +- src/fsharp/IlxGen.fs | 28 +- src/fsharp/InnerLambdasToTopLevelFuncs.fs | 21 +- src/fsharp/Optimizer.fs | 16 +- src/fsharp/PostInferenceChecks.fs | 17 +- src/fsharp/QuotationTranslator.fs | 53 +++- src/fsharp/QuotationTranslator.fsi | 2 +- src/fsharp/TypeChecker.fs | 2 + src/fsharp/TypedTree.fs | 9 +- src/fsharp/TypedTreeOps.fs | 145 ++++++---- src/fsharp/TypedTreePickle.fs | 1 + tests/fsharp/tools/eval/test.fsx | 263 ++++++++++++++++++ 13 files changed, 470 insertions(+), 94 deletions(-) diff --git a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj index 9b33f948815..6b5d660b151 100644 --- a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj +++ b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj @@ -406,10 +406,10 @@ TypedTree\TypedTreeOps.fs - TypedTree\.TypedTreePickle.fsi + TypedTree\TypedTreePickle.fsi - TypedTree\.TypedTreePickle.fs + TypedTree\TypedTreePickle.fs Logic\import.fsi diff --git a/src/fsharp/FindUnsolved.fs b/src/fsharp/FindUnsolved.fs index a5cf703516c..c9ea31aa576 100644 --- a/src/fsharp/FindUnsolved.fs +++ b/src/fsharp/FindUnsolved.fs @@ -109,7 +109,8 @@ let rec accExpr (cenv:cenv) (env:env) expr = | TTyconIsStruct(ty1) -> accTy cenv env ty1) - | Expr.Link _eref -> failwith "Unexpected reclink" + | Expr.Link _eref -> failwith "Unexpected Expr.Link" + | Expr.WitnessArg (_witnessInfo, _m) -> failwith "Unexpected Expr.WitnessArg" and accMethods cenv env baseValOpt l = List.iter (accMethod cenv env baseValOpt) l diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index a42f4db0101..5c059446474 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -979,7 +979,10 @@ let StorageForValRef g m (v: ValRef) eenv = StorageForVal g m v.Deref eenv let TryStorageForWitness eenv (w: TraitWitnessInfo) = match eenv.witnessesInScope.TryGetValue w with | true, storage -> Some storage - | _ -> None + | _ -> + let inWitnessPassingScope = not eenv.witnessesInScope.IsEmpty + assert not inWitnessPassingScope + None let IsValRefIsDllImport g (vref: ValRef) = vref.Attribs |> HasFSharpAttributeOpt g g.attrib_DllImportAttribute @@ -2413,7 +2416,12 @@ and GenExprAux (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = | Expr.Obj (_, ty, basev, basecall, overrides, interfaceImpls, m) -> GenObjectExpr cenv cgbuf eenv expr (ty, basev, basecall, overrides, interfaceImpls, m) sequel - | Expr.Quote (ast, conv, _, m, ty) -> GenQuotation cenv cgbuf eenv (ast, conv, m, ty) sequel + | Expr.Quote (ast, conv, _, m, ty) -> + GenQuotation cenv cgbuf eenv (ast, conv, m, ty) sequel + + | Expr.WitnessArg (witnessInfo, m) -> + GenWitnessArgFromInfo cenv cgbuf eenv m witnessInfo + GenSequel cenv eenv.cloc cgbuf sequel | Expr.Link _ -> failwith "Unexpected reclink" @@ -3931,13 +3939,19 @@ and GenAsmCode cenv cgbuf eenv (il, tyargs, args, returnTys, m) sequel = and GenQuotation cenv cgbuf eenv (ast, conv, m, ety) sequel = let g = cenv.g - let referencedTypeDefs, spliceTypes, spliceArgExprs, astSpec = + let referencedTypeDefs, spliceTypes, exprSplices, astSpec = match !conv with - | Some res -> res + | Some (data1, data2) -> + if eenv.witnessesInScope.IsEmpty then + data1 + else + data2 + | None -> try + let inWitnessPassingScope = not eenv.witnessesInScope.IsEmpty let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, cenv.tcVal, QuotationTranslator.IsReflectedDefinition.No) - let astSpec = QuotationTranslator.ConvExprPublic qscope ast + let astSpec = QuotationTranslator.ConvExprPublic qscope inWitnessPassingScope ast let referencedTypeDefs, typeSplices, exprSplices = qscope.Close() referencedTypeDefs, List.map fst typeSplices, List.map fst exprSplices, astSpec with @@ -3957,12 +3971,12 @@ and GenQuotation cenv cgbuf eenv (ast, conv, m, ety) sequel = let referencedTypeDefExprs = List.map (mkILNonGenericBoxedTy >> mkTypeOfExpr cenv m) referencedTypeDefs let referencedTypeDefsExpr = mkArray (g.system_Type_ty, referencedTypeDefExprs, m) let spliceTypesExpr = mkArray (g.system_Type_ty, spliceTypeExprs, m) - let spliceArgsExpr = mkArray (rawTy, spliceArgExprs, m) + let spliceArgsExpr = mkArray (rawTy, exprSplices, m) mkCallDeserializeQuotationFSharp40Plus g m someTypeInModuleExpr referencedTypeDefsExpr spliceTypesExpr spliceArgsExpr bytesExpr else let mkList ty els = List.foldBack (mkCons g ty) els (mkNil g m ty) let spliceTypesExpr = mkList g.system_Type_ty spliceTypeExprs - let spliceArgsExpr = mkList rawTy spliceArgExprs + let spliceArgsExpr = mkList rawTy exprSplices mkCallDeserializeQuotationFSharp20Plus g m someTypeInModuleExpr spliceTypesExpr spliceArgsExpr bytesExpr let afterCastExpr = diff --git a/src/fsharp/InnerLambdasToTopLevelFuncs.fs b/src/fsharp/InnerLambdasToTopLevelFuncs.fs index b21f0d22790..a3ef9665db6 100644 --- a/src/fsharp/InnerLambdasToTopLevelFuncs.fs +++ b/src/fsharp/InnerLambdasToTopLevelFuncs.fs @@ -1168,12 +1168,20 @@ module Pass4_RewriteAssembly = | Expr.Const _ -> expr,z - | Expr.Quote (a,{contents=Some(typeDefs,argTypes,argExprs,data)},isFromQueryExpression,m,ty) -> - let argExprs,z = List.mapFold (TransExpr penv) z argExprs - Expr.Quote (a,{contents=Some(typeDefs,argTypes,argExprs,data)},isFromQueryExpression,m,ty),z + | Expr.Quote (a,dataCell,isFromQueryExpression,m,ty) -> + let doData (typeDefs,argTypes,argExprs,data) z = + let argExprs,z = List.mapFold (TransExpr penv) z argExprs + (typeDefs,argTypes,argExprs,data), z - | Expr.Quote (a,{contents=None},isFromQueryExpression,m,ty) -> - Expr.Quote (a,{contents=None},isFromQueryExpression,m,ty),z + let data, z = + match !dataCell with + | Some (data1, data2) -> + let data1, z = doData data1 z + let data2, z = doData data2 z + Some (data1, data2), z + | None -> None, z + + Expr.Quote (a,ref data,isFromQueryExpression,m,ty),z | Expr.Op (c,tyargs,args,m) -> let args,z = List.mapFold (TransExpr penv) z args @@ -1187,6 +1195,9 @@ module Pass4_RewriteAssembly = | Expr.TyChoose (_,_,m) -> error(Error(FSComp.SR.tlrUnexpectedTExpr(),m)) + | Expr.WitnessArg (_witnessInfo, _m) -> + expr, z + /// Walk over linear structured terms in tail-recursive loop, using a continuation /// to represent the rebuild-the-term stack and TransLinearExpr penv z expr (contf: Expr * RewriteState -> Expr * RewriteState) = diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index ff3d998f013..e5f7f461aa3 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -1893,8 +1893,12 @@ let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr = OptimizeVal cenv env expr (v, m) | Expr.Quote (ast, splices, isFromQueryExpression, m, ty) -> - let splices = ref (splices.Value |> Option.map (map3Of4 (List.map (OptimizeExpr cenv env >> fst)))) - Expr.Quote (ast, splices, isFromQueryExpression, m, ty), + let doData data = map3Of4 (List.map (OptimizeExpr cenv env >> fst)) data + let splices = + match splices.Value with + | Some (data1, data2opt) -> Some (doData data1, doData data2opt) + | None -> None + Expr.Quote (ast, ref splices, isFromQueryExpression, m, ty), { TotalSize = 10 FunctionSize = 1 HasEffect = false @@ -1946,6 +1950,14 @@ let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr = assert ("unexpected reclink" = "") failwith "Unexpected reclink" + | Expr.WitnessArg _ -> + expr, + { TotalSize = 10 + FunctionSize = 1 + HasEffect = false + MightMakeCriticalTailcall=false + Info=UnknownValue } + /// Optimize/analyze an object expression and OptimizeObjectExpr cenv env (ty, baseValOpt, basecall, overrides, iimpls, m) = let basecallR, basecallinfo = OptimizeExpr cenv env basecall diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index 5b61f1e3bd7..df330b513ed 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -976,11 +976,16 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi // Translate the quotation to quotation data try - let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, cenv.tcVal, QuotationTranslator.IsReflectedDefinition.No) - let qdata = QuotationTranslator.ConvExprPublic qscope ast - let typeDefs, spliceTypes, spliceExprs = qscope.Close() + let doData flag = + let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, cenv.tcVal, QuotationTranslator.IsReflectedDefinition.No) + let qdata = QuotationTranslator.ConvExprPublic qscope flag ast + let typeDefs, spliceTypes, spliceExprs = qscope.Close() + typeDefs, List.map fst spliceTypes, List.map fst spliceExprs, qdata + + let data1 = doData false + let data2 = doData true match savedConv.Value with - | None -> savedConv:= Some (typeDefs, List.map fst spliceTypes, List.map fst spliceExprs, qdata) + | None -> savedConv:= Some (data1, data2) | Some _ -> () with QuotationTranslator.InvalidQuotedTerm e -> errorRecovery e m @@ -1126,6 +1131,10 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi CheckTypeNoByrefs cenv env m ty1) NoLimit + | Expr.WitnessArg _ -> + assert false + NoLimit + | Expr.Link _ -> failwith "Unexpected reclink" diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index 1bcbfd3cc8f..338682ab095 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -40,20 +40,32 @@ type QuotationSerializationFormat = } type QuotationGenerationScope = - { g: TcGlobals + { + g: TcGlobals + amap: Import.ImportMap + scope: CcuThunk + tcVal : ConstraintSolver.TcValF + // Accumulate the references to type definitions referencedTypeDefs: ResizeArray + referencedTypeDefsTable: Dictionary - // Accumulate the type splices (i.e. captured type parameters) into here + + /// Accumulate the type splices (i.e. captured type parameters) into here typeSplices: ResizeArray - // Accumulate the expression splices into here + + /// Accumulate the expression splices into here exprSplices: ResizeArray + isReflectedDefinition : IsReflectedDefinition + quotationFormat : QuotationSerializationFormat - mutable emitDebugInfoInQuotations : bool } + + mutable emitDebugInfoInQuotations : bool + } static member Create (g: TcGlobals, amap, scope, tcVal, isReflectedDefinition) = { g = g @@ -88,7 +100,7 @@ type QuotationTranslationEnv = tyvs: StampMap /// Indicates this is a witness arg we we disable further generation of witnesses - isWitness: bool + includeWitnesses: bool /// All witnesses in scope and their mapping to lambda variables. // @@ -109,7 +121,7 @@ type QuotationTranslationEnv = { vs = ValMap<_>.Empty numValsInScope = 0 tyvs = Map.empty - isWitness = false + includeWitnesses = true witnessesInScope = EmptyTraitWitnessInfoHashMap g isinstVals = ValMap<_>.Empty substVals = ValMap<_>.Empty } @@ -235,25 +247,32 @@ and ConvExpr cenv env (expr : Expr) = and GetWitnessArgs cenv (env : QuotationTranslationEnv) m tps tyargs = let g = cenv.g - if g.generateWitnesses && not env.isWitness then + if g.generateWitnesses && env.includeWitnesses then let witnessExprs = ConstraintSolver.CodegenWitnessesForTyparInst cenv.tcVal g cenv.amap m tps tyargs |> CommitOperationResult - let env = { env with isWitness = true } + let env = { env with includeWitnesses = false } witnessExprs |> List.map (fun arg -> match arg with | Choice1Of2 witnessInfo -> - if env.witnessesInScope.ContainsKey witnessInfo then - let witnessArgIdx = env.witnessesInScope.[witnessInfo] - QP.mkVar witnessArgIdx - else - System.Diagnostics.Debug.Assert(false, "unexpected missing witness representation") - QP.mkVar 0 + ConvWitnessInfo cenv env m witnessInfo | Choice2Of2 arg -> ConvExpr cenv env arg) else [] +and ConvWitnessInfo cenv env m witnessInfo = + let g = cenv.g + let env = { env with includeWitnesses = false } + if env.witnessesInScope.ContainsKey witnessInfo then + let witnessArgIdx = env.witnessesInScope.[witnessInfo] + QP.mkVar witnessArgIdx + else + let holeTy = GenWitnessTy g witnessInfo + let idx = cenv.exprSplices.Count + cenv.exprSplices.Add((Expr.WitnessArg(witnessInfo, m), m)) + QP.mkHole(ConvType cenv env m holeTy, idx) + and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.ExprData = let expr = DetectAndOptimizeForExpression cenv.g OptimizeIntRangesOnly expr @@ -707,6 +726,9 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. | _ -> wfail(InternalError( "Unexpected expression shape", m)) + | Expr.WitnessArg (witnessInfo, m) -> + ConvWitnessInfo cenv env m witnessInfo + | _ -> wfail(InternalError(sprintf "unhandled construct in AST: %A" expr, expr.Range)) @@ -1175,8 +1197,9 @@ and ConvReturnType cenv envinner m retTy = | None -> ConvVoidType cenv m | Some ty -> ConvType cenv envinner m ty -let ConvExprPublic cenv e = +let ConvExprPublic cenv includeWitnesses e = let env = QuotationTranslationEnv.CreateEmpty(cenv.g) + let env = { env with includeWitnesses = includeWitnesses } let astExpr = let astExpr = ConvExpr cenv env e // always emit debug info for the top level expression diff --git a/src/fsharp/QuotationTranslator.fsi b/src/fsharp/QuotationTranslator.fsi index f3d9a7b7575..1562e454146 100755 --- a/src/fsharp/QuotationTranslator.fsi +++ b/src/fsharp/QuotationTranslator.fsi @@ -34,7 +34,7 @@ type QuotationGenerationScope = member Close: unit -> ILTypeRef list * (TType * range) list * (Expr * range) list static member ComputeQuotationFormat : TcGlobals -> QuotationSerializationFormat -val ConvExprPublic : QuotationGenerationScope -> Expr -> QuotationPickler.ExprData +val ConvExprPublic : QuotationGenerationScope -> includeWitnesses: bool -> Expr -> QuotationPickler.ExprData val ConvReflectedDefinition: QuotationGenerationScope -> string -> Val -> Expr -> QuotationPickler.MethodBaseData * QuotationPickler.ExprData val (|ModuleValueOrMemberUse|_|) : TcGlobals -> Expr -> (ValRef * ValUseFlag * Expr * TType * TypeInst * Expr list) option diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 6888dbdcf9e..1e9d1057faa 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -3863,6 +3863,8 @@ let EliminateInitializationGraphs | Expr.Link eref -> CheckExpr st !eref | Expr.TyChoose (_, b, _) -> CheckExpr st b | Expr.Quote _ -> () + | Expr.WitnessArg (_witnessInfo, _m) -> + failwith "Unexpected Expr.WitnessArg" and CheckBinding st (TBind(_, e, _)) = CheckExpr st e and CheckDecisionTree st = function diff --git a/src/fsharp/TypedTree.fs b/src/fsharp/TypedTree.fs index e8f31eb4788..139dcc31975 100644 --- a/src/fsharp/TypedTree.fs +++ b/src/fsharp/TypedTree.fs @@ -4523,11 +4523,17 @@ type Expr = // MUTABILITY: this use of mutability is awkward and perhaps should be removed | Quote of quotedExpr: Expr * - quotationInfo: (ILTypeRef list * TTypes * Exprs * ExprData) option ref * + quotationInfo: ((ILTypeRef list * TTypes * Exprs * ExprData) * (ILTypeRef list * TTypes * Exprs * ExprData)) option ref * isFromQueryExpression: bool * range: range * quotedType: TType + + /// Used in quotation generation to indicate a witness argument + | WitnessArg of + witnessInfo: TraitWitnessInfo * + range: range + /// Indicates a free choice of typars that arises due to /// minimization of polymorphism at let-rec bindings. These are /// resolved to a concrete instantiation on subsequent rewrites. @@ -4564,6 +4570,7 @@ type Expr = | StaticOptimization (_, _, _, _) -> "StaticOptimization(..)" | Op (op, _, args, _) -> "Op(" + op.ToString() + ", " + String.concat ", " (args |> List.map (fun e -> e.ToDebugString(depth))) + ")" | Quote _ -> "Quote(..)" + | WitnessArg _ -> "WitnessArg(..)" | TyChoose _ -> "TyChoose(..)" | Link e -> "Link(" + e.Value.ToDebugString(depth) + ")" diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 9042e45633a..92c958458c2 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -253,7 +253,7 @@ and remapTyparConstraintsAux tyenv cs = | TyparConstraint.CoercesTo(ty, m) -> Some(TyparConstraint.CoercesTo (remapTypeAux tyenv ty, m)) | TyparConstraint.MayResolveMember(traitInfo, m) -> - Some(TyparConstraint.MayResolveMember (remapTraitAux tyenv traitInfo, m)) + Some(TyparConstraint.MayResolveMember (remapTraitSln tyenv traitInfo, m)) | TyparConstraint.DefaultsTo(priority, ty, m) -> Some(TyparConstraint.DefaultsTo(priority, remapTypeAux tyenv ty, m)) | TyparConstraint.IsEnum(uty, m) -> @@ -270,7 +270,13 @@ and remapTyparConstraintsAux tyenv cs = | TyparConstraint.IsReferenceType _ | TyparConstraint.RequiresDefaultConstructor _ -> Some x) -and remapTraitAux tyenv (TTrait(tys, nm, mf, argtys, rty, slnCell)) = +and remapTraitWitnessInfo tyenv (TraitWitnessInfo(tys, nm, mf, argtys, rty)) = + let tysR = remapTypesAux tyenv tys + let argtysR = remapTypesAux tyenv argtys + let rtyR = Option.map (remapTypeAux tyenv) rty + TraitWitnessInfo(tysR, nm, mf, argtysR, rtyR) + +and remapTraitSln tyenv (TTrait(tys, nm, mf, argtys, rty, slnCell)) = let slnCell = match !slnCell with | None -> None @@ -397,7 +403,7 @@ let mkInstRemap tpinst = // entry points for "typar -> TType" instantiation let instType tpinst x = if isNil tpinst then x else remapTypeAux (mkInstRemap tpinst) x let instTypes tpinst x = if isNil tpinst then x else remapTypesAux (mkInstRemap tpinst) x -let instTrait tpinst x = if isNil tpinst then x else remapTraitAux (mkInstRemap tpinst) x +let instTrait tpinst x = if isNil tpinst then x else remapTraitSln (mkInstRemap tpinst) x let instTyparConstraints tpinst x = if isNil tpinst then x else remapTyparConstraintsAux (mkInstRemap tpinst) x let instSlotSig tpinst ss = remapSlotSig (fun _ -> []) (mkInstRemap tpinst) ss let copySlotSig ss = remapSlotSig (fun _ -> []) Remap.Empty ss @@ -1159,6 +1165,7 @@ let rec rangeOfExpr x = | Expr.Val (_, _, m) | Expr.Op (_, _, _, m) | Expr.Const (_, m, _) | Expr.Quote (_, _, _, m, _) | Expr.Obj (_, _, _, _, _, _, m) | Expr.App (_, _, _, _, m) | Expr.Sequential (_, _, _, _, m) | Expr.StaticOptimization (_, _, _, m) | Expr.Lambda (_, _, _, _, _, m, _) + | Expr.WitnessArg (_, m) | Expr.TyLambda (_, _, _, m, _)| Expr.TyChoose (_, _, m) | Expr.LetRec (_, _, m, _) | Expr.Let (_, _, m, _) | Expr.Match (_, _, _, _, m, _) -> m | Expr.Link eref -> rangeOfExpr (!eref) @@ -2065,6 +2072,11 @@ and accFreeInTrait opts (TTrait(tys, _, _, argtys, rty, sln)) acc = (accFreeInTypes opts argtys (Option.foldBack (accFreeInType opts) rty acc))) +and accFreeInWitnessArg opts (TraitWitnessInfo(tys, _nm, _mf, argtys, rty)) acc = + accFreeInTypes opts tys + (accFreeInTypes opts argtys + (Option.foldBack (accFreeInType opts) rty acc)) + and accFreeInTraitSln opts sln acc = match sln with | ILMethSln(ty, _, _, minst) -> @@ -3918,6 +3930,7 @@ module DebugPrint = @@ rightL (tagText "}") + | Expr.WitnessArg _ -> wordL (tagText "") | Expr.StaticOptimization (_tcs, csx, x, _) -> (wordL(tagText "opt") @@- (exprL x)) @@-- (wordL(tagText "|") ^^ exprL csx --- (wordL(tagText "when...") )) @@ -4422,6 +4435,8 @@ let accFreevarsInVal opts v acc = accFreeTyvars opts accFreeInVal v acc let accFreeVarsInTraitSln opts tys acc = accFreeTyvars opts accFreeInTraitSln tys acc +let accFreeVarsInWitnessArg opts tys acc = accFreeTyvars opts accFreeInWitnessArg tys acc + let boundLocalVal opts v fvs = if not opts.includeLocals then fvs else let fvs = accFreevarsInVal opts v fvs @@ -4602,14 +4617,16 @@ and accFreeInExprNonLinear opts x acc = | Expr.Val (lvr, flags, _) -> accFreeInValFlags opts flags (accFreeValRef opts lvr acc) - | Expr.Quote (ast, {contents=Some(_, argTypes, argExprs, _data)}, _, _, ty) -> - accFreeInExpr opts ast - (accFreeInExprs opts argExprs - (accFreeVarsInTys opts argTypes - (accFreeVarsInTy opts ty acc))) + | Expr.Quote (ast, dataCell, _, _, ty) -> + match dataCell.Value with + | Some (_, (_, argTypes, argExprs, _data)) -> + accFreeInExpr opts ast + (accFreeInExprs opts argExprs + (accFreeVarsInTys opts argTypes + (accFreeVarsInTy opts ty acc))) - | Expr.Quote (ast, {contents=None}, _, _, ty) -> - accFreeInExpr opts ast (accFreeVarsInTy opts ty acc) + | None -> + accFreeInExpr opts ast (accFreeVarsInTy opts ty acc) | Expr.App (f0, f0ty, tyargs, args, _) -> accFreeVarsInTy opts f0ty @@ -4650,6 +4667,9 @@ and accFreeInExprNonLinear opts x acc = let acc = accFreeVarsInTys opts tinst acc accFreeInExprs opts args acc + | Expr.WitnessArg (witnessInfo, _) -> + accFreeVarsInWitnessArg opts witnessInfo acc + and accFreeInOp opts op acc = match op with @@ -5124,13 +5144,15 @@ and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = if vr === vr' && vf === vf' then expr else Expr.Val (vr', vf', m) - | Expr.Quote (a, {contents=Some(typeDefs, argTypes, argExprs, data)}, isFromQueryExpression, m, ty) -> - // fix value of compgen for both original expression and pickled AST + | Expr.Quote (a, dataCell, isFromQueryExpression, m, ty) -> + let doData (typeDefs, argTypes, argExprs, res) = (typeDefs, remapTypesAux tmenv argTypes, remapExprs g compgen tmenv argExprs, res) + let data' = + match dataCell.Value with + | None -> None + | Some (data1, data2) -> Some (doData data1, doData data2) + // fix value of compgen for both original expression and pickled AST let compgen = fixValCopyFlagForQuotations compgen - Expr.Quote (remapExpr g compgen tmenv a, {contents=Some(typeDefs, remapTypesAux tmenv argTypes, remapExprs g compgen tmenv argExprs, data)}, isFromQueryExpression, m, remapType tmenv ty) - - | Expr.Quote (a, {contents=None}, isFromQueryExpression, m, ty) -> - Expr.Quote (remapExpr g (fixValCopyFlagForQuotations compgen) tmenv a, {contents=None}, isFromQueryExpression, m, remapType tmenv ty) + Expr.Quote (remapExpr g compgen tmenv a, ref data', isFromQueryExpression, m, remapType tmenv ty) | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, m) -> let basev', tmenvinner = Option.mapFold (copyAndRemapAndBindVal g compgen) tmenv basev @@ -5188,6 +5210,10 @@ and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = let ty' = remapType tmenv ty if ty === ty' then expr else Expr.Const (c, m, ty') + | Expr.WitnessArg (witnessInfo, m) -> + let witnessInfoR = remapTraitWitnessInfo tmenv witnessInfo + Expr.WitnessArg (witnessInfoR, m) + and remapTarget g compgen tmenv (TTarget(vs, e, spTarget)) = let vs', tmenvinner = copyAndRemapAndBindVals g compgen tmenv vs TTarget(vs', remapExpr g compgen tmenvinner e, spTarget) @@ -5252,7 +5278,7 @@ and remapOp tmenv op = let tys2 = remapTypes tmenv tys if tys === tys2 then op else TOp.ILAsm (instrs, tys2) - | TOp.TraitCall traitInfo -> TOp.TraitCall (remapTraitAux tmenv traitInfo) + | TOp.TraitCall traitInfo -> TOp.TraitCall (remapTraitSln tmenv traitInfo) | TOp.LValueOp (kind, lvr) -> TOp.LValueOp (kind, remapValRef tmenv lvr) | TOp.ILCall (isVirtCall, isProtectedCall, valu, isNewObjCall, valUseFlags, isProperty, noTailCall, ilMethRef, enclTypeArgs, methTypeArgs, tys) -> TOp.ILCall (isVirtCall, isProtectedCall, valu, isNewObjCall, remapValFlags tmenv valUseFlags, @@ -5637,8 +5663,12 @@ let rec remarkExpr m x = | Expr.StaticOptimization (eqns, e2, e3, _) -> Expr.StaticOptimization (eqns, remarkExpr m e2, remarkExpr m e3, m) - | Expr.Const (c, _, ty) -> Expr.Const (c, m, ty) + | Expr.Const (c, _, ty) -> + Expr.Const (c, m, ty) + | Expr.WitnessArg (witnessInfo, _) -> + Expr.WitnessArg (witnessInfo, m) + and remarkObjExprMethod m (TObjExprMethod(slotsig, attribs, tps, vs, e, _)) = TObjExprMethod(slotsig, attribs, tps, vs, remarkExpr m e, m) @@ -5744,6 +5774,32 @@ let mkArrayType (g: TcGlobals) ty = TType_app (g.array_tcr_nice, [ty]) let mkByteArrayTy (g: TcGlobals) = mkArrayType g g.byte_ty +//--------------------------------------------------------------------------- +// Witnesses +//--------------------------------------------------------------------------- + +let GenWitnessArgTys (g: TcGlobals) (traitInfo: TraitWitnessInfo) = + let (TraitWitnessInfo(_tys, _nm, _memFlags, argtys, _rty)) = traitInfo + let argtys = if argtys.IsEmpty then [g.unit_ty] else argtys + let argtysl = List.map List.singleton argtys + argtysl + //match tys with + //| _ when not memFlags.IsInstance -> argtysl + //| [ty] -> [ty] :: argtysl + //| [_; _] -> [g.obj_ty] :: argtysl + //| _ -> failwith "unexpected empty type support for trait constraint" + +let GenWitnessTy (g: TcGlobals) (traitInfo: TraitWitnessInfo) = + let rty = match traitInfo.ReturnType with None -> g.unit_ty | Some ty -> ty + let argtysl = GenWitnessArgTys g traitInfo + mkMethodTy g argtysl rty + +let GenWitnessTys (g: TcGlobals) (cxs: TraitWitnessInfos) = + if g.generateWitnesses then + cxs |> List.map (GenWitnessTy g) + else + [] + //-------------------------------------------------------------------------- // tyOfExpr //-------------------------------------------------------------------------- @@ -5798,6 +5854,7 @@ let rec tyOfExpr g e = //errorR(InternalError("unexpected goto/label/return in tyOfExpr", m)) // It doesn't matter what type we return here. This is only used in free variable analysis in the code generator g.unit_ty + | Expr.WitnessArg (witnessInfo, _m) -> GenWitnessTy g witnessInfo //-------------------------------------------------------------------------- // Make applications @@ -6466,12 +6523,11 @@ type ExprFolders<'State> (folders: ExprFolder<'State>) = // tailcall targetF z targets.[targets.Length - 1] - | Expr.Quote (e, {contents=Some(_typeDefs, _argTypes, argExprs, _)}, _, _, _) -> + | Expr.Quote (e, dataCell, _, _, _) -> let z = exprF z e - exprsF z argExprs - - | Expr.Quote (e, {contents=None}, _, _m, _) -> - exprF z e + match dataCell.Value with + | None -> z + | Some ((_typeDefs, _argTypes, argExprs, _), _) -> exprsF z argExprs | Expr.Obj (_n, _typ, _basev, basecall, overrides, iimpls, _m) -> let z = exprF z basecall @@ -6481,6 +6537,8 @@ type ExprFolders<'State> (folders: ExprFolder<'State>) = | Expr.StaticOptimization (_tcs, csx, x, _) -> exprsF z [csx;x] + | Expr.WitnessArg (_witnessInfo, _m) -> z + and valBindF dtree z bind = let z = folders.nonRecBindingsIntercept z bind bindF dtree z bind @@ -7850,32 +7908,6 @@ let LinearizeTopMatch g parent = function | x -> x -//--------------------------------------------------------------------------- -// Witnesses -//--------------------------------------------------------------------------- - -let GenWitnessArgTys (g: TcGlobals) (traitInfo: TraitWitnessInfo) = - let (TraitWitnessInfo(_tys, _nm, _memFlags, argtys, _rty)) = traitInfo - let argtys = if argtys.IsEmpty then [g.unit_ty] else argtys - let argtysl = List.map List.singleton argtys - argtysl - //match tys with - //| _ when not memFlags.IsInstance -> argtysl - //| [ty] -> [ty] :: argtysl - //| [_; _] -> [g.obj_ty] :: argtysl - //| _ -> failwith "unexpected empty type support for trait constraint" - -let GenWitnessTy (g: TcGlobals) (traitInfo: TraitWitnessInfo) = - let rty = match traitInfo.ReturnType with None -> g.unit_ty | Some ty -> ty - let argtysl = GenWitnessArgTys g traitInfo - mkMethodTy g argtysl rty - -let GenWitnessTys (g: TcGlobals) (cxs: TraitWitnessInfos) = - if g.generateWitnesses then - cxs |> List.map (GenWitnessTy g) - else - [] - //--------------------------------------------------------------------------- // XmlDoc signatures //--------------------------------------------------------------------------- @@ -8425,13 +8457,12 @@ and rewriteExprStructure env expr = if f0 === f0' && args === args' then expr else Expr.App (f0', f0ty, tyargs, args', m) - | Expr.Quote (ast, {contents=Some(typeDefs, argTypes, argExprs, data)}, isFromQueryExpression, m, ty) -> - Expr.Quote ((if env.IsUnderQuotations then RewriteExpr env ast else ast), - {contents=Some(typeDefs, argTypes, rewriteExprs env argExprs, data)}, - isFromQueryExpression, m, ty) - - | Expr.Quote (ast, {contents=None}, isFromQueryExpression, m, ty) -> - Expr.Quote ((if env.IsUnderQuotations then RewriteExpr env ast else ast), {contents=None}, isFromQueryExpression, m, ty) + | Expr.Quote (ast, dataCell, isFromQueryExpression, m, ty) -> + let data = + match dataCell.Value with + | None -> None + | Some (data1, data2) -> Some(map3Of4 (rewriteExprs env) data1, map3Of4 (rewriteExprs env) data2) + Expr.Quote ((if env.IsUnderQuotations then RewriteExpr env ast else ast), ref data, isFromQueryExpression, m, ty) | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, m) -> mkObjExpr(ty, basev, RewriteExpr env basecall, List.map (rewriteObjExprOverride env) overrides, @@ -8474,6 +8505,8 @@ and rewriteExprStructure env expr = | Expr.TyChoose (a, b, m) -> Expr.TyChoose (a, RewriteExpr env b, m) + | Expr.WitnessArg (witnessInfo, m) -> Expr.WitnessArg (witnessInfo, m) + and rewriteLinearExpr env expr contf = // schedule a rewrite on the way back up by adding to the continuation let contf = contf << postRewriteExpr env diff --git a/src/fsharp/TypedTreePickle.fs b/src/fsharp/TypedTreePickle.fs index 94691a9fb63..445d40de9e7 100644 --- a/src/fsharp/TypedTreePickle.fs +++ b/src/fsharp/TypedTreePickle.fs @@ -2585,6 +2585,7 @@ and p_expr expr st = | Expr.StaticOptimization (a, b, c, d) -> p_byte 11 st; p_tup4 p_constraints p_expr p_expr p_dummy_range (a, b, c, d) st | Expr.TyChoose (a, b, c) -> p_byte 12 st; p_tup3 p_tyar_specs p_expr p_dummy_range (a, b, c) st | Expr.Quote (ast, _, _, m, ty) -> p_byte 13 st; p_tup3 p_expr p_dummy_range p_ty (ast, m, ty) st + | Expr.WitnessArg _ -> pfailwith st "unexpected Expr.WitnessArg" and u_expr st = let tag = u_byte st diff --git a/tests/fsharp/tools/eval/test.fsx b/tests/fsharp/tools/eval/test.fsx index e3545645b2e..7a0feed0ee6 100644 --- a/tests/fsharp/tools/eval/test.fsx +++ b/tests/fsharp/tools/eval/test.fsx @@ -1477,6 +1477,269 @@ module EvaluationTests = Eval <@ Array.average [| 0.0 .. 1.0 .. 10000.0 |] @> + module GenericInlinedOperationsStillDynamicallyAvailableTests = + + let inline test1 (x: 'T) = + checkEval ("vroievr093-(" + typeof<'T>.ToString() + ")") (<@ LanguagePrimitives.GenericZero<_> @>) x + + test1 0s + test1 0 + test1 0L + test1 0n + test1 0uy + test1 0us + test1 0u + test1 0UL + test1 0un + test1 0.0 + test1 0.0f + test1 0M + + let inline test2 (x: 'T) = + checkEval ("vroievr095f3-(" + typeof<'T>.ToString() + ")") (<@ LanguagePrimitives.GenericOne<_> @>) x + + test2 1s + test2 1 + test2 1L + test2 1n + test2 1uy + test2 1us + test2 1u + test2 1UL + test2 1un + test2 1.0 + test2 1.0f + test2 1M + + let inline test3 (x: 'T) y = + checkEval ("vroievr096cfqw-(" + typeof<'T>.ToString() + ")") (<@ x + y @>) (x + y) + + test3 3s 4s + test3 3L 4L + + let inline test4 (x: 'T) = + checkEval ("vroievrgerwwge41-(" + typeof<'T>.ToString() + ")") (<@ abs x @>) (abs x) + checkEval ("vroievrgerwwge42-(" + typeof<'T>.ToString() + ")") (<@ sin x @>) (sin x) + checkEval ("vroievrgerwwge43-(" + typeof<'T>.ToString() + ")") (<@ cos x @>) (cos x) + checkEval ("vroievrgerwwge44-(" + typeof<'T>.ToString() + ")") (<@ tan x @>) (tan x) + checkEval ("vroievrgerwwge45-(" + typeof<'T>.ToString() + ")") (<@ sinh x @>) (sinh x) + checkEval ("vroievrgerwwge46-(" + typeof<'T>.ToString() + ")") (<@ cosh x @>) (cosh x) + checkEval ("vroievrgerwwge47-(" + typeof<'T>.ToString() + ")") (<@ ceil x @>) (ceil x) + checkEval ("vroievrgerwwge49-(" + typeof<'T>.ToString() + ")") (<@ tanh x @>) (tanh x) + checkEval ("vroievrgerwwge48-(" + typeof<'T>.ToString() + ")") (<@ floor x @>) (floor x) + checkEval ("vroievrgerwwge48-(" + typeof<'T>.ToString() + ")") (<@ truncate x @>) (truncate x) + checkEval ("vroievrgerwwge48-(" + typeof<'T>.ToString() + ")") (<@ round x @>) (round x) + checkEval ("vroievrgerwwge48-(" + typeof<'T>.ToString() + ")") (<@ log (abs x) @>) (log (abs x)) + checkEval ("vroievrgerwwge48-(" + typeof<'T>.ToString() + ")") (<@ sqrt (abs x) @>) (sqrt (abs x)) + checkEval ("vroievrgerwwge48-(" + typeof<'T>.ToString() + ")") (<@ log10 (abs x) @>) (log10 (abs x)) + checkEval ("vroievrgerwwge48-(" + typeof<'T>.ToString() + ")") (<@ exp (abs x) @>) (exp (abs x)) + + test4 -1.1 + test4 -1.1f + + let inline test5 (x: 'T) y = + checkEval ("vrbrer096cfqw-(" + typeof<'T>.ToString() + ")") (<@ (fun x2 y2 -> x2 + y2) x y @>) (x + y) + + test5 3s 4s + test5 3L 4L +(* + let iarr = [| 0..1000 |] + let ilist = [ 0..1000 ] + + let farr = [| 0.0 .. 1.0 .. 100.0 |] + let flist = [ 0.0 .. 1.0 .. 100.0 ] + + Array.average farr + + checkEval "vrewoinrv091" (<@ farr.[0] @>) 0.0 + checkEval "vrewoinrv092" (<@ flist.[0] @>) 0.0 + checkEval "vrewoinrv093" (<@ iarr.[0] @>) 0 + checkEval "vrewoinrv094" (<@ ilist.[0] @>) 0 + + checkEval "vrewoinrv095" (<@ farr.[0] <- 0.0 @>) () + checkEval "vrewoinrv096" (<@ iarr.[0] <- 0 @>) () + + checkEval "vrewoinrv097" (<@ farr.[0] <- 1.0 @>) () + checkEval "vrewoinrv098" (<@ iarr.[0] <- 1 @>) () + + checkEval "vrewoinrv099" (<@ farr.[0] @>) 1.0 + checkEval "vrewoinrv09q" (<@ iarr.[0] @>) 1 + + checkEval "vrewoinrv09w" (<@ farr.[0] <- 0.0 @>) () + checkEval "vrewoinrv09e" (<@ iarr.[0] <- 0 @>) () + + + checkEval "vrewoinrv09r" (<@ Array.average farr @>) (Array.average farr) + checkEval "vrewoinrv09t" (<@ Array.sum farr @>) (Array.sum farr) + checkEval "vrewoinrv09y" (<@ Seq.sum farr @>) (Seq.sum farr) + checkEval "vrewoinrv09u" (<@ Seq.average farr @>) (Seq.average farr) + checkEval "vrewoinrv09i" (<@ Seq.average flist @>) (Seq.average flist) + checkEval "vrewoinrv09o" (<@ Seq.averageBy (fun x -> x) farr @> ) (Seq.averageBy (fun x -> x) farr ) + checkEval "vrewoinrv09p" (<@ Seq.averageBy (fun x -> x) flist @>) (Seq.averageBy (fun x -> x) flist ) + checkEval "vrewoinrv09a" (<@ Seq.averageBy float ilist @>) (Seq.averageBy float ilist) + checkEval "vrewoinrv09s" (<@ List.sum flist @>) (List.sum flist) + checkEval "vrewoinrv09d" (<@ List.average flist @>) (List.average flist) + checkEval "vrewoinrv09f" (<@ List.averageBy float ilist @>) (List.averageBy float ilist) + + checkEval "vrewoinrv09g1" (<@ compare 0 0 = 0 @>) true + checkEval "vrewoinrv09g2" (<@ compare 0 1 < 0 @>) true + checkEval "vrewoinrv09g3" (<@ compare 1 0 > 0 @>) true + checkEval "vrewoinrv09g4" (<@ 0 < 1 @>) true + checkEval "vrewoinrv09g5" (<@ 0 <= 1 @>) true + checkEval "vrewoinrv09g6" (<@ 1 <= 1 @>) true + checkEval "vrewoinrv09g7" (<@ 2 <= 1 @>) false + checkEval "vrewoinrv09g8" (<@ 0 > 1 @>) false + checkEval "vrewoinrv09g9" (<@ 0 >= 1 @>) false + checkEval "vrewoinrv09g0" (<@ 1 >= 1 @>) true + checkEval "vrewoinrv09gQ" (<@ 2 >= 1 @>) true + + checkEval "vrewoinrv09gw" (<@ compare 0.0 0.0 = 0 @>) true + checkEval "vrewoinrv09ge" (<@ compare 0.0 1.0 < 0 @>) true + checkEval "vrewoinrv09gr" (<@ compare 1.0 0.0 > 0 @>) true + checkEval "vrewoinrv09gt" (<@ 0.0 < 1.0 @>) true + checkEval "vrewoinrv09gy" (<@ 0.0 <= 1.0 @>) true + checkEval "vrewoinrv09gu" (<@ 1.0 <= 1.0 @>) true + checkEval "vrewoinrv09gi" (<@ 2.0 <= 1.0 @>) false + checkEval "vrewoinrv09go" (<@ 0.0 > 1.0 @>) false + checkEval "vrewoinrv09gp" (<@ 0.0 >= 1.0 @>) false + checkEval "vrewoinrv09ga" (<@ 1.0 >= 1.0 @>) true + checkEval "vrewoinrv09gs" (<@ 2.0 >= 1.0 @>) true + + checkEval "vrewoinrv09gd" (<@ compare 0.0f 0.0f = 0 @>) true + checkEval "vrewoinrv09gf" (<@ compare 0.0f 1.0f < 0 @>) true + checkEval "vrewoinrv09gg" (<@ compare 1.0f 0.0f > 0 @>) true + checkEval "vrewoinrv09gh" (<@ 0.0f < 1.0f @>) true + checkEval "vrewoinrv09gk" (<@ 0.0f <= 1.0f @>) true + checkEval "vrewoinrv09gl" (<@ 1.0f <= 1.0f @>) true + checkEval "vrewoinrv09gz" (<@ 2.0f <= 1.0f @>) false + checkEval "vrewoinrv09gx" (<@ 0.0f > 1.0f @>) false + checkEval "vrewoinrv09gc" (<@ 0.0f >= 1.0f @>) false + checkEval "vrewoinrv09gv" (<@ 1.0f >= 1.0f @>) true + checkEval "vrewoinrv09gb" (<@ 2.0f >= 1.0f @>) true + + checkEval "vrewoinrv09gn" (<@ compare 0L 0L = 0 @>) true + checkEval "vrewoinrv09gm" (<@ compare 0L 1L < 0 @>) true + checkEval "vrewoinrv09g11" (<@ compare 1L 0L > 0 @>) true + checkEval "vrewoinrv09g12" (<@ 0L < 1L @>) true + checkEval "vrewoinrv09g13" (<@ 0L <= 1L @>) true + checkEval "vrewoinrv09g14" (<@ 1L <= 1L @>) true + checkEval "vrewoinrv09g15" (<@ 2L <= 1L @>) false + checkEval "vrewoinrv09g16" (<@ 0L > 1L @>) false + checkEval "vrewoinrv09g17" (<@ 0L >= 1L @>) false + checkEval "vrewoinrv09g18" (<@ 1L >= 1L @>) true + checkEval "vrewoinrv09g19" (<@ 2L >= 1L @>) true + + checkEval "vrewoinrv09g21" (<@ compare 0y 0y = 0 @>) true + checkEval "vrewoinrv09g22" (<@ compare 0y 1y < 0 @>) true + checkEval "vrewoinrv09g23" (<@ compare 1y 0y > 0 @>) true + checkEval "vrewoinrv09g24" (<@ 0y < 1y @>) true + checkEval "vrewoinrv09g25" (<@ 0y <= 1y @>) true + checkEval "vrewoinrv09g26" (<@ 1y <= 1y @>) true + checkEval "vrewoinrv09g27" (<@ 2y <= 1y @>) false + checkEval "vrewoinrv09g28" (<@ 0y > 1y @>) false + checkEval "vrewoinrv09g29" (<@ 0y >= 1y @>) false + checkEval "vrewoinrv09g30" (<@ 1y >= 1y @>) true + checkEval "vrewoinrv09g31" (<@ 2y >= 1y @>) true + + checkEval "vrewoinrv09g32" (<@ compare 0M 0M = 0 @>) true + checkEval "vrewoinrv09g33" (<@ compare 0M 1M < 0 @>) true + checkEval "vrewoinrv09g34" (<@ compare 1M 0M > 0 @>) true + checkEval "vrewoinrv09g35" (<@ 0M < 1M @>) true + checkEval "vrewoinrv09g36" (<@ 0M <= 1M @>) true + checkEval "vrewoinrv09g37" (<@ 1M <= 1M @>) true + checkEval "vrewoinrv09g38" (<@ 2M <= 1M @>) false + checkEval "vrewoinrv09g39" (<@ 0M > 1M @>) false + checkEval "vrewoinrv09g40" (<@ 0M >= 1M @>) false + checkEval "vrewoinrv09g41" (<@ 1M >= 1M @>) true + checkEval "vrewoinrv09g42" (<@ 2M >= 1M @>) true + + checkEval "vrewoinrv09g43" (<@ compare 0I 0I = 0 @>) true + checkEval "vrewoinrv09g44" (<@ compare 0I 1I < 0 @>) true + checkEval "vrewoinrv09g45" (<@ compare 1I 0I > 0 @>) true + checkEval "vrewoinrv09g46" (<@ 0I < 1I @>) true + checkEval "vrewoinrv09g47" (<@ 0I <= 1I @>) true + checkEval "vrewoinrv09g48" (<@ 1I <= 1I @>) true + checkEval "vrewoinrv09g49" (<@ 2I <= 1I @>) false + checkEval "vrewoinrv09g50" (<@ 0I > 1I @>) false + checkEval "vrewoinrv09g51" (<@ 0I >= 1I @>) false + checkEval "vrewoinrv09g52" (<@ 1I >= 1I @>) true + checkEval "vrewoinrv09g53" (<@ 2I >= 1I @>) true + + + checkEval "vrewoinrv09g" (<@ sin 0.0 @>) (sin 0.0) + checkEval "vrewoinrv09h" (<@ sinh 0.0 @>) (sinh 0.0) + checkEval "vrewoinrv09j" (<@ cos 0.0 @>) (cos 0.0) + checkEval "vrewoinrv09k" (<@ cosh 0.0 @>) (cosh 0.0) + checkEval "vrewoinrv09l" (<@ tan 1.0 @>) (tan 1.0) + checkEval "vrewoinrv09z" (<@ tanh 1.0 @>) (tanh 1.0) + checkEval "vrewoinrv09x" (<@ abs -2.0 @>) (abs -2.0) + checkEval "vrewoinrv09c" (<@ ceil 2.0 @>) (ceil 2.0) + checkEval "vrewoinrv09v" (<@ sqrt 2.0 @>) (sqrt 2.0) + checkEval "vrewoinrv09b" (<@ sign 2.0 @>) (sign 2.0) + checkEval "vrewoinrv09n" (<@ truncate 2.3 @>) (truncate 2.3) + checkEval "vrewoinrv09m" (<@ floor 2.3 @>) (floor 2.3) + checkEval "vrewoinrv09Q" (<@ round 2.3 @>) (round 2.3) + checkEval "vrewoinrv09W" (<@ log 2.3 @>) (log 2.3) + checkEval "vrewoinrv09E" (<@ log10 2.3 @>) (log10 2.3) + checkEval "vrewoinrv09R" (<@ exp 2.3 @>) (exp 2.3) + checkEval "vrewoinrv09T" (<@ 2.3 ** 2.4 @>) (2.3 ** 2.4) + + checkEval "vrewoinrv09Y" (<@ sin 0.0f @>) (sin 0.0f) + checkEval "vrewoinrv09U" (<@ sinh 0.0f @>) (sinh 0.0f) + checkEval "vrewoinrv09I" (<@ cos 0.0f @>) (cos 0.0f) + checkEval "vrewoinrv09O" (<@ cosh 0.0f @>) (cosh 0.0f) + checkEval "vrewoinrv09P" (<@ tan 1.0f @>) (tan 1.0f) + checkEval "vrewoinrv09A" (<@ tanh 1.0f @>) (tanh 1.0f) + checkEval "vrewoinrv09S" (<@ abs -2.0f @>) (abs -2.0f) + checkEval "vrewoinrv09D" (<@ ceil 2.0f @>) (ceil 2.0f) + checkEval "vrewoinrv09F" (<@ sqrt 2.0f @>) (sqrt 2.0f) + checkEval "vrewoinrv09G" (<@ sign 2.0f @>) (sign 2.0f) + checkEval "vrewoinrv09H" (<@ truncate 2.3f @>) (truncate 2.3f) + checkEval "vrewoinrv09J" (<@ floor 2.3f @>) (floor 2.3f) + checkEval "vrewoinrv09K" (<@ round 2.3f @>) (round 2.3f) + checkEval "vrewoinrv09L" (<@ log 2.3f @>) (log 2.3f) + checkEval "vrewoinrv09Z" (<@ log10 2.3f @>) (log10 2.3f) + checkEval "vrewoinrv09X" (<@ exp 2.3f @>) (exp 2.3f) + checkEval "vrewoinrv09C" (<@ 2.3f ** 2.4f @>) (2.3f ** 2.4f) + + checkEval "vrewoinrv09V" (<@ ceil 2.0M @>) (ceil 2.0M) + checkEval "vrewoinrv09B" (<@ sign 2.0M @>) (sign 2.0M) + checkEval "vrewoinrv09N" (<@ truncate 2.3M @>) (truncate 2.3M) + checkEval "vrewoinrv09M" (<@ floor 2.3M @>) (floor 2.3M) + + checkEval "vrewoinrv09QQ" (<@ sign -2 @>) (sign -2) + checkEval "vrewoinrv09WW" (<@ sign -2y @>) (sign -2y) + checkEval "vrewoinrv09EE" (<@ sign -2s @>) (sign -2s) + checkEval "vrewoinrv09RR" (<@ sign -2L @>) (sign -2L) + + checkEval "vrewoinrv09TT" (<@ [ 0 .. 10 ] @>) [ 0 .. 10 ] + checkEval "vrewoinrv09YY" (<@ [ 0y .. 10y ] @>) [ 0y .. 10y ] + checkEval "vrewoinrv09UU" (<@ [ 0s .. 10s ] @>) [ 0s .. 10s ] + checkEval "vrewoinrv09II" (<@ [ 0L .. 10L ] @>) [ 0L .. 10L ] + checkEval "vrewoinrv09OO" (<@ [ 0u .. 10u ] @>) [ 0u .. 10u ] + checkEval "vrewoinrv09PP" (<@ [ 0uy .. 10uy ] @>) [ 0uy .. 10uy ] + checkEval "vrewoinrv09AA" (<@ [ 0us .. 10us ] @>) [ 0us .. 10us ] + checkEval "vrewoinrv09SS" (<@ [ 0UL .. 10UL ] @>) [ 0UL .. 10UL ] + + + + // Round dynamic dispatch on Decimal + checkEval "vrewoinrv09FF" (<@ round 2.3M @>) (round 2.3M) + + // Measure stuff: + checkEval "vrewoinrv09GG" (<@ atan2 3.0 4.0 @>) (atan2 3.0 4.0 ) + + [] + type kg + checkEval "vrewoinrv09HH" (<@ 1.0 @>) (1.0) + + // Measure stuff: + checkEval "vrewoinrv09JJ" (<@ 1.0 + 2.0 @>) (3.0) + + + Eval <@ Array.average [| 0.0 .. 1.0 .. 10000.0 |] @> +*) + module LanguagePrimitiveCastingUnitsOfMeasure = [] type m From 4ade851c8539375d06845d713736719431e4caad Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 6 May 2020 00:21:53 +0100 Subject: [PATCH 08/14] isLegacy internal --- src/fsharp/FSharp.Core/prim-types.fsi | 2 +- tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs | 1 - tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs | 1 - 3 files changed, 1 insertion(+), 3 deletions(-) diff --git a/src/fsharp/FSharp.Core/prim-types.fsi b/src/fsharp/FSharp.Core/prim-types.fsi index 2fdd5233db5..929fa17890f 100644 --- a/src/fsharp/FSharp.Core/prim-types.fsi +++ b/src/fsharp/FSharp.Core/prim-types.fsi @@ -715,7 +715,7 @@ namespace Microsoft.FSharp.Core new : unit -> NoDynamicInvocationAttribute [] - new : isLegacy: bool -> NoDynamicInvocationAttribute + internal new : isLegacy: bool -> NoDynamicInvocationAttribute /// This attribute is used to indicate that references to the elements of a module, record or union /// type require explicit qualified access. diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs index 70c18372541..c117102906a 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.coreclr.fs @@ -2793,7 +2793,6 @@ Microsoft.FSharp.Core.LanguagePrimitives: TResult LogicalNotDynamic[T,TResult](T Microsoft.FSharp.Core.LanguagePrimitives: TResult RightShiftDynamic[T1,T2,TResult](T1, T2) Microsoft.FSharp.Core.LanguagePrimitives: TResult SubtractionDynamic[T1,T2,TResult](T1, T2) Microsoft.FSharp.Core.LanguagePrimitives: TResult UnaryNegationDynamic[T,TResult](T) -Microsoft.FSharp.Core.NoDynamicInvocationAttribute: Void .ctor(Boolean) Microsoft.FSharp.Core.Operators+Checked: Byte ToByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Byte], T) Microsoft.FSharp.Core.Operators+Checked: Char ToChar$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Char], T) Microsoft.FSharp.Core.Operators+Checked: Int16 ToInt16$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int16], T) diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs index 413b90b7173..a55410b3a41 100644 --- a/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs +++ b/tests/FSharp.Core.UnitTests/SurfaceArea.net40.fs @@ -2793,7 +2793,6 @@ Microsoft.FSharp.Core.LanguagePrimitives: TResult LogicalNotDynamic[T,TResult](T Microsoft.FSharp.Core.LanguagePrimitives: TResult RightShiftDynamic[T1,T2,TResult](T1, T2) Microsoft.FSharp.Core.LanguagePrimitives: TResult SubtractionDynamic[T1,T2,TResult](T1, T2) Microsoft.FSharp.Core.LanguagePrimitives: TResult UnaryNegationDynamic[T,TResult](T) -Microsoft.FSharp.Core.NoDynamicInvocationAttribute: Void .ctor(Boolean) Microsoft.FSharp.Core.Operators+Checked: Byte ToByte$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Byte], T) Microsoft.FSharp.Core.Operators+Checked: Char ToChar$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Char], T) Microsoft.FSharp.Core.Operators+Checked: Int16 ToInt16$W[T](Microsoft.FSharp.Core.FSharpFunc`2[T,System.Int16], T) From 5989abb1ab0d644d7d03279b09814100a69015ae Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 6 May 2020 12:03:06 +0100 Subject: [PATCH 09/14] cleanup WitnessArg and add documentation --- src/fsharp/FindUnsolved.fs | 9 ++++++- src/fsharp/PostInferenceChecks.fs | 6 +++-- src/fsharp/QuotationTranslator.fs | 39 ++++++++++++++++++++----------- src/fsharp/TypeChecker.fs | 3 +-- src/fsharp/TypedTree.fs | 18 ++++++++++++-- src/fsharp/TypedTreeOps.fs | 6 +++-- src/fsharp/TypedTreePickle.fs | 17 +++++++++++++- 7 files changed, 74 insertions(+), 24 deletions(-) diff --git a/src/fsharp/FindUnsolved.fs b/src/fsharp/FindUnsolved.fs index c9ea31aa576..27189988465 100644 --- a/src/fsharp/FindUnsolved.fs +++ b/src/fsharp/FindUnsolved.fs @@ -109,8 +109,15 @@ let rec accExpr (cenv:cenv) (env:env) expr = | TTyconIsStruct(ty1) -> accTy cenv env ty1) + | Expr.WitnessArg (witnessInfo, _m) -> + accWitnessInfo cenv env witnessInfo + | Expr.Link _eref -> failwith "Unexpected Expr.Link" - | Expr.WitnessArg (_witnessInfo, _m) -> failwith "Unexpected Expr.WitnessArg" + +and accWitnessInfo cenv env (TraitWitnessInfo(tys, _nm, _mf, argtys, rty)) = + argtys |> accTypeInst cenv env + rty |> Option.iter (accTy cenv env) + tys |> List.iter (accTy cenv env) and accMethods cenv env baseValOpt l = List.iter (accMethod cenv env baseValOpt) l diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index df330b513ed..44c0c784fee 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -1131,8 +1131,10 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi CheckTypeNoByrefs cenv env m ty1) NoLimit - | Expr.WitnessArg _ -> - assert false + | Expr.WitnessArg (TraitWitnessInfo(tys, _nm, _mf, argtys, rty), m) -> + CheckTypeInstNoByrefs cenv env m tys + CheckTypeInstNoByrefs cenv env m argtys + Option.iter (CheckTypeNoByrefs cenv env m) rty NoLimit | Expr.Link _ -> diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index 338682ab095..834d4b9063d 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -412,12 +412,12 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. // Blast type application nodes and expression application nodes apart so values are left with just their type arguments | Expr.App (f, fty, (_ :: _ as tyargs), (_ :: _ as args), m) -> - let rfty = applyForallTy cenv.g fty tyargs - ConvExpr cenv env (primMkApp (primMkApp (f, fty) tyargs [] m, rfty) [] args m) + let rfty = applyForallTy cenv.g fty tyargs + ConvExpr cenv env (primMkApp (primMkApp (f, fty) tyargs [] m, rfty) [] args m) // Uses of possibly-polymorphic values | Expr.App (InnerExprPat(Expr.Val (vref, _vFlags, m)), _fty, tyargs, [], _) -> - ConvValRef true cenv env m vref tyargs + ConvValRef true cenv env m vref tyargs // Simple applications | Expr.App (f, _fty, tyargs, args, m) -> @@ -469,18 +469,29 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. ConvDecisionTree cenv env tgs typR dtree // initialization check - | Expr.Sequential (ObjectInitializationCheck cenv.g, x1, NormalSeq, _, _) -> ConvExpr cenv env x1 - | Expr.Sequential (x0, x1, NormalSeq, _, _) -> QP.mkSequential(ConvExpr cenv env x0, ConvExpr cenv env x1) + | Expr.Sequential (ObjectInitializationCheck cenv.g, x1, NormalSeq, _, _) -> + ConvExpr cenv env x1 + + | Expr.Sequential (x0, x1, NormalSeq, _, _) -> + QP.mkSequential(ConvExpr cenv env x0, ConvExpr cenv env x1) + | Expr.Obj (_, ty, _, _, [TObjExprMethod(TSlotSig(_, ctyp, _, _, _, _), _, tps, [tmvs], e, _) as tmethod], _, m) when isDelegateTy cenv.g ty -> - let f = mkLambdas m tps tmvs (e, GetFSharpViewOfReturnType cenv.g (returnTyOfMethod cenv.g tmethod)) - let fR = ConvExpr cenv env f - let tyargR = ConvType cenv env m ctyp - QP.mkDelegate(tyargR, fR) - - | Expr.StaticOptimization (_, _, x, _) -> ConvExpr cenv env x - | Expr.TyChoose _ -> ConvExpr cenv env (TypeRelations.ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr) - | Expr.Sequential (x0, x1, ThenDoSeq, _, _) -> QP.mkSequential(ConvExpr cenv env x0, ConvExpr cenv env x1) - | Expr.Obj (_lambdaId, _typ, _basev, _basecall, _overrides, _iimpls, m) -> wfail(Error(FSComp.SR.crefQuotationsCantContainObjExprs(), m)) + let f = mkLambdas m tps tmvs (e, GetFSharpViewOfReturnType cenv.g (returnTyOfMethod cenv.g tmethod)) + let fR = ConvExpr cenv env f + let tyargR = ConvType cenv env m ctyp + QP.mkDelegate(tyargR, fR) + + | Expr.StaticOptimization (_, _, x, _) -> + ConvExpr cenv env x + + | Expr.TyChoose _ -> + ConvExpr cenv env (TypeRelations.ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr) + + | Expr.Sequential (x0, x1, ThenDoSeq, _, _) -> + QP.mkSequential(ConvExpr cenv env x0, ConvExpr cenv env x1) + + | Expr.Obj (_lambdaId, _typ, _basev, _basecall, _overrides, _iimpls, m) -> + wfail(Error(FSComp.SR.crefQuotationsCantContainObjExprs(), m)) | Expr.Op (op, tyargs, args, m) -> match op, tyargs, args with diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 1e9d1057faa..5e10aea6042 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -3863,8 +3863,7 @@ let EliminateInitializationGraphs | Expr.Link eref -> CheckExpr st !eref | Expr.TyChoose (_, b, _) -> CheckExpr st b | Expr.Quote _ -> () - | Expr.WitnessArg (_witnessInfo, _m) -> - failwith "Unexpected Expr.WitnessArg" + | Expr.WitnessArg (_witnessInfo, _m) -> () and CheckBinding st (TBind(_, e, _)) = CheckExpr st e and CheckDecisionTree st = function diff --git a/src/fsharp/TypedTree.fs b/src/fsharp/TypedTree.fs index 139dcc31975..6d9d967eb24 100644 --- a/src/fsharp/TypedTree.fs +++ b/src/fsharp/TypedTree.fs @@ -4528,8 +4528,22 @@ type Expr = range: range * quotedType: TType - - /// Used in quotation generation to indicate a witness argument + /// Used in quotation generation to indicate a witness argument, spliced into a quotation literal. + /// + /// For example: + /// + /// let inline f x = <@ sin x @> + /// + /// needs to pass a witness argument to `sin x`, captured from the surrounding context, for the witness-passing + /// version of the code. Thus the QuotationTranslation and IlxGen makes the generated code as follows: + /// + /// f(x) { return Deserialize(<@ sin _spliceHole @>, [| x |]) } + /// + /// f$W(witnessForSin, x) { return Deserialize(<@ sin$W _spliceHole1 _spliceHole2 @>, [| WitnessArg(witnessForSin), x |]) } + /// + /// where _spliceHole1 will be the location of the witness argument in the quotation data, and + /// witnessArg is the lambda for the witness + /// | WitnessArg of witnessInfo: TraitWitnessInfo * range: range diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 92c958458c2..3b53c8750a0 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -6537,7 +6537,8 @@ type ExprFolders<'State> (folders: ExprFolder<'State>) = | Expr.StaticOptimization (_tcs, csx, x, _) -> exprsF z [csx;x] - | Expr.WitnessArg (_witnessInfo, _m) -> z + | Expr.WitnessArg (_witnessInfo, _m) -> + z and valBindF dtree z bind = let z = folders.nonRecBindingsIntercept z bind @@ -8505,7 +8506,8 @@ and rewriteExprStructure env expr = | Expr.TyChoose (a, b, m) -> Expr.TyChoose (a, RewriteExpr env b, m) - | Expr.WitnessArg (witnessInfo, m) -> Expr.WitnessArg (witnessInfo, m) + | Expr.WitnessArg (witnessInfo, m) -> + Expr.WitnessArg (witnessInfo, m) and rewriteLinearExpr env expr contf = // schedule a rewrite on the way back up by adding to the continuation diff --git a/src/fsharp/TypedTreePickle.fs b/src/fsharp/TypedTreePickle.fs index 445d40de9e7..8e0e7e7a5d1 100644 --- a/src/fsharp/TypedTreePickle.fs +++ b/src/fsharp/TypedTreePickle.fs @@ -2585,7 +2585,14 @@ and p_expr expr st = | Expr.StaticOptimization (a, b, c, d) -> p_byte 11 st; p_tup4 p_constraints p_expr p_expr p_dummy_range (a, b, c, d) st | Expr.TyChoose (a, b, c) -> p_byte 12 st; p_tup3 p_tyar_specs p_expr p_dummy_range (a, b, c) st | Expr.Quote (ast, _, _, m, ty) -> p_byte 13 st; p_tup3 p_expr p_dummy_range p_ty (ast, m, ty) st - | Expr.WitnessArg _ -> pfailwith st "unexpected Expr.WitnessArg" + | Expr.WitnessArg (TraitWitnessInfo(tys, nm, mf, argtys, rty), m) -> + p_byte 14 st + p_tys tys st + p_string nm st + p_MemberFlags mf st + p_tys argtys st + p_option p_ty rty st + p_dummy_range m st and u_expr st = let tag = u_byte st @@ -2660,6 +2667,14 @@ and u_expr st = let c = u_dummy_range st let d = u_ty st Expr.Quote (b, ref None, false, c, d) // isFromQueryExpression=false + | 14 -> + let tys = u_tys st + let nm = u_string st + let mf = u_MemberFlags st + let argtys = u_tys st + let rty = u_option u_ty st + let m = u_dummy_range st + Expr.WitnessArg (TraitWitnessInfo(tys, nm, mf, argtys, rty), m) | _ -> ufailwith st "u_expr" and p_static_optimization_constraint x st = From 050b022e8d332f2a7baf28d90fee02416fdf5aa2 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 6 May 2020 16:03:26 +0100 Subject: [PATCH 10/14] fix test --- src/fsharp/IlxGen.fs | 72 ++++++++++++---------- src/fsharp/PostInferenceChecks.fs | 8 +-- src/fsharp/QuotationTranslator.fs | 95 ++++++++++++++++-------------- src/fsharp/QuotationTranslator.fsi | 2 +- 4 files changed, 97 insertions(+), 80 deletions(-) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 5c059446474..8bfb8d65649 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -877,6 +877,9 @@ and IlxGenEnv = /// All witnesses in scope and their mapping to storage for the witness value. witnessesInScope: TraitWitnessInfoHashMap + /// Suppress witnesses when not generating witness-passing code + suppressWitnesses: bool + /// For optimizing direct tail recursion to a loop - mark says where to branch to. Length is 0 or 1. /// REVIEW: generalize to arbitrary nested local loops?? innerVals: (ValRef * (BranchCallItem * Mark)) list @@ -976,12 +979,15 @@ let StorageForVal g m v eenv = let StorageForValRef g m (v: ValRef) eenv = StorageForVal g m v.Deref eenv -let TryStorageForWitness eenv (w: TraitWitnessInfo) = +let ComputeGenerateWitnesses (g: TcGlobals) eenv = + g.generateWitnesses && not eenv.witnessesInScope.IsEmpty && not eenv.suppressWitnesses + +let TryStorageForWitness (g: TcGlobals) eenv (w: TraitWitnessInfo) = match eenv.witnessesInScope.TryGetValue w with | true, storage -> Some storage | _ -> - let inWitnessPassingScope = not eenv.witnessesInScope.IsEmpty - assert not inWitnessPassingScope + let generateWitnesses = ComputeGenerateWitnesses g eenv + assert not generateWitnesses None let IsValRefIsDllImport g (vref: ValRef) = @@ -3107,7 +3113,7 @@ and GenUntupledArgExpr cenv cgbuf eenv m argInfos expr sequel = and GenWitnessArgFromInfo cenv cgbuf eenv m witnessInfo = let g = cenv.g - let storage = TryStorageForWitness eenv witnessInfo + let storage = TryStorageForWitness g eenv witnessInfo match storage with | None -> System.Diagnostics.Debug.Assert(false, "expected storage for witness") @@ -3117,17 +3123,17 @@ and GenWitnessArgFromInfo cenv cgbuf eenv m witnessInfo = and GenWitnessArgsFromInfos cenv cgbuf eenv m witnessInfos = let g = cenv.g - let inWitnessPassingScope = not eenv.witnessesInScope.IsEmpty + let generateWitnesses = ComputeGenerateWitnesses g eenv // Witness arguments are only generated in emitted 'inline' code where witness parameters are available. - if g.generateWitnesses && inWitnessPassingScope then + if generateWitnesses then for witnessInfo in witnessInfos do GenWitnessArgFromInfo cenv cgbuf eenv m witnessInfo and GenWitnessArgs cenv cgbuf eenv m tps tyargs = let g = cenv.g - let inWitnessPassingScope = not eenv.witnessesInScope.IsEmpty + let generateWitnesses = ComputeGenerateWitnesses g eenv // Witness arguments are only generated in emitted 'inline' code where witness parameters are available. - if g.generateWitnesses && inWitnessPassingScope then + if generateWitnesses then let mwitnesses = ConstraintSolver.CodegenWitnessesForTyparInst cenv.tcVal g cenv.amap m tps tyargs |> CommitOperationResult @@ -3937,21 +3943,18 @@ and GenAsmCode cenv cgbuf eenv (il, tyargs, args, returnTys, m) sequel = // Generate expression quotations //-------------------------------------------------------------------------- -and GenQuotation cenv cgbuf eenv (ast, conv, m, ety) sequel = +and GenQuotation cenv cgbuf eenv (ast, qdataCell, m, ety) sequel = let g = cenv.g + let suppressWitnesses = eenv.suppressWitnesses let referencedTypeDefs, spliceTypes, exprSplices, astSpec = - match !conv with + match qdataCell.Value with | Some (data1, data2) -> - if eenv.witnessesInScope.IsEmpty then - data1 - else - data2 + if suppressWitnesses then data1 else data2 | None -> try - let inWitnessPassingScope = not eenv.witnessesInScope.IsEmpty let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, cenv.tcVal, QuotationTranslator.IsReflectedDefinition.No) - let astSpec = QuotationTranslator.ConvExprPublic qscope inWitnessPassingScope ast + let astSpec = QuotationTranslator.ConvExprPublic qscope suppressWitnesses ast let referencedTypeDefs, typeSplices, exprSplices = qscope.Close() referencedTypeDefs, List.map fst typeSplices, List.map fst exprSplices, astSpec with @@ -4045,10 +4048,10 @@ and MakeNotSupportedExnExpr cenv eenv (argExpr, m) = and GenTraitCall (cenv: cenv) cgbuf eenv (traitInfo: TraitConstraintInfo, argExprs, m) expr sequel = let g = cenv.g - let inWitnessPassingScope = not eenv.witnessesInScope.IsEmpty + let generateWitnesses = ComputeGenerateWitnesses g eenv let witness = - if g.generateWitnesses && inWitnessPassingScope then - TryStorageForWitness eenv traitInfo.TraitKey + if generateWitnesses then + TryStorageForWitness g eenv traitInfo.TraitKey else None @@ -4062,7 +4065,7 @@ and GenTraitCall (cenv: cenv) cgbuf eenv (traitInfo: TraitConstraintInfo, argExp | None -> // If witnesses are available, we should now always find trait witnesses in scope - assert not inWitnessPassingScope + assert not generateWitnesses let minfoOpt = CommitOperationResult (ConstraintSolver.CodegenWitnessForTraitConstraint cenv.tcVal g cenv.amap m traitInfo argExprs) match minfoOpt with @@ -4710,8 +4713,8 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) eenvouter takenNames ex // Work out if the closure captures any witnesses. let cloWitnessInfos = - let inWitnessPassingScope = not eenvouter.witnessesInScope.IsEmpty - if g.generateWitnesses && inWitnessPassingScope then + let generateWitnesses = ComputeGenerateWitnesses g eenvinner + if generateWitnesses then GetTraitWitnessInfosOfTypars g 0 cloFreeTyvars // TODO: 0 may be wrong here else [] @@ -5019,8 +5022,8 @@ and GenStaticOptimization cenv cgbuf eenv (constraints, e2, e3, _m) sequel = // When witnesses are not available we use the dynamic implementation. let e = - let inWitnessPassingScope = not eenv.witnessesInScope.IsEmpty - if DecideStaticOptimizations cenv.g constraints inWitnessPassingScope = StaticOptimizationAnswer.Yes then + let generateWitnesses = ComputeGenerateWitnesses cenv.g eenv + if DecideStaticOptimizations cenv.g constraints generateWitnesses = StaticOptimizationAnswer.Yes then e2 else e3 @@ -5540,13 +5543,15 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) star // if we have any expression recursion depth, we should delay the generation of a method to prevent stack overflows let generator = if cenv.exprRecursionDepth > 0 then DelayGenMethodForBinding else GenMethodForBinding - generator cenv cgbuf.mgbuf eenv (vspec, mspec, false, access, ctps, mtps, [], curriedArgInfos, paramInfos, argTys, retInfo, topValInfo, methLambdaCtorThisValOpt, methLambdaBaseValOpt, methLambdaTypars, methLambdaVars, methLambdaBody, methLambdaBodyTy) + let hasWitnessEntry = cenv.g.generateWitnesses && not witnessInfos.IsEmpty + + generator cenv cgbuf.mgbuf eenv (vspec, mspec, hasWitnessEntry, false, access, ctps, mtps, [], curriedArgInfos, paramInfos, argTys, retInfo, topValInfo, methLambdaCtorThisValOpt, methLambdaBaseValOpt, methLambdaTypars, methLambdaVars, methLambdaBody, methLambdaBodyTy) // If generating witnesses, then generate the second entry point with additional arguments. // Take a copy of the expression to ensure generated names are unique. - if cenv.g.generateWitnesses && not witnessInfos.IsEmpty then + if hasWitnessEntry then let copyOfLambdaBody = copyExpr cenv.g CloneAll methLambdaBody - generator cenv cgbuf.mgbuf eenv (vspec, mspecW, true, access, ctps, mtps, witnessInfos, curriedArgInfos, paramInfos, argTys, retInfo, topValInfo, methLambdaCtorThisValOpt, methLambdaBaseValOpt, methLambdaTypars, methLambdaVars, copyOfLambdaBody, methLambdaBodyTy) + generator cenv cgbuf.mgbuf eenv (vspec, mspecW, hasWitnessEntry, true, access, ctps, mtps, witnessInfos, curriedArgInfos, paramInfos, argTys, retInfo, topValInfo, methLambdaCtorThisValOpt, methLambdaBaseValOpt, methLambdaTypars, methLambdaVars, copyOfLambdaBody, methLambdaBodyTy) | StaticProperty (ilGetterMethSpec, optShadowLocal) -> @@ -6010,10 +6015,14 @@ and DelayGenMethodForBinding cenv mgbuf eenv ilxMethInfoArgs = and GenMethodForBinding cenv mgbuf eenv - (v: Val, mspec, hasWitnessArgs, access, ctps, mtps, witnessInfos, curriedArgInfos, paramInfos, argTys, retInfo, topValInfo, + (v: Val, mspec, hasWitnessEntry, generateWitnessArgs, access, ctps, mtps, witnessInfos, curriedArgInfos, paramInfos, argTys, retInfo, topValInfo, ctorThisValOpt, baseValOpt, methLambdaTypars, methLambdaVars, methLambdaBody, returnTy) = let g = cenv.g let m = v.Range + + // If a method has a witness-passing version of the code, then suppress + // the generation of any witness in the non-witness passing version of the code + let eenv = { eenv with suppressWitnesses = hasWitnessEntry && not generateWitnessArgs } let selfMethodVars, nonSelfMethodVars, compileAsInstance = match v.MemberInfo with @@ -6038,7 +6047,7 @@ and GenMethodForBinding let isCtor = v.IsConstructor let methLambdaWitnessInfos = - if hasWitnessArgs then + if generateWitnessArgs then GetTraitWitnessInfosOfTypars cenv.g ctps.Length methLambdaTypars else [] @@ -6084,8 +6093,8 @@ and GenMethodForBinding // on the attribute. Older compilers let bodyExpr = let attr = TryFindFSharpBoolAttributeAssumeFalse cenv.g cenv.g.attrib_NoDynamicInvocationAttribute v.Attribs - if (not hasWitnessArgs && attr.IsSome) || - (hasWitnessArgs && attr = Some false) then + if (not generateWitnessArgs && attr.IsSome) || + (generateWitnessArgs && attr = Some false) then let exnArg = mkString cenv.g m (FSComp.SR.ilDynamicInvocationNotSupported(v.CompiledName g.CompilerGlobalState)) let exnExpr = MakeNotSupportedExnExpr cenv eenv (exnArg, m) mkThrow m returnTy exnExpr @@ -7883,6 +7892,7 @@ let GetEmptyIlxGenEnv (g: TcGlobals) ccu = cloc = thisCompLoc valsInScope=ValMap<_>.Empty witnessesInScope = EmptyTraitWitnessInfoHashMap g + suppressWitnesses = false someTypeInThisAssembly= g.ilg.typ_Object // dummy value isFinalFile = false letBoundVars=[] diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index 44c0c784fee..23747daef18 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -976,14 +976,14 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi // Translate the quotation to quotation data try - let doData flag = + let doData suppressWitnesses = let qscope = QuotationTranslator.QuotationGenerationScope.Create (g, cenv.amap, cenv.viewCcu, cenv.tcVal, QuotationTranslator.IsReflectedDefinition.No) - let qdata = QuotationTranslator.ConvExprPublic qscope flag ast + let qdata = QuotationTranslator.ConvExprPublic qscope suppressWitnesses ast let typeDefs, spliceTypes, spliceExprs = qscope.Close() typeDefs, List.map fst spliceTypes, List.map fst spliceExprs, qdata - let data1 = doData false - let data2 = doData true + let data1 = doData true + let data2 = doData false match savedConv.Value with | None -> savedConv:= Some (data1, data2) | Some _ -> () diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index 834d4b9063d..7e4708c0583 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -99,8 +99,8 @@ type QuotationTranslationEnv = /// Map from typar stamps to binding index tyvs: StampMap - /// Indicates this is a witness arg we we disable further generation of witnesses - includeWitnesses: bool + /// Indicates that we disable generation of witnesses + suppressWitnesses: bool /// All witnesses in scope and their mapping to lambda variables. // @@ -121,7 +121,7 @@ type QuotationTranslationEnv = { vs = ValMap<_>.Empty numValsInScope = 0 tyvs = Map.empty - includeWitnesses = true + suppressWitnesses = false witnessesInScope = EmptyTraitWitnessInfoHashMap g isinstVals = ValMap<_>.Empty substVals = ValMap<_>.Empty } @@ -247,11 +247,11 @@ and ConvExpr cenv env (expr : Expr) = and GetWitnessArgs cenv (env : QuotationTranslationEnv) m tps tyargs = let g = cenv.g - if g.generateWitnesses && env.includeWitnesses then + if g.generateWitnesses && not env.suppressWitnesses then let witnessExprs = ConstraintSolver.CodegenWitnessesForTyparInst cenv.tcVal g cenv.amap m tps tyargs |> CommitOperationResult - let env = { env with includeWitnesses = false } + let env = { env with suppressWitnesses = true } witnessExprs |> List.map (fun arg -> match arg with | Choice1Of2 witnessInfo -> @@ -263,7 +263,7 @@ and GetWitnessArgs cenv (env : QuotationTranslationEnv) m tps tyargs = and ConvWitnessInfo cenv env m witnessInfo = let g = cenv.g - let env = { env with includeWitnesses = false } + let env = { env with suppressWitnesses = true } if env.witnessesInScope.ContainsKey witnessInfo then let witnessArgIdx = env.witnessesInScope.[witnessInfo] QP.mkVar witnessArgIdx @@ -275,11 +275,13 @@ and ConvWitnessInfo cenv env m witnessInfo = and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.ExprData = - let expr = DetectAndOptimizeForExpression cenv.g OptimizeIntRangesOnly expr + let g = cenv.g + + let expr = DetectAndOptimizeForExpression g OptimizeIntRangesOnly expr // Eliminate subsumption coercions for functions. This must be done post-typechecking because we need // complete inference types. - let expr = NormalizeAndAdjustPossibleSubsumptionExprs cenv.g expr + let expr = NormalizeAndAdjustPossibleSubsumptionExprs g expr // Remove TExpr_ref nodes let expr = stripExpr expr @@ -289,9 +291,9 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. match expr with // Detect expression tree exprSplices | Expr.App (InnerExprPat(Expr.Val (vf, _, _)), _, _, x0 :: rest, m) - when isSplice cenv.g vf -> + when isSplice g vf -> let idx = cenv.exprSplices.Count - let ty = tyOfExpr cenv.g expr + let ty = tyOfExpr g expr match (freeInExpr CollectTyparsAndLocalsNoCaching x0).FreeLocals |> Seq.tryPick (fun v -> if env.vs.ContainsVal v then Some v else None) with | Some v -> errorR(Error(FSComp.SR.crefBoundVarUsedInSplice(v.DisplayName), v.Range)) @@ -301,25 +303,25 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let hole = QP.mkHole(ConvType cenv env m ty, idx) (hole, rest) ||> List.fold (fun fR arg -> QP.mkApp (fR, ConvExpr cenv env arg)) - | ModuleValueOrMemberUse cenv.g (vref, vFlags, _f, _fty, tyargs, curriedArgs) - when not (isSplice cenv.g vref) -> + | ModuleValueOrMemberUse g (vref, vFlags, _f, _fty, tyargs, curriedArgs) + when not (isSplice g vref) -> let m = expr.Range let (numEnclTypeArgs, _, isNewObj, valUseFlags, isSelfInit, takesInstanceArg, isPropGet, isPropSet) = - GetMemberCallInfo cenv.g (vref, vFlags) + GetMemberCallInfo g (vref, vFlags) let isMember, tps, witnessInfos, curriedArgInfos, retTy = match vref.MemberInfo with | Some _ when not vref.IsExtensionMember -> // This is an application of a member method // We only count one argument block for these. - let tps, witnessInfos, curriedArgInfos, retTy, _ = GetTypeOfIntrinsicMemberInCompiledForm cenv.g vref + let tps, witnessInfos, curriedArgInfos, retTy, _ = GetTypeOfIntrinsicMemberInCompiledForm g vref true, tps, witnessInfos, curriedArgInfos, retTy | _ -> // This is an application of a module value or extension member let arities = arityOfVal vref.Deref let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal vref.Deref - let tps, witnessInfos, curriedArgInfos, retTy, _ = GetTopValTypeInCompiledForm cenv.g arities numEnclosingTypars vref.Type m + let tps, witnessInfos, curriedArgInfos, retTy, _ = GetTopValTypeInCompiledForm g arities numEnclosingTypars vref.Type m false, tps, witnessInfos, curriedArgInfos, retTy // Compute the object arguments as they appear in a compiled call @@ -349,8 +351,8 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. | None -> error(InternalError("no arity information found for F# value " + vref.LogicalName, vref.Range)) | Some a -> a - let expr, exprty = AdjustValForExpectedArity cenv.g m vref vFlags topValInfo - ConvExpr cenv env (MakeApplicationAndBetaReduce cenv.g (expr, exprty, [tyargs], curriedArgs, m)) + let expr, exprty = AdjustValForExpectedArity g m vref vFlags topValInfo + ConvExpr cenv env (MakeApplicationAndBetaReduce g (expr, exprty, [tyargs], curriedArgs, m)) else // Too many arguments? Chop let (curriedArgs: Expr list ), laterArgs = List.splitAt nCurriedArgInfos curriedArgs @@ -370,7 +372,12 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. if verboseCReflect then dprintfn "vref.DisplayName = %A , after unit adjust, #untupledCurriedArgs = %A, #curriedArgInfos = %d" vref.DisplayName (List.map List.length untupledCurriedArgs) curriedArgInfos.Length - let witnessArgTys = GenWitnessTys cenv.g witnessInfos + let witnessArgTys = + if g.generateWitnesses && not env.suppressWitnesses then + GenWitnessTys g witnessInfos + else + [] + let witnessArgs = GetWitnessArgs cenv env m tps tyargs let subCall = @@ -384,7 +391,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let witnessArgTypesR = ConvTypes cenv envinner m witnessArgTys let methArgTypesR = ConvTypes cenv envinner m argTys let methRetTypeR = ConvReturnType cenv envinner m retTy - let methName = vref.CompiledName cenv.g.CompilerGlobalState + let methName = vref.CompiledName g.CompilerGlobalState let numGenericArgs = tyargs.Length - numEnclTypeArgs ConvObjectModelCall cenv env m (isPropGet, isPropSet, isNewObj, parentTyconR, witnessArgTypesR, methArgTypesR, methRetTypeR, methName, tyargs, numGenericArgs, objArgs, witnessArgs, untupledCurriedArgs) else @@ -412,7 +419,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. // Blast type application nodes and expression application nodes apart so values are left with just their type arguments | Expr.App (f, fty, (_ :: _ as tyargs), (_ :: _ as args), m) -> - let rfty = applyForallTy cenv.g fty tyargs + let rfty = applyForallTy g fty tyargs ConvExpr cenv env (primMkApp (primMkApp (f, fty) tyargs [] m, rfty) [] args m) // Uses of possibly-polymorphic values @@ -446,7 +453,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. QP.mkLetRec(bindsR, bodyR) | Expr.Lambda (_, _, _, vs, b, _, _) -> - let v, b = MultiLambdaToTupledLambda cenv.g vs b + let v, b = MultiLambdaToTupledLambda g vs b let vR = ConvVal cenv env v let bR = ConvExpr cenv (BindVal env v) b QP.mkLambda(vR, bR) @@ -455,7 +462,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. // F# 2.0-3.1 had a bug with nested 'raw' quotations. F# 4.0 + FSharp.Core 4.4.0.0+ allows us to do the right thing. if cenv.quotationFormat.SupportsDeserializeEx && // Look for a 'raw' quotation - tyconRefEq cenv.g (tcrefOfAppTy cenv.g ety) cenv.g.raw_expr_tcr + tyconRefEq g (tcrefOfAppTy g ety) g.raw_expr_tcr then QP.mkQuoteRaw40(ConvExpr cenv env ast) else @@ -469,14 +476,14 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. ConvDecisionTree cenv env tgs typR dtree // initialization check - | Expr.Sequential (ObjectInitializationCheck cenv.g, x1, NormalSeq, _, _) -> + | Expr.Sequential (ObjectInitializationCheck g, x1, NormalSeq, _, _) -> ConvExpr cenv env x1 | Expr.Sequential (x0, x1, NormalSeq, _, _) -> QP.mkSequential(ConvExpr cenv env x0, ConvExpr cenv env x1) - | Expr.Obj (_, ty, _, _, [TObjExprMethod(TSlotSig(_, ctyp, _, _, _, _), _, tps, [tmvs], e, _) as tmethod], _, m) when isDelegateTy cenv.g ty -> - let f = mkLambdas m tps tmvs (e, GetFSharpViewOfReturnType cenv.g (returnTyOfMethod cenv.g tmethod)) + | Expr.Obj (_, ty, _, _, [TObjExprMethod(TSlotSig(_, ctyp, _, _, _, _), _, tps, [tmvs], e, _) as tmethod], _, m) when isDelegateTy g ty -> + let f = mkLambdas m tps tmvs (e, GetFSharpViewOfReturnType g (returnTyOfMethod g tmethod)) let fR = ConvExpr cenv env f let tyargR = ConvType cenv env m ctyp QP.mkDelegate(tyargR, fR) @@ -485,7 +492,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. ConvExpr cenv env x | Expr.TyChoose _ -> - ConvExpr cenv env (TypeRelations.ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr) + ConvExpr cenv env (TypeRelations.ChooseTyparSolutionsForFreeChoiceTypars g cenv.amap expr) | Expr.Sequential (x0, x1, ThenDoSeq, _, _) -> QP.mkSequential(ConvExpr cenv env x0, ConvExpr cenv env x1) @@ -502,7 +509,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. QP.mkUnion(tcR, s, tyargsR, argsR) | TOp.Tuple tupInfo, tyargs, _ -> - let tyR = ConvType cenv env m (mkAnyTupledTy cenv.g tupInfo tyargs) + let tyR = ConvType cenv env m (mkAnyTupledTy g tupInfo tyargs) let argsR = ConvExprs cenv env args QP.mkTuple(tyR, argsR) @@ -543,7 +550,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. | TOp.TupleFieldGet (tupInfo, n), tyargs, [e] -> let eR = ConvLValueExpr cenv env e - let tyR = ConvType cenv env m (mkAnyTupledTy cenv.g tupInfo tyargs) + let tyR = ConvType cenv env m (mkAnyTupledTy g tupInfo tyargs) QP.mkTupleGet(tyR, n, eR) | TOp.ILAsm (([ I_ldfld (_, _, fspec) ] @@ -559,12 +566,12 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. QP.mkFieldSet(parentTyconR, fspec.Name, tyargsR, argsR) | TOp.ILAsm ([ AI_ceq ], _), _, [arg1;arg2] -> - let ty = tyOfExpr cenv.g arg1 - let eq = mkCallEqualsOperator cenv.g m ty arg1 arg2 + let ty = tyOfExpr g arg1 + let eq = mkCallEqualsOperator g m ty arg1 arg2 ConvExpr cenv env eq | TOp.ILAsm ([ I_throw ], _), _, [arg1] -> - let raiseExpr = mkCallRaise cenv.g m (tyOfExpr cenv.g expr) arg1 + let raiseExpr = mkCallRaise g m (tyOfExpr g expr) arg1 ConvExpr cenv env raiseExpr | TOp.ILAsm (_il, _), _, _ -> @@ -581,7 +588,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. QP.mkCtorCall( { ctorParent = parentTyconR ctorArgTypes = methArgTypesR }, [], argsR) - let exnTypeR = ConvType cenv env m cenv.g.exn_ty + let exnTypeR = ConvType cenv env m g.exn_ty QP.mkCoerce(exnTypeR, objR) | TOp.ValFieldSet rfref, _tinst, args -> @@ -612,14 +619,14 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. | TOp.Coerce, [tgtTy;srcTy], [x] -> let xR = ConvExpr cenv env x - if typeEquiv cenv.g tgtTy srcTy then + if typeEquiv g tgtTy srcTy then xR else QP.mkCoerce(ConvType cenv env m tgtTy, xR) | TOp.Reraise, [toTy], [] -> // rebuild reraise() and Convert - mkReraiseLibCall cenv.g toTy m |> ConvExpr cenv env + mkReraiseLibCall g toTy m |> ConvExpr cenv env | TOp.LValueOp (LAddrOf _, vref), [], [] -> QP.mkAddressOf(ConvValRef false cenv env m vref []) @@ -630,9 +637,9 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. | TOp.LValueOp (LSet, vref), [], [e] -> // Sets of module values become property sets match vref.DeclaringEntity with - | Parent tcref when IsCompiledAsStaticProperty cenv.g vref.Deref -> + | Parent tcref when IsCompiledAsStaticProperty g vref.Deref -> let parentTyconR = ConvTyconRef cenv tcref m - let propName = vref.CompiledName cenv.g.CompilerGlobalState + let propName = vref.CompiledName g.CompilerGlobalState let propTy = ConvType cenv env m vref.Type QP.mkPropSet( (parentTyconR, propName, propTy, []), [], [ConvExpr cenv env e]) | _ -> @@ -647,10 +654,10 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. | TOp.While _, [], [Expr.Lambda (_, _, _, [_], test, _, _);Expr.Lambda (_, _, _, [_], body, _, _)] -> QP.mkWhileLoop(ConvExpr cenv env test, ConvExpr cenv env body) - | TOp.For (_, FSharpForLoopUp), [], [Expr.Lambda (_, _, _, [_], lim0, _, _); Expr.Lambda (_, _, _, [_], SimpleArrayLoopUpperBound, lm, _); SimpleArrayLoopBody cenv.g (arr, elemTy, body)] -> + | TOp.For (_, FSharpForLoopUp), [], [Expr.Lambda (_, _, _, [_], lim0, _, _); Expr.Lambda (_, _, _, [_], SimpleArrayLoopUpperBound, lm, _); SimpleArrayLoopBody g (arr, elemTy, body)] -> let lim1 = - let len = mkCallArrayLength cenv.g lm elemTy arr // Array.length arr - mkCallSubtractionOperator cenv.g lm cenv.g.int32_ty len (Expr.Const (Const.Int32 1, m, cenv.g.int32_ty)) // len - 1 + let len = mkCallArrayLength g lm elemTy arr // Array.length arr + mkCallSubtractionOperator g lm g.int32_ty len (Expr.Const (Const.Int32 1, m, g.int32_ty)) // len - 1 QP.mkForLoop(ConvExpr cenv env lim0, ConvExpr cenv env lim1, ConvExpr cenv env body) | TOp.For (_, dir), [], [Expr.Lambda (_, _, _, [_], lim0, _, _);Expr.Lambda (_, _, _, [_], lim1, _, _);body] -> @@ -680,10 +687,10 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. QP.mkTryWith(ConvExpr cenv env e1, vfR, ConvExpr cenv envf ef, vhR, ConvExpr cenv envh eh) | TOp.Bytes bytes, [], [] -> - ConvExpr cenv env (Expr.Op (TOp.Array, [cenv.g.byte_ty], List.ofArray (Array.map (mkByte cenv.g m) bytes), m)) + ConvExpr cenv env (Expr.Op (TOp.Array, [g.byte_ty], List.ofArray (Array.map (mkByte g m) bytes), m)) | TOp.UInt16s arr, [], [] -> - ConvExpr cenv env (Expr.Op (TOp.Array, [cenv.g.uint16_ty], List.ofArray (Array.map (mkUInt16 cenv.g m) arr), m)) + ConvExpr cenv env (Expr.Op (TOp.Array, [g.uint16_ty], List.ofArray (Array.map (mkUInt16 g m) arr), m)) | TOp.UnionCaseProof _, _, [e] -> ConvExpr cenv env e // Note: we erase the union case proof conversions when converting to quotations @@ -701,7 +708,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. wfail(Error(FSComp.SR.crefQuotationsCantRequireByref(), m)) | TOp.TraitCall traitInfo, _, args -> - let g = cenv.g + let g = g let inWitnessPassingScope = not env.witnessesInScope.IsEmpty let witnessArgInfo = if g.generateWitnesses && inWitnessPassingScope then @@ -1208,9 +1215,9 @@ and ConvReturnType cenv envinner m retTy = | None -> ConvVoidType cenv m | Some ty -> ConvType cenv envinner m ty -let ConvExprPublic cenv includeWitnesses e = +let ConvExprPublic cenv suppressWitnesses e = let env = QuotationTranslationEnv.CreateEmpty(cenv.g) - let env = { env with includeWitnesses = includeWitnesses } + let env = { env with suppressWitnesses = suppressWitnesses } let astExpr = let astExpr = ConvExpr cenv env e // always emit debug info for the top level expression diff --git a/src/fsharp/QuotationTranslator.fsi b/src/fsharp/QuotationTranslator.fsi index 1562e454146..c140beb1639 100755 --- a/src/fsharp/QuotationTranslator.fsi +++ b/src/fsharp/QuotationTranslator.fsi @@ -34,7 +34,7 @@ type QuotationGenerationScope = member Close: unit -> ILTypeRef list * (TType * range) list * (Expr * range) list static member ComputeQuotationFormat : TcGlobals -> QuotationSerializationFormat -val ConvExprPublic : QuotationGenerationScope -> includeWitnesses: bool -> Expr -> QuotationPickler.ExprData +val ConvExprPublic : QuotationGenerationScope -> suppressWitnesses: bool -> Expr -> QuotationPickler.ExprData val ConvReflectedDefinition: QuotationGenerationScope -> string -> Val -> Expr -> QuotationPickler.MethodBaseData * QuotationPickler.ExprData val (|ModuleValueOrMemberUse|_|) : TcGlobals -> Expr -> (ValRef * ValUseFlag * Expr * TType * TypeInst * Expr list) option From 05ba6e0fe33e8199a390a86fc2c48169c907f987 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 20 May 2020 02:12:52 +0100 Subject: [PATCH 11/14] fix abs bug and test calling it --- src/fsharp/ConstraintSolver.fs | 17 +++++--- src/fsharp/ConstraintSolver.fsi | 5 ++- src/fsharp/FSharp.Core/prim-types.fsi | 1 - src/fsharp/FindUnsolved.fs | 20 ++++----- src/fsharp/IlxGen.fs | 63 ++++++++++++++++++--------- src/fsharp/MethodCalls.fs | 2 +- src/fsharp/PostInferenceChecks.fs | 5 +-- src/fsharp/QuotationTranslator.fs | 17 +++++--- src/fsharp/TypedTree.fs | 2 +- src/fsharp/TypedTreeOps.fs | 32 +++++++------- src/fsharp/TypedTreeOps.fsi | 2 + src/fsharp/TypedTreePickle.fs | 17 ++------ tests/fsharp/core/quotes/test.fsx | 32 +++++++++++++- tests/fsharp/tools/eval/test.fsx | 3 +- 14 files changed, 132 insertions(+), 86 deletions(-) diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 981732e68f2..a82b22038c2 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -3071,23 +3071,28 @@ let CreateCodegenState tcVal g amap = /// Generate a witness expression if none is otherwise available, e.g. in legacy non-witness-passing code let CodegenWitnessForTraitConstraint tcVal g amap m (traitInfo:TraitConstraintInfo) argExprs = trackErrors { let css = CreateCodegenState tcVal g amap - let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) - let! _res = SolveMemberConstraint csenv true PermitWeakResolution.Yes 0 m NoTrace traitInfo - let sln = GenWitnessExpr amap g m traitInfo argExprs return sln } -/// Generate the arguments passed for a use of a generic construct that accepts trait witnesses +/// Generate the lambda argument passed for a use of a generic construct that accepts trait witnesses let CodegenWitnessesForTyparInst tcVal g amap m typars tyargs = trackErrors { let css = CreateCodegenState tcVal g amap let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) let ftps, _renaming, tinst = FreshenTypeInst m typars - let cxs = GetTraitConstraintInfosOfTypars g ftps + let traitInfos = GetTraitConstraintInfosOfTypars g ftps do! SolveTypeEqualsTypeEqns csenv 0 m NoTrace None tinst tyargs - return MethodCalls.GenWitnessArgs amap g m cxs + return MethodCalls.GenWitnessArgs amap g m traitInfos + } + +/// Generate the lambda argument passed for a use of a generic construct that accepts trait witnesses +let CodegenWitnessesForTraitWitness tcVal g amap m traitInfo = trackErrors { + let css = CreateCodegenState tcVal g amap + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) + let! _res = SolveMemberConstraint csenv true PermitWeakResolution.Yes 0 m NoTrace traitInfo + return MethodCalls.GenWitnessExprLambda amap g m traitInfo } /// For some code like "let f() = ([] = [])", a free choice is made for a type parameter diff --git a/src/fsharp/ConstraintSolver.fsi b/src/fsharp/ConstraintSolver.fsi index ec97e7a1225..78872f1d805 100644 --- a/src/fsharp/ConstraintSolver.fsi +++ b/src/fsharp/ConstraintSolver.fsi @@ -195,7 +195,10 @@ val ApplyTyparDefaultAtPriority: DisplayEnv -> ConstraintSolverState -> priority val CodegenWitnessForTraitConstraint : TcValF -> TcGlobals -> ImportMap -> range -> TraitConstraintInfo -> Expr list -> OperationResult /// Generate the arguments passed when using a generic construct that accepts traits witnesses -val CodegenWitnessesForTyparInst : TcValF -> TcGlobals -> ImportMap -> range -> Typars -> TType list -> OperationResult list> +val CodegenWitnessesForTyparInst : TcValF -> TcGlobals -> ImportMap -> range -> Typars -> TType list -> OperationResult list> + +/// Generate the lambda argument passed for a use of a generic construct that accepts trait witnesses +val CodegenWitnessesForTraitWitness : TcValF -> TcGlobals -> ImportMap -> range -> TraitConstraintInfo -> OperationResult> /// For some code like "let f() = ([] = [])", a free choice is made for a type parameter /// for an interior type variable. This chooses a solution for a type parameter subject diff --git a/src/fsharp/FSharp.Core/prim-types.fsi b/src/fsharp/FSharp.Core/prim-types.fsi index aedc81dca7b..3c35192188e 100644 --- a/src/fsharp/FSharp.Core/prim-types.fsi +++ b/src/fsharp/FSharp.Core/prim-types.fsi @@ -719,7 +719,6 @@ namespace Microsoft.FSharp.Core /// NoDynamicInvocationAttribute new : unit -> NoDynamicInvocationAttribute - [] internal new : isLegacy: bool -> NoDynamicInvocationAttribute /// This attribute is used to indicate that references to the elements of a module, record or union diff --git a/src/fsharp/FindUnsolved.fs b/src/fsharp/FindUnsolved.fs index 27189988465..33166d34f9e 100644 --- a/src/fsharp/FindUnsolved.fs +++ b/src/fsharp/FindUnsolved.fs @@ -109,16 +109,11 @@ let rec accExpr (cenv:cenv) (env:env) expr = | TTyconIsStruct(ty1) -> accTy cenv env ty1) - | Expr.WitnessArg (witnessInfo, _m) -> - accWitnessInfo cenv env witnessInfo + | Expr.WitnessArg (traitInfo, _m) -> + accTraitInfo cenv env traitInfo | Expr.Link _eref -> failwith "Unexpected Expr.Link" -and accWitnessInfo cenv env (TraitWitnessInfo(tys, _nm, _mf, argtys, rty)) = - argtys |> accTypeInst cenv env - rty |> Option.iter (accTy cenv env) - tys |> List.iter (accTy cenv env) - and accMethods cenv env baseValOpt l = List.iter (accMethod cenv env baseValOpt) l @@ -143,15 +138,18 @@ and accOp cenv env (op, tyargs, args, _m) = accTypeInst cenv env enclTypeArgs accTypeInst cenv env methTypeArgs accTypeInst cenv env tys - | TOp.TraitCall (TTrait(tys, _nm, _, argtys, rty, _sln)) -> - argtys |> accTypeInst cenv env - rty |> Option.iter (accTy cenv env) - tys |> List.iter (accTy cenv env) + | TOp.TraitCall traitInfo -> + accTraitInfo cenv env traitInfo | TOp.ILAsm (_, tys) -> accTypeInst cenv env tys | _ -> () +and accTraitInfo cenv env (TTrait(tys, _nm, _, argtys, rty, _sln)) = + argtys |> accTypeInst cenv env + rty |> Option.iter (accTy cenv env) + tys |> List.iter (accTy cenv env) + and accLambdas cenv env topValInfo e ety = match e with | Expr.TyChoose (_tps, e1, _m) -> accLambdas cenv env topValInfo e1 ety diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 4ab6f2e1196..ad73201f55c 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -982,12 +982,12 @@ let StorageForValRef g m (v: ValRef) eenv = StorageForVal g m v.Deref eenv let ComputeGenerateWitnesses (g: TcGlobals) eenv = g.generateWitnesses && not eenv.witnessesInScope.IsEmpty && not eenv.suppressWitnesses -let TryStorageForWitness (g: TcGlobals) eenv (w: TraitWitnessInfo) = +let TryStorageForWitness (_g: TcGlobals) eenv (w: TraitWitnessInfo) = match eenv.witnessesInScope.TryGetValue w with | true, storage -> Some storage | _ -> - let generateWitnesses = ComputeGenerateWitnesses g eenv - assert not generateWitnesses + //let generateWitnesses = ComputeGenerateWitnesses g eenv + //assert not generateWitnesses None let IsValRefIsDllImport g (vref: ValRef) = @@ -2425,8 +2425,8 @@ and GenExprAux (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = | Expr.Quote (ast, conv, _, m, ty) -> GenQuotation cenv cgbuf eenv (ast, conv, m, ty) sequel - | Expr.WitnessArg (witnessInfo, m) -> - GenWitnessArgFromInfo cenv cgbuf eenv m witnessInfo + | Expr.WitnessArg (traitInfo, m) -> + GenWitnessArgFromTraitInfo cenv cgbuf eenv m traitInfo GenSequel cenv eenv.cloc cgbuf sequel | Expr.Link _ -> failwith "Unexpected reclink" @@ -3111,23 +3111,43 @@ and GenUntupledArgExpr cenv cgbuf eenv m argInfos expr sequel = // Generate calls (try to detect direct calls) //-------------------------------------------------------------------------- -and GenWitnessArgFromInfo cenv cgbuf eenv m witnessInfo = +and GenWitnessArgFromTraitInfo cenv cgbuf eenv m traitInfo = + let g = cenv.g + let storage = TryStorageForWitness g eenv traitInfo.TraitKey + match storage with + | None -> + let witnessExpr = + ConstraintSolver.CodegenWitnessesForTraitWitness cenv.tcVal g cenv.amap m traitInfo + |> CommitOperationResult + match witnessExpr with + | Choice1Of2 _traitInfo -> + System.Diagnostics.Debug.Assert(false, "expected storage for witness") + //failwith "unexpected non-generation of witness " + | Choice2Of2 arg -> + let eenv = { eenv with suppressWitnesses = true } + GenExpr cenv cgbuf eenv SPSuppress arg Continue + | Some storage -> + let ty = GenWitnessTy g traitInfo.TraitKey + GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv.amap m eenv.tyenv ty) storage None + +and GenWitnessArgFromWitnessInfo cenv cgbuf eenv m witnessInfo = let g = cenv.g let storage = TryStorageForWitness g eenv witnessInfo match storage with | None -> System.Diagnostics.Debug.Assert(false, "expected storage for witness") + //failwith "unexpected non-generation of witness " | Some storage -> let ty = GenWitnessTy g witnessInfo GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv.amap m eenv.tyenv ty) storage None -and GenWitnessArgsFromInfos cenv cgbuf eenv m witnessInfos = +and GenWitnessArgsFromWitnessInfos cenv cgbuf eenv m witnessInfos = let g = cenv.g let generateWitnesses = ComputeGenerateWitnesses g eenv // Witness arguments are only generated in emitted 'inline' code where witness parameters are available. if generateWitnesses then for witnessInfo in witnessInfos do - GenWitnessArgFromInfo cenv cgbuf eenv m witnessInfo + GenWitnessArgFromWitnessInfo cenv cgbuf eenv m witnessInfo and GenWitnessArgs cenv cgbuf eenv m tps tyargs = let g = cenv.g @@ -3140,8 +3160,8 @@ and GenWitnessArgs cenv cgbuf eenv m tps tyargs = for witnessArg in mwitnesses do match witnessArg with - | Choice1Of2 witnessInfo -> - GenWitnessArgFromInfo cenv cgbuf eenv m witnessInfo + | Choice1Of2 traitInfo -> + GenWitnessArgFromTraitInfo cenv cgbuf eenv m traitInfo | Choice2Of2 arg -> GenExpr cenv cgbuf eenv SPSuppress arg Continue @@ -3289,7 +3309,8 @@ and GenApp (cenv: cenv) cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel = let _, witnessInfos, curriedArgInfos, returnTy, _ = GetTopValTypeInCompiledForm cenv.g topValInfo ctps.Length vref.Type m let mspec = - if not cenv.g.generateWitnesses || witnessInfos.IsEmpty then + let generateWitnesses = ComputeGenerateWitnesses g eenv + if not generateWitnesses || witnessInfos.IsEmpty then mspec else mspecW @@ -3946,7 +3967,7 @@ and GenAsmCode cenv cgbuf eenv (il, tyargs, args, returnTys, m) sequel = and GenQuotation cenv cgbuf eenv (ast, qdataCell, m, ety) sequel = let g = cenv.g let suppressWitnesses = eenv.suppressWitnesses - let referencedTypeDefs, spliceTypes, exprSplices, astSpec = + let referencedTypeDefs, typeSplices, exprSplices, astSpec = match qdataCell.Value with | Some (data1, data2) -> if suppressWitnesses then data1 else data2 @@ -3964,7 +3985,7 @@ and GenQuotation cenv cgbuf eenv (ast, qdataCell, m, ety) sequel = let someTypeInModuleExpr = mkTypeOfExpr cenv m eenv.someTypeInThisAssembly let rawTy = mkRawQuotedExprTy g - let spliceTypeExprs = List.map (GenType cenv.amap m eenv.tyenv >> (mkTypeOfExpr cenv m)) spliceTypes + let typeSpliceExprs = List.map (GenType cenv.amap m eenv.tyenv >> (mkTypeOfExpr cenv m)) typeSplices let bytesExpr = Expr.Op (TOp.Bytes astSerializedBytes, [], [], m) @@ -3973,14 +3994,14 @@ and GenQuotation cenv cgbuf eenv (ast, qdataCell, m, ety) sequel = if qf.SupportsDeserializeEx then let referencedTypeDefExprs = List.map (mkILNonGenericBoxedTy >> mkTypeOfExpr cenv m) referencedTypeDefs let referencedTypeDefsExpr = mkArray (g.system_Type_ty, referencedTypeDefExprs, m) - let spliceTypesExpr = mkArray (g.system_Type_ty, spliceTypeExprs, m) + let typeSplicesExpr = mkArray (g.system_Type_ty, typeSpliceExprs, m) let spliceArgsExpr = mkArray (rawTy, exprSplices, m) - mkCallDeserializeQuotationFSharp40Plus g m someTypeInModuleExpr referencedTypeDefsExpr spliceTypesExpr spliceArgsExpr bytesExpr + mkCallDeserializeQuotationFSharp40Plus g m someTypeInModuleExpr referencedTypeDefsExpr typeSplicesExpr spliceArgsExpr bytesExpr else let mkList ty els = List.foldBack (mkCons g ty) els (mkNil g m ty) - let spliceTypesExpr = mkList g.system_Type_ty spliceTypeExprs + let typeSplicesExpr = mkList g.system_Type_ty typeSpliceExprs let spliceArgsExpr = mkList rawTy exprSplices - mkCallDeserializeQuotationFSharp20Plus g m someTypeInModuleExpr spliceTypesExpr spliceArgsExpr bytesExpr + mkCallDeserializeQuotationFSharp20Plus g m someTypeInModuleExpr typeSplicesExpr spliceArgsExpr bytesExpr let afterCastExpr = // Detect a typed quotation and insert the cast if needed. The cast should not fail but does @@ -4437,7 +4458,7 @@ and GenSequenceExpr CodeGenMethod cenv cgbuf.mgbuf ([], "GetFreshEnumerator", eenvinner, 1, (fun cgbuf eenv -> - GenWitnessArgsFromInfos cenv cgbuf eenv m cloWitnessInfos + GenWitnessArgsFromWitnessInfos cenv cgbuf eenv m cloWitnessInfos for fv in cloFreeVars do // State variables always get zero-initialized if stateVarsSet.Contains fv then @@ -4489,7 +4510,7 @@ and GenSequenceExpr CountClosure() - GenWitnessArgsFromInfos cenv cgbuf eenvouter m cloWitnessInfos + GenWitnessArgsFromWitnessInfos cenv cgbuf eenvouter m cloWitnessInfos for fv in cloFreeVars do /// State variables always get zero-initialized if stateVarsSet.Contains fv then @@ -4611,7 +4632,7 @@ and GenLambdaClosure cenv (cgbuf: CodeGenBuffer) eenv isLocalTypeFunc thisVars e and GenClosureAlloc cenv (cgbuf: CodeGenBuffer) eenv (cloinfo, m) = let g = cenv.g CountClosure() - GenWitnessArgsFromInfos cenv cgbuf eenv m cloinfo.cloWitnessInfos + GenWitnessArgsFromWitnessInfos cenv cgbuf eenv m cloinfo.cloWitnessInfos GenGetLocalVals cenv cgbuf eenv m cloinfo.cloFreeVars CG.EmitInstr cgbuf (pop cloinfo.ilCloAllFreeVars.Length) @@ -4993,7 +5014,7 @@ and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod((TSlotSig(_, deleg let ctxtGenericArgsForDelegee = GenGenericArgs m eenvouter.tyenv cloFreeTyvars let ilxCloSpec = IlxClosureSpec.Create(IlxClosureRef(ilDelegeeTypeRef, ilCloLambdas, ilCloAllFreeVars), ctxtGenericArgsForDelegee) - GenWitnessArgsFromInfos cenv cgbuf eenvouter m cloWitnessInfos + GenWitnessArgsFromWitnessInfos cenv cgbuf eenvouter m cloWitnessInfos GenGetLocalVals cenv cgbuf eenvouter m cloFreeVars CG.EmitInstr cgbuf (pop ilCloAllFreeVars.Length) (Push [EraseClosures.mkTyOfLambdas g.ilxPubCloEnv ilCloLambdas]) (I_newobj (ilxCloSpec.Constructor, None)) diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index 992131fd059..3b5b1ead27e 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -1924,7 +1924,7 @@ let GenWitnessExprLambda amap g m (traitInfo: TraitConstraintInfo) = | Some expr -> Choice2Of2 (mkMemberLambdas m [] None None vsl (expr, tyOfExpr g expr)) | None -> - Choice1Of2 witnessInfo + Choice1Of2 traitInfo /// Generate the arguments passed for a set of (solved) traits in non-generic code let GenWitnessArgs amap g m (traitInfos: TraitConstraintInfo list) = diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index 23747daef18..87d4bcbe4f0 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -1131,10 +1131,7 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi CheckTypeNoByrefs cenv env m ty1) NoLimit - | Expr.WitnessArg (TraitWitnessInfo(tys, _nm, _mf, argtys, rty), m) -> - CheckTypeInstNoByrefs cenv env m tys - CheckTypeInstNoByrefs cenv env m argtys - Option.iter (CheckTypeNoByrefs cenv env m) rty + | Expr.WitnessArg _ -> NoLimit | Expr.Link _ -> diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index 7e4708c0583..a1eff73e819 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -254,23 +254,28 @@ and GetWitnessArgs cenv (env : QuotationTranslationEnv) m tps tyargs = let env = { env with suppressWitnesses = true } witnessExprs |> List.map (fun arg -> match arg with - | Choice1Of2 witnessInfo -> - ConvWitnessInfo cenv env m witnessInfo + | Choice1Of2 traitInfo -> + ConvWitnessInfo cenv env m traitInfo | Choice2Of2 arg -> ConvExpr cenv env arg) else [] -and ConvWitnessInfo cenv env m witnessInfo = +and ConvWitnessInfo cenv env m traitInfo = let g = cenv.g + let witnessInfo = traitInfo.TraitKey let env = { env with suppressWitnesses = true } + // First check if this is a witness in ReflectedDefinition code if env.witnessesInScope.ContainsKey witnessInfo then let witnessArgIdx = env.witnessesInScope.[witnessInfo] QP.mkVar witnessArgIdx + // Otherwise it is a witness in a quotation literal else let holeTy = GenWitnessTy g witnessInfo let idx = cenv.exprSplices.Count - cenv.exprSplices.Add((Expr.WitnessArg(witnessInfo, m), m)) + let fillExpr = Expr.WitnessArg(traitInfo, m) + let liftExpr = mkCallLiftValue cenv.g m holeTy fillExpr + cenv.exprSplices.Add((liftExpr, m)) QP.mkHole(ConvType cenv env m holeTy, idx) and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.ExprData = @@ -744,8 +749,8 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. | _ -> wfail(InternalError( "Unexpected expression shape", m)) - | Expr.WitnessArg (witnessInfo, m) -> - ConvWitnessInfo cenv env m witnessInfo + | Expr.WitnessArg (traitInfo, m) -> + ConvWitnessInfo cenv env m traitInfo | _ -> wfail(InternalError(sprintf "unhandled construct in AST: %A" expr, expr.Range)) diff --git a/src/fsharp/TypedTree.fs b/src/fsharp/TypedTree.fs index 6d9d967eb24..24842ab9d94 100644 --- a/src/fsharp/TypedTree.fs +++ b/src/fsharp/TypedTree.fs @@ -4545,7 +4545,7 @@ type Expr = /// witnessArg is the lambda for the witness /// | WitnessArg of - witnessInfo: TraitWitnessInfo * + traitInfo: TraitConstraintInfo * range: range /// Indicates a free choice of typars that arises due to diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 423e55b749b..556d26a7119 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -253,7 +253,7 @@ and remapTyparConstraintsAux tyenv cs = | TyparConstraint.CoercesTo(ty, m) -> Some(TyparConstraint.CoercesTo (remapTypeAux tyenv ty, m)) | TyparConstraint.MayResolveMember(traitInfo, m) -> - Some(TyparConstraint.MayResolveMember (remapTraitSln tyenv traitInfo, m)) + Some(TyparConstraint.MayResolveMember (remapTraitInfo tyenv traitInfo, m)) | TyparConstraint.DefaultsTo(priority, ty, m) -> Some(TyparConstraint.DefaultsTo(priority, remapTypeAux tyenv ty, m)) | TyparConstraint.IsEnum(uty, m) -> @@ -276,7 +276,7 @@ and remapTraitWitnessInfo tyenv (TraitWitnessInfo(tys, nm, mf, argtys, rty)) = let rtyR = Option.map (remapTypeAux tyenv) rty TraitWitnessInfo(tysR, nm, mf, argtysR, rtyR) -and remapTraitSln tyenv (TTrait(tys, nm, mf, argtys, rty, slnCell)) = +and remapTraitInfo tyenv (TTrait(tys, nm, mf, argtys, rty, slnCell)) = let slnCell = match !slnCell with | None -> None @@ -403,7 +403,7 @@ let mkInstRemap tpinst = // entry points for "typar -> TType" instantiation let instType tpinst x = if isNil tpinst then x else remapTypeAux (mkInstRemap tpinst) x let instTypes tpinst x = if isNil tpinst then x else remapTypesAux (mkInstRemap tpinst) x -let instTrait tpinst x = if isNil tpinst then x else remapTraitSln (mkInstRemap tpinst) x +let instTrait tpinst x = if isNil tpinst then x else remapTraitInfo (mkInstRemap tpinst) x let instTyparConstraints tpinst x = if isNil tpinst then x else remapTyparConstraintsAux (mkInstRemap tpinst) x let instSlotSig tpinst ss = remapSlotSig (fun _ -> []) (mkInstRemap tpinst) ss let copySlotSig ss = remapSlotSig (fun _ -> []) Remap.Empty ss @@ -4435,7 +4435,7 @@ let accFreevarsInVal opts v acc = accFreeTyvars opts accFreeInVal v acc let accFreeVarsInTraitSln opts tys acc = accFreeTyvars opts accFreeInTraitSln tys acc -let accFreeVarsInWitnessArg opts tys acc = accFreeTyvars opts accFreeInWitnessArg tys acc +let accFreeVarsInTraitInfo opts tys acc = accFreeTyvars opts accFreeInTrait tys acc let boundLocalVal opts v fvs = if not opts.includeLocals then fvs else @@ -4667,8 +4667,8 @@ and accFreeInExprNonLinear opts x acc = let acc = accFreeVarsInTys opts tinst acc accFreeInExprs opts args acc - | Expr.WitnessArg (witnessInfo, _) -> - accFreeVarsInWitnessArg opts witnessInfo acc + | Expr.WitnessArg (traitInfo, _) -> + accFreeVarsInTraitInfo opts traitInfo acc and accFreeInOp opts op acc = match op with @@ -5210,9 +5210,9 @@ and remapExpr (g: TcGlobals) (compgen: ValCopyFlag) (tmenv: Remap) expr = let ty' = remapType tmenv ty if ty === ty' then expr else Expr.Const (c, m, ty') - | Expr.WitnessArg (witnessInfo, m) -> - let witnessInfoR = remapTraitWitnessInfo tmenv witnessInfo - Expr.WitnessArg (witnessInfoR, m) + | Expr.WitnessArg (traitInfo, m) -> + let traitInfoR = remapTraitInfo tmenv traitInfo + Expr.WitnessArg (traitInfoR, m) and remapTarget g compgen tmenv (TTarget(vs, e, spTarget)) = let vs', tmenvinner = copyAndRemapAndBindVals g compgen tmenv vs @@ -5278,7 +5278,7 @@ and remapOp tmenv op = let tys2 = remapTypes tmenv tys if tys === tys2 then op else TOp.ILAsm (instrs, tys2) - | TOp.TraitCall traitInfo -> TOp.TraitCall (remapTraitSln tmenv traitInfo) + | TOp.TraitCall traitInfo -> TOp.TraitCall (remapTraitInfo tmenv traitInfo) | TOp.LValueOp (kind, lvr) -> TOp.LValueOp (kind, remapValRef tmenv lvr) | TOp.ILCall (isVirtCall, isProtectedCall, valu, isNewObjCall, valUseFlags, isProperty, noTailCall, ilMethRef, enclTypeArgs, methTypeArgs, tys) -> TOp.ILCall (isVirtCall, isProtectedCall, valu, isNewObjCall, remapValFlags tmenv valUseFlags, @@ -5783,11 +5783,6 @@ let GenWitnessArgTys (g: TcGlobals) (traitInfo: TraitWitnessInfo) = let argtys = if argtys.IsEmpty then [g.unit_ty] else argtys let argtysl = List.map List.singleton argtys argtysl - //match tys with - //| _ when not memFlags.IsInstance -> argtysl - //| [ty] -> [ty] :: argtysl - //| [_; _] -> [g.obj_ty] :: argtysl - //| _ -> failwith "unexpected empty type support for trait constraint" let GenWitnessTy (g: TcGlobals) (traitInfo: TraitWitnessInfo) = let rty = match traitInfo.ReturnType with None -> g.unit_ty | Some ty -> ty @@ -5854,7 +5849,7 @@ let rec tyOfExpr g e = //errorR(InternalError("unexpected goto/label/return in tyOfExpr", m)) // It doesn't matter what type we return here. This is only used in free variable analysis in the code generator g.unit_ty - | Expr.WitnessArg (witnessInfo, _m) -> GenWitnessTy g witnessInfo + | Expr.WitnessArg (traitInfo, _m) -> GenWitnessTy g traitInfo.TraitKey //-------------------------------------------------------------------------- // Make applications @@ -7112,6 +7107,9 @@ let mkCallDeserializeQuotationFSharp40Plus g m e1 e2 e3 e4 e5 = let mkCallCastQuotation g m ty e1 = mkApps g (typedExprForIntrinsic g m g.cast_quotation_info, [[ty]], [ e1 ], m) +let mkCallLiftValue (g: TcGlobals) m ty e1 = + mkApps g (typedExprForIntrinsic g m g.lift_value_info, [[ty]], [e1], m) + let mkCallLiftValueWithName (g: TcGlobals) m ty nm e1 = let vref = ValRefForIntrinsic g.lift_value_with_name_info // Use "Expr.ValueWithName" if it exists in FSharp.Core @@ -7119,7 +7117,7 @@ let mkCallLiftValueWithName (g: TcGlobals) m ty nm e1 = | ValueSome _ -> mkApps g (typedExprForIntrinsic g m g.lift_value_with_name_info, [[ty]], [mkRefTupledNoTypes g m [e1; mkString g m nm]], m) | ValueNone -> - mkApps g (typedExprForIntrinsic g m g.lift_value_info, [[ty]], [e1], m) + mkCallLiftValue g m ty e1 let mkCallLiftValueWithDefn g m qty e1 = assert isQuotedExprTy g qty diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index 856452bb435..416d04b520e 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -1955,6 +1955,8 @@ val mkCallCastQuotation : TcGlobals -> range -> TType -> Expr -> Expr val mkCallLiftValueWithName : TcGlobals -> range -> TType -> string -> Expr -> Expr +val mkCallLiftValue: TcGlobals -> range -> TType -> Expr -> Expr + val mkCallLiftValueWithDefn : TcGlobals -> range -> TType -> Expr -> Expr val mkCallSeqCollect : TcGlobals -> range -> TType -> TType -> Expr -> Expr -> Expr diff --git a/src/fsharp/TypedTreePickle.fs b/src/fsharp/TypedTreePickle.fs index 8e0e7e7a5d1..4289827f651 100644 --- a/src/fsharp/TypedTreePickle.fs +++ b/src/fsharp/TypedTreePickle.fs @@ -2585,14 +2585,7 @@ and p_expr expr st = | Expr.StaticOptimization (a, b, c, d) -> p_byte 11 st; p_tup4 p_constraints p_expr p_expr p_dummy_range (a, b, c, d) st | Expr.TyChoose (a, b, c) -> p_byte 12 st; p_tup3 p_tyar_specs p_expr p_dummy_range (a, b, c) st | Expr.Quote (ast, _, _, m, ty) -> p_byte 13 st; p_tup3 p_expr p_dummy_range p_ty (ast, m, ty) st - | Expr.WitnessArg (TraitWitnessInfo(tys, nm, mf, argtys, rty), m) -> - p_byte 14 st - p_tys tys st - p_string nm st - p_MemberFlags mf st - p_tys argtys st - p_option p_ty rty st - p_dummy_range m st + | Expr.WitnessArg (traitInfo, m) -> p_byte 14 st; p_trait traitInfo st; p_dummy_range m st and u_expr st = let tag = u_byte st @@ -2668,13 +2661,9 @@ and u_expr st = let d = u_ty st Expr.Quote (b, ref None, false, c, d) // isFromQueryExpression=false | 14 -> - let tys = u_tys st - let nm = u_string st - let mf = u_MemberFlags st - let argtys = u_tys st - let rty = u_option u_ty st + let traitInfo = u_trait st let m = u_dummy_range st - Expr.WitnessArg (TraitWitnessInfo(tys, nm, mf, argtys, rty), m) + Expr.WitnessArg (traitInfo, m) | _ -> ufailwith st "u_expr" and p_static_optimization_constraint x st = diff --git a/tests/fsharp/core/quotes/test.fsx b/tests/fsharp/core/quotes/test.fsx index 6a8bdb5d185..70c3fa11102 100644 --- a/tests/fsharp/core/quotes/test.fsx +++ b/tests/fsharp/core/quotes/test.fsx @@ -3574,7 +3574,6 @@ module MoreWitnessTests = open System.Runtime.CompilerServices open System.IO - // TODO - ths fails [] module Tests = let inline f0 (x: 'T) : (unit -> 'T) list = @@ -3834,6 +3833,37 @@ module TestOuterConstrainedClass = let z = { Group1 = 1; Group2 = 2 } + { Group1 = 2; Group2 = 3 } // ok +module TestInlineQuotationOfAbsOperator = + + let inline f x = <@ abs x @> + + type C(n:int) = + static member Abs(c: C) = C(-c.P) + member x.P = n + + let v1 = f 3 + let v2 = f 3.4 + let v3 = f (C(4)) + + test "check abs1" + (match v1 with + | CallWithWitnesses(None, minfo1, minfo2, [Value(f,_)], [Int32 3]) -> + minfo1.Name = "Abs" && minfo2.Name = "Abs$W" && ((f :?> (int -> int)) -3 = 3) + | _ -> false) + + test "check abs2" + (match v2 with + | CallWithWitnesses(None, minfo1, minfo2, [Value(f,_)], [Double 3.4]) -> + minfo1.Name = "Abs" && minfo2.Name = "Abs$W" && ((f :?> (double -> double)) -3.0 = 3.0) + | _ -> false) + + test "check abs3" + (match v3 with + | CallWithWitnesses(None, minfo1, minfo2, [Value(f,_)], [Value (v,_)]) -> + minfo1.Name = "Abs" && minfo2.Name = "Abs$W" && ((v :?> C).P = 4) && (((f :?> (C -> C)) (C(-7))).P = 7) + | _ -> false) + + #endif diff --git a/tests/fsharp/tools/eval/test.fsx b/tests/fsharp/tools/eval/test.fsx index 7a0feed0ee6..5a1b246779b 100644 --- a/tests/fsharp/tools/eval/test.fsx +++ b/tests/fsharp/tools/eval/test.fsx @@ -1542,7 +1542,7 @@ module EvaluationTests = test5 3s 4s test5 3L 4L -(* + let iarr = [| 0..1000 |] let ilist = [ 0..1000 ] @@ -1738,7 +1738,6 @@ module EvaluationTests = Eval <@ Array.average [| 0.0 .. 1.0 .. 10000.0 |] @> -*) module LanguagePrimitiveCastingUnitsOfMeasure = [] From debf17a94fe9c10d2ef2de5c19c4303a25e0fd74 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 28 May 2020 18:34:49 +0100 Subject: [PATCH 12/14] code review feedback --- src/fsharp/IlxGen.fs | 2 +- src/fsharp/MethodCalls.fs | 2 +- src/fsharp/TcGlobals.fs | 35 +++++++++++++++++++++++++---------- src/fsharp/TypedTreeOps.fs | 4 ++-- 4 files changed, 29 insertions(+), 14 deletions(-) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index ca87239e12f..b7c4e8d47e1 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -7760,7 +7760,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = .WithAccess(access) .WithInitSemantics(ILTypeInit.BeforeField) - let tdef2 = g.eraseClassUnionDef tref tdef cuinfo + let tdef2 = g.EraseClassUnionDef tref tdef cuinfo // Discard the user-supplied (i.e. prim-type.fs) implementations of the get_Empty, get_IsEmpty, get_Value and get_None and Some methods. // This is because we will replace their implementations by ones that load the unique diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index 6ac088f96c7..e78b681e774 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -1906,7 +1906,7 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = | None -> None // the trait has been generalized | Some _-> // For these operators, the witness is just a call to the coresponding FSharp.Core operator - match g.tryMakeOperatorAsBuiltInWitnessInfo isStringTy isArrayTy traitInfo argExprs with + match g.TryMakeOperatorAsBuiltInWitnessInfo isStringTy isArrayTy traitInfo argExprs with | Some (info, tyargs, actualArgExprs) -> tryMkCallCoreFunctionAsBuiltInWitness g info tyargs actualArgExprs m | None -> diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index eaf8185d7b0..edc894a3f06 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -1474,24 +1474,37 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d ((ValRefForIntrinsic g.call_with_witnesses_info).TryDeref.IsSome && langVersion.SupportsFeature LanguageFeature.WitnessPassing) member __.FindSysTyconRef path nm = findSysTyconRef path nm + member __.TryFindSysTyconRef path nm = tryFindSysTyconRef path nm + member __.FindSysILTypeRef nm = findSysILTypeRef nm + member __.TryFindSysILTypeRef nm = tryFindSysILTypeRef nm + member __.FindSysAttrib nm = findSysAttrib nm + member __.TryFindSysAttrib nm = tryFindSysAttrib nm - member val ilxPubCloEnv=EraseClosures.newIlxPubCloEnv(ilg, addMethodGeneratedAttrs, addFieldGeneratedAttrs, addFieldNeverAttrs) + member val ilxPubCloEnv = + EraseClosures.newIlxPubCloEnv(ilg, addMethodGeneratedAttrs, addFieldGeneratedAttrs, addFieldNeverAttrs) + member __.AddMethodGeneratedAttributes mdef = addMethodGeneratedAttrs mdef + member __.AddFieldGeneratedAttrs mdef = addFieldGeneratedAttrs mdef + member __.AddFieldNeverAttrs mdef = addFieldNeverAttrs mdef - member __.mkDebuggerHiddenAttribute() = mkILCustomAttribute ilg (findSysILTypeRef tname_DebuggerHiddenAttribute, [], [], []) - member __.mkDebuggerDisplayAttribute s = mkILCustomAttribute ilg (findSysILTypeRef tname_DebuggerDisplayAttribute, [ilg.typ_String], [ILAttribElem.String (Some s)], []) - member __.DebuggerBrowsableNeverAttribute = mkDebuggerBrowsableNeverAttribute() - member __.mkDebuggerStepThroughAttribute() = mkILCustomAttribute ilg (findSysILTypeRef tname_DebuggerStepThroughAttribute, [], [], []) - member __.mkDebuggableAttribute (jitOptimizerDisabled) = - mkILCustomAttribute ilg (tref_DebuggableAttribute, [ilg.typ_Bool; ilg.typ_Bool], [ILAttribElem.Bool false; ILAttribElem.Bool jitOptimizerDisabled], []) + member __.mkDebuggerHiddenAttribute() = mkILCustomAttribute ilg (findSysILTypeRef tname_DebuggerHiddenAttribute, [], [], []) + + member __.mkDebuggerDisplayAttribute s = mkILCustomAttribute ilg (findSysILTypeRef tname_DebuggerDisplayAttribute, [ilg.typ_String], [ILAttribElem.String (Some s)], []) + + member __.DebuggerBrowsableNeverAttribute = mkDebuggerBrowsableNeverAttribute() + member __.mkDebuggerStepThroughAttribute() = + mkILCustomAttribute ilg (findSysILTypeRef tname_DebuggerStepThroughAttribute, [], [], []) + + member __.mkDebuggableAttribute (jitOptimizerDisabled) = + mkILCustomAttribute ilg (tref_DebuggableAttribute, [ilg.typ_Bool; ilg.typ_Bool], [ILAttribElem.Bool false; ILAttribElem.Bool jitOptimizerDisabled], []) member __.mkDebuggableAttributeV2(jitTracking, ignoreSymbolStoreSequencePoints, jitOptimizerDisabled, enableEnC) = let debuggingMode = @@ -1511,7 +1524,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d /// Find an FSharp.Core LaguagePrimitives dynamic function that corresponds to a trait witness, e.g. /// AdditionDynamic for op_Addition. Also work out the type instantiation of the dynamic function. - member __.makeBuiltInWitnessInfo (t: TraitConstraintInfo) = + member __.MakeBuiltInWitnessInfo (t: TraitConstraintInfo) = let memberName = let nm = t.MemberName let coreName = @@ -1539,7 +1552,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d vref, tinst /// Find an FSharp.Core operator that corresponds to a trait witness - member g.tryMakeOperatorAsBuiltInWitnessInfo isStringTy isArrayTy (t: TraitConstraintInfo) argExprs = + member g.TryMakeOperatorAsBuiltInWitnessInfo isStringTy isArrayTy (t: TraitConstraintInfo) argExprs = match t.MemberName, t.ArgumentTypes, t.ReturnType, argExprs with | "get_Sign", [aty], _, (objExpr :: _) -> @@ -1587,7 +1600,9 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d Some (g.getstring_info, [], argExprs) | _ -> None - member __.eraseClassUnionDef = EraseUnions.mkClassUnionDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addPropertyNeverAttrs, addFieldGeneratedAttrs, addFieldNeverAttrs, mkDebuggerTypeProxyAttribute) ilg + + member __.EraseClassUnionDef cud = + EraseUnions.mkClassUnionDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addPropertyNeverAttrs, addFieldGeneratedAttrs, addFieldNeverAttrs, mkDebuggerTypeProxyAttribute) ilg cud #if DEBUG // This global is only used during debug output diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 556d26a7119..4d45c49045c 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -2311,7 +2311,7 @@ let CountEnclosingTyparsOfActualParentOfVal (v: Val) = let GetTopValTypeInCompiledForm g topValInfo numEnclosingTypars ty m = let tps, paramArgInfos, rty, retInfo = GetTopValTypeInFSharpForm g topValInfo ty m - let witnessInfos = GetTraitWitnessInfosOfTypars g numEnclosingTypars tps // TODO: parentTypars + let witnessInfos = GetTraitWitnessInfosOfTypars g numEnclosingTypars tps // Eliminate lone single unit arguments let paramArgInfos = match paramArgInfos, topValInfo.ArgInfos with @@ -7022,7 +7022,7 @@ let mkCallNewDecimal (g: TcGlobals) m (e1, e2, e3, e4, e5) = mkApps g (typedExpr let mkCallNewFormat (g: TcGlobals) m aty bty cty dty ety e1 = mkApps g (typedExprForIntrinsic g m g.new_format_info, [[aty;bty;cty;dty;ety]], [ e1 ], m) let tryMkCallBuiltInWitness (g: TcGlobals) traitInfo argExprs m = - let info, tinst = g.makeBuiltInWitnessInfo traitInfo + let info, tinst = g.MakeBuiltInWitnessInfo traitInfo let vref = ValRefForIntrinsic info match vref.TryDeref with | ValueSome v -> From a60ab5a7835450fb0c7c196b9aad72bfa7dc8942 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 1 Jun 2020 19:04:02 +0100 Subject: [PATCH 13/14] fix build --- src/fsharp/TypedTreeOps.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index b31386e09f1..71792597a69 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -2296,7 +2296,7 @@ let GetTraitConstraintInfosOfTypars g (tps: Typars) = /// Get information about the runtime witnesses needed for a set of generalized typars let GetTraitWitnessInfosOfTypars g numParentTypars tps = - let tps = tps |> List.drop numParentTypars + let tps = tps |> List.skip numParentTypars let cxs = GetTraitConstraintInfosOfTypars g tps cxs |> List.map (fun cx -> cx.TraitKey) From 2d74d247376bfeba07d039ec644cbbd263668af8 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 1 Jun 2020 23:29:40 +0100 Subject: [PATCH 14/14] clarify code --- src/fsharp/IlxGen.fs | 13 +++++-------- src/fsharp/MethodOverrides.fs | 2 +- src/fsharp/QuotationTranslator.fs | 2 +- 3 files changed, 7 insertions(+), 10 deletions(-) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index c70115e7a59..f029114e1e2 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -985,10 +985,7 @@ let ComputeGenerateWitnesses (g: TcGlobals) eenv = let TryStorageForWitness (_g: TcGlobals) eenv (w: TraitWitnessInfo) = match eenv.witnessesInScope.TryGetValue w with | true, storage -> Some storage - | _ -> - //let generateWitnesses = ComputeGenerateWitnesses g eenv - //assert not generateWitnesses - None + | _ -> None let IsValRefIsDllImport g (vref: ValRef) = vref.Attribs |> HasFSharpAttributeOpt g g.attrib_DllImportAttribute @@ -3122,7 +3119,7 @@ and GenWitnessArgFromTraitInfo cenv cgbuf eenv m traitInfo = match witnessExpr with | Choice1Of2 _traitInfo -> System.Diagnostics.Debug.Assert(false, "expected storage for witness") - //failwith "unexpected non-generation of witness " + failwith "unexpected non-generation of witness " | Choice2Of2 arg -> let eenv = { eenv with suppressWitnesses = true } GenExpr cenv cgbuf eenv SPSuppress arg Continue @@ -3136,7 +3133,7 @@ and GenWitnessArgFromWitnessInfo cenv cgbuf eenv m witnessInfo = match storage with | None -> System.Diagnostics.Debug.Assert(false, "expected storage for witness") - //failwith "unexpected non-generation of witness " + failwith "unexpected non-generation of witness " | Some storage -> let ty = GenWitnessTy g witnessInfo GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv.amap m eenv.tyenv ty) storage None @@ -3203,7 +3200,6 @@ and GenApp (cenv: cenv) cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel = let numArgs = List.sum arityInfo - // TODO: witness argument generation for closures for i = numArgs - 1 downto 0 do CG.EmitInstrs cgbuf (pop 1) Push0 [ I_starg (uint16 (cgbuf.PreallocatedArgCount+i)) ] @@ -4744,7 +4740,8 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) eenvouter takenNames ex let cloWitnessInfos = let generateWitnesses = ComputeGenerateWitnesses g eenvinner if generateWitnesses then - GetTraitWitnessInfosOfTypars g 0 cloFreeTyvars // TODO: 0 may be wrong here + // The 0 here represents that a closure doesn't reside within a generic class - there are no "enclosing class type parameters" to lop off. + GetTraitWitnessInfosOfTypars g 0 cloFreeTyvars else [] diff --git a/src/fsharp/MethodOverrides.fs b/src/fsharp/MethodOverrides.fs index 676a69e38ff..0826749fd65 100644 --- a/src/fsharp/MethodOverrides.fs +++ b/src/fsharp/MethodOverrides.fs @@ -152,7 +152,7 @@ module DispatchSlotChecking = /// Get the override information for an object expression method being used to implement dispatch slots let GetObjectExprOverrideInfo g amap (implty, id: Ident, memberFlags, ty, arityInfo, bindingAttribs, rhsExpr) = - // Dissect the type + // Dissect the type. The '0' indicates there are no enclosing generic class type parameters relevant here. let tps, _, argInfos, retTy, _ = GetMemberTypeInMemberForm g memberFlags arityInfo 0 ty id.idRange let argTys = argInfos |> List.mapSquared fst // Dissect the implementation diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index a1eff73e819..5b154ebf22d 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -719,7 +719,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. if g.generateWitnesses && inWitnessPassingScope then match env.witnessesInScope.TryGetValue traitInfo.TraitKey with | true, storage -> Some storage - | _ -> None // failwithf "no storage for witness %s found in scope" w.MemberName + | _ -> None else None