Skip to content

Commit 3af3d41

Browse files
dawedawedawedawe
authored
check reportErrors and feature support at top level (#16549)
1 parent f50f8e8 commit 3af3d41

File tree

1 file changed

+76
-80
lines changed

1 file changed

+76
-80
lines changed

‎src/Compiler/Checking/TailCallChecks.fs

Lines changed: 76 additions & 80 deletions
Original file line numberDiff line numberDiff line change
@@ -68,8 +68,6 @@ type cenv =
6868

6969
amap: Import.ImportMap
7070

71-
reportErrors: bool
72-
7371
/// Values in module that have been marked [<TailCall>]
7472
mustTailCall: Zset<Val>
7573
}
@@ -140,81 +138,79 @@ let rec mkArgsForAppliedExpr isBaseCall argsl x =
140138
| Expr.Op(TOp.Coerce, _, [ f ], _) -> mkArgsForAppliedExpr isBaseCall argsl f
141139
| _ -> []
142140

143-
/// Check an expression, where the expression is in a position where byrefs can be generated
144-
let rec CheckExprNoByrefs cenv (tailCall: TailCall) expr =
145-
CheckExpr cenv expr PermitByRefExpr.No tailCall
146-
147141
/// Check an expression, warn if it's attributed with TailCall but our analysis concludes it's not a valid tail call
148-
and CheckForNonTailRecCall (cenv: cenv) expr (tailCall: TailCall) =
142+
let CheckForNonTailRecCall (cenv: cenv) expr (tailCall: TailCall) =
149143
let g = cenv.g
150144
let expr = stripExpr expr
151145
let expr = stripDebugPoints expr
152146

153147
match expr with
154148
| Expr.App(f, _fty, _tyargs, argsl, m) ->
155149

156-
if cenv.reportErrors then
157-
if cenv.g.langVersion.SupportsFeature LanguageFeature.WarningWhenTailRecAttributeButNonTailRecUsage then
158-
match f with
159-
| ValUseAtApp(vref, valUseFlags) when cenv.mustTailCall.Contains vref.Deref ->
160-
161-
let canTailCall =
162-
match tailCall with
163-
| TailCall.No -> // an upper level has already decided that this is not in a tailcall position
164-
false
165-
| TailCall.Yes returnType ->
166-
if vref.IsMemberOrModuleBinding && vref.ValReprInfo.IsSome then
167-
let topValInfo = vref.ValReprInfo.Value
168-
169-
let nowArgs, laterArgs =
170-
let _, curriedArgInfos, _, _ =
171-
GetValReprTypeInFSharpForm cenv.g topValInfo vref.Type m
172-
173-
if argsl.Length >= curriedArgInfos.Length then
174-
(List.splitAfter curriedArgInfos.Length argsl)
175-
else
176-
([], argsl)
177-
178-
let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal vref.Deref
179-
180-
let _, _, _, returnTy, _ =
181-
GetValReprTypeInCompiledForm g topValInfo numEnclosingTypars vref.Type m
182-
183-
let _, _, isNewObj, isSuperInit, isSelfInit, _, _, _ =
184-
GetMemberCallInfo cenv.g (vref, valUseFlags)
185-
186-
let isCCall =
187-
match valUseFlags with
188-
| PossibleConstrainedCall _ -> true
189-
| _ -> false
190-
191-
let hasByrefArg = nowArgs |> List.exists (tyOfExpr cenv.g >> isByrefTy cenv.g)
192-
193-
let mustGenerateUnitAfterCall =
194-
(Option.isNone returnTy && returnType <> TailCallReturnType.MustReturnVoid)
195-
196-
let noTailCallBlockers =
197-
not isNewObj
198-
&& not isSuperInit
199-
&& not isSelfInit
200-
&& not mustGenerateUnitAfterCall
201-
&& isNil laterArgs
202-
&& not (IsValRefIsDllImport cenv.g vref)
203-
&& not isCCall
204-
&& not hasByrefArg
205-
206-
noTailCallBlockers // blockers that will prevent the IL level from emmiting a tail instruction
150+
match f with
151+
| ValUseAtApp(vref, valUseFlags) when cenv.mustTailCall.Contains vref.Deref ->
152+
153+
let canTailCall =
154+
match tailCall with
155+
| TailCall.No -> // an upper level has already decided that this is not in a tailcall position
156+
false
157+
| TailCall.Yes returnType ->
158+
if vref.IsMemberOrModuleBinding && vref.ValReprInfo.IsSome then
159+
let topValInfo = vref.ValReprInfo.Value
160+
161+
let nowArgs, laterArgs =
162+
let _, curriedArgInfos, _, _ =
163+
GetValReprTypeInFSharpForm cenv.g topValInfo vref.Type m
164+
165+
if argsl.Length >= curriedArgInfos.Length then
166+
(List.splitAfter curriedArgInfos.Length argsl)
207167
else
208-
true
168+
([], argsl)
209169

