diff --git a/.fantomasignore b/.fantomasignore index 6b568034be7..395a314aed8 100644 --- a/.fantomasignore +++ b/.fantomasignore @@ -21,7 +21,7 @@ src/Compiler/Checking/AttributeChecking.fs src/Compiler/Checking/AugmentWithHashCompare.fs src/Compiler/Checking/CheckBasics.fs src/Compiler/Checking/CheckDeclarations.fs -src/Compiler/Checking/CheckExpressions.fs +src/Compiler/Checking/Expressions/CheckExpressions.fs src/Compiler/Checking/CheckFormatStrings.fs src/Compiler/Checking/CheckIncrementalClasses.fs src/Compiler/Checking/CheckPatterns.fs diff --git a/docs/overview.md b/docs/overview.md index 1c796bbd87d..8136b63a6d8 100644 --- a/docs/overview.md +++ b/docs/overview.md @@ -33,7 +33,7 @@ The following are the key data formats and internal data representations of the * _Typed Abstract Syntax Tree (Typed Tree)_, see [TypedTree.fs](https://github.com/dotnet/fsharp/blob/main/src/Compiler/TypedTree/TypedTree.fs), [TypedTreeBasics.fs](https://github.com/dotnet/fsharp/blob/main/src/Compiler/TypedTree/TypedTreeBasics.fs), [TypedTreeOps.fs](https://github.com/dotnet/fsharp/blob/main/src/Compiler/TypedTree/TypedTreeOps.fs), and related files. The typed, bound syntax tree including both type/module definitions and their backing expressions, resulting from type checking and the subject of successive phases of optimization and representation change. -* _Type checking context/state_, see for example [`TcState` in ParseAndCheckInputs.fsi](https://github.com/dotnet/fsharp/blob/main/src/Compiler/Driver/ParseAndCheckInputs.fsi) and its constituent parts, particularly `TcEnv` in [CheckExpressions.fsi](https://github.com/dotnet/fsharp/blob/main/src/Compiler/Checking/CheckExpressions.fsi) and `NameResolutionEnv` in [NameResolution.fsi](https://github.com/dotnet/fsharp/blob/main/src/Compiler/Checking/NameResolution.fsi). A set of tables representing the available names, assemblies etc. in scope during type checking, plus associated information. +* _Type checking context/state_, see for example [`TcState` in ParseAndCheckInputs.fsi](https://github.com/dotnet/fsharp/blob/main/src/Compiler/Driver/ParseAndCheckInputs.fsi) and its constituent parts, particularly `TcEnv` in [CheckExpressions.fsi](https://github.com/dotnet/fsharp/blob/main/src/Compiler/Checking/Expressions/CheckExpressions.fsi) and `NameResolutionEnv` in [NameResolution.fsi](https://github.com/dotnet/fsharp/blob/main/src/Compiler/Checking/NameResolution.fsi). A set of tables representing the available names, assemblies etc. in scope during type checking, plus associated information. * _Abstract IL_, the output of code generation, then used for binary generation, and the input format when reading .NET assemblies, see [`ILModuleDef` in il.fsi](https://github.com/dotnet/fsharp/blob/main/src/Compiler/AbstractIL/il.fsi). @@ -146,7 +146,7 @@ The following are the key phases and high-level logical operations of the F# com * _Sequentially type checking files_, see [CheckDeclarations.fsi](https://github.com/dotnet/fsharp/blob/main/src/Compiler/Checking/CheckDeclarations.fsi)/[CheckDeclarations.fs](https://github.com/dotnet/fsharp/blob/main/src/Compiler/Checking/CheckDeclarations.fs). Accepts an AST plus a type checking context/state and produces new Typed Tree nodes incorporated into an updated type checking state, plus additional Typed Tree Expression nodes used during code generation. A key part of this is - checking syntactic types and expressions, see [CheckExpressions.fsi](https://github.com/dotnet/fsharp/blob/main/src/Compiler/Checking/CheckDeclarations.fsi)/[CheckExpressions.fs](https://github.com/dotnet/fsharp/blob/main/src/Compiler/Checking/CheckDeclarations.fs) including the state held across the checking of a file (see `TcFileState`) and the + checking syntactic types and expressions, see [CheckExpressions.fsi](https://github.com/dotnet/fsharp/blob/main/src/Compiler/Checking/CheckDeclarations.fsi)/[CheckExpressions.fs](https://github.com/dotnet/fsharp/blob/main/src/Compiler/Checking/Expressions/CheckDeclarations.fs) including the state held across the checking of a file (see `TcFileState`) and the environment active as we traverse declarations and expressions (see `TcEnv`). * _Pattern match compilation_, see [PatternMatchCompilation.fsi](https://github.com/dotnet/fsharp/blob/main/src/Compiler/Checking/PatternMatchCompilation.fsi)/[PatternMatchCompilation.fs](https://github.com/dotnet/fsharp/blob/main/src/Compiler/Checking/PatternMatchCompilation.fs). Accepts a subset of checked Typed Tree nodes representing F# pattern matching and produces Typed Tree expressions implementing the pattern matching. Called during type checking as each construct involving pattern matching is processed. diff --git a/docs/release-notes/.FSharp.Compiler.Service/9.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/9.0.100.md index 56c6126d217..8d206a1bd1e 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/9.0.100.md +++ b/docs/release-notes/.FSharp.Compiler.Service/9.0.100.md @@ -15,5 +15,6 @@ * Treat `{ new Foo() }` as `SynExpr.ObjExpr` ([PR #17388](https://github.com/dotnet/fsharp/pull/17388)) * Optimize metadata reading for type members and custom attributes. ([PR #17364](https://github.com/dotnet/fsharp/pull/17364)) * Enforce `AttributeTargets` on unions. ([PR #17389](https://github.com/dotnet/fsharp/pull/17389)) +* Ensure that isinteractive multi-emit backing fields are not public. ([Issue #17439](https://github.com/dotnet/fsharp/issues/17438)), ([PR #17439](https://github.com/dotnet/fsharp/pull/17439)) ### Breaking Changes diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index b18ee27f8cb..9ddff1e7585 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -11,13 +11,16 @@ open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras open Internal.Utilities.Library.ResultOrException -open FSharp.Compiler -open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler +open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking open FSharp.Compiler.CheckComputationExpressions open FSharp.Compiler.CheckExpressions +open FSharp.Compiler.CheckSequenceExpressions +open FSharp.Compiler.CheckArrayOrListComputedExpressions open FSharp.Compiler.CheckBasics +open FSharp.Compiler.CheckExpressionsOps open FSharp.Compiler.CheckIncrementalClasses open FSharp.Compiler.CheckPatterns open FSharp.Compiler.ConstraintSolver @@ -413,6 +416,7 @@ let private CheckDuplicatesAbstractMethodParmsSig (typeSpecs: SynTypeDefnSig li | _ -> () module TcRecdUnionAndEnumDeclarations = + open CheckExpressionsOps let CombineReprAccess parent vis = match parent with @@ -612,7 +616,7 @@ module TcRecdUnionAndEnumDeclarations = | _ -> let expr, actualTy, _ = TcExprOfUnknownType cenv env tpenv valueExpr UnifyTypes cenv env valueRange fieldTy actualTy - + match EvalLiteralExprOrAttribArg cenv.g expr with | Expr.Const (konst, _, _) -> MakeEnumCaseSpec g cenv env parent attrs thisTy caseRange id xmldoc konst | _ -> error(Error(FSComp.SR.tcInvalidEnumerationLiteral(), valueRange)) diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index d2a6b566ab2..e1ed518f2d3 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -27,6 +27,7 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.CheckExpressionsOps type cenv = TcFileState @@ -787,4 +788,3 @@ and TcPatLongIdentLiteral warnOnUpper (cenv: cenv) env vFlags patEnv ty (mLongId and TcPatterns warnOnUpper cenv env vFlags s argTys args = assert (List.length args = List.length argTys) List.mapFold (fun s (ty, pat) -> TcPat warnOnUpper cenv env None vFlags s ty pat) s (List.zip argTys args) - diff --git a/src/Compiler/Checking/Expressions/CheckArrayOrListComputedExpressions.fs b/src/Compiler/Checking/Expressions/CheckArrayOrListComputedExpressions.fs new file mode 100644 index 00000000000..f8a2abd7d73 --- /dev/null +++ b/src/Compiler/Checking/Expressions/CheckArrayOrListComputedExpressions.fs @@ -0,0 +1,163 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +/// Sequence expressions checking +module internal FSharp.Compiler.CheckArrayOrListComputedExpressions + +open FSharp.Compiler.CheckBasics +open FSharp.Compiler.ConstraintSolver +open FSharp.Compiler.CheckExpressionsOps +open FSharp.Compiler.CheckExpressions +open FSharp.Compiler.NameResolution +open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.Features +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Syntax +open FSharp.Compiler.CheckSequenceExpressions + +let TcArrayOrListComputedExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv (isArray, comp) m = + let g = cenv.g + + // The syntax '[ n .. m ]' and '[ n .. step .. m ]' is not really part of array or list syntax. + // It could be in the future, e.g. '[ 1; 2..30; 400 ]' + // + // The elaborated form of '[ n .. m ]' is 'List.ofSeq (seq (op_Range n m))' and this shouldn't change + match RewriteRangeExpr comp with + | Some replacementExpr -> + let genCollElemTy = NewInferenceType g + + let genCollTy = (if isArray then mkArrayType else mkListTy) cenv.g genCollElemTy + + UnifyTypes cenv env m overallTy.Commit genCollTy + + let exprTy = mkSeqTy cenv.g genCollElemTy + + let expr, tpenv = TcExpr cenv (MustEqual exprTy) env tpenv replacementExpr + + let expr = + if cenv.g.compilingFSharpCore then + expr + else + // We add a call to 'seq ... ' to make sure sequence expression compilation gets applied to the contents of the + // comprehension. But don't do this in FSharp.Core.dll since 'seq' may not yet be defined. + mkCallSeq cenv.g m genCollElemTy expr + + let expr = mkCoerceExpr (expr, exprTy, expr.Range, overallTy.Commit) + + let expr = + if isArray then + mkCallSeqToArray cenv.g m genCollElemTy expr + else + mkCallSeqToList cenv.g m genCollElemTy expr + + expr, tpenv + + | None -> + + // LanguageFeatures.ImplicitYield do not require this validation + let implicitYieldEnabled = + cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield + + let validateExpressionWithIfRequiresParenthesis = not implicitYieldEnabled + let acceptDeprecatedIfThenExpression = not implicitYieldEnabled + + match comp with + | SimpleSemicolonSequence cenv acceptDeprecatedIfThenExpression elems -> + match comp with + | SimpleSemicolonSequence cenv false _ -> () + | _ when validateExpressionWithIfRequiresParenthesis -> + errorR (Deprecated(FSComp.SR.tcExpressionWithIfRequiresParenthesis (), m)) + | _ -> () + + let replacementExpr = + if isArray then + // This are to improve parsing/processing speed for parser tables by converting to an array blob ASAP + let nelems = elems.Length + + if + nelems > 0 + && List.forall + (function + | SynExpr.Const(SynConst.UInt16 _, _) -> true + | _ -> false) + elems + then + SynExpr.Const( + SynConst.UInt16s( + Array.ofList ( + List.map + (function + | SynExpr.Const(SynConst.UInt16 x, _) -> x + | _ -> failwith "unreachable") + elems + ) + ), + m + ) + elif + nelems > 0 + && List.forall + (function + | SynExpr.Const(SynConst.Byte _, _) -> true + | _ -> false) + elems + then + SynExpr.Const( + SynConst.Bytes( + Array.ofList ( + List.map + (function + | SynExpr.Const(SynConst.Byte x, _) -> x + | _ -> failwith "unreachable") + elems + ), + SynByteStringKind.Regular, + m + ), + m + ) + else + SynExpr.ArrayOrList(isArray, elems, m) + else if cenv.g.langVersion.SupportsFeature(LanguageFeature.ReallyLongLists) then + SynExpr.ArrayOrList(isArray, elems, m) + else + if elems.Length > 500 then + error (Error(FSComp.SR.tcListLiteralMaxSize (), m)) + + SynExpr.ArrayOrList(isArray, elems, m) + + TcExprUndelayed cenv overallTy env tpenv replacementExpr + | _ -> + + let genCollElemTy = NewInferenceType g + + let genCollTy = (if isArray then mkArrayType else mkListTy) cenv.g genCollElemTy + + // Propagating type directed conversion, e.g. for + // let x : seq = [ yield 1; if true then yield 2 ] + TcPropagatingExprLeafThenConvert cenv overallTy genCollTy env (* canAdhoc *) m (fun () -> + + let exprTy = mkSeqTy cenv.g genCollElemTy + + // Check the comprehension + let expr, tpenv = TcSequenceExpression cenv env tpenv comp (MustEqual exprTy) m + + let expr = mkCoerceIfNeeded cenv.g exprTy (tyOfExpr cenv.g expr) expr + + let expr = + if cenv.g.compilingFSharpCore then + //warning(Error(FSComp.SR.fslibUsingComputedListOrArray(), expr.Range)) + expr + else + // We add a call to 'seq ... ' to make sure sequence expression compilation gets applied to the contents of the + // comprehension. But don't do this in FSharp.Core.dll since 'seq' may not yet be defined. + mkCallSeq cenv.g m genCollElemTy expr + + let expr = mkCoerceExpr (expr, exprTy, expr.Range, overallTy.Commit) + + let expr = + if isArray then + mkCallSeqToArray cenv.g m genCollElemTy expr + else + mkCallSeqToList cenv.g m genCollElemTy expr + + expr, tpenv) diff --git a/src/Compiler/Checking/CheckComputationExpressions.fs b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs similarity index 68% rename from src/Compiler/Checking/CheckComputationExpressions.fs rename to src/Compiler/Checking/Expressions/CheckComputationExpressions.fs index 10b14cd7b1c..55ed6c9761d 100644 --- a/src/Compiler/Checking/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs @@ -7,6 +7,7 @@ module internal FSharp.Compiler.CheckComputationExpressions open Internal.Utilities.Library open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking +open FSharp.Compiler.CheckExpressionsOps open FSharp.Compiler.CheckExpressions open FSharp.Compiler.CheckBasics open FSharp.Compiler.ConstraintSolver @@ -15,7 +16,6 @@ open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader open FSharp.Compiler.NameResolution -open FSharp.Compiler.PatternMatchCompilation open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTrivia @@ -28,20 +28,22 @@ open FSharp.Compiler.TypedTreeOps type cenv = TcFileState /// Used to flag if this is the first or a sebsequent translation pass through a computation expression +[] type CompExprTranslationPass = | Initial | Subsequent /// Used to flag if computation expression custom operations are allowed in a given context +[] type CustomOperationsMode = | Allowed | Denied -let TryFindIntrinsicOrExtensionMethInfo collectionSettings (cenv: cenv) (env: TcEnv) m ad nm ty = +let inline TryFindIntrinsicOrExtensionMethInfo collectionSettings (cenv: cenv) (env: TcEnv) m ad nm ty = AllMethInfosOfTypeInScope collectionSettings cenv.infoReader env.NameEnv (Some nm) ad IgnoreOverrides m ty /// Ignores an attribute -let IgnoreAttribute _ = None +let inline IgnoreAttribute _ = None [] let (|ExprAsPat|_|) (f: SynExpr) = @@ -103,146 +105,62 @@ let (|JoinRelation|_|) cenv env (expr: SynExpr) = | _ -> ValueNone -let elimFastIntegerForLoop (spFor, spTo, id, start: SynExpr, dir, finish: SynExpr, innerExpr, m: range) = - let mOp = (unionRanges start.Range finish.Range).MakeSynthetic() - - let pseudoEnumExpr = - if dir then - mkSynInfix mOp start ".." finish - else - mkSynTrifix mOp ".. .." start (SynExpr.Const(SynConst.Int32 -1, mOp)) finish - - SynExpr.ForEach(spFor, spTo, SeqExprOnly false, true, mkSynPatVar None id, pseudoEnumExpr, innerExpr, m) - -/// Check if a computation or sequence expression is syntactically free of 'yield' (though not yield!) -let YieldFree (cenv: cenv) expr = - if cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield then - - // Implement yield free logic for F# Language including the LanguageFeature.ImplicitYield - let rec YieldFree expr = - match expr with - | SynExpr.Sequential(expr1 = expr1; expr2 = expr2) -> YieldFree expr1 && YieldFree expr2 - - | SynExpr.IfThenElse(thenExpr = thenExpr; elseExpr = elseExprOpt) -> YieldFree thenExpr && Option.forall YieldFree elseExprOpt - - | SynExpr.TryWith(tryExpr = body; withCases = clauses) -> - YieldFree body - && clauses |> List.forall (fun (SynMatchClause(resultExpr = res)) -> YieldFree res) - - | SynExpr.Match(clauses = clauses) - | SynExpr.MatchBang(clauses = clauses) -> clauses |> List.forall (fun (SynMatchClause(resultExpr = res)) -> YieldFree res) - - | SynExpr.For(doBody = body) - | SynExpr.TryFinally(tryExpr = body) - | SynExpr.LetOrUse(body = body) - | SynExpr.While(doExpr = body) - | SynExpr.WhileBang(doExpr = body) - | SynExpr.ForEach(bodyExpr = body) -> YieldFree body - - | SynExpr.LetOrUseBang(body = body) -> YieldFree body +let (|ForEachThen|_|) synExpr = + match synExpr with + | SynExpr.ForEach(_spFor, + _spIn, + SeqExprOnly false, + isFromSource, + pat1, + expr1, + SynExpr.Sequential(isTrueSeq = true; expr1 = clause; expr2 = rest), + _) -> Some(isFromSource, pat1, expr1, clause, rest) + | _ -> None + +let (|CustomOpId|_|) isCustomOperation predicate synExpr = + match synExpr with + | SingleIdent nm when isCustomOperation nm && predicate nm -> Some nm + | _ -> None + +let inline mkSynDelay2 (e: SynExpr) = mkSynDelay (e.Range.MakeSynthetic()) e + +/// Make a builder.Method(...) call +let mkSynCall nm (m: range) args builderValName = + let m = m.MakeSynthetic() // Mark as synthetic so the language service won't pick it up. + + let args = + match args with + | [] -> SynExpr.Const(SynConst.Unit, m) + | [ arg ] -> SynExpr.Paren(SynExpr.Paren(arg, range0, None, m), range0, None, m) + | args -> SynExpr.Paren(SynExpr.Tuple(false, args, [], m), range0, None, m) - | SynExpr.YieldOrReturn(flags = (true, _)) -> false + let builderVal = mkSynIdGet m builderValName + mkSynApp1 (SynExpr.DotGet(builderVal, range0, SynLongIdent([ mkSynId m nm ], [], [ None ]), m)) args m - | _ -> true +// Optionally wrap sources of "let!", "yield!", "use!" in "query.Source" +let mkSourceExpr callExpr sourceMethInfo builderValName = + match sourceMethInfo with + | [] -> callExpr + | _ -> mkSynCall "Source" callExpr.Range [ callExpr ] builderValName - YieldFree expr +let mkSourceExprConditional isFromSource callExpr sourceMethInfo builderValName = + if isFromSource then + mkSourceExpr callExpr sourceMethInfo builderValName else - // Implement yield free logic for F# Language without the LanguageFeature.ImplicitYield - let rec YieldFree expr = - match expr with - | SynExpr.Sequential(expr1 = expr1; expr2 = expr2) -> YieldFree expr1 && YieldFree expr2 - - | SynExpr.IfThenElse(thenExpr = thenExpr; elseExpr = elseExprOpt) -> YieldFree thenExpr && Option.forall YieldFree elseExprOpt - - | SynExpr.TryWith(tryExpr = e1; withCases = clauses) -> - YieldFree e1 - && clauses |> List.forall (fun (SynMatchClause(resultExpr = res)) -> YieldFree res) - - | SynExpr.Match(clauses = clauses) - | SynExpr.MatchBang(clauses = clauses) -> clauses |> List.forall (fun (SynMatchClause(resultExpr = res)) -> YieldFree res) - - | SynExpr.For(doBody = body) - | SynExpr.TryFinally(tryExpr = body) - | SynExpr.LetOrUse(body = body) - | SynExpr.While(doExpr = body) - | SynExpr.WhileBang(doExpr = body) - | SynExpr.ForEach(bodyExpr = body) -> YieldFree body - - | SynExpr.LetOrUseBang _ - | SynExpr.YieldOrReturnFrom _ - | SynExpr.YieldOrReturn _ - | SynExpr.ImplicitZero _ - | SynExpr.Do _ -> false + callExpr - | _ -> true - - YieldFree expr - -/// Determine if a syntactic expression inside 'seq { ... }' or '[...]' counts as a "simple sequence -/// of semicolon separated values". For example [1;2;3]. -/// 'acceptDeprecated' is true for the '[ ... ]' case, where we allow the syntax '[ if g then t else e ]' but ask it to be parenthesized -[] -let (|SimpleSemicolonSequence|_|) cenv acceptDeprecated cexpr = - - let IsSimpleSemicolonSequenceElement expr = - match expr with - | SynExpr.IfThenElse _ when acceptDeprecated && YieldFree cenv expr -> true - | SynExpr.IfThenElse _ - | SynExpr.TryWith _ - | SynExpr.Match _ - | SynExpr.For _ - | SynExpr.ForEach _ - | SynExpr.TryFinally _ - | SynExpr.YieldOrReturnFrom _ - | SynExpr.YieldOrReturn _ - | SynExpr.LetOrUse _ - | SynExpr.Do _ - | SynExpr.MatchBang _ - | SynExpr.LetOrUseBang _ - | SynExpr.While _ - | SynExpr.WhileBang _ -> false - | _ -> true - - let rec TryGetSimpleSemicolonSequenceOfComprehension expr acc = - match expr with - | SynExpr.Sequential(isTrueSeq = true; expr1 = e1; expr2 = e2) -> - if IsSimpleSemicolonSequenceElement e1 then - TryGetSimpleSemicolonSequenceOfComprehension e2 (e1 :: acc) - else - ValueNone - | _ -> - if IsSimpleSemicolonSequenceElement expr then - ValueSome(List.rev (expr :: acc)) - else - ValueNone - - TryGetSimpleSemicolonSequenceOfComprehension cexpr [] - -let RecordNameAndTypeResolutions cenv env tpenv expr = - // This function is motivated by cases like - // query { for ... join(for x in f(). } - // where there is incomplete code in a query, and we are current just dropping a piece of the AST on the floor (above, the bit inside the 'join'). - // - // The problem with dropping the AST on the floor is that we get no captured resolutions, which means no Intellisense/QuickInfo/ParamHelp. - // - // We check this AST-fragment, to get resolutions captured. - // - // This may have effects from typechecking, producing side-effects on the typecheck environment. - suppressErrorReporting (fun () -> - try - ignore (TcExprOfUnknownType cenv env tpenv expr) - with _ -> - ()) +let hasMethInfo nm cenv env mBuilderVal ad builderTy = + match TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad nm builderTy with + | [] -> false + | _ -> true /// Used for all computation expressions except sequence expressions -let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhole, interpExpr: Expr, builderTy, comp: SynExpr) = +let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv (mWhole, interpExpr: Expr, builderTy, comp: SynExpr) = let overallTy = overallTy.Commit let g = cenv.g let ad = env.eAccessRights - let mkSynDelay2 (e: SynExpr) = mkSynDelay (e.Range.MakeSynthetic()) e - let builderValName = CompilerGeneratedName "builder" let mBuilderVal = interpExpr.Range @@ -258,38 +176,11 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol valRefEq cenv.g vref cenv.g.query_value_vref | _ -> false - /// Make a builder.Method(...) call - let mkSynCall nm (m: range) args = - let m = m.MakeSynthetic() // Mark as synthetic so the language service won't pick it up. - - let args = - match args with - | [] -> SynExpr.Const(SynConst.Unit, m) - | [ arg ] -> SynExpr.Paren(SynExpr.Paren(arg, range0, None, m), range0, None, m) - | args -> SynExpr.Paren(SynExpr.Tuple(false, args, [], m), range0, None, m) - - let builderVal = mkSynIdGet m builderValName - mkSynApp1 (SynExpr.DotGet(builderVal, range0, SynLongIdent([ mkSynId m nm ], [], [ None ]), m)) args m - - let hasMethInfo nm = - TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad nm builderTy - |> isNil - |> not - let sourceMethInfo = TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad "Source" builderTy - // Optionally wrap sources of "let!", "yield!", "use!" in "query.Source" - let mkSourceExpr callExpr = - match sourceMethInfo with - | [] -> callExpr - | _ -> mkSynCall "Source" callExpr.Range [ callExpr ] - - let mkSourceExprConditional isFromSource callExpr = - if isFromSource then mkSourceExpr callExpr else callExpr - /// Decide if the builder is an auto-quote builder - let isAutoQuote = hasMethInfo "Quote" + let isAutoQuote = hasMethInfo "Quote" cenv env mBuilderVal ad builderTy let customOperationMethods = AllMethInfosOfTypeInScope @@ -750,23 +641,6 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol errorR (Error(FSComp.SR.tcCustomOperationInvalid opName, nm.idRange)) false - let (|ForEachThen|_|) synExpr = - match synExpr with - | SynExpr.ForEach(_spFor, - _spIn, - SeqExprOnly false, - isFromSource, - pat1, - expr1, - SynExpr.Sequential(isTrueSeq = true; expr1 = clause; expr2 = rest), - _) -> Some(isFromSource, pat1, expr1, clause, rest) - | _ -> None - - let (|CustomOpId|_|) predicate synExpr = - match synExpr with - | SingleIdent nm when isCustomOperation nm && predicate nm -> Some nm - | _ -> None - // e1 in e2 ('in' is parsed as 'JOIN_IN') let (|InExpr|_|) synExpr = match synExpr with @@ -827,13 +701,14 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol let JoinOrGroupJoinOp detector synExpr = match synExpr with - | SynExpr.App(_, _, CustomOpId detector nm, ExprAsPat innerSourcePat, mJoinCore) -> Some(nm, innerSourcePat, mJoinCore, false) + | SynExpr.App(_, _, CustomOpId isCustomOperation detector nm, ExprAsPat innerSourcePat, mJoinCore) -> + Some(nm, innerSourcePat, mJoinCore, false) // join with bad pattern (gives error on "join" and continues) - | SynExpr.App(_, _, CustomOpId detector nm, _innerSourcePatExpr, mJoinCore) -> + | SynExpr.App(_, _, CustomOpId isCustomOperation detector nm, _innerSourcePatExpr, mJoinCore) -> errorR (Error(FSComp.SR.tcBinaryOperatorRequiresVariable (nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) Some(nm, arbPat mJoinCore, mJoinCore, true) // join (without anything after - gives error on "join" and continues) - | CustomOpId detector nm -> + | CustomOpId isCustomOperation detector nm -> errorR (Error(FSComp.SR.tcBinaryOperatorRequiresVariable (nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) Some(nm, arbPat synExpr.Range, synExpr.Range, true) | _ -> None @@ -894,16 +769,17 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol Some(nm, innerSourcePat, innerSource, Some keySelectors, Some intoPat, mGroupJoinCore) // zip intoPat in secondSource - | InExpr(SynExpr.App(_, _, CustomOpId customOperationIsLikeZip nm, ExprAsPat secondSourcePat, _), secondSource, mZipCore) -> - Some(nm, secondSourcePat, secondSource, None, None, mZipCore) + | InExpr(SynExpr.App(_, _, CustomOpId isCustomOperation customOperationIsLikeZip nm, ExprAsPat secondSourcePat, _), + secondSource, + mZipCore) -> Some(nm, secondSourcePat, secondSource, None, None, mZipCore) // zip (without secondSource or in - gives error) - | CustomOpId customOperationIsLikeZip nm -> + | CustomOpId isCustomOperation customOperationIsLikeZip nm -> errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) Some(nm, arbPat synExpr.Range, arbExpr ("_secondSource", synExpr.Range), None, None, synExpr.Range) // zip secondSource (without in - gives error) - | SynExpr.App(_, _, CustomOpId customOperationIsLikeZip nm, ExprAsPat secondSourcePat, mZipCore) -> + | SynExpr.App(_, _, CustomOpId isCustomOperation customOperationIsLikeZip nm, ExprAsPat secondSourcePat, mZipCore) -> errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText nm)), mZipCore)) Some(nm, secondSourcePat, arbExpr ("_innerSource", synExpr.Range), None, None, mZipCore) @@ -1081,9 +957,9 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol // positions as 'yield'. 'yield!' may be present in the computation expression. let enableImplicitYield = cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield - && (hasMethInfo "Yield" - && hasMethInfo "Combine" - && hasMethInfo "Delay" + && (hasMethInfo "Yield" cenv env mBuilderVal ad builderTy + && hasMethInfo "Combine" cenv env mBuilderVal ad builderTy + && hasMethInfo "Delay" cenv env mBuilderVal ad builderTy && YieldFree cenv comp) let origComp = comp @@ -1137,219 +1013,227 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol secondResultPatOpt, mOpCore, innerComp) -> + match q with + | CustomOperationsMode.Denied -> error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere (), nm.idRange)) + | CustomOperationsMode.Allowed -> - if q = CustomOperationsMode.Denied then - error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere (), nm.idRange)) - - let firstSource = mkSourceExprConditional isFromSource firstSource - let secondSource = mkSourceExpr secondSource - - // Add the variables to the variable space, on demand - let varSpaceWithFirstVars = - addVarsToVarSpace varSpace (fun _mCustomOp env -> - use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink - - let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType g) env tpenv firstSourcePat None + let firstSource = + mkSourceExprConditional isFromSource firstSource sourceMethInfo builderValName - vspecs, envinner) + let secondSource = mkSourceExpr secondSource sourceMethInfo builderValName - let varSpaceWithSecondVars = - addVarsToVarSpace varSpaceWithFirstVars (fun _mCustomOp env -> - use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink + // Add the variables to the variable space, on demand + let varSpaceWithFirstVars = + addVarsToVarSpace varSpace (fun _mCustomOp env -> + use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink - let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType g) env tpenv secondSourcePat None + let _, _, vspecs, envinner, _ = + TcMatchPattern cenv (NewInferenceType g) env tpenv firstSourcePat None - vspecs, envinner) + vspecs, envinner) - let varSpaceWithGroupJoinVars = - match secondResultPatOpt with - | Some pat3 -> + let varSpaceWithSecondVars = addVarsToVarSpace varSpaceWithFirstVars (fun _mCustomOp env -> use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink let _, _, vspecs, envinner, _ = - TcMatchPattern cenv (NewInferenceType g) env tpenv pat3 None + TcMatchPattern cenv (NewInferenceType g) env tpenv secondSourcePat None vspecs, envinner) - | None -> varSpace - let firstSourceSimplePats, later1 = - SimplePatsOfPat cenv.synArgNameGenerator firstSourcePat + let varSpaceWithGroupJoinVars = + match secondResultPatOpt with + | Some pat3 -> + addVarsToVarSpace varSpaceWithFirstVars (fun _mCustomOp env -> + use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink - let secondSourceSimplePats, later2 = - SimplePatsOfPat cenv.synArgNameGenerator secondSourcePat + let _, _, vspecs, envinner, _ = + TcMatchPattern cenv (NewInferenceType g) env tpenv pat3 None - if Option.isSome later1 then - errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern (nm.idText), firstSourcePat.Range)) + vspecs, envinner) + | None -> varSpace - if Option.isSome later2 then - errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern (nm.idText), secondSourcePat.Range)) + let firstSourceSimplePats, later1 = + SimplePatsOfPat cenv.synArgNameGenerator firstSourcePat - // check 'join' or 'groupJoin' or 'zip' is permitted for this builder - match tryGetDataForCustomOperation nm with - | None -> error (Error(FSComp.SR.tcMissingCustomOperation (nm.idText), nm.idRange)) - | Some opDatas -> - let opName, _, _, _, _, _, _, _, methInfo = opDatas[0] + let secondSourceSimplePats, later2 = + SimplePatsOfPat cenv.synArgNameGenerator secondSourcePat - // Record the resolution of the custom operation for posterity - let item = - Item.CustomOperation(opName, (fun () -> customOpUsageText nm), Some methInfo) + if Option.isSome later1 then + errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern (nm.idText), firstSourcePat.Range)) - // FUTURE: consider whether we can do better than emptyTyparInst here, in order to display instantiations - // of type variables in the quick info provided in the IDE. - CallNameResolutionSink cenv.tcSink (nm.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) + if Option.isSome later2 then + errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern (nm.idText), secondSourcePat.Range)) - let mkJoinExpr keySelector1 keySelector2 innerPat e = - let mSynthetic = mOpCore.MakeSynthetic() + // check 'join' or 'groupJoin' or 'zip' is permitted for this builder + match tryGetDataForCustomOperation nm with + | None -> error (Error(FSComp.SR.tcMissingCustomOperation (nm.idText), nm.idRange)) + | Some opDatas -> + let opName, _, _, _, _, _, _, _, methInfo = opDatas[0] - mkSynCall - methInfo.DisplayName - mOpCore - [ - firstSource - secondSource - mkSynLambda firstSourceSimplePats keySelector1 mSynthetic - mkSynLambda secondSourceSimplePats keySelector2 mSynthetic - mkSynLambda firstSourceSimplePats (mkSynLambda innerPat e mSynthetic) mSynthetic - ] + // Record the resolution of the custom operation for posterity + let item = + Item.CustomOperation(opName, (fun () -> customOpUsageText nm), Some methInfo) - let mkZipExpr e = - let mSynthetic = mOpCore.MakeSynthetic() + // FUTURE: consider whether we can do better than emptyTyparInst here, in order to display instantiations + // of type variables in the quick info provided in the IDE. + CallNameResolutionSink + cenv.tcSink + (nm.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) - mkSynCall - methInfo.DisplayName - mOpCore - [ - firstSource - secondSource - mkSynLambda firstSourceSimplePats (mkSynLambda secondSourceSimplePats e mSynthetic) mSynthetic - ] + let mkJoinExpr keySelector1 keySelector2 innerPat e = + let mSynthetic = mOpCore.MakeSynthetic() - // wraps given expression into sequence with result produced by arbExpr so result will look like: - // l; SynExpr.ArbitraryAfterError (...) - // this allows to handle cases like 'on (a > b)' // '>' is not permitted as correct join relation - // after wrapping a and b can still be typechecked (so we'll have correct completion inside 'on' part) - // but presence of SynExpr.ArbitraryAfterError allows to avoid errors about incompatible types in cases like - // query { - // for a in [1] do - // join b in [""] on (a > b) - // } - // if we typecheck raw 'a' and 'b' then we'll end up with 2 errors: - // 1. incorrect join relation - // 2. incompatible types: int and string - // with SynExpr.ArbitraryAfterError we have only first one - let wrapInArbErrSequence l caption = - SynExpr.Sequential( - DebugPointAtSequential.SuppressNeither, - true, - l, - (arbExpr (caption, l.Range.EndRange)), - l.Range, - SynExprSequentialTrivia.Zero - ) + mkSynCall + methInfo.DisplayName + mOpCore + [ + firstSource + secondSource + mkSynLambda firstSourceSimplePats keySelector1 mSynthetic + mkSynLambda secondSourceSimplePats keySelector2 mSynthetic + mkSynLambda firstSourceSimplePats (mkSynLambda innerPat e mSynthetic) mSynthetic + ] + + let mkZipExpr e = + let mSynthetic = mOpCore.MakeSynthetic() + + mkSynCall + methInfo.DisplayName + mOpCore + [ + firstSource + secondSource + mkSynLambda firstSourceSimplePats (mkSynLambda secondSourceSimplePats e mSynthetic) mSynthetic + ] + + // wraps given expression into sequence with result produced by arbExpr so result will look like: + // l; SynExpr.ArbitraryAfterError (...) + // this allows to handle cases like 'on (a > b)' // '>' is not permitted as correct join relation + // after wrapping a and b can still be typechecked (so we'll have correct completion inside 'on' part) + // but presence of SynExpr.ArbitraryAfterError allows to avoid errors about incompatible types in cases like + // query { + // for a in [1] do + // join b in [""] on (a > b) + // } + // if we typecheck raw 'a' and 'b' then we'll end up with 2 errors: + // 1. incorrect join relation + // 2. incompatible types: int and string + // with SynExpr.ArbitraryAfterError we have only first one + let wrapInArbErrSequence l caption = + SynExpr.Sequential( + DebugPointAtSequential.SuppressNeither, + true, + l, + (arbExpr (caption, l.Range.EndRange)), + l.Range, + SynExprSequentialTrivia.Zero + ) - let mkOverallExprGivenVarSpaceExpr, varSpaceInner = - - let isNullableOp opId = - match ConvertValLogicalNameToDisplayNameCore opId with - | "?=" - | "=?" - | "?=?" -> true - | _ -> false - - match secondResultPatOpt, keySelectorsOpt with - // groupJoin - | Some secondResultPat, Some relExpr when customOperationIsLikeGroupJoin nm -> - let secondResultSimplePats, later3 = - SimplePatsOfPat cenv.synArgNameGenerator secondResultPat - - if Option.isSome later3 then - errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern (nm.idText), secondResultPat.Range)) - - match relExpr with - | JoinRelation cenv env (keySelector1, keySelector2) -> - mkJoinExpr keySelector1 keySelector2 secondResultSimplePats, varSpaceWithGroupJoinVars - | BinOpExpr(opId, l, r) -> - if isNullableOp opId.idText then - // When we cannot resolve NullableOps, recommend the relevant namespace to be added - errorR ( - Error( - FSComp.SR.cannotResolveNullableOperators (ConvertValLogicalNameToDisplayNameCore opId.idText), - relExpr.Range + let mkOverallExprGivenVarSpaceExpr, varSpaceInner = + + let isNullableOp opId = + match ConvertValLogicalNameToDisplayNameCore opId with + | "?=" + | "=?" + | "?=?" -> true + | _ -> false + + match secondResultPatOpt, keySelectorsOpt with + // groupJoin + | Some secondResultPat, Some relExpr when customOperationIsLikeGroupJoin nm -> + let secondResultSimplePats, later3 = + SimplePatsOfPat cenv.synArgNameGenerator secondResultPat + + if Option.isSome later3 then + errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern (nm.idText), secondResultPat.Range)) + + match relExpr with + | JoinRelation cenv env (keySelector1, keySelector2) -> + mkJoinExpr keySelector1 keySelector2 secondResultSimplePats, varSpaceWithGroupJoinVars + | BinOpExpr(opId, l, r) -> + if isNullableOp opId.idText then + // When we cannot resolve NullableOps, recommend the relevant namespace to be added + errorR ( + Error( + FSComp.SR.cannotResolveNullableOperators ( + ConvertValLogicalNameToDisplayNameCore opId.idText + ), + relExpr.Range + ) ) - ) - else + else + errorR (Error(FSComp.SR.tcInvalidRelationInJoin (nm.idText), relExpr.Range)) + + let l = wrapInArbErrSequence l "_keySelector1" + let r = wrapInArbErrSequence r "_keySelector2" + // this is not correct JoinRelation but it is still binary operation + // we've already reported error now we can use operands of binary operation as join components + mkJoinExpr l r secondResultSimplePats, varSpaceWithGroupJoinVars + | _ -> errorR (Error(FSComp.SR.tcInvalidRelationInJoin (nm.idText), relExpr.Range)) - - let l = wrapInArbErrSequence l "_keySelector1" - let r = wrapInArbErrSequence r "_keySelector2" - // this is not correct JoinRelation but it is still binary operation - // we've already reported error now we can use operands of binary operation as join components - mkJoinExpr l r secondResultSimplePats, varSpaceWithGroupJoinVars - | _ -> - errorR (Error(FSComp.SR.tcInvalidRelationInJoin (nm.idText), relExpr.Range)) - // since the shape of relExpr doesn't match our expectations (JoinRelation) - // then we assume that this is l.h.s. of the join relation - // so typechecker will treat relExpr as body of outerKeySelector lambda parameter in GroupJoin method - mkJoinExpr relExpr (arbExpr ("_keySelector2", relExpr.Range)) secondResultSimplePats, - varSpaceWithGroupJoinVars - - | None, Some relExpr when customOperationIsLikeJoin nm -> - match relExpr with - | JoinRelation cenv env (keySelector1, keySelector2) -> - mkJoinExpr keySelector1 keySelector2 secondSourceSimplePats, varSpaceWithSecondVars - | BinOpExpr(opId, l, r) -> - if isNullableOp opId.idText then - // When we cannot resolve NullableOps, recommend the relevant namespace to be added - errorR ( - Error( - FSComp.SR.cannotResolveNullableOperators (ConvertValLogicalNameToDisplayNameCore opId.idText), - relExpr.Range + // since the shape of relExpr doesn't match our expectations (JoinRelation) + // then we assume that this is l.h.s. of the join relation + // so typechecker will treat relExpr as body of outerKeySelector lambda parameter in GroupJoin method + mkJoinExpr relExpr (arbExpr ("_keySelector2", relExpr.Range)) secondResultSimplePats, + varSpaceWithGroupJoinVars + + | None, Some relExpr when customOperationIsLikeJoin nm -> + match relExpr with + | JoinRelation cenv env (keySelector1, keySelector2) -> + mkJoinExpr keySelector1 keySelector2 secondSourceSimplePats, varSpaceWithSecondVars + | BinOpExpr(opId, l, r) -> + if isNullableOp opId.idText then + // When we cannot resolve NullableOps, recommend the relevant namespace to be added + errorR ( + Error( + FSComp.SR.cannotResolveNullableOperators ( + ConvertValLogicalNameToDisplayNameCore opId.idText + ), + relExpr.Range + ) ) - ) - else + else + errorR (Error(FSComp.SR.tcInvalidRelationInJoin (nm.idText), relExpr.Range)) + // this is not correct JoinRelation but it is still binary operation + // we've already reported error now we can use operands of binary operation as join components + let l = wrapInArbErrSequence l "_keySelector1" + let r = wrapInArbErrSequence r "_keySelector2" + mkJoinExpr l r secondSourceSimplePats, varSpaceWithGroupJoinVars + | _ -> errorR (Error(FSComp.SR.tcInvalidRelationInJoin (nm.idText), relExpr.Range)) - // this is not correct JoinRelation but it is still binary operation - // we've already reported error now we can use operands of binary operation as join components - let l = wrapInArbErrSequence l "_keySelector1" - let r = wrapInArbErrSequence r "_keySelector2" - mkJoinExpr l r secondSourceSimplePats, varSpaceWithGroupJoinVars - | _ -> - errorR (Error(FSComp.SR.tcInvalidRelationInJoin (nm.idText), relExpr.Range)) - // since the shape of relExpr doesn't match our expectations (JoinRelation) - // then we assume that this is l.h.s. of the join relation - // so typechecker will treat relExpr as body of outerKeySelector lambda parameter in Join method - mkJoinExpr relExpr (arbExpr ("_keySelector2", relExpr.Range)) secondSourceSimplePats, - varSpaceWithGroupJoinVars + // since the shape of relExpr doesn't match our expectations (JoinRelation) + // then we assume that this is l.h.s. of the join relation + // so typechecker will treat relExpr as body of outerKeySelector lambda parameter in Join method + mkJoinExpr relExpr (arbExpr ("_keySelector2", relExpr.Range)) secondSourceSimplePats, + varSpaceWithGroupJoinVars - | None, None when customOperationIsLikeZip nm -> mkZipExpr, varSpaceWithSecondVars + | None, None when customOperationIsLikeZip nm -> mkZipExpr, varSpaceWithSecondVars - | _ -> - assert false - failwith "unreachable" - - // Case from C# spec: A query expression with a join clause with an into followed by something other than a select clause - // Case from C# spec: A query expression with a join clause without an into followed by something other than a select clause - let valsInner, _env = varSpaceInner.Force mOpCore - let varSpaceExpr = mkExprForVarSpace mOpCore valsInner - let varSpacePat = mkPatForVarSpace mOpCore valsInner - let joinExpr = mkOverallExprGivenVarSpaceExpr varSpaceExpr - - let consumingExpr = - SynExpr.ForEach( - DebugPointAtFor.No, - DebugPointAtInOrTo.No, - SeqExprOnly false, - false, - varSpacePat, - joinExpr, - innerComp, - mOpCore - ) + | _ -> + assert false + failwith "unreachable" + + // Case from C# spec: A query expression with a join clause with an into followed by something other than a select clause + // Case from C# spec: A query expression with a join clause without an into followed by something other than a select clause + let valsInner, _env = varSpaceInner.Force mOpCore + let varSpaceExpr = mkExprForVarSpace mOpCore valsInner + let varSpacePat = mkPatForVarSpace mOpCore valsInner + let joinExpr = mkOverallExprGivenVarSpaceExpr varSpaceExpr builderValName + + let consumingExpr = + SynExpr.ForEach( + DebugPointAtFor.No, + DebugPointAtInOrTo.No, + SeqExprOnly false, + false, + varSpacePat, + joinExpr, + innerComp, + mOpCore + ) - Some(trans CompExprTranslationPass.Initial q varSpaceInner consumingExpr translatedCtxt) + Some(trans CompExprTranslationPass.Initial q varSpaceInner consumingExpr translatedCtxt) | SynExpr.ForEach(spFor, spIn, SeqExprOnly _seqExprOnly, isFromSource, pat, sourceExpr, innerComp, _mEntireForEach) -> let sourceExpr = @@ -1357,7 +1241,8 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol | Some e -> e | None -> sourceExpr - let wrappedSourceExpr = mkSourceExprConditional isFromSource sourceExpr + let wrappedSourceExpr = + mkSourceExprConditional isFromSource sourceExpr sourceMethInfo builderValName let mFor = match spFor with @@ -1410,6 +1295,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol mFor ) ] + builderValName let forCall = match spFor with @@ -1480,8 +1366,9 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol mWhile [ mkSynDelay2 guardExpr - mkSynCall "Delay" mWhile [ mkSynDelay innerComp.Range holeFill ] + mkSynCall "Delay" mWhile [ mkSynDelay innerComp.Range holeFill ] builderValName ] + builderValName )) ) @@ -1617,9 +1504,10 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol "TryFinally" mTry [ - mkSynCall "Delay" mTry [ mkSynDelay innerComp.Range innerExpr ] + mkSynCall "Delay" mTry [ mkSynDelay innerComp.Range innerExpr ] builderValName mkSynDelay2 unwindExpr2 ] + builderValName ) ) @@ -1649,7 +1537,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol error (Error(FSComp.SR.tcEmptyBodyRequiresBuilderZeroMethod (), mWhole)) | _ -> error (Error(FSComp.SR.tcRequireBuilderMethod ("Zero"), m)) - Some(translatedCtxt (mkSynCall "Zero" m [])) + Some(translatedCtxt (mkSynCall "Zero" m [] builderValName)) | OptionalSequential(JoinOrGroupJoinOrZipClause(_, _, _, _, _, mClause), _) when firstTry = CompExprTranslationPass.Initial -> @@ -1679,18 +1567,18 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol | OptionalSequential(CustomOperationClause(nm, _, opExpr, mClause, _), _) -> - if q = CustomOperationsMode.Denied then - error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere (), opExpr.Range)) - - let patvs, _env = varSpace.Force comp.Range - let varSpaceExpr = mkExprForVarSpace mClause patvs + match q with + | CustomOperationsMode.Denied -> error (Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere (), opExpr.Range)) + | CustomOperationsMode.Allowed -> + let patvs, _env = varSpace.Force comp.Range + let varSpaceExpr = mkExprForVarSpace mClause patvs - let dataCompPriorToOp = - let isYield = not (customOperationMaintainsVarSpaceUsingBind nm) - translatedCtxt (transNoQueryOps (SynExpr.YieldOrReturn((isYield, false), varSpaceExpr, mClause))) + let dataCompPriorToOp = + let isYield = not (customOperationMaintainsVarSpaceUsingBind nm) + translatedCtxt (transNoQueryOps (SynExpr.YieldOrReturn((isYield, false), varSpaceExpr, mClause))) - // Now run the consumeCustomOpClauses - Some(consumeCustomOpClauses q varSpace dataCompPriorToOp comp false mClause) + // Now run the consumeCustomOpClauses + Some(consumeCustomOpClauses q varSpace dataCompPriorToOp comp false mClause) | SynExpr.Sequential(sp, true, innerComp1, innerComp2, m, _) -> @@ -1737,8 +1625,9 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol m1 [ c - mkSynCall "Delay" m1 [ mkSynDelay innerComp2.Range (transNoQueryOps innerComp2) ] + mkSynCall "Delay" m1 [ mkSynDelay innerComp2.Range (transNoQueryOps innerComp2) ] builderValName ] + builderValName Some(translatedCtxt combineCall) @@ -1783,15 +1672,16 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol // have type 'unit' we interpret it as a 'Yield + Combine'. let combineExpr = let m1 = rangeForCombine innerComp1 - let implicitYieldExpr = mkSynCall "Yield" comp.Range [ innerComp1 ] + let implicitYieldExpr = mkSynCall "Yield" comp.Range [ innerComp1 ] builderValName mkSynCall "Combine" m1 [ implicitYieldExpr - mkSynCall "Delay" m1 [ mkSynDelay holeFill.Range holeFill ] + mkSynCall "Delay" m1 [ mkSynDelay holeFill.Range holeFill ] builderValName ] + builderValName SynExpr.SequentialOrImplicitYield(sp, innerComp1, holeFill, combineExpr, m) else @@ -1835,7 +1725,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol then error (Error(FSComp.SR.tcRequireBuilderMethod ("Zero"), trivia.IfToThenRange)) - mkSynCall "Zero" trivia.IfToThenRange [] + mkSynCall "Zero" trivia.IfToThenRange [] builderValName Some( trans CompExprTranslationPass.Initial q varSpace thenComp (fun holeFill -> @@ -1928,7 +1818,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol error (Error(FSComp.SR.tcRequireBuilderMethod ("Using"), mBind)) Some( - translatedCtxt (mkSynCall "Using" mBind [ rhsExpr; consumeExpr ]) + translatedCtxt (mkSynCall "Using" mBind [ rhsExpr; consumeExpr ] builderValName) |> addBindDebugPoint spBind ) @@ -1963,7 +1853,9 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol vspecs, envinner) - let rhsExpr = mkSourceExprConditional isFromSource rhsExpr + let rhsExpr = + mkSourceExprConditional isFromSource rhsExpr sourceMethInfo builderValName + Some(transBind q varSpace mBind (addBindDebugPoint spBind) "Bind" [ rhsExpr ] pat innerComp translatedCtxt) // 'use! pat = e1 in e2' --> build.Bind(e1, (function _argN -> match _argN with pat -> build.Using(x, (fun _argN -> match _argN with pat -> e2)))) @@ -2021,7 +1913,8 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol mBind ) - let consumeExpr = mkSynCall "Using" mBind [ SynExpr.Ident id; consumeExpr ] + let consumeExpr = + mkSynCall "Using" mBind [ SynExpr.Ident id; consumeExpr ] builderValName let consumeExpr = SynExpr.MatchLambda( @@ -2034,8 +1927,11 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol mBind ) - let rhsExpr = mkSourceExprConditional isFromSource rhsExpr - mkSynCall "Bind" mBind [ rhsExpr; consumeExpr ] |> addBindDebugPoint spBind + let rhsExpr = + mkSourceExprConditional isFromSource rhsExpr sourceMethInfo builderValName + + mkSynCall "Bind" mBind [ rhsExpr; consumeExpr ] builderValName + |> addBindDebugPoint spBind Some(translatedCtxt bindExpr) @@ -2075,7 +1971,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol let sources = (letRhsExpr :: [ for SynExprAndBang(body = andExpr) in andBangBindings -> andExpr ]) - |> List.map (mkSourceExprConditional isFromSource) + |> List.map (fun expr -> mkSourceExprConditional isFromSource expr sourceMethInfo builderValName) let pats = letPat :: [ for SynExprAndBang(pat = andPat) in andBangBindings -> andPat ] @@ -2207,7 +2103,9 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol then error (Error(FSComp.SR.tcRequireMergeSourcesOrBindN (bindNName), mBind)) - let source = mkSynCall mergeSourcesName sourcesRange (List.map fst sourcesAndPats) + let source = + mkSynCall mergeSourcesName sourcesRange (List.map fst sourcesAndPats) builderValName + let pat = SynPat.Tuple(false, List.map snd sourcesAndPats, [], letPat.Range) source, pat @@ -2236,7 +2134,11 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol let laterSource, laterPat = mergeSources laterSourcesAndPats let source = - mkSynCall mergeSourcesName sourcesRange (List.map fst nowSourcesAndPats @ [ laterSource ]) + mkSynCall + mergeSourcesName + sourcesRange + (List.map fst nowSourcesAndPats @ [ laterSource ]) + builderValName let pat = SynPat.Tuple(false, List.map snd nowSourcesAndPats @ [ laterPat ], [], letPat.Range) @@ -2283,7 +2185,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol // 'match! expr with pats ...' --> build.Bind(e1, (function pats ...)) // FUTURE: consider allowing translation to BindReturn | SynExpr.MatchBang(spMatch, expr, clauses, _m, trivia) -> - let inputExpr = mkSourceExpr expr + let inputExpr = mkSourceExpr expr sourceMethInfo builderValName if isQuery then error (Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery (), trivia.MatchBangKeyword)) @@ -2317,7 +2219,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol ) let callExpr = - mkSynCall "Bind" trivia.MatchBangKeyword [ inputExpr; consumeExpr ] + mkSynCall "Bind" trivia.MatchBangKeyword [ inputExpr; consumeExpr ] builderValName |> addBindDebugPoint spMatch Some(translatedCtxt callExpr) @@ -2364,19 +2266,19 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol | _ -> innerExpr let callExpr = - mkSynCall "TryWith" mTry [ mkSynCall "Delay" mTry [ mkSynDelay2 innerExpr ]; consumeExpr ] + mkSynCall "TryWith" mTry [ mkSynCall "Delay" mTry [ mkSynDelay2 innerExpr ] builderValName; consumeExpr ] builderValName Some(translatedCtxt callExpr) | SynExpr.YieldOrReturnFrom((true, _), synYieldExpr, m) -> - let yieldFromExpr = mkSourceExpr synYieldExpr + let yieldFromExpr = mkSourceExpr synYieldExpr sourceMethInfo builderValName if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "YieldFrom" builderTy) then error (Error(FSComp.SR.tcRequireBuilderMethod ("YieldFrom"), m)) - let yieldFromCall = mkSynCall "YieldFrom" m [ yieldFromExpr ] + let yieldFromCall = mkSynCall "YieldFrom" m [ yieldFromExpr ] builderValName let yieldFromCall = if IsControlFlowExpression synYieldExpr then @@ -2387,7 +2289,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol Some(translatedCtxt yieldFromCall) | SynExpr.YieldOrReturnFrom((false, _), synReturnExpr, m) -> - let returnFromExpr = mkSourceExpr synReturnExpr + let returnFromExpr = mkSourceExpr synReturnExpr sourceMethInfo builderValName if isQuery then error (Error(FSComp.SR.tcReturnMayNotBeUsedInQueries (), m)) @@ -2399,7 +2301,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol then error (Error(FSComp.SR.tcRequireBuilderMethod ("ReturnFrom"), m)) - let returnFromCall = mkSynCall "ReturnFrom" m [ returnFromExpr ] + let returnFromCall = mkSynCall "ReturnFrom" m [ returnFromExpr ] builderValName let returnFromCall = if IsControlFlowExpression synReturnExpr then @@ -2420,7 +2322,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol then error (Error(FSComp.SR.tcRequireBuilderMethod (methName), m)) - let yieldOrReturnCall = mkSynCall methName m [ synYieldOrReturnExpr ] + let yieldOrReturnCall = mkSynCall methName m [ synYieldOrReturnExpr ] builderValName let yieldOrReturnCall = if IsControlFlowExpression synYieldOrReturnExpr then @@ -2500,7 +2402,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol else arg) - mkSynCall methInfo.DisplayName mClause (dataCompPrior :: args) + mkSynCall methInfo.DisplayName mClause (dataCompPrior :: args) builderValName else let expectedArgCount = defaultArg expectedArgCount 0 @@ -2516,6 +2418,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol mClause ([ dataCompPrior ] @ List.init expectedArgCount (fun i -> arbExpr ("_arg" + string i, mClause))) + builderValName | _ -> failwith "unreachable" match optionalCont with @@ -2620,7 +2523,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol // "do! expr;" in final position is treated as { let! () = expr in return () } when Return is provided (and no Zero with Default attribute is available) or as { let! () = expr in zero } otherwise | SynExpr.DoBang(rhsExpr, m) -> let mUnit = rhsExpr.Range - let rhsExpr = mkSourceExpr rhsExpr + let rhsExpr = mkSourceExpr rhsExpr sourceMethInfo builderValName if isQuery then error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), m)) @@ -2677,7 +2580,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol trans CompExprTranslationPass.Initial q varSpace (SynExpr.ImplicitZero comp.Range) (fun holeFill -> let fillExpr = if enableImplicitYield then - let implicitYieldExpr = mkSynCall "Yield" comp.Range [ comp ] + let implicitYieldExpr = mkSynCall "Yield" comp.Range [ comp ] builderValName SynExpr.SequentialOrImplicitYield( DebugPointAtSequential.SuppressExpr, @@ -2698,7 +2601,17 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol translatedCtxt fillExpr) - and transBind q varSpace bindRange addBindDebugPoint bindName bindArgs (consumePat: SynPat) (innerComp: SynExpr) translatedCtxt = + and transBind + q + varSpace + bindRange + addBindDebugPoint + bindName + (bindArgs: SynExpr list) + (consumePat: SynPat) + (innerComp: SynExpr) + translatedCtxt + = let innerRange = innerComp.Range @@ -2734,7 +2647,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol innerRange ) - translatedCtxt (mkSynCall bindName bindRange (bindArgs @ [ consumeExpr ])) + translatedCtxt (mkSynCall bindName bindRange (bindArgs @ [ consumeExpr ]) builderValName) match customOpInfo with | None -> dataCompPriorToOp @@ -2764,7 +2677,9 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol innerRange ) - let bindCall = mkSynCall bindName bindRange (bindArgs @ [ consumeExpr ]) + let bindCall = + mkSynCall bindName bindRange (bindArgs @ [ consumeExpr ]) builderValName + translatedCtxt (bindCall |> addBindDebugPoint)) /// This function is for desugaring into .Bind{N}Return calls if possible @@ -2882,7 +2797,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol let delayedExpr = match TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad "Delay" builderTy with | [] -> basicSynExpr - | _ -> mkSynCall "Delay" mDelayOrQuoteOrRun [ (mkSynDelay2 basicSynExpr) ] + | _ -> mkSynCall "Delay" mDelayOrQuoteOrRun [ (mkSynDelay2 basicSynExpr) ] builderValName // Add a call to 'Quote' if the method is present let quotedSynExpr = @@ -2895,7 +2810,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol let runExpr = match TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad "Run" builderTy with | [] -> quotedSynExpr - | _ -> mkSynCall "Run" mDelayOrQuoteOrRun [ quotedSynExpr ] + | _ -> mkSynCall "Run" mDelayOrQuoteOrRun [ quotedSynExpr ] builderValName let lambdaExpr = SynExpr.Lambda( @@ -2928,685 +2843,3 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol mkApps cenv.g ((lambdaExpr, tyOfExpr cenv.g lambdaExpr), [], [ interpExpr ], mBuilderVal) coreExpr, tpenv - -let mkSeqEmpty (cenv: cenv) env m genTy = - // We must discover the 'zero' of the monadic algebra being generated in order to compile failing matches. - let g = cenv.g - let genResultTy = NewInferenceType g - UnifyTypes cenv env m genTy (mkSeqTy g genResultTy) - mkCallSeqEmpty g m genResultTy - -let mkSeqCollect (cenv: cenv) env m enumElemTy genTy lam enumExpr = - let g = cenv.g - let genResultTy = NewInferenceType g - UnifyTypes cenv env m genTy (mkSeqTy cenv.g genResultTy) - - let enumExpr = - mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g enumElemTy) (tyOfExpr cenv.g enumExpr) enumExpr - - mkCallSeqCollect cenv.g m enumElemTy genResultTy lam enumExpr - -let mkSeqUsing (cenv: cenv) (env: TcEnv) m resourceTy genTy resourceExpr lam = - let g = cenv.g - AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace cenv.g.system_IDisposable_ty resourceTy - let genResultTy = NewInferenceType g - UnifyTypes cenv env m genTy (mkSeqTy cenv.g genResultTy) - mkCallSeqUsing cenv.g m resourceTy genResultTy resourceExpr lam - -let mkSeqDelay (cenv: cenv) env m genTy lam = - let g = cenv.g - let genResultTy = NewInferenceType g - UnifyTypes cenv env m genTy (mkSeqTy cenv.g genResultTy) - mkCallSeqDelay cenv.g m genResultTy (mkUnitDelayLambda cenv.g m lam) - -let mkSeqAppend (cenv: cenv) env m genTy e1 e2 = - let g = cenv.g - let genResultTy = NewInferenceType g - UnifyTypes cenv env m genTy (mkSeqTy cenv.g genResultTy) - - let e1 = - mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g genResultTy) (tyOfExpr cenv.g e1) e1 - - let e2 = - mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g genResultTy) (tyOfExpr cenv.g e2) e2 - - mkCallSeqAppend cenv.g m genResultTy e1 e2 - -let mkSeqFromFunctions (cenv: cenv) env m genTy e1 e2 = - let g = cenv.g - let genResultTy = NewInferenceType g - UnifyTypes cenv env m genTy (mkSeqTy cenv.g genResultTy) - - let e2 = - mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g genResultTy) (tyOfExpr cenv.g e2) e2 - - mkCallSeqGenerated cenv.g m genResultTy e1 e2 - -let mkSeqFinally (cenv: cenv) env m genTy e1 e2 = - let g = cenv.g - let genResultTy = NewInferenceType g - UnifyTypes cenv env m genTy (mkSeqTy cenv.g genResultTy) - - let e1 = - mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g genResultTy) (tyOfExpr cenv.g e1) e1 - - mkCallSeqFinally cenv.g m genResultTy e1 e2 - -let mkSeqTryWith (cenv: cenv) env m genTy origSeq exnFilter exnHandler = - let g = cenv.g - let genResultTy = NewInferenceType g - UnifyTypes cenv env m genTy (mkSeqTy cenv.g genResultTy) - - let origSeq = - mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g genResultTy) (tyOfExpr cenv.g origSeq) origSeq - - mkCallSeqTryWith cenv.g m genResultTy origSeq exnFilter exnHandler - -let mkSeqExprMatchClauses (pat, vspecs) innerExpr = - [ MatchClause(pat, None, TTarget(vspecs, innerExpr, None), pat.Range) ] - -let compileSeqExprMatchClauses (cenv: cenv) env inputExprMark (pat: Pattern, vspecs) innerExpr inputExprOpt bindPatTy genInnerTy = - let patMark = pat.Range - let tclauses = mkSeqExprMatchClauses (pat, vspecs) innerExpr - - CompilePatternForMatchClauses - cenv - env - inputExprMark - patMark - false - ThrowIncompleteMatchException - inputExprOpt - bindPatTy - genInnerTy - tclauses - -/// This case is used for computation expressions which are sequence expressions. Technically the code path is different because it -/// typechecks rather than doing a shallow syntactic translation, and generates calls into the Seq.* library -/// and helpers rather than to the builder methods (there is actually no builder for 'seq' in the library). -/// These are later detected by state machine compilation. -/// -/// Also "ienumerable extraction" is performed on arguments to "for". -let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = - - let g = cenv.g - let genEnumElemTy = NewInferenceType g - UnifyTypes cenv env m overallTy.Commit (mkSeqTy cenv.g genEnumElemTy) - - // Allow subsumption at 'yield' if the element type is nominal prior to the analysis of the body of the sequence expression - let flex = not (isTyparTy cenv.g genEnumElemTy) - - // If there are no 'yield' in the computation expression then allow the type-directed rule - // interpreting non-unit-typed expressions in statement positions as 'yield'. 'yield!' may be - // present in the computation expression. - let enableImplicitYield = - cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield - && (YieldFree cenv comp) - - let mkSeqDelayedExpr m (coreExpr: Expr) = - let overallTy = tyOfExpr cenv.g coreExpr - mkSeqDelay cenv env m overallTy coreExpr - - let rec tryTcSequenceExprBody env genOuterTy tpenv comp = - match comp with - | SynExpr.ForEach(spFor, spIn, SeqExprOnly _seqExprOnly, _isFromSource, pat, pseudoEnumExpr, innerComp, _m) -> - let pseudoEnumExpr = - match RewriteRangeExpr pseudoEnumExpr with - | Some e -> e - | None -> pseudoEnumExpr - // This expression is not checked with the knowledge it is an IEnumerable, since we permit other enumerable types with GetEnumerator/MoveNext methods, as does C# - let pseudoEnumExpr, arbitraryTy, tpenv = - TcExprOfUnknownType cenv env tpenv pseudoEnumExpr - - let enumExpr, enumElemTy = - ConvertArbitraryExprToEnumerable cenv arbitraryTy env pseudoEnumExpr - - let patR, _, vspecs, envinner, tpenv = - TcMatchPattern cenv enumElemTy env tpenv pat None - - let innerExpr, tpenv = - let envinner = { envinner with eIsControlFlow = true } - tcSequenceExprBody envinner genOuterTy tpenv innerComp - - let enumExprRange = enumExpr.Range - - // We attach the debug point to the lambda expression so we can fetch it out again in LowerComputedListOrArraySeqExpr - let mFor = - match spFor with - | DebugPointAtFor.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.For) - | _ -> enumExprRange - - // We attach the debug point to the lambda expression so we can fetch it out again in LowerComputedListOrArraySeqExpr - let mIn = - match spIn with - | DebugPointAtInOrTo.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.InOrTo) - | _ -> pat.Range - - match patR, vspecs, innerExpr with - // Legacy peephole optimization: - // "seq { .. for x in e1 -> e2 .. }" == "e1 |> Seq.map (fun x -> e2)" - // "seq { .. for x in e1 do yield e2 .. }" == "e1 |> Seq.map (fun x -> e2)" - // - // This transformation is visible in quotations and thus needs to remain. - | (TPat_as(TPat_wild _, PatternValBinding(v, _), _), - [ _ ], - DebugPoints(Expr.App(Expr.Val(vref, _, _), _, [ genEnumElemTy ], [ yieldExpr ], _mYield), recreate)) when - valRefEq cenv.g vref cenv.g.seq_singleton_vref - -> - - // The debug point mFor is attached to the 'map' - // The debug point mIn is attached to the lambda - // Note: the 'yield' part of the debug point for 'yield expr' is currently lost in debug points. - let lam = mkLambda mIn v (recreate yieldExpr, genEnumElemTy) - - let enumExpr = - mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g enumElemTy) (tyOfExpr cenv.g enumExpr) enumExpr - - Some(mkCallSeqMap cenv.g mFor enumElemTy genEnumElemTy lam enumExpr, tpenv) - - | _ -> - // The debug point mFor is attached to the 'collect' - // The debug point mIn is attached to the lambda - let matchv, matchExpr = - compileSeqExprMatchClauses cenv env enumExprRange (patR, vspecs) innerExpr None enumElemTy genOuterTy - - let lam = mkLambda mIn matchv (matchExpr, tyOfExpr cenv.g matchExpr) - Some(mkSeqCollect cenv env mFor enumElemTy genOuterTy lam enumExpr, tpenv) - - | SynExpr.For( - forDebugPoint = spFor - toDebugPoint = spTo - ident = id - identBody = start - direction = dir - toBody = finish - doBody = innerComp - range = m) -> - Some(tcSequenceExprBody env genOuterTy tpenv (elimFastIntegerForLoop (spFor, spTo, id, start, dir, finish, innerComp, m))) - - | SynExpr.While(spWhile, guardExpr, innerComp, _m) -> - let guardExpr, tpenv = - let env = { env with eIsControlFlow = false } - TcExpr cenv (MustEqual cenv.g.bool_ty) env tpenv guardExpr - - let innerExpr, tpenv = - let env = { env with eIsControlFlow = true } - tcSequenceExprBody env genOuterTy tpenv innerComp - - let guardExprMark = guardExpr.Range - let guardLambdaExpr = mkUnitDelayLambda cenv.g guardExprMark guardExpr - - // We attach the debug point to the lambda expression so we can fetch it out again in LowerComputedListOrArraySeqExpr - let mWhile = - match spWhile with - | DebugPointAtWhile.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.While) - | _ -> guardExprMark - - let innerDelayedExpr = mkSeqDelayedExpr mWhile innerExpr - Some(mkSeqFromFunctions cenv env guardExprMark genOuterTy guardLambdaExpr innerDelayedExpr, tpenv) - - | SynExpr.TryFinally(innerComp, unwindExpr, mTryToLast, spTry, spFinally, trivia) -> - let env = { env with eIsControlFlow = true } - let innerExpr, tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp - let unwindExpr, tpenv = TcExpr cenv (MustEqual cenv.g.unit_ty) env tpenv unwindExpr - - // We attach the debug points to the lambda expressions so we can fetch it out again in LowerComputedListOrArraySeqExpr - let mTry = - match spTry with - | DebugPointAtTry.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.Try) - | _ -> trivia.TryKeyword - - let mFinally = - match spFinally with - | DebugPointAtFinally.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.Finally) - | _ -> trivia.FinallyKeyword - - let innerExpr = mkSeqDelayedExpr mTry innerExpr - let unwindExpr = mkUnitDelayLambda cenv.g mFinally unwindExpr - - Some(mkSeqFinally cenv env mTryToLast genOuterTy innerExpr unwindExpr, tpenv) - - | SynExpr.Paren(range = m) when not (cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield) -> - error (Error(FSComp.SR.tcConstructIsAmbiguousInSequenceExpression (), m)) - - | SynExpr.ImplicitZero m -> Some(mkSeqEmpty cenv env m genOuterTy, tpenv) - - | SynExpr.DoBang(_rhsExpr, m) -> error (Error(FSComp.SR.tcDoBangIllegalInSequenceExpression (), m)) - - | SynExpr.Sequential(sp, true, innerComp1, innerComp2, m, _) -> - let env1 = - { env with - eIsControlFlow = - (match sp with - | DebugPointAtSequential.SuppressNeither - | DebugPointAtSequential.SuppressExpr -> true - | _ -> false) - } - - let res, tpenv = - tcSequenceExprBodyAsSequenceOrStatement env1 genOuterTy tpenv innerComp1 - - let env2 = - { env with - eIsControlFlow = - (match sp with - | DebugPointAtSequential.SuppressNeither - | DebugPointAtSequential.SuppressStmt -> true - | _ -> false) - } - - // "expr; cexpr" is treated as sequential execution - // "cexpr; cexpr" is treated as append - match res with - | Choice1Of2 innerExpr1 -> - let innerExpr2, tpenv = tcSequenceExprBody env2 genOuterTy tpenv innerComp2 - let innerExpr2 = mkSeqDelayedExpr innerExpr2.Range innerExpr2 - Some(mkSeqAppend cenv env innerComp1.Range genOuterTy innerExpr1 innerExpr2, tpenv) - | Choice2Of2 stmt1 -> - let innerExpr2, tpenv = tcSequenceExprBody env2 genOuterTy tpenv innerComp2 - Some(Expr.Sequential(stmt1, innerExpr2, NormalSeq, m), tpenv) - - | SynExpr.IfThenElse(guardExpr, thenComp, elseCompOpt, spIfToThen, _isRecovery, mIfToEndOfElseBranch, trivia) -> - let guardExpr', tpenv = TcExpr cenv (MustEqual cenv.g.bool_ty) env tpenv guardExpr - let env = { env with eIsControlFlow = true } - let thenExpr, tpenv = tcSequenceExprBody env genOuterTy tpenv thenComp - - let elseComp = - (match elseCompOpt with - | Some c -> c - | None -> SynExpr.ImplicitZero trivia.IfToThenRange) - - let elseExpr, tpenv = tcSequenceExprBody env genOuterTy tpenv elseComp - Some(mkCond spIfToThen mIfToEndOfElseBranch genOuterTy guardExpr' thenExpr elseExpr, tpenv) - - // 'let x = expr in expr' - | SynExpr.LetOrUse(isUse = false) -> - TcLinearExprs - (fun overallTy envinner tpenv e -> tcSequenceExprBody envinner overallTy.Commit tpenv e) - cenv - env - overallTy - tpenv - true - comp - id - |> Some - - // 'use x = expr in expr' - | SynExpr.LetOrUse( - isUse = true - bindings = [ SynBinding(kind = SynBindingKind.Normal; headPat = pat; expr = rhsExpr; debugPoint = spBind) ] - body = innerComp - range = wholeExprMark) -> - - let bindPatTy = NewInferenceType g - let inputExprTy = NewInferenceType g - - let pat', _, vspecs, envinner, tpenv = - TcMatchPattern cenv bindPatTy env tpenv pat None - - UnifyTypes cenv env m inputExprTy bindPatTy - - let inputExpr, tpenv = - let env = { env with eIsControlFlow = true } - TcExpr cenv (MustEqual inputExprTy) env tpenv rhsExpr - - let innerExpr, tpenv = - let envinner = { envinner with eIsControlFlow = true } - tcSequenceExprBody envinner genOuterTy tpenv innerComp - - let mBind = - match spBind with - | DebugPointAtBinding.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.Binding) - | _ -> inputExpr.Range - - let inputExprMark = inputExpr.Range - - let matchv, matchExpr = - compileSeqExprMatchClauses cenv envinner inputExprMark (pat', vspecs) innerExpr (Some inputExpr) bindPatTy genOuterTy - - let consumeExpr = mkLambda mBind matchv (matchExpr, genOuterTy) - - // The 'mBind' is attached to the lambda - Some(mkSeqUsing cenv env wholeExprMark bindPatTy genOuterTy inputExpr consumeExpr, tpenv) - - | SynExpr.LetOrUseBang(range = m) -> error (Error(FSComp.SR.tcUseForInSequenceExpression (), m)) - - | SynExpr.Match(spMatch, expr, clauses, _m, _trivia) -> - let inputExpr, inputTy, tpenv = TcExprOfUnknownType cenv env tpenv expr - - let tclauses, tpenv = - (tpenv, clauses) - ||> List.mapFold (fun tpenv (SynMatchClause(pat, cond, innerComp, _, sp, _)) -> - let patR, condR, vspecs, envinner, tpenv = - TcMatchPattern cenv inputTy env tpenv pat cond - - let envinner = - match sp with - | DebugPointAtTarget.Yes -> { envinner with eIsControlFlow = true } - | DebugPointAtTarget.No -> envinner - - let innerExpr, tpenv = tcSequenceExprBody envinner genOuterTy tpenv innerComp - MatchClause(patR, condR, TTarget(vspecs, innerExpr, None), patR.Range), tpenv) - - let inputExprTy = tyOfExpr cenv.g inputExpr - let inputExprMark = inputExpr.Range - - let matchv, matchExpr = - CompilePatternForMatchClauses - cenv - env - inputExprMark - inputExprMark - true - ThrowIncompleteMatchException - (Some inputExpr) - inputExprTy - genOuterTy - tclauses - - Some(mkLet spMatch inputExprMark matchv inputExpr matchExpr, tpenv) - - | SynExpr.TryWith(innerTry, withList, mTryToWith, _spTry, _spWith, trivia) -> - if not (g.langVersion.SupportsFeature(LanguageFeature.TryWithInSeqExpression)) then - error (Error(FSComp.SR.tcTryIllegalInSequenceExpression (), mTryToWith)) - - let env = { env with eIsControlFlow = true } - - let tryExpr, tpenv = - let inner, tpenv = tcSequenceExprBody env genOuterTy tpenv innerTry - mkSeqDelayedExpr mTryToWith inner, tpenv - - // Compile the pattern twice, once as a filter with all succeeding targets returning "1", and once as a proper catch block. - let clauses, tpenv = - (tpenv, withList) - ||> List.mapFold (fun tpenv (SynMatchClause(pat, cond, innerComp, m, sp, _)) -> - let patR, condR, vspecs, envinner, tpenv = - TcMatchPattern cenv g.exn_ty env tpenv pat cond - - let envinner = - match sp with - | DebugPointAtTarget.Yes -> { envinner with eIsControlFlow = true } - | DebugPointAtTarget.No -> envinner - - let matchBody, tpenv = tcSequenceExprBody envinner genOuterTy tpenv innerComp - - let handlerClause = - MatchClause(patR, condR, TTarget(vspecs, matchBody, None), patR.Range) - - let filterClause = - MatchClause(patR, condR, TTarget([], Expr.Const(Const.Int32 1, m, g.int_ty), None), patR.Range) - - (handlerClause, filterClause), tpenv) - - let handlers, filterClauses = List.unzip clauses - let withRange = trivia.WithToEndRange - - let v1, filterExpr = - CompilePatternForMatchClauses cenv env withRange withRange true FailFilter None g.exn_ty g.int_ty filterClauses - - let v2, handlerExpr = - CompilePatternForMatchClauses cenv env withRange withRange true FailFilter None g.exn_ty genOuterTy handlers - - let filterLambda = mkLambda filterExpr.Range v1 (filterExpr, genOuterTy) - let handlerLambda = mkLambda handlerExpr.Range v2 (handlerExpr, genOuterTy) - - let combinatorExpr = - mkSeqTryWith cenv env mTryToWith genOuterTy tryExpr filterLambda handlerLambda - - Some(combinatorExpr, tpenv) - - | SynExpr.YieldOrReturnFrom((isYield, _), synYieldExpr, m) -> - let env = { env with eIsControlFlow = false } - let resultExpr, genExprTy, tpenv = TcExprOfUnknownType cenv env tpenv synYieldExpr - - if not isYield then - errorR (Error(FSComp.SR.tcUseYieldBangForMultipleResults (), m)) - - AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace genOuterTy genExprTy - - let resultExpr = mkCoerceExpr (resultExpr, genOuterTy, m, genExprTy) - - let resultExpr = - if IsControlFlowExpression synYieldExpr then - resultExpr - else - mkDebugPoint m resultExpr - - Some(resultExpr, tpenv) - - | SynExpr.YieldOrReturn((isYield, _), synYieldExpr, m) -> - let env = { env with eIsControlFlow = false } - let genResultTy = NewInferenceType g - - if not isYield then - errorR (Error(FSComp.SR.tcSeqResultsUseYield (), m)) - - UnifyTypes cenv env m genOuterTy (mkSeqTy cenv.g genResultTy) - - let resultExpr, tpenv = TcExprFlex cenv flex true genResultTy env tpenv synYieldExpr - - let resultExpr = mkCallSeqSingleton cenv.g m genResultTy resultExpr - - let resultExpr = - if IsControlFlowExpression synYieldExpr then - resultExpr - else - mkDebugPoint m resultExpr - - Some(resultExpr, tpenv) - - | _ -> None - - and tcSequenceExprBody env (genOuterTy: TType) tpenv comp = - let res, tpenv = tcSequenceExprBodyAsSequenceOrStatement env genOuterTy tpenv comp - - match res with - | Choice1Of2 expr -> expr, tpenv - | Choice2Of2 stmt -> - let m = comp.Range - let resExpr = Expr.Sequential(stmt, mkSeqEmpty cenv env m genOuterTy, NormalSeq, m) - resExpr, tpenv - - and tcSequenceExprBodyAsSequenceOrStatement env genOuterTy tpenv comp = - match tryTcSequenceExprBody env genOuterTy tpenv comp with - | Some(expr, tpenv) -> Choice1Of2 expr, tpenv - | None -> - - let env = - { env with - eContextInfo = ContextInfo.SequenceExpression genOuterTy - } - - if enableImplicitYield then - let hasTypeUnit, _ty, expr, tpenv = TryTcStmt cenv env tpenv comp - - if hasTypeUnit then - Choice2Of2 expr, tpenv - else - let genResultTy = NewInferenceType g - let mExpr = expr.Range - UnifyTypes cenv env mExpr genOuterTy (mkSeqTy cenv.g genResultTy) - let expr, tpenv = TcExprFlex cenv flex true genResultTy env tpenv comp - let exprTy = tyOfExpr cenv.g expr - AddCxTypeMustSubsumeType env.eContextInfo env.DisplayEnv cenv.css mExpr NoTrace genResultTy exprTy - - let resExpr = - mkCallSeqSingleton cenv.g mExpr genResultTy (mkCoerceExpr (expr, genResultTy, mExpr, exprTy)) - - Choice1Of2 resExpr, tpenv - else - let stmt, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv comp - Choice2Of2 stmt, tpenv - - let coreExpr, tpenv = tcSequenceExprBody env overallTy.Commit tpenv comp - let delayedExpr = mkSeqDelayedExpr coreExpr.Range coreExpr - delayedExpr, tpenv - -let TcSequenceExpressionEntry (cenv: cenv) env (overallTy: OverallTy) tpenv (hasBuilder, comp) m = - match RewriteRangeExpr comp with - | Some replacementExpr -> TcExpr cenv overallTy env tpenv replacementExpr - | None -> - - let implicitYieldEnabled = - cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield - - let validateObjectSequenceOrRecordExpression = not implicitYieldEnabled - - match comp with - | SimpleSemicolonSequence cenv false _ when validateObjectSequenceOrRecordExpression -> - errorR (Error(FSComp.SR.tcInvalidObjectSequenceOrRecordExpression (), m)) - | _ -> () - - if not hasBuilder && not cenv.g.compilingFSharpCore then - error (Error(FSComp.SR.tcInvalidSequenceExpressionSyntaxForm (), m)) - - TcSequenceExpression cenv env tpenv comp overallTy m - -let TcArrayOrListComputedExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (isArray, comp) m = - let g = cenv.g - - // The syntax '[ n .. m ]' and '[ n .. step .. m ]' is not really part of array or list syntax. - // It could be in the future, e.g. '[ 1; 2..30; 400 ]' - // - // The elaborated form of '[ n .. m ]' is 'List.ofSeq (seq (op_Range n m))' and this shouldn't change - match RewriteRangeExpr comp with - | Some replacementExpr -> - let genCollElemTy = NewInferenceType g - - let genCollTy = (if isArray then mkArrayType else mkListTy) cenv.g genCollElemTy - - UnifyTypes cenv env m overallTy.Commit genCollTy - - let exprTy = mkSeqTy cenv.g genCollElemTy - - let expr, tpenv = TcExpr cenv (MustEqual exprTy) env tpenv replacementExpr - - let expr = - if cenv.g.compilingFSharpCore then - expr - else - // We add a call to 'seq ... ' to make sure sequence expression compilation gets applied to the contents of the - // comprehension. But don't do this in FSharp.Core.dll since 'seq' may not yet be defined. - mkCallSeq cenv.g m genCollElemTy expr - - let expr = mkCoerceExpr (expr, exprTy, expr.Range, overallTy.Commit) - - let expr = - if isArray then - mkCallSeqToArray cenv.g m genCollElemTy expr - else - mkCallSeqToList cenv.g m genCollElemTy expr - - expr, tpenv - - | None -> - - // LanguageFeatures.ImplicitYield do not require this validation - let implicitYieldEnabled = - cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield - - let validateExpressionWithIfRequiresParenthesis = not implicitYieldEnabled - let acceptDeprecatedIfThenExpression = not implicitYieldEnabled - - match comp with - | SimpleSemicolonSequence cenv acceptDeprecatedIfThenExpression elems -> - match comp with - | SimpleSemicolonSequence cenv false _ -> () - | _ when validateExpressionWithIfRequiresParenthesis -> - errorR (Deprecated(FSComp.SR.tcExpressionWithIfRequiresParenthesis (), m)) - | _ -> () - - let replacementExpr = - if isArray then - // This are to improve parsing/processing speed for parser tables by converting to an array blob ASAP - let nelems = elems.Length - - if - nelems > 0 - && List.forall - (function - | SynExpr.Const(SynConst.UInt16 _, _) -> true - | _ -> false) - elems - then - SynExpr.Const( - SynConst.UInt16s( - Array.ofList ( - List.map - (function - | SynExpr.Const(SynConst.UInt16 x, _) -> x - | _ -> failwith "unreachable") - elems - ) - ), - m - ) - elif - nelems > 0 - && List.forall - (function - | SynExpr.Const(SynConst.Byte _, _) -> true - | _ -> false) - elems - then - SynExpr.Const( - SynConst.Bytes( - Array.ofList ( - List.map - (function - | SynExpr.Const(SynConst.Byte x, _) -> x - | _ -> failwith "unreachable") - elems - ), - SynByteStringKind.Regular, - m - ), - m - ) - else - SynExpr.ArrayOrList(isArray, elems, m) - else if cenv.g.langVersion.SupportsFeature(LanguageFeature.ReallyLongLists) then - SynExpr.ArrayOrList(isArray, elems, m) - else - if elems.Length > 500 then - error (Error(FSComp.SR.tcListLiteralMaxSize (), m)) - - SynExpr.ArrayOrList(isArray, elems, m) - - TcExprUndelayed cenv overallTy env tpenv replacementExpr - | _ -> - - let genCollElemTy = NewInferenceType g - - let genCollTy = (if isArray then mkArrayType else mkListTy) cenv.g genCollElemTy - - // Propagating type directed conversion, e.g. for - // let x : seq = [ yield 1; if true then yield 2 ] - TcPropagatingExprLeafThenConvert cenv overallTy genCollTy env (* canAdhoc *) m (fun () -> - - let exprTy = mkSeqTy cenv.g genCollElemTy - - // Check the comprehension - let expr, tpenv = TcSequenceExpression cenv env tpenv comp (MustEqual exprTy) m - - let expr = mkCoerceIfNeeded cenv.g exprTy (tyOfExpr cenv.g expr) expr - - let expr = - if cenv.g.compilingFSharpCore then - //warning(Error(FSComp.SR.fslibUsingComputedListOrArray(), expr.Range)) - expr - else - // We add a call to 'seq ... ' to make sure sequence expression compilation gets applied to the contents of the - // comprehension. But don't do this in FSharp.Core.dll since 'seq' may not yet be defined. - mkCallSeq cenv.g m genCollElemTy expr - - let expr = mkCoerceExpr (expr, exprTy, expr.Range, overallTy.Commit) - - let expr = - if isArray then - mkCallSeqToArray cenv.g m genCollElemTy expr - else - mkCallSeqToList cenv.g m genCollElemTy expr - - expr, tpenv) diff --git a/src/Compiler/Checking/CheckComputationExpressions.fsi b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fsi similarity index 55% rename from src/Compiler/Checking/CheckComputationExpressions.fsi rename to src/Compiler/Checking/Expressions/CheckComputationExpressions.fsi index e9f24dfb15e..ac9554252f3 100644 --- a/src/Compiler/Checking/CheckComputationExpressions.fsi +++ b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fsi @@ -8,24 +8,6 @@ open FSharp.Compiler.Syntax open FSharp.Compiler.Text open FSharp.Compiler.TypedTree -val TcSequenceExpressionEntry: - cenv: TcFileState -> - env: TcEnv -> - overallTy: OverallTy -> - tpenv: UnscopedTyparEnv -> - hasBuilder: bool * comp: SynExpr -> - m: range -> - Expr * UnscopedTyparEnv - -val TcArrayOrListComputedExpression: - cenv: TcFileState -> - env: TcEnv -> - overallTy: OverallTy -> - tpenv: UnscopedTyparEnv -> - isArray: bool * comp: SynExpr -> - m: range -> - Expr * UnscopedTyparEnv - val TcComputationExpression: cenv: TcFileState -> env: TcEnv -> diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs similarity index 98% rename from src/Compiler/Checking/CheckExpressions.fs rename to src/Compiler/Checking/Expressions/CheckExpressions.fs index 08c71018f05..2b3d9e7f6c6 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -18,6 +18,7 @@ open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking open FSharp.Compiler.CheckBasics +open FSharp.Compiler.CheckExpressionsOps open FSharp.Compiler.CheckRecordSyntaxHelpers open FSharp.Compiler.ConstraintSolver open FSharp.Compiler.DiagnosticsLogger @@ -466,13 +467,6 @@ type CheckedBindingInfo = type cenv = TcFileState -let CopyAndFixupTypars g m rigid tpsorig = - FreshenAndFixupTypars g m rigid [] [] tpsorig - -let UnifyTypes (cenv: cenv) (env: TcEnv) m expectedTy actualTy = - let g = cenv.g - AddCxTypeEqualsType env.eContextInfo env.DisplayEnv cenv.css m (tryNormalizeMeasureInType g expectedTy) (tryNormalizeMeasureInType g actualTy) - // If the overall type admits subsumption or type directed conversion, and the original unify would have failed, // then allow subsumption or type directed conversion. // @@ -483,8 +477,8 @@ let UnifyOverallType (cenv: cenv) (env: TcEnv) m overallTy actualTy = match overallTy with | MustConvertTo(isMethodArg, reqdTy) when g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions -> let actualTy = tryNormalizeMeasureInType g actualTy - let reqdTy = tryNormalizeMeasureInType g reqdTy - let reqTyForUnification = reqTyForArgumentNullnessInference g actualTy reqdTy + let reqdTy = tryNormalizeMeasureInType g reqdTy + let reqTyForUnification = reqTyForArgumentNullnessInference g actualTy reqdTy if AddCxTypeEqualsTypeUndoIfFailed env.DisplayEnv cenv.css m reqTyForUnification actualTy then () else @@ -676,7 +670,7 @@ let UnifyFunctionTypeUndoIfFailed (cenv: cenv) denv m ty = | ValueNone -> let domainTy = NewInferenceType g let resultTy = NewInferenceType g - if AddCxTypeEqualsTypeUndoIfFailed denv cenv.css m ty (mkFunTy g domainTy resultTy) then + if AddCxTypeEqualsTypeUndoIfFailed denv cenv.css m ty (mkFunTy g domainTy resultTy) then ValueSome(domainTy, resultTy) else ValueNone @@ -738,7 +732,7 @@ let UnifyUnitType (cenv: cenv) (env: TcEnv) m ty expr = else let domainTy = NewInferenceType g let resultTy = NewInferenceType g - if AddCxTypeEqualsTypeUndoIfFailed denv cenv.css m ty (mkFunTy g domainTy resultTy) then + if AddCxTypeEqualsTypeUndoIfFailed denv cenv.css m ty (mkFunTy g domainTy resultTy) then warning (FunctionValueUnexpected(denv, ty, m)) else let reportImplicitlyDiscardError() = @@ -1018,16 +1012,16 @@ let TranslatePartialValReprInfo tps (PrelimValReprInfo (argsData, retData)) = let TcAddNullnessToType (warn: bool) (cenv: cenv) (env: TcEnv) nullness innerTyC m = let g = cenv.g - if g.langFeatureNullness then + if g.langFeatureNullness then if TypeNullNever g innerTyC then let tyString = NicePrint.minimalStringOfType env.DisplayEnv innerTyC - errorR(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m)) + errorR(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m)) - match tryAddNullnessToTy nullness innerTyC with + match tryAddNullnessToTy nullness innerTyC with - | None -> + | None -> let tyString = NicePrint.minimalStringOfType env.DisplayEnv innerTyC - errorR(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m)) + errorR(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m)) innerTyC | Some innerTyCWithNull -> @@ -1039,7 +1033,7 @@ let TcAddNullnessToType (warn: bool) (cenv: cenv) (env: TcEnv) nullness innerTyC // wihout implying 'T is not null. This is because it is legitimate to use this // function to "collapse" null and obj-null-coming-from-option using such a function. - if not g.compilingFSharpCore || not (isTyparTy g innerTyC) then + if not g.compilingFSharpCore || not (isTyparTy g innerTyC) then AddCxTypeDefnNotSupportsNull env.DisplayEnv cenv.css m NoTrace innerTyC AddCxTypeIsReferenceType env.DisplayEnv cenv.css m NoTrace innerTyC @@ -1318,7 +1312,7 @@ let CheckRequiredProperties (g:TcGlobals) (env: TcEnv) (cenv: TcFileState) (minf let details = NicePrint.multiLineStringOfPropInfos g cenv.amap mMethExpr env.DisplayEnv missingProps errorR(Error(FSComp.SR.tcMissingRequiredMembers details, mMethExpr)) -let private HasMethodImplNoInliningAttribute g attrs = +let private HasMethodImplNoInliningAttribute g attrs = match TryFindFSharpAttribute g g.attrib_MethodImplAttribute attrs with // NO_INLINING = 8 | Some (Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> (flags &&& 0x8) <> 0x0 @@ -1366,16 +1360,16 @@ let MakeAndPublishVal (cenv: cenv) env (altActualParent, inSig, declKind, valRec let vis, _ = ComputeAccessAndCompPath g env (Some declKind) id.idRange vis overrideVis actualParent - let inlineFlag = - if HasFSharpAttributeOpt g g.attrib_DllImportAttribute attrs then - if inlineFlag = ValInline.Always then - errorR(Error(FSComp.SR.tcDllImportStubsCannotBeInlined(), m)) - ValInline.Never - else - if HasMethodImplNoInliningAttribute g attrs - then ValInline.Never - else inlineFlag - + let inlineFlag = + if HasFSharpAttributeOpt g g.attrib_DllImportAttribute attrs then + if inlineFlag = ValInline.Always then + errorR(Error(FSComp.SR.tcDllImportStubsCannotBeInlined(), m)) + ValInline.Never + else + if HasMethodImplNoInliningAttribute g attrs + then ValInline.Never + else inlineFlag + // CompiledName not allowed on virtual/abstract/override members let compiledNameAttrib = TryFindFSharpStringAttribute g g.attrib_CompiledNameAttribute attrs @@ -1693,9 +1687,9 @@ let CombineSyntacticAndInferredValReprInfo g rhsExpr prelimScheme = | _ when memberInfoOpt.IsSome -> partialValReprInfoOpt // Don't use any expression information for 'let' bindings where return attributes are present - | _ when retAttribs.Length > 0 -> + | _ when retAttribs.Length > 0 -> partialValReprInfoOpt - | Some partialValReprInfoFromSyntax -> + | Some partialValReprInfoFromSyntax -> let (PrelimValReprInfo(curriedArgInfosFromSyntax, retInfoFromSyntax)) = partialValReprInfoFromSyntax let partialArityInfo = if isMutable then @@ -1826,7 +1820,7 @@ let MakeAndPublishSimpleValsForMergedScope (cenv: cenv) env m (names: NameMap<_> // to C<_> occurs then generate C for a fresh type inference variable ?ty. //------------------------------------------------------------------------- -let FreshenTyconRef (g: TcGlobals) m rigid (tcref: TyconRef) declaredTyconTypars = +let FreshenTyconRef (g: TcGlobals) m rigid (tcref: TyconRef) declaredTyconTypars = let origTypars = declaredTyconTypars let clearStaticReq = g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers let freshTypars = copyTypars clearStaticReq origTypars @@ -1839,7 +1833,7 @@ let FreshenTyconRef (g: TcGlobals) m rigid (tcref: TyconRef) declaredTyconTypars let freshTy = TType_app(tcref, tinst, g.knownWithoutNull) origTy, freshTypars, renaming, freshTy -let FreshenPossibleForallTy g m rigid ty = +let FreshenPossibleForallTy g m rigid ty = let origTypars, tau = tryDestForallTy g ty if isNil origTypars then [], [], [], tau @@ -1849,7 +1843,7 @@ let FreshenPossibleForallTy g m rigid ty = let tps, renaming, tinst = CopyAndFixupTypars g m rigid origTypars origTypars, tps, tinst, instType renaming tau -let FreshenTyconRef2 (g: TcGlobals) m (tcref: TyconRef) = +let FreshenTyconRef2 (g: TcGlobals) m (tcref: TyconRef) = let tps, renaming, tinst = FreshenTypeInst g m (tcref.Typars m) tps, renaming, tinst, TType_app (tcref, tinst, g.knownWithoutNull) @@ -1885,9 +1879,9 @@ let FreshenAbstractSlot g amap m synTyparDecls absMethInfo = typarsFromAbsSlotAreRigid, typarsFromAbsSlot, argTysFromAbsSlot, retTyFromAbsSlot let CheckRecdExprDuplicateFields (elems: Ident list) = - elems |> List.iteri (fun i (uc1: Ident) -> - elems |> List.iteri (fun j (uc2: Ident) -> - if j > i && uc1.idText = uc2.idText then + elems |> List.iteri (fun i (uc1: Ident) -> + elems |> List.iteri (fun j (uc2: Ident) -> + if j > i && uc1.idText = uc2.idText then errorR (Error(FSComp.SR.tcMultipleFieldsInRecord(uc1.idText), uc1.idRange)))) //------------------------------------------------------------------------- @@ -2132,12 +2126,12 @@ module GeneralizationHelpers = /// Recursively knock out typars we can't generalize. /// For non-generalized type variables be careful to iteratively knock out /// both the typars and any typars free in the constraints of the typars - /// into the set that are considered free in the environment. - let rec TrimUngeneralizableTypars genConstrainedTyparFlag inlineFlag (generalizedTypars: Typar list) freeInEnv = - // Do not generalize type variables with a static requirement unless function is marked 'inline' - let generalizedTypars, ungeneralizableTypars1 = + /// into the set that are considered free in the environment. + let rec TrimUngeneralizableTypars genConstrainedTyparFlag inlineFlag (generalizedTypars: Typar list) freeInEnv = + // Do not generalize type variables with a static requirement unless function is marked 'inline' + let generalizedTypars, ungeneralizableTypars1 = if inlineFlag = ValInline.Always then generalizedTypars, [] - else generalizedTypars |> List.partition (fun tp -> tp.StaticReq = TyparStaticReq.None) + else generalizedTypars |> List.partition (fun tp -> tp.StaticReq = TyparStaticReq.None) // Do not generalize type variables which would escape their scope // because they are free in the environment @@ -2323,7 +2317,7 @@ module GeneralizationHelpers = //------------------------------------------------------------------------- let ComputeInlineFlag (memFlagsOption: SynMemberFlags option) isInline isMutable g attrs m = - let hasNoCompilerInliningAttribute () = HasFSharpAttribute g g.attrib_NoCompilerInliningAttribute attrs + let hasNoCompilerInliningAttribute () = HasFSharpAttribute g g.attrib_NoCompilerInliningAttribute attrs let isCtorOrAbstractSlot () = match memFlagsOption with @@ -2340,7 +2334,7 @@ let ComputeInlineFlag (memFlagsOption: SynMemberFlags option) isInline isMutable if isMutable || isCtorOrAbstractSlot() || hasNoCompilerInliningAttribute() || isExtern () then ValInline.Never, errorR elif HasMethodImplNoInliningAttribute g attrs then - ValInline.Never, + ValInline.Never, if g.langVersion.SupportsFeature LanguageFeature.WarningWhenInliningMethodImplNoInlineMarkedFunction then warning else ignore @@ -2349,7 +2343,7 @@ let ComputeInlineFlag (memFlagsOption: SynMemberFlags option) isInline isMutable else ValInline.Optional, ignore - if isInline && (inlineFlag <> ValInline.Always) then + if isInline && (inlineFlag <> ValInline.Always) then reportIncorrectInlineKeywordUsage (Error(FSComp.SR.tcThisValueMayNotBeInlined(), m)) inlineFlag @@ -2426,9 +2420,9 @@ type IsObjExprBinding = | ValOrMemberBinding module BindingNormalization = - /// Push a bunch of pats at once. They may contain patterns, e.g. let f (A x) (B y) = ... - /// In this case the semantics is let f a b = let A x = a in let B y = b - let private PushMultiplePatternsToRhs (cenv: cenv) isMember pats (NormalizedBindingRhs(spatsL, rtyOpt, rhsExpr)) = + /// Push a bunch of pats at once. They may contain patterns, e.g. let f (A x) (B y) = ... + /// In this case the semantics is let f a b = let A x = a in let B y = b + let private PushMultiplePatternsToRhs (cenv: cenv) isMember pats (NormalizedBindingRhs(spatsL, rtyOpt, rhsExpr)) = let spatsL2, rhsExpr = PushCurriedPatternsToExpr cenv.synArgNameGenerator rhsExpr.Range isMember pats None rhsExpr NormalizedBindingRhs(spatsL2@spatsL, rtyOpt, rhsExpr) @@ -2832,34 +2826,6 @@ let TcVal checkAttributes (cenv: cenv) env (tpenv: UnscopedTyparEnv) (vref: ValR | Some AfterResolution.DoNothing | None -> () res -/// simplified version of TcVal used in calls to BuildMethodCall (typrelns.fs) -/// this function is used on typechecking step for making calls to provided methods and on optimization step (for the same purpose). -let LightweightTcValForUsingInBuildMethodCall g (vref: ValRef) vrefFlags (vrefTypeInst: TTypes) m = - let v = vref.Deref - let vTy = vref.Type - // byref-typed values get dereferenced - if isByrefTy g vTy then - mkAddrGet m vref, destByrefTy g vTy - else - match v.LiteralValue with - | Some literalConst -> - let _, _, _, tau = FreshenPossibleForallTy g m TyparRigidity.Flexible vTy - Expr.Const (literalConst, m, tau), tau - - | None -> - // Instantiate the value - let tau = - // If we have got an explicit instantiation then use that - let _, tps, tpTys, tau = FreshenPossibleForallTy g m TyparRigidity.Flexible vTy - - if tpTys.Length <> vrefTypeInst.Length then error(Error(FSComp.SR.tcTypeParameterArityMismatch(tps.Length, vrefTypeInst.Length), m)) - - instType (mkTyparInst tps vrefTypeInst) tau - - let exprForVal = Expr.Val (vref, vrefFlags, m) - let exprForVal = mkTyAppExpr m (exprForVal, vTy) vrefTypeInst - exprForVal, tau - /// Mark points where we decide whether an expression will support automatic /// decondensation or not. type ApplicableExpr = @@ -3239,30 +3205,6 @@ let GetMethodArgs arg = unnamedCallerArgs, namedCallerArgs - -//------------------------------------------------------------------------- -// Helpers dealing with pattern match compilation -//------------------------------------------------------------------------- - -let CompilePatternForMatch (cenv: cenv) (env: TcEnv) mExpr mMatch warnOnUnused actionOnFailure (inputVal, generalizedTypars, inputExprOpt) clauses inputTy resultTy = - let g = cenv.g - let dtree, targets = CompilePattern g env.DisplayEnv cenv.amap (LightweightTcValForUsingInBuildMethodCall g) cenv.infoReader mExpr mMatch warnOnUnused actionOnFailure (inputVal, generalizedTypars, inputExprOpt) clauses inputTy resultTy - mkAndSimplifyMatch DebugPointAtBinding.NoneAtInvisible mExpr mMatch resultTy dtree targets - -/// Compile a pattern -let CompilePatternForMatchClauses (cenv: cenv) env mExpr mMatch warnOnUnused actionOnFailure inputExprOpt inputTy resultTy tclauses = - // Avoid creating a dummy in the common cases where we are about to bind a name for the expression - // CLEANUP: avoid code duplication with code further below, i.e.all callers should call CompilePatternForMatch - match tclauses with - | [MatchClause(TPat_as (pat1, PatternValBinding (asVal, GeneralizedType(generalizedTypars, _)), _), None, TTarget(vs, targetExpr, _), m2)] -> - let vs2 = ListSet.remove valEq asVal vs - let expr = CompilePatternForMatch cenv env mExpr mMatch warnOnUnused actionOnFailure (asVal, generalizedTypars, None) [MatchClause(pat1, None, TTarget(vs2, targetExpr, None), m2)] inputTy resultTy - asVal, expr - | _ -> - let matchValueTmp, _ = mkCompGenLocal mExpr "matchValue" inputTy - let expr = CompilePatternForMatch cenv env mExpr mMatch warnOnUnused actionOnFailure (matchValueTmp, [], inputExprOpt) tclauses inputTy resultTy - matchValueTmp, expr - //------------------------------------------------------------------------- // Helpers dealing with sequence expressions //------------------------------------------------------------------------- @@ -3520,9 +3462,9 @@ let EliminateInitializationGraphs | Expr.TyLambda (_, _, b, _, _) -> CheckExpr st b | Expr.Obj (_, ty, _, e, overrides, extraImpls, _) -> - // NOTE: we can't fixup recursive references inside delegates since the closure delegee of a delegate is not accessible - // from outside. Object expressions implementing interfaces can, on the other hand, be fixed up. See FSharp 1.0 bug 1469 - if isInterfaceTy g ty then + // NOTE: we can't fixup recursive references inside delegates since the closure delegee of a delegate is not accessible + // from outside. Object expressions implementing interfaces can, on the other hand, be fixed up. See FSharp 1.0 bug 1469 + if isInterfaceTy g ty then List.iter (fun (TObjExprMethod(_, _, _, _, e, _)) -> checkDelayed st e) overrides List.iter (snd >> List.iter (fun (TObjExprMethod(_, _, _, _, e, _)) -> checkDelayed st e)) extraImpls else @@ -3564,7 +3506,7 @@ let EliminateInitializationGraphs | Expr.Quote _ -> () | Expr.WitnessArg (_witnessInfo, _m) -> () - and CheckBinding st (TBind(_, e, _)) = CheckExpr st e + and CheckBinding st (TBind(_, e, _)) = CheckExpr st e and CheckDecisionTree st dt = match dt with @@ -3640,7 +3582,7 @@ let EliminateInitializationGraphs let vTy = mkLazyTy g ty let fty = mkFunTy g g.unit_ty ty - let flazy, felazy = mkCompGenLocal m v.LogicalName fty + let flazy, felazy = mkCompGenLocal m v.LogicalName fty let frhs = mkUnitDelayLambda g m e if mustHaveValReprInfo then @@ -3725,7 +3667,7 @@ let CheckAndRewriteObjectCtor g env (ctorLambdaExpr: Expr) = // = "let pat = expr in " | Expr.Let (bind, body, m, _) -> mkLetBind m bind (checkAndRewrite body) - // The constructor is a sequence "let pat = expr in " + // The constructor is a sequence "let pat = expr in " | Expr.Match (debugPoint, a, b, targets, c, d) -> let targets = targets |> Array.map (fun (TTarget(vs, body, flags)) -> TTarget(vs, checkAndRewrite body, flags)) Expr.Match (debugPoint, a, b, targets, c, d) @@ -3868,22 +3810,22 @@ let buildApp (cenv: cenv) expr resultTy arg m = type DelayedItem = /// Represents the in "item" - | DelayedTypeApp of - typeArgs: SynType list * - mTypeArgs: range * + | DelayedTypeApp of + typeArgs: SynType list * + mTypeArgs: range * mExprAndTypeArgs: range /// Represents the args in "item args", or "item.Property(args)". - | DelayedApp of - isAtomic: ExprAtomicFlag * - isSugar: bool * - synLeftExprOpt: SynExpr option * - argExpr: SynExpr * + | DelayedApp of + isAtomic: ExprAtomicFlag * + isSugar: bool * + synLeftExprOpt: SynExpr option * + argExpr: SynExpr * mFuncAndArg: range /// Represents the long identifiers in "item.Ident1", or "item.Ident1.Ident2" etc. - | DelayedDotLookup of - idents: Ident list * + | DelayedDotLookup of + idents: Ident list * range /// Represents an incomplete "item." @@ -3893,7 +3835,7 @@ type DelayedItem = | DelayedSet of SynExpr * range module DelayedItem = - let maybeAppliedArgForPreferExtensionOverProperty delayed = + let maybeAppliedArgForPreferExtensionOverProperty delayed = match delayed with | [] -> None | DelayedItem.DelayedApp(argExpr=argExpr) :: _ -> Some argExpr @@ -4081,7 +4023,7 @@ let rec TcTyparConstraint ridx (cenv: cenv) newOk checkConstraints occ (env: TcE TcSimpleTyparConstraint cenv env newOk tpenv tp m AddCxTypeUseSupportsNull | SynTypeConstraint.WhereTyparNotSupportsNull(tp, m) -> - if g.langFeatureNullness then + if g.langFeatureNullness then TcSimpleTyparConstraint cenv env newOk tpenv tp m AddCxTypeDefnNotSupportsNull else warning(Error(FSComp.SR.tcNullnessCheckingNotEnabled(), m)) @@ -4277,12 +4219,12 @@ and TcValSpec (cenv: cenv) env declKind newOk containerInfo memFlagsOpt thisTyOp if arginfos.Length > 1 then error(Error(FSComp.SR.tcInvalidPropertyType(), m)) match memberFlags.MemberKind with | SynMemberKind.PropertyGet -> - if SynInfo.HasNoArgs valSynInfo then + if SynInfo.HasNoArgs valSynInfo then let getterTy = mkFunTy g g.unit_ty declaredTy getterTy, (SynInfo.IncorporateEmptyTupledArgForPropertyGetter valSynInfo) else declaredTy, valSynInfo - | _ -> + | _ -> let setterArgTys = List.map fst (List.concat arginfos) @ [returnTy] let setterArgTy = mkRefTupledTy g setterArgTys let setterTy = mkFunTy g setterArgTy cenv.g.unit_ty @@ -4463,7 +4405,7 @@ and TcTypeOrMeasure kindOpt (cenv: cenv) newOk checkConstraints occ (iwsam: Warn | MultiDimensionArrayType (rank, elemTy, m) -> TcArrayType cenv newOk checkConstraints occ env tpenv rank elemTy m - + | SynType.App (StripParenTypes (SynType.LongIdent longId), _, args, _, _, postfix, m) -> TcLongIdentAppType kindOpt cenv newOk checkConstraints occ iwsam env tpenv longId postfix args m @@ -4510,7 +4452,7 @@ and TcTypeOrMeasure kindOpt (cenv: cenv) newOk checkConstraints occ (iwsam: Warn errorR(Error(FSComp.SR.parsInvalidLiteralInType(), m)) NewErrorType (), tpenv - | SynType.WithNull(innerTy, ambivalent, m) -> + | SynType.WithNull(innerTy, ambivalent, m) -> let innerTyC, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv innerTy let nullness = if ambivalent then KnownAmbivalentToNull else KnownWithNull let tyWithNull = TcAddNullnessToType false cenv env nullness innerTyC m @@ -4520,12 +4462,12 @@ and TcTypeOrMeasure kindOpt (cenv: cenv) newOk checkConstraints occ (iwsam: Warn TcTypeMeasurePower kindOpt cenv newOk checkConstraints occ env tpenv ty exponent m | SynType.App(arg1, _, args, _, _, postfix, m) -> - TcTypeMeasureApp kindOpt cenv newOk checkConstraints occ env tpenv arg1 args postfix m + TcTypeMeasureApp kindOpt cenv newOk checkConstraints occ env tpenv arg1 args postfix m | SynType.Paren(innerType, _) | SynType.SignatureParameter(usedType = innerType) -> TcTypeOrMeasure kindOpt cenv newOk checkConstraints occ iwsam env tpenv innerType - + | SynType.Or(range = m) -> // The inner types are expected to be collected by (|TypesForTypar|) at this point. error(Error((FSComp.SR.tcSynTypeOrInvalidInDeclaration()), m)) @@ -4625,18 +4567,18 @@ and TcTupleType kindOpt (cenv: cenv) newOk checkConstraints occ env tpenv isStru | Some TyparKind.Measure -> true | None -> args |> List.exists(function | SynTupleTypeSegment.Slash _ -> true | _ -> false) | Some _ -> false - + if isMeasure then let ms,tpenv = TcMeasuresAsTuple cenv newOk checkConstraints occ env tpenv args m TType_measure ms,tpenv else let argsR,tpenv = TcTypesAsTuple cenv newOk checkConstraints occ env tpenv args m TType_tuple(tupInfo, argsR), tpenv - + and CheckAnonRecdTypeDuplicateFields (elems: Ident array) = - elems |> Array.iteri (fun i (uc1: Ident) -> - elems |> Array.iteri (fun j (uc2: Ident) -> - if j > i && uc1.idText = uc2.idText then + elems |> Array.iteri (fun i (uc1: Ident) -> + elems |> Array.iteri (fun j (uc2: Ident) -> + if j > i && uc1.idText = uc2.idText then errorR(Error(FSComp.SR.tcAnonRecdTypeDuplicateFieldId(uc1.idText), uc1.idRange)))) and TcAnonRecdType (cenv: cenv) newOk checkConstraints occ env tpenv isStruct args m = @@ -4798,9 +4740,9 @@ and TcTypesAsTuple (cenv: cenv) newOk checkConstraints occ env tpenv (args: SynT let hasASlash = args |> List.exists(function | SynTupleTypeSegment.Slash _ -> true | _ -> false) - + if hasASlash then errorR(Error(FSComp.SR.tcUnexpectedSlashInType(), m)) - + let args : SynType list = getTypeFromTuplePath args match args with | [] -> error(InternalError("empty tuple type", m)) @@ -5165,7 +5107,7 @@ and TcPatLongIdentActivePatternCase warnOnUpper (cenv: cenv) (env: TcEnv) vFlags let (TcPatLinearEnv(tpenv, names, takenNames)) = patEnv let (APElemRef (apinfo, vref, idx, isStructRetTy)) = apref - let cenv = + let cenv = match g.checkNullness,TryFindLocalizedFSharpStringAttribute g g.attrib_WarnOnWithoutNullArgumentAttribute vref.Attribs with | true, (Some _ as warnMsg) -> {cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = warnMsg} | _ -> cenv @@ -5179,7 +5121,7 @@ and TcPatLongIdentActivePatternCase warnOnUpper (cenv: cenv) (env: TcEnv) vFlags let vExprTy = vExpr.Type let activePatArgsAsSynPats, patArg = - // only cases which return unit or unresolved type (in AP definition) compatible with unit can omit output arg + // only cases which return unit or unresolved type (in AP definition) compatible with unit can omit output arg let canOmit retTy = let couldResolveToUnit ty = tryDestTyparTy g ty @@ -5228,7 +5170,7 @@ and TcPatLongIdentActivePatternCase warnOnUpper (cenv: cenv) (env: TcEnv) vFlags if i > paramCount then sb.ToString() elif i > cutoff then sb.Append("...").ToString() else loop (i + 1) (sb.Append(" e").Append i) - + loop 1 (Text.StringBuilder()) let caseName = apinfo.ActiveTags[idx] @@ -5253,14 +5195,14 @@ and TcPatLongIdentActivePatternCase warnOnUpper (cenv: cenv) (env: TcEnv) vFlags elif apinfo.IsTotal && apinfo.ActiveTags.Length = 1 && dtys.Length >= args.Length && not args.IsEmpty then List.frontAndBack args - // active pattern cases returning unit or unknown things (in AP definition) can omit output arg + // active pattern cases returning unit or unknown things (in AP definition) can omit output arg elif paramCount = args.Length then - // only cases which return unit or unresolved type (in AP definition) can omit output arg + // only cases which return unit or unresolved type (in AP definition) can omit output arg if canOmit retTy then args, SynPat.Const(SynConst.Unit, m) else showErrMsg 1 - + // active pattern in function param (e.g. let f (|P|_|) = ...) elif tryDestTyparTy g vExprTy |> ValueOption.exists (fun typar -> not typar.IsSolved) then List.frontAndBack args @@ -5449,11 +5391,11 @@ and CheckForAdjacentListExpression (cenv: cenv) synExpr hpa isInfix delayed (arg let g = cenv.g // func (arg)[arg2] gives warning that .[ must be used. match delayed with - | DelayedApp (hpa2, isSugar2, _, arg2, _) :: _ when not isInfix && (hpa = ExprAtomicFlag.NonAtomic) && isAdjacentListExpr isSugar2 hpa2 (Some synExpr) arg2 -> + | DelayedApp (hpa2, isSugar2, _, arg2, _) :: _ when not isInfix && (hpa = ExprAtomicFlag.NonAtomic) && isAdjacentListExpr isSugar2 hpa2 (Some synExpr) arg2 -> let mWarning = unionRanges arg.Range arg2.Range - match arg with - | SynExpr.Paren _ -> + match arg with + | SynExpr.Paren _ -> if g.langVersion.SupportsFeature LanguageFeature.IndexerNotationWithoutDot then warning(Error(FSComp.SR.tcParenThenAdjacentListArgumentNeedsAdjustment(), mWarning)) elif not (g.langVersion.IsExplicitlySpecifiedAs50OrBefore()) then @@ -5466,7 +5408,7 @@ and CheckForAdjacentListExpression (cenv: cenv) synExpr hpa isInfix delayed (arg elif not (g.langVersion.IsExplicitlySpecifiedAs50OrBefore()) then informationalWarning(Error(FSComp.SR.tcListThenAdjacentListArgumentReserved(), mWarning)) - | _ -> + | _ -> if g.langVersion.SupportsFeature LanguageFeature.IndexerNotationWithoutDot then warning(Error(FSComp.SR.tcOtherThenAdjacentListArgumentNeedsAdjustment(), mWarning)) elif not (g.langVersion.IsExplicitlySpecifiedAs50OrBefore()) then @@ -5479,19 +5421,19 @@ and CheckForAdjacentListExpression (cenv: cenv) synExpr hpa isInfix delayed (arg /// method applications and other item-based syntax. and TcExprThen (cenv: cenv) overallTy env tpenv isArg synExpr delayed = let g = cenv.g - - let cachedExpression = + + let cachedExpression = env.eCachedImplicitYieldExpressions.FindAll synExpr.Range |> List.tryPick (fun (se, ty, e) -> if obj.ReferenceEquals(se, synExpr) then Some (ty, e) else None ) - + match cachedExpression with | Some (ty, expr) -> UnifyOverallType cenv env synExpr.Range overallTy ty expr, tpenv | _ -> - + match synExpr with @@ -5510,7 +5452,7 @@ and TcExprThen (cenv: cenv) overallTy env tpenv isArg synExpr delayed = // Check to see if pattern translation decided to use an alternative identifier. match altNameRefCellOpt with - | Some {contents = SynSimplePatAlternativeIdInfo.Decided altId} -> + | Some {contents = SynSimplePatAlternativeIdInfo.Decided altId} -> TcExprThen cenv overallTy env tpenv isArg (SynExpr.LongIdent (isOpt, SynLongIdent([altId], [], [None]), None, mLongId)) delayed | _ -> TcLongIdentThen cenv overallTy env tpenv longId delayed @@ -5518,7 +5460,7 @@ and TcExprThen (cenv: cenv) overallTy env tpenv isArg synExpr delayed = // f?x<-v | SynExpr.Set(SynExpr.Dynamic(e1, _, e2, _) , rhsExpr, m) -> TcExprThenSetDynamic cenv overallTy env tpenv isArg e1 e2 rhsExpr m delayed - + // f x // f(x) // hpa=true // f[x] // hpa=true @@ -5528,7 +5470,7 @@ and TcExprThen (cenv: cenv) overallTy env tpenv isArg synExpr delayed = | _ -> () TcNonControlFlowExpr env <| fun env -> - + CheckForAdjacentListExpression cenv synExpr hpa isInfix delayed arg TcExprThen cenv overallTy env tpenv false func ((DelayedApp (hpa, isInfix, Some func, arg, mFuncAndArg)) :: delayed) @@ -5594,9 +5536,9 @@ and TcExprThenSetDynamic (cenv: cenv) overallTy env tpenv isArg e1 e2 rhsExpr m and TcExprThenDynamic (cenv: cenv) overallTy env tpenv isArg e1 mQmark e2 delayed = let appExpr = - let argExpr = mkDynamicArgExpr e2 + let argExpr = mkDynamicArgExpr e2 mkSynInfix mQmark e1 "?" argExpr - + TcExprThen cenv overallTy env tpenv isArg appExpr delayed and TcExprsWithFlexes (cenv: cenv) env m tpenv flexes (argTys: TType list) (args: SynExpr list) = @@ -5628,7 +5570,7 @@ and TcExprUndelayedNoType (cenv: cenv) env tpenv synExpr = /// or '_ array') is already sufficiently pre-known, and the information in the overall type /// can be eagerly propagated into the actual type (UnifyOverallType), including pre-calculating /// any type-directed conversion. This must mean that types extracted when processing the expression are not -/// considered in determining any type-directed conversion. +/// considered in determining any type-directed conversion. /// /// Used for: /// - Array or List expressions (both computed and fixed-size), to propagate from the overall type into the array/list type @@ -5693,13 +5635,13 @@ and TcPossiblyPropagatingExprLeafThenConvert isPropagating (cenv: cenv) (overall processExpr overallTy.Commit /// Process a leaf construct where the processing of the construct is initially independent -/// of the overall type. Determine and apply additional type-directed conversions after the processing +/// of the overall type. Determine and apply additional type-directed conversions after the processing /// is complete, as the inferred type of the expression may enable a type-directed conversion. /// /// Used for: -/// - trait call +/// - trait call /// - LibraryOnlyUnionCaseFieldGet -/// - constants +/// - constants and TcNonPropagatingExprLeafThenConvert (cenv: cenv) (overallTy: OverallTy) (env: TcEnv) m processExpr = // Process the construct @@ -5722,11 +5664,11 @@ and TcAdjustExprForTypeDirectedConversions (cenv: cenv) (overallTy: OverallTy) a expr and TcNonControlFlowExpr (env: TcEnv) f = - if env.eIsControlFlow then + if env.eIsControlFlow then let envinner = { env with eIsControlFlow = false } let res, tpenv = f envinner let m = res.Range - + // If the range is associated with calls like `async.For` for computation expression syntax control-flow // desugaring then don't emit a debug point - the debug points are placed separately in CheckComputationExpressions.fs match m.NotedSourceConstruct with @@ -5795,13 +5737,13 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy.Commit, env.AccessRights) TcConstExpr cenv overallTy env m tpenv synConst | SynExpr.DotLambda (synExpr, m, trivia) -> - match env.NameEnv.eUnqualifiedItems |> Map.tryFind "_arg1" with + match env.NameEnv.eUnqualifiedItems |> Map.tryFind "_arg1" with // Compiler-generated _arg items can have more forms, the real underscore will be 1-character wide | Some (Item.Value(valRef)) when valRef.Range.StartColumn+1 = valRef.Range.EndColumn -> warning(Error(FSComp.SR.tcAmbiguousDiscardDotLambda(), trivia.UnderscoreRange)) | Some _ -> () | None -> () - + let unaryArg = mkSynId trivia.UnderscoreRange (cenv.synArgNameGenerator.New()) let svar = mkSynCompGenSimplePatVar unaryArg let pushedExpr = pushUnaryArg synExpr unaryArg @@ -6170,7 +6112,7 @@ and TcExprArrayOrList (cenv: cenv) overallTy env tpenv (isArray, args, m) = let argTy = NewInferenceType g let actualTy = if isArray then mkArrayType g argTy else mkListTy g argTy - // Propagating type directed conversion, e.g. for + // Propagating type directed conversion, e.g. for // let x : seq = [ 1; 2 ] // Consider also the case where there is no relation but an op_Implicit is enabled from List<_> to C // let x : C = [ B(); B() ] @@ -6243,7 +6185,7 @@ and TcExprWhileLoop (cenv: cenv) overallTy env tpenv (spWhile, synGuardExpr, syn let g = cenv.g UnifyTypes cenv env m overallTy.Commit g.unit_ty - let guardExpr, tpenv = + let guardExpr, tpenv = let env = { env with eIsControlFlow = false } TcExpr cenv (MustEqual g.bool_ty) env tpenv synGuardExpr @@ -6339,7 +6281,7 @@ and TcExprSequentialOrImplicitYield (cenv: cenv) overallTy env tpenv (sp, synExp match expr1 with | Expr.DebugPoint(_,e) -> e | _ -> expr1 - + env.eCachedImplicitYieldExpressions.Add(synExpr1.Range, (synExpr1, expr1Ty, cachedExpr)) try TcExpr cenv overallTy env tpenv otherExpr finally env.eCachedImplicitYieldExpressions.Remove synExpr1.Range @@ -6362,8 +6304,8 @@ and TcExprDotSet (cenv: cenv) overallTy env tpenv (synExpr1, synLongId, synExpr2 and TcExprDotNamedIndexedPropertySet (cenv: cenv) overallTy env tpenv (synExpr1, synLongId, synExpr2, expr3, mStmt) = let (SynLongIdent(longId, _, _)) = synLongId let mExprAndDotLookup = unionRanges synExpr1.Range (rangeOfLid longId) - TcExprThen cenv overallTy env tpenv false synExpr1 - [ DelayedDotLookup(longId, mExprAndDotLookup); + TcExprThen cenv overallTy env tpenv false synExpr1 + [ DelayedDotLookup(longId, mExprAndDotLookup); DelayedApp(ExprAtomicFlag.Atomic, false, None, synExpr2, mStmt) MakeDelayedSet(expr3, mStmt)] @@ -6372,7 +6314,7 @@ and TcExprLongIdentSet (cenv: cenv) overallTy env tpenv (synLongId, synExpr2, m) // Type.Items(synExpr1) <- synExpr2 and TcExprNamedIndexPropertySet (cenv: cenv) overallTy env tpenv (synLongId, synExpr1, synExpr2, mStmt) = - TcLongIdentThen cenv overallTy env tpenv synLongId + TcLongIdentThen cenv overallTy env tpenv synLongId [ DelayedApp(ExprAtomicFlag.Atomic, false, None, synExpr1, mStmt) MakeDelayedSet(synExpr2, mStmt) ] @@ -6436,29 +6378,6 @@ and TcExprILAssembly (cenv: cenv) overallTy env tpenv (ilInstrs, synTyArgs, synA UnifyTypes cenv env m overallTy.Commit returnTy mkAsmExpr (Array.toList ilInstrs, tyargs, args, retTys, m), tpenv -// Converts 'a..b' to a call to the '(..)' operator in FSharp.Core -// Converts 'a..b..c' to a call to the '(.. ..)' operator in FSharp.Core -// -// NOTE: we could eliminate these more efficiently in LowerComputedCollections.fs, since -// [| 1..4 |] -// becomes [| for i in (..) 1 4 do yield i |] -// instead of generating the array directly from the ranges -and RewriteRangeExpr synExpr = - match synExpr with - // a..b..c (parsed as (a..b)..c ) - | SynExpr.IndexRange(Some (SynExpr.IndexRange(Some synExpr1, _, Some synStepExpr, _, _, _)), _, Some synExpr2, _m1, _m2, mWhole) -> - let mWhole = mWhole.MakeSynthetic() - Some (mkSynTrifix mWhole ".. .." synExpr1 synStepExpr synExpr2) - // a..b - | SynExpr.IndexRange (Some synExpr1, mOperator, Some synExpr2, _m1, _m2, mWhole) -> - let otherExpr = - let mWhole = mWhole.MakeSynthetic() - match mkSynInfix mOperator synExpr1 ".." synExpr2 with - | SynExpr.App (a, b, c, d, _) -> SynExpr.App (a, b, c, d, mWhole) - | _ -> failwith "impossible" - Some otherExpr - | _ -> None - /// Check lambdas as a group, to catch duplicate names in patterns and TcIteratedLambdas (cenv: cenv) isFirst (env: TcEnv) overallTy takenNames tpenv e = let g = cenv.g @@ -6474,29 +6393,29 @@ and TcIteratedLambdas (cenv: cenv) isFirst (env: TcEnv) overallTy takenNames tpe let byrefs = vspecMap |> Map.map (fun _ v -> isByrefTy g v.Type, v) let envinner = if isMember then envinner else ExitFamilyRegion envinner let vspecs = vs |> List.map (fun nm -> NameMap.find nm vspecMap) - + // Match up the arginfos with the generated arguments and apply any information extracted from the attributes let envinner = - match envinner.eLambdaArgInfos with - | infos :: rest -> - if infos.Length = vspecs.Length then - (vspecs, infos) ||> List.iter2 (fun v argInfo -> + match envinner.eLambdaArgInfos with + | infos :: rest -> + if infos.Length = vspecs.Length then + (vspecs, infos) ||> List.iter2 (fun v argInfo -> v.SetArgReprInfoForDisplay (Some argInfo) let inlineIfLambda = HasFSharpAttribute g g.attrib_InlineIfLambdaAttribute argInfo.Attribs - if inlineIfLambda then + if inlineIfLambda then v.SetInlineIfLambda()) { envinner with eLambdaArgInfos = rest } | [] -> envinner - + let bodyExpr, tpenv = TcIteratedLambdas cenv false envinner (MustConvertTo (false, resultTy)) takenNames tpenv bodyExpr // See bug 5758: Non-monotonicity in inference: need to ensure that parameters are never inferred to have byref type, instead it is always declared byrefs |> Map.iter (fun _ (orig, v) -> if not orig && isByrefTy g v.Type then errorR(Error(FSComp.SR.tcParameterInferredByref v.DisplayName, v.Range))) - mkMultiLambda m vspecs (bodyExpr, resultTy), tpenv + mkMultiLambda m vspecs (bodyExpr, resultTy), tpenv - | e -> + | e -> let env = { env with eIsControlFlow = true } // Dive into the expression to check for syntax errors and suppress them if they show. conditionallySuppressErrorReporting (not isFirst && synExprContainsError e) (fun () -> @@ -6539,14 +6458,14 @@ and (|IndexArgOptionalFromEnd|) (cenv: cenv) indexArg = and DecodeIndexArg (cenv: cenv) indexArg = match indexArg with | SynExpr.IndexRange (info1, _opm, info2, m1, m2, _) -> - let info1 = - match info1 with + let info1 = + match info1 with | Some (IndexArgOptionalFromEnd cenv (expr1, isFromEnd1, _)) -> Some (expr1, isFromEnd1) - | None -> None - let info2 = - match info2 with + | None -> None + let info2 = + match info2 with | Some (IndexArgOptionalFromEnd cenv (synExpr2, isFromEnd2, _)) -> Some (synExpr2, isFromEnd2) - | None -> None + | None -> None IndexArgRange (info1, info2, m1, m2) | IndexArgOptionalFromEnd cenv (expr, isFromEnd, m) -> IndexArgItem(expr, isFromEnd, m) @@ -6555,7 +6474,7 @@ and DecodeIndexArgs (cenv: cenv) indexArgs = indexArgs |> List.map (DecodeIndexArg cenv) and (|IndexerArgs|) expr = - match expr with + match expr with | SynExpr.Tuple (false, argExprs, _, _) -> argExprs | _ -> [expr] @@ -6571,15 +6490,15 @@ and ExpandIndexArgs (cenv: cenv) (synLeftExprOpt: SynExpr option) indexArgs = let rewriteReverseExpr (rank: int) (offset: SynExpr) (range: range) = let rankExpr = SynExpr.Const(SynConst.Int32 rank, range) let sliceArgs = SynExpr.Paren(SynExpr.Tuple(false, [rankExpr; offset], [], range), range, Some range, range) - match synLeftExprOpt with - | None -> error(Error(FSComp.SR.tcInvalidUseOfReverseIndex(), range)) - | Some xsId -> + match synLeftExprOpt with + | None -> error(Error(FSComp.SR.tcInvalidUseOfReverseIndex(), range)) + | Some xsId -> mkSynApp1 (mkSynDot range range xsId (SynIdent((mkSynId (range.MakeSynthetic()) "GetReverseIndex"), None))) sliceArgs range - let mkSynSomeExpr (m: range) x = + let mkSynSomeExpr (m: range) x = let m = m.MakeSynthetic() SynExpr.App (ExprAtomicFlag.NonAtomic, false, mkSynLidGet m FSharpLib.CorePath "Some", x, m) @@ -6595,12 +6514,12 @@ and ExpandIndexArgs (cenv: cenv) (synLeftExprOpt: SynExpr option) indexArgs = [ if fromEnd then rewriteReverseExpr pos expr range else expr ] | IndexArgRange(info1, info2, range1, range2) -> [ - match info1 with + match info1 with | Some (a1, isFromEnd1) -> yield mkSynSomeExpr range1 (if isFromEnd1 then rewriteReverseExpr pos a1 range1 else a1) - | None -> + | None -> yield mkSynNoneExpr range1 - match info2 with + match info2 with | Some (a2, isFromEnd2) -> yield mkSynSomeExpr range2 (if isFromEnd2 then rewriteReverseExpr pos a2 range2 else a2) | None -> @@ -7037,7 +6956,7 @@ and FreshenObjExprAbstractSlot (cenv: cenv) (env: TcEnv) (implTy: TType) virtNam FreshenAbstractSlot g cenv.amap mBinding synTyparDecls absSlot // Work out the required type of the member - let bindingTy = mkFunTy cenv.g implTy (mkMethodTy cenv.g argTysFromAbsSlot retTyFromAbsSlot) + let bindingTy = mkFunTy cenv.g implTy (mkMethodTy cenv.g argTysFromAbsSlot retTyFromAbsSlot) Some(typarsFromAbsSlotAreRigid, typarsFromAbsSlot, bindingTy) @@ -7061,7 +6980,7 @@ and TcObjectExprBinding (cenv: cenv) (env: TcEnv) implTy tpenv (absSlotInfo, bin let logicalMethId = id let memberFlags = OverrideMemberFlags SynMemberKind.Member bindingRhs, logicalMethId, memberFlags - + | SynPat.Named (SynIdent(id,_), _, _, _), Some memberFlags -> CheckMemberFlags None NewSlotsOK OverridesOK memberFlags mBinding let bindingRhs = PushOnePatternToRhs cenv true (mkSynThisPatVar (ident (CompilerGeneratedName "this", id.idRange))) bindingRhs @@ -7344,7 +7263,7 @@ and TcConstStringExpr cenv (overallTy: OverallTy) env m tpenv (s: string) litera | _ -> false let g = cenv.g - + match isFormat g overallTy.Commit, literalType with | true, LiteralArgumentType.StaticField -> @@ -7827,10 +7746,10 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m | None -> expr expr, tpenv -and CheckAnonRecdExprDuplicateFields (elems: Ident array) = - elems |> Array.iteri (fun i (uc1: Ident) -> - elems |> Array.iteri (fun j (uc2: Ident) -> - if j > i && uc1.idText = uc2.idText then +and CheckAnonRecdExprDuplicateFields (elems: Ident array) = + elems |> Array.iteri (fun i (uc1: Ident) -> + elems |> Array.iteri (fun j (uc2: Ident) -> + if j > i && uc1.idText = uc2.idText then errorR(Error (FSComp.SR.tcAnonRecdDuplicateFieldId(uc1.idText), uc1.idRange)))) // Check '{| .... |}' @@ -8132,7 +8051,7 @@ and TcForEachExpr cenv overallTy env tpenv (seqExprOnly, isFromSource, synPat, s let valsDefinedByMatching = ListSet.remove valEq elemVar vspecs CompilePatternForMatch cenv env synEnumExpr.Range pat.Range false IgnoreWithWarning (elemVar, [], None) - [MatchClause(pat, None, TTarget(valsDefinedByMatching, bodyExpr, None), mIn)] + [MatchClause(pat, None, TTarget(valsDefinedByMatching, bodyExpr, None), mIn)] enumElemTy overallTy.Commit @@ -8164,7 +8083,7 @@ and TcForEachExpr cenv overallTy env tpenv (seqExprOnly, isFromSource, synPat, s WhileLoopForCompiledForEachExprMarker, guardExpr, mkInvisibleLet mIn elemVar currentExpr bodyExpr, mFor), - BuildDisposableCleanup cenv env mWholeExpr enumeratorVar, + BuildDisposableCleanup cenv env mWholeExpr enumeratorVar, mFor, g.unit_ty, DebugPointAtTry.No, DebugPointAtFinally.No))) let overallExpr = overallExprFixup overallExpr @@ -8195,7 +8114,7 @@ and TcQuotationExpr cenv overallTy env tpenv (_oper, raw, ast, isFromQueryExpres // We serialize the quoted expression to bytes in IlxGen after type inference etc. is complete. expr, tpenv -/// When checking sequence of function applications, +/// When checking sequence of function applications, /// type applications and dot-notation projections, first extract known /// type information from the applications. /// @@ -8276,7 +8195,7 @@ and Propagate (cenv: cenv) (overallTy: OverallTy) (env: TcEnv) tpenv (expr: Appl () else // This is the error path. The error we give depends on what's enabled. - // + // // First, 'delayed' is about to be dropped on the floor, do rudimentary checking to get name resolutions in its body RecordNameAndTypeResolutionsDelayed cenv env tpenv delayed let vName = @@ -8288,15 +8207,15 @@ and Propagate (cenv: cenv) (overallTy: OverallTy) (env: TcEnv) tpenv (expr: Appl if g.langVersion.IsExplicitlySpecifiedAs50OrBefore() then error (NotAFunctionButIndexer(denv, overallTy.Commit, vName, mExpr, mArg, false)) match vName with - | Some nm -> + | Some nm -> error(Error(FSComp.SR.tcNotAFunctionButIndexerNamedIndexingNotYetEnabled(nm, nm), mExprAndArg)) - | _ -> + | _ -> error(Error(FSComp.SR.tcNotAFunctionButIndexerIndexingNotYetEnabled(), mExprAndArg)) else match vName with - | Some nm -> + | Some nm -> error(Error(FSComp.SR.tcNotAnIndexerNamedIndexingNotYetEnabled(nm), mExprAndArg)) - | _ -> + | _ -> error(Error(FSComp.SR.tcNotAnIndexerIndexingNotYetEnabled(), mExprAndArg)) else if IsIndexerType g cenv.amap expr.Type then @@ -8500,7 +8419,7 @@ and TcNameOfExprResult (cenv: cenv) (lastIdent: Ident) m = // TcApplicationThen: Typecheck "expr x" + projections //------------------------------------------------------------------------- -// leftExpr[idx] gives a warning +// leftExpr[idx] gives a warning and isAdjacentListExpr isSugar atomicFlag (synLeftExprOpt: SynExpr option) (synArg: SynExpr) = not isSugar && if atomicFlag = ExprAtomicFlag.Atomic then @@ -8510,11 +8429,11 @@ and isAdjacentListExpr isSugar atomicFlag (synLeftExprOpt: SynExpr option) (synA | _ -> false else match synLeftExprOpt with - | Some synLeftExpr -> + | Some synLeftExpr -> match synArg with | SynExpr.ArrayOrList (false, _, _) | SynExpr.ArrayOrListComputed (false, _, _) -> - synLeftExpr.Range.IsAdjacentTo synArg.Range + synLeftExpr.Range.IsAdjacentTo synArg.Range | _ -> false | _ -> false @@ -8543,7 +8462,7 @@ and TcApplicationThen (cenv: cenv) (overallTy: OverallTy) env tpenv mExprAndArg match UnifyFunctionTypeUndoIfFailed cenv denv mLeftExpr exprTy with | ValueSome (domainTy, resultTy) -> - // atomicLeftExpr[idx] unifying as application gives a warning + // atomicLeftExpr[idx] unifying as application gives a warning if not isSugar then checkHighPrecedenceFunctionApplicationToList g [synArg] atomicFlag mExprAndArg @@ -8579,7 +8498,7 @@ and TcApplicationThen (cenv: cenv) (overallTy: OverallTy) env tpenv mExprAndArg | ApplicableExpr(expr=Expr.Val (vref, _, _)) | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [_], _)) when valRefEq g vref g.and_vref - || valRefEq g vref g.and2_vref + || valRefEq g vref g.and2_vref || valRefEq g vref g.or_vref || valRefEq g vref g.or2_vref -> { env with eIsControlFlow = true },cenv @@ -8588,7 +8507,7 @@ and TcApplicationThen (cenv: cenv) (overallTy: OverallTy) env tpenv mExprAndArg match TryFindLocalizedFSharpStringAttribute g g.attrib_WarnOnWithoutNullArgumentAttribute vref.Attribs with | Some _ as msg -> env,{ cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = msg} | None when cenv.css.WarnWhenUsingWithoutNullOnAWithNullTarget <> None -> - env, { cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = None} + env, { cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = None} | None -> env,cenv | _ -> env,cenv @@ -8603,14 +8522,14 @@ and TcApplicationThen (cenv: cenv) (overallTy: OverallTy) env tpenv mExprAndArg match synArg with // leftExpr[idx] // leftExpr[idx] <- expr2 - | SynExpr.ArrayOrListComputed(false, IndexerArgs indexArgs, m) - when - isAdjacentListExpr isSugar atomicFlag synLeftExprOpt synArg && + | SynExpr.ArrayOrListComputed(false, IndexerArgs indexArgs, m) + when + isAdjacentListExpr isSugar atomicFlag synLeftExprOpt synArg && g.langVersion.SupportsFeature LanguageFeature.IndexerNotationWithoutDot -> let expandedIndexArgs = ExpandIndexArgs cenv synLeftExprOpt indexArgs - let setInfo, delayed = - match delayed with + let setInfo, delayed = + match delayed with | DelayedSet(expr3, _) :: rest -> Some (expr3, unionRanges leftExpr.Range synArg.Range), rest | _ -> None, delayed TcIndexingThen cenv env overallTy mExprAndArg m tpenv setInfo synLeftExprOpt leftExpr.Expr exprTy expandedIndexArgs indexArgs delayed @@ -8878,7 +8797,7 @@ and TcUnionCaseOrExnCaseOrActivePatternResultItemThen (cenv: cenv) overallTy env let argName = argNamesIfFeatureEnabled |> List.tryItem i |> Option.map (fun x -> x.idText) |> Option.defaultWith (fun () -> "arg" + string i) mkCompGenLocal mItem argName ty) |> List.unzip - + let constrApp = mkConstrApp mItem args let lam = mkMultiLambda mItem vs (constrApp, tyOfExpr g constrApp) lam) @@ -9300,7 +9219,7 @@ and TcValueItemThen cenv overallTy env vref tpenv mItem afterResolution delayed and TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem afterResolution staticTyOpt delayed = let g = cenv.g let ad = env.eAccessRights - + if isNil pinfos then error (InternalError ("Unexpected error: empty property list", mItem)) @@ -9313,7 +9232,7 @@ and TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem afterResolution GetMemberApplicationArgs delayed cenv env tpenv else ExprAtomicFlag.Atomic, None, [mkSynUnit mItem], delayed, tpenv - + if not pinfo.IsStatic then error (Error (FSComp.SR.tcPropertyIsNotStatic nm, mItem)) @@ -9460,7 +9379,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela let objArgs = [objExpr] - let findFlag = + let findFlag = // 'base' calls use a different resolution strategy when finding methods // nullness checks need the overrides, since those can change nullable semantics (e.g. ToString from BCL) if (g.checkNullness && g.langFeatureNullness) || IsBaseCall objArgs then @@ -9471,7 +9390,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela // Canonicalize inference problem prior to '.' lookup on variable types if isTyparTy g objExprTy then CanonicalizePartialInferenceProblem cenv.css env.DisplayEnv mExprAndLongId (freeInTypeLeftToRight g false objExprTy) - + let maybeAppliedArgExpr = DelayedItem.maybeAppliedArgForPreferExtensionOverProperty delayed let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad env.NameEnv objExprTy longId TypeNameResolutionInfo.Default findFlag false maybeAppliedArgExpr TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed item mItem rest afterResolution @@ -9615,7 +9534,7 @@ and TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed TcTraitItemThen cenv overallTy env (Some objExpr) traitInfo tpenv mItem delayed | Item.DelegateCtor _ -> error (Error (FSComp.SR.tcConstructorsCannotBeFirstClassValues(), mItem)) - + | Item.UnionCase(info, _) -> let clashingNames = info.Tycon.MembersOfFSharpTyconSorted |> List.tryFind(fun mem -> mem.DisplayNameCore = info.DisplayNameCore) match clashingNames with @@ -9658,13 +9577,13 @@ and TcEventItemThen (cenv: cenv) overallTy env tpenv mItem mExprAndItem objDetai | _ -> () // The F# wrappers around events are null safe (impl is in FSharp.Core). Therefore, from an F# perspective, the type of the delegate can be considered Not Null. - let delTy = einfo.GetDelegateType(cenv.amap, mItem) |> replaceNullnessOfTy KnownWithoutNull + let delTy = einfo.GetDelegateType(cenv.amap, mItem) |> replaceNullnessOfTy KnownWithoutNull let (SigOfFunctionForDelegate(delInvokeMeth, delArgTys, _, _)) = GetSigOfFunctionForDelegate cenv.infoReader delTy mItem ad let objArgs = Option.toList (Option.map fst objDetails) MethInfoChecks g cenv.amap true None objArgs env.eAccessRights mItem delInvokeMeth - + CheckILEventAttributes g einfo.DeclaringTyconRef (einfo.GetCustomAttrs()) mItem |> CommitOperationResult - + // This checks for and drops the 'object' sender let argsTy = ArgsTypeOfEventInfo cenv.infoReader mItem ad einfo if not (slotSigHasVoidReturnTy (delInvokeMeth.GetSlotSig(cenv.amap, mItem))) then errorR (nonStandardEventError einfo.EventName mItem) @@ -9763,7 +9682,7 @@ and GetNewInferenceTypeForMethodArg (cenv: cenv) env tpenv x = GetNewInferenceTypeForMethodArg cenv env tpenv a | SynExpr.AddressOf (true, a, _, m) -> mkByrefTyWithInference g (GetNewInferenceTypeForMethodArg cenv env tpenv a) (NewByRefKindInferenceType g m) - | SynExpr.Lambda (body = a) + | SynExpr.Lambda (body = a) | SynExpr.DotLambda (expr = a) -> mkFunTy g (NewInferenceType g) (GetNewInferenceTypeForMethodArg cenv env tpenv a) | SynExpr.Quote (_, raw, a, _, _) -> @@ -9983,7 +9902,7 @@ and TcMethodApplication_CheckArguments callerObjArgTys ad mMethExpr - mItem + mItem tpenv = let g = cenv.g @@ -10024,7 +9943,7 @@ and TcMethodApplication_CheckArguments |> List.mapiSquared (fun i j ty -> let argName = curriedArgNamesIfFeatureEnabled |> List.tryItem i |> Option.bind (List.tryItem j) |> Option.flatten |> Option.defaultWith (fun () -> "arg" + string i + string j) mkCompGenLocal mMethExpr argName ty) - + let unnamedCurriedCallerArgs = lambdaVarsAndExprs |> List.mapSquared (fun (_, e) -> CallerArg(tyOfExpr g e, e.Range, false, e)) let namedCurriedCallerArgs = lambdaVarsAndExprs |> List.map (fun _ -> []) let lambdaVars = List.mapSquared fst lambdaVarsAndExprs @@ -10043,7 +9962,7 @@ and TcMethodApplication_CheckArguments match ExamineMethodForLambdaPropagation g mMethExpr meth ad with | Some (unnamedInfo, namedInfo) -> let calledObjArgTys = meth.CalledObjArgTys mMethExpr - if (calledObjArgTys, callerObjArgTys) ||> Seq.forall2 (fun calledTy callerTy -> + if (calledObjArgTys, callerObjArgTys) ||> Seq.forall2 (fun calledTy callerTy -> let noEagerConstraintApplication = MethInfoHasAttribute g mMethExpr g.attrib_NoEagerConstraintApplicationAttribute meth.Method // The logic associated with NoEagerConstraintApplicationAttribute is part of the @@ -10492,9 +10411,9 @@ and TcMethodArg cenv env (lambdaPropagationInfo, tpenv) (lambdaPropagationInfoFo yield info | CalledArgMatchesType (adjustedCalledArgTy, noEagerConstraintApplication) -> // If matching, we can solve 'tp1 --> tp2' but we can't transfer extra - // constraints from tp1 to tp2. + // constraints from tp1 to tp2. // - // The 'task' feature requires this fix to SRTP resolution. + // The 'task' feature requires this fix to SRTP resolution. let extraRigidTps = if noEagerConstraintApplication then Zset.ofList typarOrder (freeInTypeLeftToRight g true callerArgTy) else emptyFreeTypars if AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed env.DisplayEnv cenv.css mArg extraRigidTps adjustedCalledArgTy callerArgTy then yield info |] @@ -10646,7 +10565,7 @@ and TcMatchPattern cenv inputTy env tpenv (synPat: SynPat) (synWhenExprOpt: SynE and TcMatchClauses cenv inputTy (resultTy: OverallTy) env tpenv clauses = let mutable first = true let isFirst() = if first then first <- false; true else false - let resultList,(tpEnv,_input) = + let resultList,(tpEnv,_input) = List.mapFold (fun (unscopedTyParEnv,inputTy) -> TcMatchClause cenv inputTy resultTy env (isFirst()) unscopedTyParEnv) (tpenv,inputTy) clauses resultList,tpEnv @@ -10668,25 +10587,25 @@ and TcMatchClause cenv inputTy (resultTy: OverallTy) env isFirst tpenv synMatchC let target = TTarget(vspecs, resultExpr, None) - let inputTypeForNextPatterns= - let removeNull t = + let inputTypeForNextPatterns= + let removeNull t = let stripped = stripTyEqns cenv.g t replaceNullnessOfTy KnownWithoutNull stripped - let rec isWild (p:Pattern) = + let rec isWild (p:Pattern) = match p with | TPat_wild _ -> true | TPat_as (p,_,_) -> isWild p | TPat_disjs(patterns,_) -> patterns |> List.exists isWild | TPat_conjs(patterns,_) -> patterns |> List.forall isWild - | TPat_tuple (_,pats,_,_) -> pats |> List.forall isWild + | TPat_tuple (_,pats,_,_) -> pats |> List.forall isWild | _ -> false - let rec eliminateNull (ty:TType) (p:Pattern) = + let rec eliminateNull (ty:TType) (p:Pattern) = match p with | TPat_null _ -> removeNull ty | TPat_as (p,_,_) -> eliminateNull ty p | TPat_disjs(patterns,_) -> (ty,patterns) ||> List.fold eliminateNull - | TPat_tuple (_,pats,_,_) -> + | TPat_tuple (_,pats,_,_) -> match stripTyparEqns ty with // In a tuple of size N, if 1 elem is matched for null and N-1 are wild => subsequent clauses can strip nullness | TType_tuple(ti,tys) when tys.Length = pats.Length && (pats |> List.count (isWild >> not)) = 1 -> @@ -10696,7 +10615,7 @@ and TcMatchClause cenv inputTy (resultTy: OverallTy) env isFirst tpenv synMatchC match whenExprOpt with | None -> eliminateNull inputTy pat | _ -> inputTy - + MatchClause(pat, whenExprOpt, target, patm), (tpenv,inputTypeForNextPatterns) and TcStaticOptimizationConstraint cenv env tpenv c = @@ -10734,22 +10653,22 @@ and TcAndBuildFixedExpr (cenv: cenv) env (overallPatTy, fixedExpr, overallExprTy | [[]], retTy when isByrefTy g retTy && mInfo.IsInstance -> true | _ -> false ) - + match getPinnableReferenceMInfo with | Some mInfo -> checkLanguageFeatureAndRecover g.langVersion LanguageFeature.ExtendedFixedBindings mBinding - + let mInst = FreshenMethInfo mBinding mInfo let pinnableReference, actualRetTy = BuildPossiblyConditionalMethodCall cenv env NeverMutates mBinding false mInfo NormalValUse mInst [ fixedExpr ] [] None - + let elemTy = destByrefTy g actualRetTy UnifyTypes cenv env mBinding (mkNativePtrTy g elemTy) overallPatTy - + // For value types: // let ptr: nativeptr = // let pinned x = &(expr: 'a).GetPinnableReference() // (nativeint) x - + // For reference types: // let ptr: nativeptr = // if isNull expr then @@ -10757,12 +10676,12 @@ and TcAndBuildFixedExpr (cenv: cenv) env (overallPatTy, fixedExpr, overallExprTy // else // let pinned x = &(expr: 'a).GetPinnableReference() // (nativeint) x - + let pinnedBinding = mkCompGenLetIn mBinding "pinnedByref" actualRetTy pinnableReference (fun (v, ve) -> v.SetIsFixed() mkConvToNativeInt g ve mBinding) - + if isStructTy g overallExprTy then Some pinnedBinding else @@ -10787,7 +10706,7 @@ and TcAndBuildFixedExpr (cenv: cenv) env (overallPatTy, fixedExpr, overallExprTy | TOp.RefAddrGet _, _, _ -> true | _ -> false | _ -> false - + if not okByRef then errorR (languageFeatureError g.langVersion LanguageFeature.ExtendedFixedBindings mBinding) @@ -10803,7 +10722,7 @@ and TcAndBuildFixedExpr (cenv: cenv) env (overallPatTy, fixedExpr, overallExprTy tryBuildGetPinnableReferenceCall () else None - + match getPinnableRefCall with | Some expr -> expr | None -> @@ -10942,10 +10861,10 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt SynValData(valMf, SynValInfo(args, SynArgInfo({Attributes=rotRetSynAttrs; Range=mHead} :: attrs, opt, retId)), valId) retAttribs, valAttribs, valSynData - let isVolatile = HasFSharpAttribute g g.attrib_VolatileFieldAttribute valAttribs + let isVolatile = HasFSharpAttribute g g.attrib_VolatileFieldAttribute valAttribs let inlineFlag = ComputeInlineFlag memberFlagsOpt isInline isMutable g valAttribs mBinding - let argAttribs = + let argAttribs = spatsL |> List.map (SynInfo.InferSynArgInfoFromSimplePats >> List.map (SynInfo.AttribsOfArgData >> TcAttrs AttributeTargets.Parameter false)) // Assert the return type of an active pattern. A [] attribute may be used on a partial active pattern. @@ -10957,16 +10876,16 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt // always be used for empty branches of if/then/else and others let isZeroMethod = match declKind, pat with - | ModuleOrMemberBinding, SynPat.Named(SynIdent(id,_), _, _, _) when id.idText = "Zero" -> + | ModuleOrMemberBinding, SynPat.Named(SynIdent(id,_), _, _, _) when id.idText = "Zero" -> match memberFlagsOpt with | Some memberFlags -> match memberFlags.MemberKind with | SynMemberKind.Member -> true | _ -> false - | _ -> false + | _ -> false | _ -> false - if HasFSharpAttribute g g.attrib_DefaultValueAttribute valAttribs && not isZeroMethod then + if HasFSharpAttribute g g.attrib_DefaultValueAttribute valAttribs && not isZeroMethod then errorR(Error(FSComp.SR.tcDefaultValueAttributeRequiresVal(), mBinding)) let isThreadStatic = isThreadOrContextStatic g valAttribs @@ -11066,7 +10985,7 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt // The right-hand-side is control flow (has an implicit debug point) in any situation where we // haven't extended the debug point to include the 'let', that is, there is a debug point noted - // at the binding. + // at the binding. // // This includes // let _ = expr @@ -11074,7 +10993,7 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt // which are transformed to sequential expressions in TcLetBinding // let rhsIsControlFlow = - match pat with + match pat with | SynPat.Wild _ | SynPat.Const (SynConst.Unit, _) | SynPat.Paren (SynPat.Const (SynConst.Unit, _), _) -> true @@ -11082,7 +11001,7 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt match debugPoint with | DebugPointAtBinding.Yes _ -> false | _ -> true - + let envinner = { envinner with eLambdaArgInfos = argInfos; eIsControlFlow = rhsIsControlFlow } if isCtor then TcExprThatIsCtorBody (safeThisValOpt, safeInitInfo) cenv (MustEqual overallExprTy) envinner tpenv rhsExpr @@ -11101,14 +11020,14 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt let activePatResTys = NewInferenceTypes g apinfo.ActiveTags let _, apReturnTy = stripFunTy g apOverallTy let apRetTy = - if apinfo.IsTotal then + if apinfo.IsTotal then if isStructRetTy then errorR(Error(FSComp.SR.tcInvalidStructReturn(), mBinding)) ActivePatternReturnKind.RefTypeWrapper else if isStructRetTy || isValueOptionTy cenv.g apReturnTy then ActivePatternReturnKind.StructTypeWrapper elif isBoolTy cenv.g apReturnTy then ActivePatternReturnKind.Boolean else ActivePatternReturnKind.RefTypeWrapper - + match apRetTy with | ActivePatternReturnKind.Boolean -> checkLanguageFeatureError g.langVersion LanguageFeature.BooleanReturningAndReturnTypeDirectedPartialActivePattern mBinding @@ -11136,7 +11055,7 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt errorR(Error(FSComp.SR.tcLiteralCannotBeInline(), mBinding)) if not (isNil declaredTypars) then errorR(Error(FSComp.SR.tcLiteralCannotHaveGenericParameters(), mBinding)) - + if g.langVersion.SupportsFeature(LanguageFeature.EnforceAttributeTargets) && memberFlagsOpt.IsNone && not attrs.IsEmpty then TcAttributeTargetsOnLetBindings cenv env attrs overallPatTy overallExprTy (not declaredTypars.IsEmpty) isClassLetBinding @@ -11250,7 +11169,7 @@ and TcAttributeEx canFail (cenv: cenv) (env: TcEnv) attrTgt attrEx (synAttr: Syn let try1 n = let tyid = mkSynId tyid.idRange n let tycon = (typath @ [tyid]) - + match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad tycon TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No with | Exception err -> raze err | Result(tinstEnclosing, tcref, inst) -> success(TcTypeApp cenv NoNewTypars CheckCxs ItemOccurence.UseInAttribute env tpenv mAttr tcref tinstEnclosing [] inst) @@ -11702,14 +11621,14 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (_: Val option) (a let details = NicePrint.multiLineStringOfMethInfos cenv.infoReader m envinner.DisplayEnv slots errorR(Error(FSComp.SR.tcOverrideArityMismatch details, memberId.idRange)) [] - + match slot with | FSMeth (_, _, valRef, _) -> match valRef.TauType with // https://github.com/dotnet/fsharp/issues/15307 // check if abstract method expects tuple, give better error message | TType_fun(_,TType_fun(TType_tuple _,_,_),_) -> - if not slot.NumArgs.IsEmpty && slot.NumArgs.Head = 1 then + if not slot.NumArgs.IsEmpty && slot.NumArgs.Head = 1 then errorR(Error(FSComp.SR.tcOverrideUsesMultipleArgumentsInsteadOfTuple(), memberId.idRange)) [] else raiseGenericArityMismatch() @@ -12131,7 +12050,7 @@ and AnalyzeAndMakeAndPublishRecursiveValue let bindingAttribs = TcAttributes cenv env attrTgt bindingSynAttribs // Allocate the type inference variable for the inferred type - let ty = NewInferenceType g + let ty = NewInferenceType g let inlineFlag = ComputeInlineFlag memberFlagsOpt isInline isMutable g bindingAttribs mBinding @@ -12815,7 +12734,7 @@ let TcAndPublishValSpec (cenv: cenv, env, containerInfo: ContainerInfo, declKind | None -> None | Some valReprInfo -> Some valReprInfo.ArgNames - let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs + let checkXmlDocs = cenv.diagnosticOptions.CheckXmlDocs let xmlDoc = xmlDoc.ToXmlDoc(checkXmlDocs, paramNames) let vspec = MakeAndPublishVal cenv env (altActualParent, true, declKind, ValNotInRecScope, valscheme, attrs, xmlDoc, literalValue, false) @@ -12823,4 +12742,4 @@ let TcAndPublishValSpec (cenv: cenv, env, containerInfo: ContainerInfo, declKind assert(vspec.InlineInfo = inlineFlag) - vspec, tpenv) + vspec, tpenv) \ No newline at end of file diff --git a/src/Compiler/Checking/CheckExpressions.fsi b/src/Compiler/Checking/Expressions/CheckExpressions.fsi similarity index 97% rename from src/Compiler/Checking/CheckExpressions.fsi rename to src/Compiler/Checking/Expressions/CheckExpressions.fsi index 40ac1cd20bd..ecd72a7f47d 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fsi @@ -123,9 +123,6 @@ exception InvalidInternalsVisibleToAssemblyName of badName: string * fileName: s val TcFieldInit: range -> ILFieldInit -> Const -val LightweightTcValForUsingInBuildMethodCall: - g: TcGlobals -> vref: ValRef -> vrefFlags: ValUseFlag -> vrefTypeInst: TTypes -> m: range -> Expr * TType - /// Indicates whether a syntactic type is allowed to include new type variables /// not declared anywhere, e.g. `let f (x: 'T option) = x.Value` type ImplicitlyBoundTyparsAllowed = @@ -442,20 +439,6 @@ val ComputeAccessAndCompPath: /// Get the expression resulting from turning an expression into an enumerable value, e.g. at 'for' loops val ConvertArbitraryExprToEnumerable: cenv: TcFileState -> ty: TType -> env: TcEnv -> expr: Expr -> Expr * TType -/// Invoke pattern match compilation -val CompilePatternForMatchClauses: - cenv: TcFileState -> - env: TcEnv -> - mExpr: range -> - mMatch: range -> - warnOnUnused: bool -> - actionOnFailure: ActionOnFailure -> - inputExprOpt: Expr option -> - inputTy: TType -> - resultTy: TType -> - tclauses: MatchClause list -> - Val * Expr - /// Process recursive bindings so that initialization is through laziness and is checked. /// The bindings may be either plain 'let rec' bindings or mutually recursive nestings of modules and types. /// The functions must iterate the actual bindings and process them to the overall result. @@ -640,9 +623,8 @@ val TcExpr: val CheckTupleIsCorrectLength: g: TcGlobals -> env: TcEnv -> m: range -> tupleTy: TType -> args: 'a list -> tcArgs: (TType list -> unit) -> unit -/// Converts 'a..b' to a call to the '(..)' operator in FSharp.Core -/// Converts 'a..b..c' to a call to the '(.. ..)' operator in FSharp.Core -val RewriteRangeExpr: synExpr: SynExpr -> SynExpr option +/// Check record names and types for cases like cases like `query { for ... join(for x in f(). }` +val RecordNameAndTypeResolutions: cenv: TcFileState -> env: TcEnv -> tpenv: UnscopedTyparEnv -> expr: SynExpr -> unit /// Check a syntactic expression and convert it to a typed tree expression val TcExprOfUnknownType: @@ -872,9 +854,6 @@ val TranslateSynValInfo: /// once type parameters have been fully inferred via generalization. val TranslatePartialValReprInfo: tps: Typar list -> PrelimValReprInfo -> ValReprInfo -/// Constrain two types to be equal within this type checking context -val UnifyTypes: cenv: TcFileState -> env: TcEnv -> m: range -> expectedTy: TType -> actualTy: TType -> unit - val TcRuntimeTypeTest: isCast: bool -> isOperator: bool -> diff --git a/src/Compiler/Checking/Expressions/CheckExpressionsOps.fs b/src/Compiler/Checking/Expressions/CheckExpressionsOps.fs new file mode 100644 index 00000000000..17572c86e4f --- /dev/null +++ b/src/Compiler/Checking/Expressions/CheckExpressionsOps.fs @@ -0,0 +1,381 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.CheckExpressionsOps + +open Internal.Utilities.Library +open Internal.Utilities.Library.Extras +open FSharp.Compiler.CheckBasics +open FSharp.Compiler.ConstraintSolver +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Features +open FSharp.Compiler.NameResolution +open FSharp.Compiler.PatternMatchCompilation +open FSharp.Compiler.Text +open FSharp.Compiler.Text.Range +open FSharp.Compiler.Syntax +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeBasics +open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.SyntaxTreeOps + +let CopyAndFixupTypars g m rigid tpsorig = + FreshenAndFixupTypars g m rigid [] [] tpsorig + +let FreshenPossibleForallTy g m rigid ty = + let origTypars, tau = tryDestForallTy g ty + + if isNil origTypars then + [], [], [], tau + else + // tps may be have been equated to other tps in equi-recursive type inference and units-of-measure type inference. Normalize them here + let origTypars = NormalizeDeclaredTyparsForEquiRecursiveInference g origTypars + let tps, renaming, tinst = CopyAndFixupTypars g m rigid origTypars + origTypars, tps, tinst, instType renaming tau + +/// simplified version of TcVal used in calls to BuildMethodCall (typrelns.fs) +/// this function is used on typechecking step for making calls to provided methods and on optimization step (for the same purpose). +let LightweightTcValForUsingInBuildMethodCall g (vref: ValRef) vrefFlags (vrefTypeInst: TTypes) m = + let v = vref.Deref + let vTy = vref.Type + // byref-typed values get dereferenced + if isByrefTy g vTy then + mkAddrGet m vref, destByrefTy g vTy + else + match v.LiteralValue with + | Some literalConst -> + let _, _, _, tau = FreshenPossibleForallTy g m TyparRigidity.Flexible vTy + Expr.Const(literalConst, m, tau), tau + + | None -> + // Instantiate the value + let tau = + // If we have got an explicit instantiation then use that + let _, tps, tpTys, tau = FreshenPossibleForallTy g m TyparRigidity.Flexible vTy + + if tpTys.Length <> vrefTypeInst.Length then + error (Error(FSComp.SR.tcTypeParameterArityMismatch (tps.Length, vrefTypeInst.Length), m)) + + instType (mkTyparInst tps vrefTypeInst) tau + + let exprForVal = Expr.Val(vref, vrefFlags, m) + let exprForVal = mkTyAppExpr m (exprForVal, vTy) vrefTypeInst + exprForVal, tau + +//------------------------------------------------------------------------- +// Helpers dealing with pattern match compilation +//------------------------------------------------------------------------- + +let CompilePatternForMatch + (cenv: TcFileState) + (env: TcEnv) + mExpr + mMatch + warnOnUnused + actionOnFailure + (inputVal, generalizedTypars, inputExprOpt) + clauses + inputTy + resultTy + = + let g = cenv.g + + let dtree, targets = + CompilePattern + g + env.DisplayEnv + cenv.amap + (LightweightTcValForUsingInBuildMethodCall g) + cenv.infoReader + mExpr + mMatch + warnOnUnused + actionOnFailure + (inputVal, generalizedTypars, inputExprOpt) + clauses + inputTy + resultTy + + mkAndSimplifyMatch DebugPointAtBinding.NoneAtInvisible mExpr mMatch resultTy dtree targets + +/// Invoke pattern match compilation +let CompilePatternForMatchClauses (cenv: TcFileState) env mExpr mMatch warnOnUnused actionOnFailure inputExprOpt inputTy resultTy tclauses = + // Avoid creating a dummy in the common cases where we are about to bind a name for the expression + // CLEANUP: avoid code duplication with code further below, i.e.all callers should call CompilePatternForMatch + match tclauses with + | [ MatchClause(TPat_as(pat1, PatternValBinding(asVal, GeneralizedType(generalizedTypars, _)), _), None, TTarget(vs, targetExpr, _), m2) ] -> + let vs2 = ListSet.remove valEq asVal vs + + let expr = + CompilePatternForMatch + cenv + env + mExpr + mMatch + warnOnUnused + actionOnFailure + (asVal, generalizedTypars, None) + [ MatchClause(pat1, None, TTarget(vs2, targetExpr, None), m2) ] + inputTy + resultTy + + asVal, expr + | _ -> + let matchValueTmp, _ = mkCompGenLocal mExpr "matchValue" inputTy + + let expr = + CompilePatternForMatch + cenv + env + mExpr + mMatch + warnOnUnused + actionOnFailure + (matchValueTmp, [], inputExprOpt) + tclauses + inputTy + resultTy + + matchValueTmp, expr + +/// Constrain two types to be equal within this type checking context +let inline UnifyTypes (cenv: TcFileState) (env: TcEnv) m expectedTy actualTy = + + AddCxTypeEqualsType + env.eContextInfo + env.DisplayEnv + cenv.css + m + (tryNormalizeMeasureInType cenv.g expectedTy) + (tryNormalizeMeasureInType cenv.g actualTy) + +// Converts 'a..b' to a call to the '(..)' operator in FSharp.Core +// Converts 'a..b..c' to a call to the '(.. ..)' operator in FSharp.Core +// +// NOTE: we could eliminate these more efficiently in LowerComputedCollections.fs, since +// [| 1..4 |] +// becomes [| for i in (..) 1 4 do yield i |] +// instead of generating the array directly from the ranges +let RewriteRangeExpr synExpr = + match synExpr with + // a..b..c (parsed as (a..b)..c ) + | SynExpr.IndexRange(Some(SynExpr.IndexRange(Some synExpr1, _, Some synStepExpr, _, _, _)), _, Some synExpr2, _m1, _m2, mWhole) -> + let mWhole = mWhole.MakeSynthetic() + Some(mkSynTrifix mWhole ".. .." synExpr1 synStepExpr synExpr2) + // a..b + | SynExpr.IndexRange(Some synExpr1, mOperator, Some synExpr2, _m1, _m2, mWhole) -> + let otherExpr = + let mWhole = mWhole.MakeSynthetic() + + match mkSynInfix mOperator synExpr1 ".." synExpr2 with + | SynExpr.App(a, b, c, d, _) -> SynExpr.App(a, b, c, d, mWhole) + | _ -> failwith "impossible" + + Some otherExpr + | _ -> None + +/// Check if a computation or sequence expression is syntactically free of 'yield' (though not yield!) +let YieldFree (cenv: TcFileState) expr = + if cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield then + + // Implement yield free logic for F# Language including the LanguageFeature.ImplicitYield + let rec YieldFree expr = + match expr with + | SynExpr.Sequential(expr1 = expr1; expr2 = expr2) -> YieldFree expr1 && YieldFree expr2 + + | SynExpr.IfThenElse(thenExpr = thenExpr; elseExpr = elseExprOpt) -> YieldFree thenExpr && Option.forall YieldFree elseExprOpt + + | SynExpr.TryWith(tryExpr = body; withCases = clauses) -> + YieldFree body + && clauses |> List.forall (fun (SynMatchClause(resultExpr = res)) -> YieldFree res) + + | SynExpr.Match(clauses = clauses) + | SynExpr.MatchBang(clauses = clauses) -> clauses |> List.forall (fun (SynMatchClause(resultExpr = res)) -> YieldFree res) + + | SynExpr.For(doBody = body) + | SynExpr.TryFinally(tryExpr = body) + | SynExpr.LetOrUse(body = body) + | SynExpr.While(doExpr = body) + | SynExpr.WhileBang(doExpr = body) + | SynExpr.ForEach(bodyExpr = body) -> YieldFree body + + | SynExpr.LetOrUseBang(body = body) -> YieldFree body + + | SynExpr.YieldOrReturn(flags = (true, _)) -> false + + | _ -> true + + YieldFree expr + else + // Implement yield free logic for F# Language without the LanguageFeature.ImplicitYield + let rec YieldFree expr = + match expr with + | SynExpr.Sequential(expr1 = expr1; expr2 = expr2) -> YieldFree expr1 && YieldFree expr2 + + | SynExpr.IfThenElse(thenExpr = thenExpr; elseExpr = elseExprOpt) -> YieldFree thenExpr && Option.forall YieldFree elseExprOpt + + | SynExpr.TryWith(tryExpr = e1; withCases = clauses) -> + YieldFree e1 + && clauses |> List.forall (fun (SynMatchClause(resultExpr = res)) -> YieldFree res) + + | SynExpr.Match(clauses = clauses) + | SynExpr.MatchBang(clauses = clauses) -> clauses |> List.forall (fun (SynMatchClause(resultExpr = res)) -> YieldFree res) + + | SynExpr.For(doBody = body) + | SynExpr.TryFinally(tryExpr = body) + | SynExpr.LetOrUse(body = body) + | SynExpr.While(doExpr = body) + | SynExpr.WhileBang(doExpr = body) + | SynExpr.ForEach(bodyExpr = body) -> YieldFree body + + | SynExpr.LetOrUseBang _ + | SynExpr.YieldOrReturnFrom _ + | SynExpr.YieldOrReturn _ + | SynExpr.ImplicitZero _ + | SynExpr.Do _ -> false + + | _ -> true + + YieldFree expr + +let inline IsSimpleSemicolonSequenceElement expr cenv acceptDeprecated = + match expr with + | SynExpr.IfThenElse _ when acceptDeprecated && YieldFree cenv expr -> true + | SynExpr.IfThenElse _ + | SynExpr.TryWith _ + | SynExpr.Match _ + | SynExpr.For _ + | SynExpr.ForEach _ + | SynExpr.TryFinally _ + | SynExpr.YieldOrReturnFrom _ + | SynExpr.YieldOrReturn _ + | SynExpr.LetOrUse _ + | SynExpr.Do _ + | SynExpr.MatchBang _ + | SynExpr.LetOrUseBang _ + | SynExpr.While _ + | SynExpr.WhileBang _ -> false + | _ -> true + +[] +let rec TryGetSimpleSemicolonSequenceOfComprehension expr acc cenv acceptDeprecated = + match expr with + | SynExpr.Sequential(isTrueSeq = true; expr1 = e1; expr2 = e2) -> + if IsSimpleSemicolonSequenceElement e1 cenv acceptDeprecated then + TryGetSimpleSemicolonSequenceOfComprehension e2 (e1 :: acc) cenv acceptDeprecated + else + ValueNone + | _ -> + if IsSimpleSemicolonSequenceElement expr cenv acceptDeprecated then + ValueSome(List.rev (expr :: acc)) + else + ValueNone + +/// Determine if a syntactic expression inside 'seq { ... }' or '[...]' counts as a "simple sequence +/// of semicolon separated values". For example [1;2;3]. +/// 'acceptDeprecated' is true for the '[ ... ]' case, where we allow the syntax '[ if g then t else e ]' but ask it to be parenthesized +[] +let (|SimpleSemicolonSequence|_|) cenv acceptDeprecated cexpr = + TryGetSimpleSemicolonSequenceOfComprehension cexpr [] cenv acceptDeprecated + +let elimFastIntegerForLoop (spFor, spTo, id, start: SynExpr, dir, finish: SynExpr, innerExpr, m: range) = + let mOp = (unionRanges start.Range finish.Range).MakeSynthetic() + + let pseudoEnumExpr = + if dir then + mkSynInfix mOp start ".." finish + else + mkSynTrifix mOp ".. .." start (SynExpr.Const(SynConst.Int32 -1, mOp)) finish + + SynExpr.ForEach(spFor, spTo, SeqExprOnly false, true, mkSynPatVar None id, pseudoEnumExpr, innerExpr, m) + +let mkSeqEmpty (cenv: TcFileState) env m genTy = + // We must discover the 'zero' of the monadic algebra being generated in order to compile failing matches. + let g = cenv.g + let genResultTy = NewInferenceType g + UnifyTypes cenv env m genTy (mkSeqTy g genResultTy) + mkCallSeqEmpty g m genResultTy + +let mkSeqUsing (cenv: TcFileState) (env: TcEnv) m resourceTy genTy resourceExpr lam = + let g = cenv.g + AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace g.system_IDisposable_ty resourceTy + let genResultTy = NewInferenceType g + UnifyTypes cenv env m genTy (mkSeqTy cenv.g genResultTy) + mkCallSeqUsing cenv.g m resourceTy genResultTy resourceExpr lam + +let mkSeqAppend (cenv: TcFileState) env m genTy e1 e2 = + let g = cenv.g + let genResultTy = NewInferenceType g + UnifyTypes cenv env m genTy (mkSeqTy cenv.g genResultTy) + + let e1 = + mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g genResultTy) (tyOfExpr cenv.g e1) e1 + + let e2 = + mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g genResultTy) (tyOfExpr cenv.g e2) e2 + + mkCallSeqAppend cenv.g m genResultTy e1 e2 + +let mkSeqDelay (cenv: TcFileState) env m genTy lam = + let g = cenv.g + let genResultTy = NewInferenceType g + UnifyTypes cenv env m genTy (mkSeqTy cenv.g genResultTy) + mkCallSeqDelay cenv.g m genResultTy (mkUnitDelayLambda cenv.g m lam) + +let mkSeqCollect (cenv: TcFileState) env m enumElemTy genTy lam enumExpr = + let g = cenv.g + let genResultTy = NewInferenceType g + UnifyTypes cenv env m genTy (mkSeqTy cenv.g genResultTy) + + let enumExpr = + mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g enumElemTy) (tyOfExpr cenv.g enumExpr) enumExpr + + mkCallSeqCollect cenv.g m enumElemTy genResultTy lam enumExpr + +let mkSeqFromFunctions (cenv: TcFileState) env m genTy e1 e2 = + let g = cenv.g + let genResultTy = NewInferenceType g + UnifyTypes cenv env m genTy (mkSeqTy cenv.g genResultTy) + + let e2 = + mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g genResultTy) (tyOfExpr cenv.g e2) e2 + + mkCallSeqGenerated cenv.g m genResultTy e1 e2 + +let mkSeqFinally (cenv: TcFileState) env m genTy e1 e2 = + let g = cenv.g + let genResultTy = NewInferenceType g + UnifyTypes cenv env m genTy (mkSeqTy cenv.g genResultTy) + + let e1 = + mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g genResultTy) (tyOfExpr cenv.g e1) e1 + + mkCallSeqFinally cenv.g m genResultTy e1 e2 + +let mkSeqTryWith (cenv: TcFileState) env m genTy origSeq exnFilter exnHandler = + let g = cenv.g + let genResultTy = NewInferenceType g + UnifyTypes cenv env m genTy (mkSeqTy cenv.g genResultTy) + + let origSeq = + mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g genResultTy) (tyOfExpr cenv.g origSeq) origSeq + + mkCallSeqTryWith cenv.g m genResultTy origSeq exnFilter exnHandler + +let inline mkSeqExprMatchClauses (pat, vspecs) innerExpr = + [ MatchClause(pat, None, TTarget(vspecs, innerExpr, None), pat.Range) ] + +let compileSeqExprMatchClauses (cenv: TcFileState) env inputExprMark (pat: Pattern, vspecs) innerExpr inputExprOpt bindPatTy genInnerTy = + let patMark = pat.Range + let tclauses = mkSeqExprMatchClauses (pat, vspecs) innerExpr + + CompilePatternForMatchClauses + cenv + env + inputExprMark + patMark + false + ThrowIncompleteMatchException + inputExprOpt + bindPatTy + genInnerTy + tclauses diff --git a/src/Compiler/Checking/Expressions/CheckSequenceExpressions.fs b/src/Compiler/Checking/Expressions/CheckSequenceExpressions.fs new file mode 100644 index 00000000000..09de598b18c --- /dev/null +++ b/src/Compiler/Checking/Expressions/CheckSequenceExpressions.fs @@ -0,0 +1,468 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +/// Sequence expressions checking +module internal FSharp.Compiler.CheckSequenceExpressions + +open Internal.Utilities.Library +open FSharp.Compiler.CheckBasics +open FSharp.Compiler.CheckExpressions +open FSharp.Compiler.CheckExpressionsOps +open FSharp.Compiler.ConstraintSolver +open FSharp.Compiler.Features +open FSharp.Compiler.NameResolution +open FSharp.Compiler.PatternMatchCompilation +open FSharp.Compiler.Syntax +open FSharp.Compiler.Text +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.SyntaxTreeOps + +/// This case is used for computation expressions which are sequence expressions. Technically the code path is different because it +/// typechecks rather than doing a shallow syntactic translation, and generates calls into the Seq.* library +/// and helpers rather than to the builder methods (there is actually no builder for 'seq' in the library). +/// These are later detected by state machine compilation. +/// +/// Also "ienumerable extraction" is performed on arguments to "for". +let TcSequenceExpression (cenv: TcFileState) env tpenv comp (overallTy: OverallTy) m = + + let g = cenv.g + let genEnumElemTy = NewInferenceType g + UnifyTypes cenv env m overallTy.Commit (mkSeqTy cenv.g genEnumElemTy) + + // Allow subsumption at 'yield' if the element type is nominal prior to the analysis of the body of the sequence expression + let flex = not (isTyparTy cenv.g genEnumElemTy) + + // If there are no 'yield' in the computation expression then allow the type-directed rule + // interpreting non-unit-typed expressions in statement positions as 'yield'. 'yield!' may be + // present in the computation expression. + let enableImplicitYield = + cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield + && (YieldFree cenv comp) + + let mkSeqDelayedExpr m (coreExpr: Expr) = + let overallTy = tyOfExpr cenv.g coreExpr + mkSeqDelay cenv env m overallTy coreExpr + + let rec tryTcSequenceExprBody env genOuterTy tpenv comp = + match comp with + | SynExpr.ForEach(spFor, spIn, SeqExprOnly _seqExprOnly, _isFromSource, pat, pseudoEnumExpr, innerComp, _m) -> + let pseudoEnumExpr = + match RewriteRangeExpr pseudoEnumExpr with + | Some e -> e + | None -> pseudoEnumExpr + // This expression is not checked with the knowledge it is an IEnumerable, since we permit other enumerable types with GetEnumerator/MoveNext methods, as does C# + let pseudoEnumExpr, arbitraryTy, tpenv = + TcExprOfUnknownType cenv env tpenv pseudoEnumExpr + + let enumExpr, enumElemTy = + ConvertArbitraryExprToEnumerable cenv arbitraryTy env pseudoEnumExpr + + let patR, _, vspecs, envinner, tpenv = + TcMatchPattern cenv enumElemTy env tpenv pat None + + let innerExpr, tpenv = + let envinner = { envinner with eIsControlFlow = true } + tcSequenceExprBody envinner genOuterTy tpenv innerComp + + let enumExprRange = enumExpr.Range + + // We attach the debug point to the lambda expression so we can fetch it out again in LowerComputedListOrArraySeqExpr + let mFor = + match spFor with + | DebugPointAtFor.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.For) + | _ -> enumExprRange + + // We attach the debug point to the lambda expression so we can fetch it out again in LowerComputedListOrArraySeqExpr + let mIn = + match spIn with + | DebugPointAtInOrTo.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.InOrTo) + | _ -> pat.Range + + match patR, vspecs, innerExpr with + // Legacy peephole optimization: + // "seq { .. for x in e1 -> e2 .. }" == "e1 |> Seq.map (fun x -> e2)" + // "seq { .. for x in e1 do yield e2 .. }" == "e1 |> Seq.map (fun x -> e2)" + // + // This transformation is visible in quotations and thus needs to remain. + | (TPat_as(TPat_wild _, PatternValBinding(v, _), _), + [ _ ], + DebugPoints(Expr.App(Expr.Val(vref, _, _), _, [ genEnumElemTy ], [ yieldExpr ], _mYield), recreate)) when + valRefEq cenv.g vref cenv.g.seq_singleton_vref + -> + + // The debug point mFor is attached to the 'map' + // The debug point mIn is attached to the lambda + // Note: the 'yield' part of the debug point for 'yield expr' is currently lost in debug points. + let lam = mkLambda mIn v (recreate yieldExpr, genEnumElemTy) + + let enumExpr = + mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g enumElemTy) (tyOfExpr cenv.g enumExpr) enumExpr + + Some(mkCallSeqMap cenv.g mFor enumElemTy genEnumElemTy lam enumExpr, tpenv) + + | _ -> + // The debug point mFor is attached to the 'collect' + // The debug point mIn is attached to the lambda + let matchv, matchExpr = + compileSeqExprMatchClauses cenv env enumExprRange (patR, vspecs) innerExpr None enumElemTy genOuterTy + + let lam = mkLambda mIn matchv (matchExpr, tyOfExpr cenv.g matchExpr) + Some(mkSeqCollect cenv env mFor enumElemTy genOuterTy lam enumExpr, tpenv) + + | SynExpr.For( + forDebugPoint = spFor + toDebugPoint = spTo + ident = id + identBody = start + direction = dir + toBody = finish + doBody = innerComp + range = m) -> + Some(tcSequenceExprBody env genOuterTy tpenv (elimFastIntegerForLoop (spFor, spTo, id, start, dir, finish, innerComp, m))) + + | SynExpr.While(spWhile, guardExpr, innerComp, _m) -> + let guardExpr, tpenv = + let env = { env with eIsControlFlow = false } + TcExpr cenv (MustEqual cenv.g.bool_ty) env tpenv guardExpr + + let innerExpr, tpenv = + let env = { env with eIsControlFlow = true } + tcSequenceExprBody env genOuterTy tpenv innerComp + + let guardExprMark = guardExpr.Range + let guardLambdaExpr = mkUnitDelayLambda cenv.g guardExprMark guardExpr + + // We attach the debug point to the lambda expression so we can fetch it out again in LowerComputedListOrArraySeqExpr + let mWhile = + match spWhile with + | DebugPointAtWhile.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.While) + | _ -> guardExprMark + + let innerDelayedExpr = mkSeqDelayedExpr mWhile innerExpr + Some(mkSeqFromFunctions cenv env guardExprMark genOuterTy guardLambdaExpr innerDelayedExpr, tpenv) + + | SynExpr.TryFinally(innerComp, unwindExpr, mTryToLast, spTry, spFinally, trivia) -> + let env = { env with eIsControlFlow = true } + let innerExpr, tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp + let unwindExpr, tpenv = TcExpr cenv (MustEqual cenv.g.unit_ty) env tpenv unwindExpr + + // We attach the debug points to the lambda expressions so we can fetch it out again in LowerComputedListOrArraySeqExpr + let mTry = + match spTry with + | DebugPointAtTry.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.Try) + | _ -> trivia.TryKeyword + + let mFinally = + match spFinally with + | DebugPointAtFinally.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.Finally) + | _ -> trivia.FinallyKeyword + + let innerExpr = mkSeqDelayedExpr mTry innerExpr + let unwindExpr = mkUnitDelayLambda cenv.g mFinally unwindExpr + + Some(mkSeqFinally cenv env mTryToLast genOuterTy innerExpr unwindExpr, tpenv) + + | SynExpr.Paren(range = m) when not (cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield) -> + error (Error(FSComp.SR.tcConstructIsAmbiguousInSequenceExpression (), m)) + + | SynExpr.ImplicitZero m -> Some(mkSeqEmpty cenv env m genOuterTy, tpenv) + + | SynExpr.DoBang(_rhsExpr, m) -> error (Error(FSComp.SR.tcDoBangIllegalInSequenceExpression (), m)) + + | SynExpr.Sequential(sp, true, innerComp1, innerComp2, m, _) -> + let env1 = + { env with + eIsControlFlow = + (match sp with + | DebugPointAtSequential.SuppressNeither + | DebugPointAtSequential.SuppressExpr -> true + | _ -> false) + } + + let res, tpenv = + tcSequenceExprBodyAsSequenceOrStatement env1 genOuterTy tpenv innerComp1 + + let env2 = + { env with + eIsControlFlow = + (match sp with + | DebugPointAtSequential.SuppressNeither + | DebugPointAtSequential.SuppressStmt -> true + | _ -> false) + } + + // "expr; cexpr" is treated as sequential execution + // "cexpr; cexpr" is treated as append + match res with + | Choice1Of2 innerExpr1 -> + let innerExpr2, tpenv = tcSequenceExprBody env2 genOuterTy tpenv innerComp2 + let innerExpr2 = mkSeqDelayedExpr innerExpr2.Range innerExpr2 + Some(mkSeqAppend cenv env innerComp1.Range genOuterTy innerExpr1 innerExpr2, tpenv) + | Choice2Of2 stmt1 -> + let innerExpr2, tpenv = tcSequenceExprBody env2 genOuterTy tpenv innerComp2 + Some(Expr.Sequential(stmt1, innerExpr2, NormalSeq, m), tpenv) + + | SynExpr.IfThenElse(guardExpr, thenComp, elseCompOpt, spIfToThen, _isRecovery, mIfToEndOfElseBranch, trivia) -> + let guardExpr', tpenv = TcExpr cenv (MustEqual cenv.g.bool_ty) env tpenv guardExpr + let env = { env with eIsControlFlow = true } + let thenExpr, tpenv = tcSequenceExprBody env genOuterTy tpenv thenComp + + let elseComp = + (match elseCompOpt with + | Some c -> c + | None -> SynExpr.ImplicitZero trivia.IfToThenRange) + + let elseExpr, tpenv = tcSequenceExprBody env genOuterTy tpenv elseComp + Some(mkCond spIfToThen mIfToEndOfElseBranch genOuterTy guardExpr' thenExpr elseExpr, tpenv) + + // 'let x = expr in expr' + | SynExpr.LetOrUse(isUse = false) -> + TcLinearExprs + (fun overallTy envinner tpenv e -> tcSequenceExprBody envinner overallTy.Commit tpenv e) + cenv + env + overallTy + tpenv + true + comp + id + |> Some + + // 'use x = expr in expr' + | SynExpr.LetOrUse( + isUse = true + bindings = [ SynBinding(kind = SynBindingKind.Normal; headPat = pat; expr = rhsExpr; debugPoint = spBind) ] + body = innerComp + range = wholeExprMark) -> + + let bindPatTy = NewInferenceType g + let inputExprTy = NewInferenceType g + + let pat', _, vspecs, envinner, tpenv = + TcMatchPattern cenv bindPatTy env tpenv pat None + + UnifyTypes cenv env m inputExprTy bindPatTy + + let inputExpr, tpenv = + let env = { env with eIsControlFlow = true } + TcExpr cenv (MustEqual inputExprTy) env tpenv rhsExpr + + let innerExpr, tpenv = + let envinner = { envinner with eIsControlFlow = true } + tcSequenceExprBody envinner genOuterTy tpenv innerComp + + let mBind = + match spBind with + | DebugPointAtBinding.Yes m -> m.NoteSourceConstruct(NotedSourceConstruct.Binding) + | _ -> inputExpr.Range + + let inputExprMark = inputExpr.Range + + let matchv, matchExpr = + compileSeqExprMatchClauses cenv envinner inputExprMark (pat', vspecs) innerExpr (Some inputExpr) bindPatTy genOuterTy + + let consumeExpr = mkLambda mBind matchv (matchExpr, genOuterTy) + + // The 'mBind' is attached to the lambda + Some(mkSeqUsing cenv env wholeExprMark bindPatTy genOuterTy inputExpr consumeExpr, tpenv) + + | SynExpr.LetOrUseBang(range = m) -> error (Error(FSComp.SR.tcUseForInSequenceExpression (), m)) + + | SynExpr.Match(spMatch, expr, clauses, _m, _trivia) -> + let inputExpr, inputTy, tpenv = TcExprOfUnknownType cenv env tpenv expr + + let tclauses, tpenv = + (tpenv, clauses) + ||> List.mapFold (fun tpenv (SynMatchClause(pat, cond, innerComp, _, sp, _)) -> + let patR, condR, vspecs, envinner, tpenv = + TcMatchPattern cenv inputTy env tpenv pat cond + + let envinner = + match sp with + | DebugPointAtTarget.Yes -> { envinner with eIsControlFlow = true } + | DebugPointAtTarget.No -> envinner + + let innerExpr, tpenv = tcSequenceExprBody envinner genOuterTy tpenv innerComp + MatchClause(patR, condR, TTarget(vspecs, innerExpr, None), patR.Range), tpenv) + + let inputExprTy = tyOfExpr cenv.g inputExpr + let inputExprMark = inputExpr.Range + + let matchv, matchExpr = + CompilePatternForMatchClauses + cenv + env + inputExprMark + inputExprMark + true + ThrowIncompleteMatchException + (Some inputExpr) + inputExprTy + genOuterTy + tclauses + + Some(mkLet spMatch inputExprMark matchv inputExpr matchExpr, tpenv) + + | SynExpr.TryWith(innerTry, withList, mTryToWith, _spTry, _spWith, trivia) -> + if not (g.langVersion.SupportsFeature(LanguageFeature.TryWithInSeqExpression)) then + error (Error(FSComp.SR.tcTryIllegalInSequenceExpression (), mTryToWith)) + + let env = { env with eIsControlFlow = true } + + let tryExpr, tpenv = + let inner, tpenv = tcSequenceExprBody env genOuterTy tpenv innerTry + mkSeqDelayedExpr mTryToWith inner, tpenv + + // Compile the pattern twice, once as a filter with all succeeding targets returning "1", and once as a proper catch block. + let clauses, tpenv = + (tpenv, withList) + ||> List.mapFold (fun tpenv (SynMatchClause(pat, cond, innerComp, m, sp, _)) -> + let patR, condR, vspecs, envinner, tpenv = + TcMatchPattern cenv g.exn_ty env tpenv pat cond + + let envinner = + match sp with + | DebugPointAtTarget.Yes -> { envinner with eIsControlFlow = true } + | DebugPointAtTarget.No -> envinner + + let matchBody, tpenv = tcSequenceExprBody envinner genOuterTy tpenv innerComp + + let handlerClause = + MatchClause(patR, condR, TTarget(vspecs, matchBody, None), patR.Range) + + let filterClause = + MatchClause(patR, condR, TTarget([], Expr.Const(Const.Int32 1, m, g.int_ty), None), patR.Range) + + (handlerClause, filterClause), tpenv) + + let handlers, filterClauses = List.unzip clauses + let withRange = trivia.WithToEndRange + + let v1, filterExpr = + CompilePatternForMatchClauses cenv env withRange withRange true FailFilter None g.exn_ty g.int_ty filterClauses + + let v2, handlerExpr = + CompilePatternForMatchClauses cenv env withRange withRange true FailFilter None g.exn_ty genOuterTy handlers + + let filterLambda = mkLambda filterExpr.Range v1 (filterExpr, genOuterTy) + let handlerLambda = mkLambda handlerExpr.Range v2 (handlerExpr, genOuterTy) + + let combinatorExpr = + mkSeqTryWith cenv env mTryToWith genOuterTy tryExpr filterLambda handlerLambda + + Some(combinatorExpr, tpenv) + + | SynExpr.YieldOrReturnFrom((isYield, _), synYieldExpr, m) -> + let env = { env with eIsControlFlow = false } + let resultExpr, genExprTy, tpenv = TcExprOfUnknownType cenv env tpenv synYieldExpr + + if not isYield then + errorR (Error(FSComp.SR.tcUseYieldBangForMultipleResults (), m)) + + AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace genOuterTy genExprTy + + let resultExpr = mkCoerceExpr (resultExpr, genOuterTy, m, genExprTy) + + let resultExpr = + if IsControlFlowExpression synYieldExpr then + resultExpr + else + mkDebugPoint m resultExpr + + Some(resultExpr, tpenv) + + | SynExpr.YieldOrReturn((isYield, _), synYieldExpr, m) -> + let env = { env with eIsControlFlow = false } + let genResultTy = NewInferenceType g + + if not isYield then + errorR (Error(FSComp.SR.tcSeqResultsUseYield (), m)) + + UnifyTypes cenv env m genOuterTy (mkSeqTy cenv.g genResultTy) + + let resultExpr, tpenv = TcExprFlex cenv flex true genResultTy env tpenv synYieldExpr + + let resultExpr = mkCallSeqSingleton cenv.g m genResultTy resultExpr + + let resultExpr = + if IsControlFlowExpression synYieldExpr then + resultExpr + else + mkDebugPoint m resultExpr + + Some(resultExpr, tpenv) + + | _ -> None + + and tcSequenceExprBody env (genOuterTy: TType) tpenv comp = + let res, tpenv = tcSequenceExprBodyAsSequenceOrStatement env genOuterTy tpenv comp + + match res with + | Choice1Of2 expr -> expr, tpenv + | Choice2Of2 stmt -> + let m = comp.Range + let resExpr = Expr.Sequential(stmt, mkSeqEmpty cenv env m genOuterTy, NormalSeq, m) + resExpr, tpenv + + and tcSequenceExprBodyAsSequenceOrStatement env genOuterTy tpenv comp = + match tryTcSequenceExprBody env genOuterTy tpenv comp with + | Some(expr, tpenv) -> Choice1Of2 expr, tpenv + | None -> + + let env = + { env with + eContextInfo = ContextInfo.SequenceExpression genOuterTy + } + + if enableImplicitYield then + let hasTypeUnit, _ty, expr, tpenv = TryTcStmt cenv env tpenv comp + + if hasTypeUnit then + Choice2Of2 expr, tpenv + else + let genResultTy = NewInferenceType g + let mExpr = expr.Range + UnifyTypes cenv env mExpr genOuterTy (mkSeqTy cenv.g genResultTy) + let expr, tpenv = TcExprFlex cenv flex true genResultTy env tpenv comp + let exprTy = tyOfExpr cenv.g expr + AddCxTypeMustSubsumeType env.eContextInfo env.DisplayEnv cenv.css mExpr NoTrace genResultTy exprTy + + let resExpr = + mkCallSeqSingleton cenv.g mExpr genResultTy (mkCoerceExpr (expr, genResultTy, mExpr, exprTy)) + + Choice1Of2 resExpr, tpenv + else + let stmt, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv comp + Choice2Of2 stmt, tpenv + + let coreExpr, tpenv = tcSequenceExprBody env overallTy.Commit tpenv comp + let delayedExpr = mkSeqDelayedExpr coreExpr.Range coreExpr + delayedExpr, tpenv + +let TcSequenceExpressionEntry (cenv: TcFileState) env (overallTy: OverallTy) tpenv (hasBuilder, comp) m = + match RewriteRangeExpr comp with + | Some replacementExpr -> TcExpr cenv overallTy env tpenv replacementExpr + | None -> + + let implicitYieldEnabled = + cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield + + let validateObjectSequenceOrRecordExpression = not implicitYieldEnabled + + match comp with + | SynExpr.New _ -> + try + TcExprUndelayed cenv overallTy env tpenv comp |> ignore + with RecoverableException e -> + errorRecovery e m + + errorR (Error(FSComp.SR.tcInvalidObjectExpressionSyntaxForm (), m)) + | SimpleSemicolonSequence cenv false _ when validateObjectSequenceOrRecordExpression -> + errorR (Error(FSComp.SR.tcInvalidObjectSequenceOrRecordExpression (), m)) + | _ -> () + + if not hasBuilder && not cenv.g.compilingFSharpCore then + error (Error(FSComp.SR.tcInvalidSequenceExpressionSyntaxForm (), m)) + + TcSequenceExpression cenv env tpenv comp overallTy m diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 4c12b687a08..f182639ae1c 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -2082,14 +2082,7 @@ type AnonTypeGenerationTable() = mkILFields [ for _, fldName, fldTy in flds -> - - let access = - if cenv.options.isInteractive && cenv.options.fsiMultiAssemblyEmit then - ILMemberAccess.Public - else - ILMemberAccess.Private - - let fdef = mkILInstanceField (fldName, fldTy, None, access) + let fdef = mkILInstanceField (fldName, fldTy, None, ILMemberAccess.Private) let attrs = [ g.CompilerGeneratedAttribute; g.DebuggerBrowsableNeverAttribute ] fdef.With(customAttrs = mkILCustomAttrs attrs) ] @@ -11059,13 +11052,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option // The IL field is hidden if the property/field is hidden OR we're using a property // AND the field is not mutable (because we can take the address of a mutable field). // Otherwise fields are always accessed via their property getters/setters - // - // Additionally, don't hide fields for multiemit in F# Interactive - let isFieldHidden = - isPropHidden - || (not useGenuineField - && not isFSharpMutable - && not (cenv.options.isInteractive && cenv.options.fsiMultiAssemblyEmit)) + let isFieldHidden = isPropHidden || (not useGenuineField && not isFSharpMutable) let extraAttribs = match tyconRepr with diff --git a/src/Compiler/Driver/OptimizeInputs.fs b/src/Compiler/Driver/OptimizeInputs.fs index 85cde3b6c0e..36eae5734ce 100644 --- a/src/Compiler/Driver/OptimizeInputs.fs +++ b/src/Compiler/Driver/OptimizeInputs.fs @@ -389,7 +389,6 @@ let ApplyAllOptimizations importMap, prevFile.FirstLoopRes.OptEnv, isIncrementalFragment, - tcConfig.fsiMultiAssemblyEmit, tcConfig.emitTailcalls, prevFile.FirstLoopRes.HidingInfo, file @@ -436,7 +435,6 @@ let ApplyAllOptimizations importMap, prevFile.OptEnvExtraLoop, isIncrementalFragment, - tcConfig.fsiMultiAssemblyEmit, tcConfig.emitTailcalls, prevPhase.FirstLoopRes.HidingInfo, file @@ -507,7 +505,6 @@ let ApplyAllOptimizations importMap, prevFile.OptEnvFinalSimplify, isIncrementalFragment, - tcConfig.fsiMultiAssemblyEmit, tcConfig.emitTailcalls, prevPhase.FirstLoopRes.HidingInfo, file diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 26be4051cbd..34322176136 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -29,13 +29,11 @@ open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.CheckExpressions open FSharp.Compiler.CheckDeclarations open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports open FSharp.Compiler.CompilerOptions -open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.CreateILModule open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics @@ -47,7 +45,6 @@ open FSharp.Compiler.IO open FSharp.Compiler.ParseAndCheckInputs open FSharp.Compiler.OptimizeInputs open FSharp.Compiler.ScriptClosure -open FSharp.Compiler.Syntax open FSharp.Compiler.StaticLinking open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text @@ -55,7 +52,7 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.XmlDocFileWriter -open FSharp.Compiler.BuildGraph +open FSharp.Compiler.CheckExpressionsOps //---------------------------------------------------------------------------- // Reporting - warnings, errors diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index d7c2c590071..e015a6a86e7 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -361,12 +361,15 @@ - - + + + - - + + + + diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index c27382e0963..5904071dd8a 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -71,6 +71,7 @@ open FSharp.Compiler.Tokenization open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.BuildGraph +open FSharp.Compiler.CheckExpressionsOps //---------------------------------------------------------------------------- // For the FSI as a service methods... @@ -1861,7 +1862,12 @@ type internal FsiDynamicCompiler let asm = match opts.pdbfile, pdbBytes with - | (Some pdbfile), (Some pdbBytes) -> File.WriteAllBytes(pdbfile, pdbBytes) + | (Some pdbfile), (Some pdbBytes) -> + File.WriteAllBytes(pdbfile, pdbBytes) +#if FOR_TESTING + Directory.CreateDirectory(scriptingSymbolsPath.Value) |> ignore + File.WriteAllBytes(Path.ChangeExtension(pdbfile, ".dll"), assemblyBytes) +#endif | _ -> () match pdbBytes with diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index bc4c0829871..5140a3da043 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -4348,8 +4348,7 @@ and OptimizeModuleDefs cenv (env, bindInfosColl) defs = let defs, minfos = List.unzip defs (defs, UnionOptimizationInfos minfos), (env, bindInfosColl) -and OptimizeImplFileInternal cenv env isIncrementalFragment fsiMultiAssemblyEmit hidden implFile = - let g = cenv.g +and OptimizeImplFileInternal cenv env isIncrementalFragment hidden implFile = let (CheckedImplFile (qname, pragmas, signature, contents, hasExplicitEntryPoint, isScript, anonRecdTypes, namedDebugPointsForInlinedCode)) = implFile let env, contentsR, minfo, hidden = // FSI compiles interactive fragments as if you're typing incrementally into one module. @@ -4361,13 +4360,7 @@ and OptimizeImplFileInternal cenv env isIncrementalFragment fsiMultiAssemblyEmit // This optimizes and builds minfo ignoring the signature let (defR, minfo), (_env, _bindInfosColl) = OptimizeModuleContents cenv (env, []) contents let hidden = ComputeImplementationHidingInfoAtAssemblyBoundary defR hidden - let minfo = - // In F# interactive multi-assembly mode, no internals are accessible across interactive fragments. - // In F# interactive single-assembly mode, internals are accessible across interactive fragments. - if fsiMultiAssemblyEmit then - AbstractLazyModulInfoByHiding true hidden minfo - else - AbstractLazyModulInfoByHiding false hidden minfo + let minfo = AbstractLazyModulInfoByHiding false hidden minfo let env = BindValsInModuleOrNamespace cenv minfo env env, defR, minfo, hidden else @@ -4375,13 +4368,7 @@ and OptimizeImplFileInternal cenv env isIncrementalFragment fsiMultiAssemblyEmit let mexprR, minfo = OptimizeModuleExprWithSig cenv env signature contents let hidden = ComputeSignatureHidingInfoAtAssemblyBoundary signature hidden let minfoExternal = AbstractLazyModulInfoByHiding true hidden minfo - let env = - // In F# interactive multi-assembly mode, internals are not accessible in the 'env' used intra-assembly - // In regular fsc compilation, internals are accessible in the 'env' used intra-assembly - if g.isInteractive && fsiMultiAssemblyEmit then - BindValsInModuleOrNamespace cenv minfoExternal env - else - BindValsInModuleOrNamespace cenv minfo env + let env = BindValsInModuleOrNamespace cenv minfo env env, mexprR, minfoExternal, hidden let implFileR = CheckedImplFile (qname, pragmas, signature, contentsR, hasExplicitEntryPoint, isScript, anonRecdTypes, namedDebugPointsForInlinedCode) @@ -4389,7 +4376,7 @@ and OptimizeImplFileInternal cenv env isIncrementalFragment fsiMultiAssemblyEmit env, implFileR, minfo, hidden /// Entry point -let OptimizeImplFile (settings, ccu, tcGlobals, tcVal, importMap, optEnv, isIncrementalFragment, fsiMultiAssemblyEmit, emitTailcalls, hidden, mimpls) = +let OptimizeImplFile (settings, ccu, tcGlobals, tcVal, importMap, optEnv, isIncrementalFragment, emitTailcalls, hidden, mimpls) = let cenv = { settings=settings scope=ccu @@ -4404,7 +4391,7 @@ let OptimizeImplFile (settings, ccu, tcGlobals, tcVal, importMap, optEnv, isIncr realsig = tcGlobals.realsig } - let env, _, _, _ as results = OptimizeImplFileInternal cenv optEnv isIncrementalFragment fsiMultiAssemblyEmit hidden mimpls + let env, _, _, _ as results = OptimizeImplFileInternal cenv optEnv isIncrementalFragment hidden mimpls let optimizeDuringCodeGen disableMethodSplitting expr = let env = { env with disableMethodSplitting = env.disableMethodSplitting || disableMethodSplitting } diff --git a/src/Compiler/Optimize/Optimizer.fsi b/src/Compiler/Optimize/Optimizer.fsi index aa205b86221..17912af7598 100644 --- a/src/Compiler/Optimize/Optimizer.fsi +++ b/src/Compiler/Optimize/Optimizer.fsi @@ -85,7 +85,6 @@ val internal OptimizeImplFile: Import.ImportMap * IncrementalOptimizationEnv * isIncrementalFragment: bool * - fsiMultiAssemblyEmit: bool * emitTailcalls: bool * SignatureHidingInfo * CheckedImplFile -> diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 6d9b9133c5b..33f56b8dd80 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -20,7 +20,7 @@ open FSharp.Compiler open FSharp.Compiler.Syntax open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.CheckExpressions +open FSharp.Compiler.CheckExpressionsOps open FSharp.Compiler.CheckDeclarations open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index a01ccf0068a..33965a93f2e 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -26,6 +26,7 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypeHierarchy +open FSharp.Compiler.CheckExpressionsOps type FSharpAccessibility(a:Accessibility, ?isProtected) = let isProtected = defaultArg isProtected false @@ -58,7 +59,7 @@ type FSharpAccessibility(a:Accessibility, ?isProtected) = type SymbolEnv(g: TcGlobals, thisCcu: CcuThunk, thisCcuTyp: ModuleOrNamespaceType option, tcImports: TcImports, amap: Import.ImportMap, infoReader: InfoReader) = - let tcVal = CheckExpressions.LightweightTcValForUsingInBuildMethodCall g + let tcVal = LightweightTcValForUsingInBuildMethodCall g new(g: TcGlobals, thisCcu: CcuThunk, thisCcuTyp: ModuleOrNamespaceType option, tcImports: TcImports) = let amap = tcImports.GetImportMap() @@ -2986,4 +2987,3 @@ type FSharpOpenDeclaration(target: SynOpenDeclTarget, range: range option, modul member _.AppliedScope = appliedScope member _.IsOwnNamespace = isOwnNamespace - diff --git a/tests/FSharp.Compiler.ComponentTests/Scripting/Interactive.fs b/tests/FSharp.Compiler.ComponentTests/Scripting/Interactive.fs index 58f90304853..4fab401b9c6 100644 --- a/tests/FSharp.Compiler.ComponentTests/Scripting/Interactive.fs +++ b/tests/FSharp.Compiler.ComponentTests/Scripting/Interactive.fs @@ -3,9 +3,9 @@ namespace Scripting open Xunit + open System open FSharp.Test.Compiler -open FSharp.Compiler.Interactive.Shell open FSharp.Test.ScriptHelpers module ``Interactive tests`` = @@ -89,3 +89,38 @@ module ``External FSI tests`` = |> runFsi |> shouldSucceed + +module MultiEmit = + + [] + [] + [] + let ``FSharp record in script`` (useMultiEmit) = + + let args : string array = [| if useMultiEmit then "--multiemit+" else "--multiemit-"|] + use session = new FSharpScript(additionalArgs=args) + + let scriptIt submission = + + let result, errors = session.Eval(submission) + Assert.Empty(errors) + match result with + | Ok _ -> () + | _ -> Assert.True(false, $"Failed in line: {submission}") + + [| + """type R = { x: int }""" + """let a = { x = 7 } """ + """if a.x <> 7 then failwith $"1: Failed {a.x} <> 7" """ + """if a.x <> 7 then failwith $"2: Failed {a.x} <> 7" """ + """if a.x <> 7 then failwith $"3: Failed {a.x} <> 7" """ + """if a.x <> 7 then failwith $"4: Failed {a.x} <> 7" """ + """let b = { x = 9 }""" + """if a.x <> 7 then failwith $"5: Failed {a.x} <> 7" """ + """if b.x <> 9 then failwith $"6: Failed {b.x} <> 9" """ + """let A = {| v = 7.2 |}""" + """if A.v <> 7.2 then failwith $"7: Failed {A.v} <> 7.2" """ + """let B = {| v = 9.3 |}""" + """if A.v <> 7.2 then failwith $"8: Failed {A.v} <> 7.2" """ + """if B.v <> 9.3 then failwith $"9: Failed {A.v} <> 9.3" """ + |] |> Seq.iter(fun item -> item |> scriptIt) diff --git a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/BackgroundCompilerBenchmarks.fs b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/BackgroundCompilerBenchmarks.fs index ff67e1acabe..a49f4e39f11 100644 --- a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/BackgroundCompilerBenchmarks.fs +++ b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/BackgroundCompilerBenchmarks.fs @@ -106,7 +106,7 @@ type ParsingBenchmark() = let mutable checker: FSharpChecker = Unchecked.defaultof<_> let mutable parsingOptions: FSharpParsingOptions = Unchecked.defaultof<_> - let filePath = __SOURCE_DIRECTORY__ ++ ".." ++ ".." ++ ".." ++ ".." ++ "src" ++ "Compiler" ++ "Checking" ++ "CheckExpressions.fs" + let filePath = __SOURCE_DIRECTORY__ ++ ".." ++ ".." ++ ".." ++ ".." ++ "src" ++ "Compiler" ++ "Checking" ++ "Expressions" ++ "CheckExpressions.fs" let source = File.ReadAllText filePath |> SourceText.ofString [] diff --git a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/CompilerServiceBenchmarks.fs b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/CompilerServiceBenchmarks.fs index 44a0f9fdaaf..a3eb749868f 100644 --- a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/CompilerServiceBenchmarks.fs +++ b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/CompilerServiceBenchmarks.fs @@ -105,7 +105,7 @@ type CompilerServiceBenchmarks() = | Some _ -> configOpt | None -> let checker = FSharpChecker.Create(projectCacheSize = 200) - let path = __SOURCE_DIRECTORY__ ++ ".." ++ ".." ++ ".." ++ ".." ++ "src" ++ "Compiler" ++ "Checking" ++ "CheckExpressions.fs" + let path = __SOURCE_DIRECTORY__ ++ ".." ++ ".." ++ ".." ++ ".." ++ "src" ++ "Compiler" ++ "Checking" ++ "Expressions" ++ "CheckExpressions.fs" let source = FSharpSourceText.From(File.OpenRead(path), Encoding.Default, FSharpSourceHashAlgorithm.Sha1, true) let assemblies = AppDomain.CurrentDomain.GetAssemblies() diff --git a/tests/benchmarks/FCSBenchmarks/FCSSourceFiles/Program.fs b/tests/benchmarks/FCSBenchmarks/FCSSourceFiles/Program.fs index 7b716505156..6bbd617708c 100644 --- a/tests/benchmarks/FCSBenchmarks/FCSSourceFiles/Program.fs +++ b/tests/benchmarks/FCSBenchmarks/FCSSourceFiles/Program.fs @@ -641,10 +641,13 @@ module Project = __SOURCE_DIRECTORY__ + @"\..\..\..\..\src\Compiler\Checking\QuotationTranslator.fs" __SOURCE_DIRECTORY__ + @"\..\..\..\..\src\Compiler\Checking\PostInferenceChecks.fsi" __SOURCE_DIRECTORY__ + @"\..\..\..\..\src\Compiler\Checking\PostInferenceChecks.fs" - __SOURCE_DIRECTORY__ + @"\..\..\..\..\src\Compiler\Checking\CheckExpressions.fsi" - __SOURCE_DIRECTORY__ + @"\..\..\..\..\src\Compiler\Checking\CheckExpressions.fs" - __SOURCE_DIRECTORY__ + @"\..\..\..\..\src\Compiler\Checking\CheckComputationExpressions.fsi" - __SOURCE_DIRECTORY__ + @"\..\..\..\..\src\Compiler\Checking\CheckComputationExpressions.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\..\src\Compiler\Checking\Expressions\CheckExpressionsOps.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\..\src\Compiler\Checking\Expressions\CheckExpressions.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\..\src\Compiler\Checking\Expressions\CheckExpressions.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\..\src\Compiler\Checking\Expressions\CheckComputationExpressions.fsi" + __SOURCE_DIRECTORY__ + @"\..\..\..\..\src\Compiler\Checking\Expressions\CheckComputationExpressions.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\..\src\Compiler\Checking\Expressions\CheckSequenceExpressions.fs" + __SOURCE_DIRECTORY__ + @"\..\..\..\..\src\Compiler\Checking\Expressions\CheckArrayOrListComputedExpressions.fs" __SOURCE_DIRECTORY__ + @"\..\..\..\..\src\Compiler\Checking\CheckDeclarations.fsi" __SOURCE_DIRECTORY__ + @"\..\..\..\..\src\Compiler\Checking\CheckDeclarations.fs" __SOURCE_DIRECTORY__ + @"\..\..\..\..\src\Compiler\Optimize\Optimizer.fsi" diff --git a/tests/benchmarks/README.md b/tests/benchmarks/README.md index dc304fed2ce..288309564aa 100644 --- a/tests/benchmarks/README.md +++ b/tests/benchmarks/README.md @@ -122,7 +122,7 @@ Here are the steps for creating benchmarks: match sourceOpt with | None -> - sourceOpt <- Some <| SourceText.ofString(File.ReadAllText("""C:\Users\vlza\code\fsharp\src\Compiler\Checking\CheckExpressions.fs""")) + sourceOpt <- Some <| SourceText.ofString(File.ReadAllText("""C:\Users\vlza\code\fsharp\src\Compiler\Checking\Expressions\CheckExpressions.fs""")) | _ -> () [] @@ -196,4 +196,3 @@ Here are the steps for creating benchmarks: 8. Repeat for any number of changes you would like to test. 9. **Optionally:** benchmark code and results can be included as part of the PR for future reference. -