From 9adb9bc53db258938412373d15380ce21b3e6b90 Mon Sep 17 00:00:00 2001 From: dawe Date: Thu, 18 Jan 2024 15:27:58 +0100 Subject: [PATCH] check reportErrors and feature support at top level --- src/Compiler/Checking/TailCallChecks.fs | 156 ++++++++++++------------ 1 file changed, 76 insertions(+), 80 deletions(-) diff --git a/src/Compiler/Checking/TailCallChecks.fs b/src/Compiler/Checking/TailCallChecks.fs index 841a9c9aca5..cd8dfd2b77c 100644 --- a/src/Compiler/Checking/TailCallChecks.fs +++ b/src/Compiler/Checking/TailCallChecks.fs @@ -68,8 +68,6 @@ type cenv = amap: Import.ImportMap - reportErrors: bool - /// Values in module that have been marked [] mustTailCall: Zset } @@ -140,12 +138,8 @@ let rec mkArgsForAppliedExpr isBaseCall argsl x = | Expr.Op(TOp.Coerce, _, [ f ], _) -> mkArgsForAppliedExpr isBaseCall argsl f | _ -> [] -/// Check an expression, where the expression is in a position where byrefs can be generated -let rec CheckExprNoByrefs cenv (tailCall: TailCall) expr = - CheckExpr cenv expr PermitByRefExpr.No tailCall - /// Check an expression, warn if it's attributed with TailCall but our analysis concludes it's not a valid tail call -and CheckForNonTailRecCall (cenv: cenv) expr (tailCall: TailCall) = +let CheckForNonTailRecCall (cenv: cenv) expr (tailCall: TailCall) = let g = cenv.g let expr = stripExpr expr let expr = stripDebugPoints expr @@ -153,68 +147,70 @@ and CheckForNonTailRecCall (cenv: cenv) expr (tailCall: TailCall) = match expr with | Expr.App(f, _fty, _tyargs, argsl, m) -> - if cenv.reportErrors then - if cenv.g.langVersion.SupportsFeature LanguageFeature.WarningWhenTailRecAttributeButNonTailRecUsage then - match f with - | ValUseAtApp(vref, valUseFlags) when cenv.mustTailCall.Contains vref.Deref -> - - let canTailCall = - match tailCall with - | TailCall.No -> // an upper level has already decided that this is not in a tailcall position - false - | TailCall.Yes returnType -> - if vref.IsMemberOrModuleBinding && vref.ValReprInfo.IsSome then - let topValInfo = vref.ValReprInfo.Value - - let nowArgs, laterArgs = - let _, curriedArgInfos, _, _ = - GetValReprTypeInFSharpForm cenv.g topValInfo vref.Type m - - if argsl.Length >= curriedArgInfos.Length then - (List.splitAfter curriedArgInfos.Length argsl) - else - ([], argsl) - - let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal vref.Deref - - let _, _, _, returnTy, _ = - GetValReprTypeInCompiledForm g topValInfo numEnclosingTypars vref.Type m - - let _, _, isNewObj, isSuperInit, isSelfInit, _, _, _ = - GetMemberCallInfo cenv.g (vref, valUseFlags) - - let isCCall = - match valUseFlags with - | PossibleConstrainedCall _ -> true - | _ -> false - - let hasByrefArg = nowArgs |> List.exists (tyOfExpr cenv.g >> isByrefTy cenv.g) - - let mustGenerateUnitAfterCall = - (Option.isNone returnTy && returnType <> TailCallReturnType.MustReturnVoid) - - let noTailCallBlockers = - not isNewObj - && not isSuperInit - && not isSelfInit - && not mustGenerateUnitAfterCall - && isNil laterArgs - && not (IsValRefIsDllImport cenv.g vref) - && not isCCall - && not hasByrefArg - - noTailCallBlockers // blockers that will prevent the IL level from emmiting a tail instruction + match f with + | ValUseAtApp(vref, valUseFlags) when cenv.mustTailCall.Contains vref.Deref -> + + let canTailCall = + match tailCall with + | TailCall.No -> // an upper level has already decided that this is not in a tailcall position + false + | TailCall.Yes returnType -> + if vref.IsMemberOrModuleBinding && vref.ValReprInfo.IsSome then + let topValInfo = vref.ValReprInfo.Value + + let nowArgs, laterArgs = + let _, curriedArgInfos, _, _ = + GetValReprTypeInFSharpForm cenv.g topValInfo vref.Type m + + if argsl.Length >= curriedArgInfos.Length then + (List.splitAfter curriedArgInfos.Length argsl) else - true + ([], argsl) - // warn if we call inside of recursive scope in non-tail-call manner/with tail blockers. See - // ``Warn successfully in match clause`` - // ``Warn for byref parameters`` - if not canTailCall then - warning (Error(FSComp.SR.chkNotTailRecursive vref.DisplayName, m)) - | _ -> () + let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal vref.Deref + + let _, _, _, returnTy, _ = + GetValReprTypeInCompiledForm g topValInfo numEnclosingTypars vref.Type m + + let _, _, isNewObj, isSuperInit, isSelfInit, _, _, _ = + GetMemberCallInfo cenv.g (vref, valUseFlags) + + let isCCall = + match valUseFlags with + | PossibleConstrainedCall _ -> true + | _ -> false + + let hasByrefArg = nowArgs |> List.exists (tyOfExpr cenv.g >> isByrefTy cenv.g) + + let mustGenerateUnitAfterCall = + (Option.isNone returnTy && returnType <> TailCallReturnType.MustReturnVoid) + + let noTailCallBlockers = + not isNewObj + && not isSuperInit + && not isSelfInit + && not mustGenerateUnitAfterCall + && isNil laterArgs + && not (IsValRefIsDllImport cenv.g vref) + && not isCCall + && not hasByrefArg + + noTailCallBlockers // blockers that will prevent the IL level from emmiting a tail instruction + else + true + + // warn if we call inside of recursive scope in non-tail-call manner/with tail blockers. See + // ``Warn successfully in match clause`` + // ``Warn for byref parameters`` + if not canTailCall then + warning (Error(FSComp.SR.chkNotTailRecursive vref.DisplayName, m)) + | _ -> () | _ -> () +/// Check an expression, where the expression is in a position where byrefs can be generated +let rec CheckExprNoByrefs cenv (tailCall: TailCall) expr = + CheckExpr cenv expr PermitByRefExpr.No tailCall + /// Check call arguments, including the return argument. and CheckCall cenv args ctxts (tailCall: TailCall) = // detect CPS-like expressions @@ -730,10 +726,7 @@ and CheckBindings cenv binds = let CheckModuleBinding cenv (isRec: bool) (TBind _ as bind) = // warn for non-rec functions which have the attribute - if - cenv.reportErrors - && cenv.g.langVersion.SupportsFeature LanguageFeature.WarningWhenTailCallAttrOnNonRec - then + if cenv.g.langVersion.SupportsFeature LanguageFeature.WarningWhenTailCallAttrOnNonRec then let isNotAFunction = match bind.Var.ValReprInfo with | Some info -> info.HasNoArgs @@ -842,14 +835,17 @@ and CheckModuleSpec cenv isRec mbind = | ModuleOrNamespaceBinding.Module(_mspec, rhs) -> CheckDefnInModule cenv rhs -let CheckImplFile (g, amap, reportErrors, implFileContents) = - let cenv = - { - g = g - reportErrors = reportErrors - stackGuard = StackGuard(PostInferenceChecksStackGuardDepth, "CheckImplFile") - amap = amap - mustTailCall = Zset.empty valOrder - } - - CheckDefnInModule cenv implFileContents +let CheckImplFile (g: TcGlobals, amap, reportErrors, implFileContents) = + if + reportErrors + && g.langVersion.SupportsFeature LanguageFeature.WarningWhenTailRecAttributeButNonTailRecUsage + then + let cenv = + { + g = g + stackGuard = StackGuard(PostInferenceChecksStackGuardDepth, "CheckImplFile") + amap = amap + mustTailCall = Zset.empty valOrder + } + + CheckDefnInModule cenv implFileContents