From ddf057baf538f20bb8d5bd30bd0815594492b860 Mon Sep 17 00:00:00 2001 From: dawe Date: Wed, 24 Jan 2024 11:17:56 +0100 Subject: [PATCH] Remove superfluous rec keywords and untangle some functions (#16544) * remove some superfluous rec keywords and untangle two functions that aren't mutually recursive. --- src/Compiler/Checking/CheckExpressions.fs | 2 +- src/Compiler/CodeGen/IlxGen.fs | 4 +- src/Compiler/Optimize/Optimizer.fs | 8 +-- src/Compiler/TypedTree/TypedTreeOps.fs | 71 ++++++++++++----------- 4 files changed, 43 insertions(+), 42 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index d72e8324300..2cac6dfbec3 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1895,7 +1895,7 @@ let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * ' | _ -> error(Error(FSComp.SR.tcRecordFieldInconsistentTypes(), m))) Some(tinst, tcref, fldsmap, List.rev rfldsList) -let rec ApplyUnionCaseOrExn (makerForUnionCase, makerForExnTag) m (cenv: cenv) env overallTy item = +let ApplyUnionCaseOrExn (makerForUnionCase, makerForExnTag) m (cenv: cenv) env overallTy item = let g = cenv.g let ad = env.eAccessRights match item with diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index d1d3c9f85c8..e301813edae 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -92,7 +92,7 @@ let ChooseParamNames fieldNamesAndTypes = ilParamName, ilFieldName, ilPropType) /// Approximation for purposes of optimization and giving a warning when compiling definition-only files as EXEs -let rec CheckCodeDoesSomething (code: ILCode) = +let CheckCodeDoesSomething (code: ILCode) = code.Instrs |> Array.exists (function | AI_ldnull @@ -476,7 +476,7 @@ let CompLocForPrivateImplementationDetails cloc = } /// Compute an ILTypeRef for a CompilationLocation -let rec TypeRefForCompLoc cloc = +let TypeRefForCompLoc cloc = match cloc.Enclosing with | [] -> mkILTyRef (cloc.Scope, TypeNameForPrivateImplementationDetails cloc) | [ h ] -> diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index 73ed2972ea0..aa2211d3ed8 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -1457,11 +1457,11 @@ let AbstractExprInfoByVars (boundVars: Val list, boundTyVars) ivalue = | UnknownValue -> ivalue | SizeValue (_vdepth, vinfo) -> MakeSizedValueInfo (abstractExprInfo vinfo) - and abstractValInfo v = + let abstractValInfo v = { ValExprInfo=abstractExprInfo v.ValExprInfo ValMakesNoCriticalTailcalls=v.ValMakesNoCriticalTailcalls } - and abstractModulInfo ss = + let rec abstractModulInfo ss = { ModuleOrNamespaceInfos = ss.ModuleOrNamespaceInfos |> NameMap.map (InterruptibleLazy.force >> abstractModulInfo >> notlazy) ValInfos = ss.ValInfos.Map (fun (vref, e) -> check vref (abstractValInfo e) ) } @@ -1592,7 +1592,7 @@ let ValueIsUsedOrHasEffect cenv fvs (b: Binding, binfo) = // No discarding for things that are used Zset.contains v (fvs()) -let rec SplitValuesByIsUsedOrHasEffect cenv fvs x = +let SplitValuesByIsUsedOrHasEffect cenv fvs x = x |> List.filter (ValueIsUsedOrHasEffect cenv fvs) |> List.unzip let IlAssemblyCodeInstrHasEffect i = @@ -2016,7 +2016,7 @@ let TryRewriteBranchingTupleBinding g (v: Val) rhs tgtSeqPtOpt body m = mkLetsBind m binds rhsAndTupleBinding |> Some | _ -> None -let rec ExpandStructuralBinding cenv expr = +let ExpandStructuralBinding cenv expr = let g = cenv.g assert cenv.settings.ExpandStructuralValues() diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 8616a7e43fa..7beb639a2ee 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3597,7 +3597,7 @@ let isSpanTyconRef g m tcref = let isSpanTy g m ty = ty |> stripTyEqns g |> (function TType_app(tcref, _, _) -> isSpanTyconRef g m tcref | _ -> false) -let rec tryDestSpanTy g m ty = +let tryDestSpanTy g m ty = match tryAppTy g ty with | ValueSome(tcref, [ty]) when isSpanTyconRef g m tcref -> Some(tcref, ty) | _ -> None @@ -4626,11 +4626,11 @@ module DebugPrint = let body = moduleOrNamespaceTypeL ms.ModuleOrNamespaceType (header @@-- body) @@ footer - let rec implFilesL implFiles = - aboveListL (List.map implFileL implFiles) - - and implFileL (CheckedImplFile (signature=implFileTy; contents=implFileContents)) = + let implFileL (CheckedImplFile (signature=implFileTy; contents=implFileContents)) = aboveListL [(wordL(tagText "top implementation ")) @@-- mexprL implFileTy implFileContents] + + let implFilesL implFiles = + aboveListL (List.map implFileL implFiles) let showType x = showL (typeL x) @@ -5097,6 +5097,33 @@ let tryGetFreeVarsCacheValue opts cache = if opts.canCache then tryGetCacheValue cache else ValueNone +let accFreeLocalVal opts v fvs = + if not opts.includeLocals then fvs else + if Zset.contains v fvs.FreeLocals then fvs + else + let fvs = accFreevarsInVal opts v fvs + {fvs with FreeLocals=Zset.add v fvs.FreeLocals} + +let accFreeInValFlags opts flag acc = + let isMethLocal = + match flag with + | VSlotDirectCall + | CtorValUsedAsSelfInit + | CtorValUsedAsSuperInit -> true + | PossibleConstrainedCall _ + | NormalValUse -> false + let acc = accUsesFunctionLocalConstructs isMethLocal acc + match flag with + | PossibleConstrainedCall ty -> accFreeTyvars opts accFreeInType ty acc + | _ -> acc + +let accLocalTyconRepr opts b fvs = + if not opts.includeLocalTyconReprs then fvs else + if Zset.contains b fvs.FreeLocalTyconReprs then fvs + else { fvs with FreeLocalTyconReprs = Zset.add b fvs.FreeLocalTyconReprs } + +let inline accFreeExnRef _exnc fvs = fvs // Note: this exnc (TyconRef) should be collected the surround types, e.g. tinst of Expr.Op + let rec accBindRhs opts (TBind(_, repr, _)) acc = accFreeInExpr opts repr acc and accFreeInSwitchCases opts csl dflt (acc: FreeVars) = @@ -5123,31 +5150,6 @@ and accFreeInDecisionTree opts x (acc: FreeVars) = | TDSwitch(e1, csl, dflt, _) -> accFreeInExpr opts e1 (accFreeInSwitchCases opts csl dflt acc) | TDSuccess (es, _) -> accFreeInFlatExprs opts es acc | TDBind (bind, body) -> unionFreeVars (bindLhs opts bind (accBindRhs opts bind (freeInDecisionTree opts body))) acc - -and accFreeInValFlags opts flag acc = - let isMethLocal = - match flag with - | VSlotDirectCall - | CtorValUsedAsSelfInit - | CtorValUsedAsSuperInit -> true - | PossibleConstrainedCall _ - | NormalValUse -> false - let acc = accUsesFunctionLocalConstructs isMethLocal acc - match flag with - | PossibleConstrainedCall ty -> accFreeTyvars opts accFreeInType ty acc - | _ -> acc - -and accFreeLocalVal opts v fvs = - if not opts.includeLocals then fvs else - if Zset.contains v fvs.FreeLocals then fvs - else - let fvs = accFreevarsInVal opts v fvs - {fvs with FreeLocals=Zset.add v fvs.FreeLocals} - -and accLocalTyconRepr opts b fvs = - if not opts.includeLocalTyconReprs then fvs else - if Zset.contains b fvs.FreeLocalTyconReprs then fvs - else { fvs with FreeLocalTyconReprs = Zset.add b fvs.FreeLocalTyconReprs } and accUsedRecdOrUnionTyconRepr opts (tc: Tycon) fvs = if (match tc.TypeReprInfo with TFSharpTyconRepr _ -> true | _ -> false) then @@ -5170,8 +5172,7 @@ and accFreeRecdFieldRef opts rfref fvs = let fvs = fvs |> accUsedRecdOrUnionTyconRepr opts rfref.Tycon let fvs = fvs |> accFreevarsInTycon opts rfref.TyconRef { fvs with FreeRecdFields = Zset.add rfref fvs.FreeRecdFields } - -and accFreeExnRef _exnc fvs = fvs // Note: this exnc (TyconRef) should be collected the surround types, e.g. tinst of Expr.Op + and accFreeValRef opts (vref: ValRef) fvs = match vref.IsLocalRef with | true -> accFreeLocalVal opts vref.ResolvedTarget fvs @@ -6609,7 +6610,7 @@ let isExpansiveUnderInstantiation g fty0 tyargs pargs argsl = | _ :: t -> not (isFunTy g fty) || loop (rangeOfFunTy g fty) t loop fty1 argsl) -let rec mkExprAppAux g f fty argsl m = +let mkExprAppAux g f fty argsl m = match argsl with | [] -> f | _ -> @@ -6780,7 +6781,7 @@ let foldLinearBindingTargetsOfMatch tree (targets: _[]) = treeR, targetsR // Simplify a little as we go, including dead target elimination -let rec simplifyTrivialMatch spBind mExpr mMatch ty tree (targets : _[]) = +let simplifyTrivialMatch spBind mExpr mMatch ty tree (targets : _[]) = match tree with | TDSuccess(es, n) -> if n >= targets.Length then failwith "simplifyTrivialMatch: target out of range" @@ -10722,7 +10723,7 @@ let rec serializeNode (writer: IndentedTextWriter) (addTrailingComma:bool) (node else writer.WriteLine("}") -let rec serializeEntity path (entity: Entity) = +let serializeEntity path (entity: Entity) = let root = visitEntity entity use sw = new System.IO.StringWriter() use writer = new IndentedTextWriter(sw)