Skip to content

Commit

Permalink
check reportErrors and feature support at top level
Browse files Browse the repository at this point in the history
  • Loading branch information
@dawedawe
dawedawe committed Jan 18, 2024
1 parent 089fb96 commit 9adb9bc
Showing 1 changed file with 76 additions and 80 deletions.
156 changes: 76 additions & 80 deletions src/Compiler/Checking/TailCallChecks.fs
View file
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

0 comments on commit 9adb9bc

Please sign in to comment.