210-
// warn if we call inside of recursive scope in non-tail-call manner/with tail blockers. See
211-
// ``Warn successfully in match clause``
212-
// ``Warn for byref parameters``
213-
if not canTailCall then
214-
warning (Error(FSComp.SR.chkNotTailRecursive vref.DisplayName, m))
215-
| _ -> ()
170+
let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal vref.Deref
171+
172+
let _, _, _, returnTy, _ =
173+
GetValReprTypeInCompiledForm g topValInfo numEnclosingTypars vref.Type m
174+
175+
let _, _, isNewObj, isSuperInit, isSelfInit, _, _, _ =
176+
GetMemberCallInfo cenv.g (vref, valUseFlags)
177+
178+
let isCCall =
179+
match valUseFlags with
180+
| PossibleConstrainedCall _ -> true
181+
| _ -> false
182+
183+
let hasByrefArg = nowArgs |> List.exists (tyOfExpr cenv.g >> isByrefTy cenv.g)
184+
185+
let mustGenerateUnitAfterCall =
186+
(Option.isNone returnTy && returnType <> TailCallReturnType.MustReturnVoid)
187+
188+
let noTailCallBlockers =
189+
not isNewObj
190+
&& not isSuperInit
191+
&& not isSelfInit
192+
&& not mustGenerateUnitAfterCall
193+
&& isNil laterArgs
194+
&& not (IsValRefIsDllImport cenv.g vref)
195+
&& not isCCall
196+
&& not hasByrefArg
197+
198+
noTailCallBlockers // blockers that will prevent the IL level from emmiting a tail instruction
199+
else
200+
true
201+
202+
// warn if we call inside of recursive scope in non-tail-call manner/with tail blockers. See
203+
// ``Warn successfully in match clause``
204+
// ``Warn for byref parameters``
205+
if not canTailCall then
206+
warning (Error(FSComp.SR.chkNotTailRecursive vref.DisplayName, m))
207+
| _ -> ()
216208
| _ -> ()
217209

210+
/// Check an expression, where the expression is in a position where byrefs can be generated
211+
let rec CheckExprNoByrefs cenv (tailCall: TailCall) expr =
212+
CheckExpr cenv expr PermitByRefExpr.No tailCall
213+
218214
/// Check call arguments, including the return argument.
219215
and CheckCall cenv args ctxts (tailCall: TailCall) =
220216
// detect CPS-like expressions
@@ -730,10 +726,7 @@ and CheckBindings cenv binds =
730726
let CheckModuleBinding cenv (isRec: bool) (TBind _ as bind) =
731727

732728
// warn for non-rec functions which have the attribute
733-
if
734-
cenv.reportErrors
735-
&& cenv.g.langVersion.SupportsFeature LanguageFeature.WarningWhenTailCallAttrOnNonRec
736-
then
729+
if cenv.g.langVersion.SupportsFeature LanguageFeature.WarningWhenTailCallAttrOnNonRec then
737730
let isNotAFunction =
738731
match bind.Var.ValReprInfo with
739732
| Some info -> info.HasNoArgs
@@ -842,14 +835,17 @@ and CheckModuleSpec cenv isRec mbind =
842835

843836
| ModuleOrNamespaceBinding.Module(_mspec, rhs) -> CheckDefnInModule cenv rhs
844837

845-
let CheckImplFile (g, amap, reportErrors, implFileContents) =
846-
let cenv =
847-
{
848-
g = g
849-
reportErrors = reportErrors
850-
stackGuard = StackGuard(PostInferenceChecksStackGuardDepth, "CheckImplFile")
851-
amap = amap
852-
mustTailCall = Zset.empty valOrder
853-
}
854-
855-
CheckDefnInModule cenv implFileContents
838+
let CheckImplFile (g: TcGlobals, amap, reportErrors, implFileContents) =
839+
if
840+
reportErrors
841+
&& g.langVersion.SupportsFeature LanguageFeature.WarningWhenTailRecAttributeButNonTailRecUsage
842+
then
843+
let cenv =
844+
{
845+
g = g
846+
stackGuard = StackGuard(PostInferenceChecksStackGuardDepth, "CheckImplFile")
847+
amap = amap
848+
mustTailCall = Zset.empty valOrder
849+
}
850+
851+
CheckDefnInModule cenv implFileContents

0 commit comments

Comments
 (0)