From f60b1b000669a6c07d683ae0ca2361c21ff5722d Mon Sep 17 00:00:00 2001 From: dawe Date: Wed, 17 Jan 2024 15:28:19 +0100 Subject: [PATCH 1/8] remove some superfluous rec keywords and untangle two functions that aren't mutually recursive. --- src/Compiler/TypedTree/TypedTreeOps.fs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 8616a7e43fa..33683c37d5e 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -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) @@ -6609,7 +6609,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 +6780,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 +10722,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) From 9fe074a6e8cb2258f4b3ff35cb49fd78b000cbb8 Mon Sep 17 00:00:00 2001 From: dawe Date: Wed, 17 Jan 2024 16:20:01 +0100 Subject: [PATCH 2/8] two more in Optimizer.fs --- src/Compiler/Optimize/Optimizer.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index e1eaddef8a8..bafcdf78e16 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -1589,7 +1589,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 = @@ -2013,7 +2013,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() From 735b32c35ca7bc6d90b5a790379280b68b77ebe4 Mon Sep 17 00:00:00 2001 From: dawe Date: Wed, 17 Jan 2024 17:22:51 +0100 Subject: [PATCH 3/8] one more in CheckExpressions.fs --- src/Compiler/Checking/CheckExpressions.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 From f2957a11cf097e27a7ddd982d2813f687867fc18 Mon Sep 17 00:00:00 2001 From: dawe Date: Wed, 17 Jan 2024 17:30:54 +0100 Subject: [PATCH 4/8] two more in IlxGen.fs --- src/Compiler/CodeGen/IlxGen.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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 ] -> From 6b3a353d4a19c610109c95832418259d0eaee854 Mon Sep 17 00:00:00 2001 From: dawe Date: Wed, 17 Jan 2024 19:04:55 +0100 Subject: [PATCH 5/8] untangle some functions in TypedTreeOps.fs --- src/Compiler/TypedTree/TypedTreeOps.fs | 55 +++++++++++++------------- 1 file changed, 28 insertions(+), 27 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 33683c37d5e..bf1b71a1eff 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -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 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 From fb4c54d24bcf2f24117b52e5d0791a4f686ffa7d Mon Sep 17 00:00:00 2001 From: dawe Date: Thu, 18 Jan 2024 13:24:39 +0100 Subject: [PATCH 6/8] inline accFreeExnRef --- src/Compiler/TypedTree/TypedTreeOps.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index bf1b71a1eff..b88c5a1df4d 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -5122,7 +5122,7 @@ let accLocalTyconRepr opts b fvs = if Zset.contains b fvs.FreeLocalTyconReprs then fvs else { fvs with FreeLocalTyconReprs = Zset.add b fvs.FreeLocalTyconReprs } -let accFreeExnRef _exnc fvs = fvs // Note: this exnc (TyconRef) should be collected the surround types, e.g. tinst of Expr.Op +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 From 48958bbcb4abd76ede6611e0674e135a3c8abfc1 Mon Sep 17 00:00:00 2001 From: dawe Date: Fri, 19 Jan 2024 12:23:56 +0100 Subject: [PATCH 7/8] one more in TypedTreeOps.fs --- src/Compiler/TypedTree/TypedTreeOps.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index b88c5a1df4d..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 From d9e37734ccf3a55b82a91dc55b5eadfd88acb339 Mon Sep 17 00:00:00 2001 From: dawe Date: Mon, 22 Jan 2024 11:33:19 +0100 Subject: [PATCH 8/8] one more in Optimizer.fs --- src/Compiler/Optimize/Optimizer.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index bafcdf78e16..4b8d0093cf3 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -1454,11 +1454,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) ) }