Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Small refactor of TailCallChecks.fs for simplicity #16549

Merged
merged 1 commit into from
Jan 23, 2024
Merged

Small refactor of TailCallChecks.fs for simplicity #16549

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
156 changes: 76 additions & 80 deletions src/Compiler/Checking/TailCallChecks.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -68,8 +68,6 @@ type cenv =

amap: Import.ImportMap

reportErrors: bool

/// Values in module that have been marked [<TailCall>]
mustTailCall: Zset<Val>
}
Expand Down Expand Up @@ -140,81 +138,79 @@ 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

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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Loading