In[]:=
ClearAll[Rec, Smp]​​SetAttributes[{Rec, Smp}, HoldFirst]​​​​Rec[_] = False;​​Smp[_] = Infinity;​​Smp[s_, _] := Smp[s]
Old

In[]:=
SetAttributes[evalOneStep, HoldFirst]​​evalOneStep[expr_] := With[{path = Select[TraceCausalGraph[expr, "Path", "TraceChanges" -> 10][[2 ;; ;; 2]], FreeQ[_TerminatedEvaluation]]},​​ Hold @@ If[Length[path] >= 2, path[[2]], path[[1]]]​​]​​​​ClearAll[SMP, $SmpCounter]​​SetAttributes[{SMP, $SmpCounter}, HoldAll]​​​​$SmpCounter[_] = 0;​​​​SMP[expr : proj_Symbol[filters___], pos_ : {}] := With[​​ evalFilters = proj @@@ Hold @ Evaluate[Join @@ MapIndexed[​​ Function[{filter, index},​​ If[​​ Rec[proj] || Smp[proj, index[[1]]] > $SmpCounter[proj],​​ ResourceFunction["InheritedBlock"][{$SmpCounter = $SmpCounter},​​ $SmpCounter[proj]++;​​ SMP[filter, Join[pos, index]]​​ ],​​ Hold[Unevaluated[filter]]​​ ],​​ HoldAll​​ ],​​ Unevaluated[{filters}] ​​ ]]​​,​​ With[{eval = evalOneStep @@ evalFilters},​​ Sow[Subscript[proj, $SmpCounter[proj]] -> DirectedEdge[HoldForm @@ Replace[evalFilters, Verbatim[Unevaluated][e_] :> e, {2}], HoldForm @@ eval, pos]];​​ If[ eval =!= evalFilters,​​ Function[, SMP[#, pos], HoldFirst] @@ eval,​​ Replace[Replace[eval, Verbatim[Unevaluated][e_] :> e, {2}], Hold[e_] :> Hold[Unevaluated[e]]]​​ ]​​ ]​​]​​​​SMP[expr_, pos_ : {}] := With[{eval = evalOneStep[expr]}, Sow[DirectedEdge[HoldForm[expr], HoldForm @@ eval, pos]]; eval]

Factorial

In[]:=
ClearAll[f]​​f[x_]:=xf[x-1]​​Smp[Times]=1;
In[]:=
f[5]
$RecursionLimit
:Recursion depth of 1024 exceeded.
Out[]=
5TerminatedEvaluation[RecursionLimit]
In[]:=
Reap[SMP[f[5]]][[2,1]]//Column
Out[]=
5
{1}

5
f
0
f[5]
{}

5f[5-1]
5
{1}

5
5
{2,1,1}

5
-1
{2,1,2}

-1
Plus
0
5-1
{2,1}

4
4
{2,1}

4
f
0
f[4]
{2}

4f[4-1]
Times
1
4f[4-1]
{2}

Unevaluated[4]Unevaluated[f[4-1]]
Times
0
5(4f[4-1])
{}

54f[4-1]
5
{1}

5
4
{2}

4
4
{3,1,1}

4
-1
{3,1,2}

-1
Plus
0
4-1
{3,1}

3
3
{3,1}

3
f
0
f[3]
{3}

3f[3-1]
Times
1
3f[3-1]
{3}

Unevaluated[3]Unevaluated[f[3-1]]
Times
0
54(3f[3-1])
{}

20(3f[3-1])
20
{1}

20
Times
1
3f[3-1]
{2}

Unevaluated[3]Unevaluated[f[3-1]]
Times
0
20(3f[3-1])
{}

203f[3-1]
20
{1}

20
3
{2}

3
3
{3,1,1}

3
-1
{3,1,2}

-1
Plus
0
3-1
{3,1}

2
2
{3,1}

2
f
0
f[2]
{3}

2f[2-1]
Times
1
2f[2-1]
{3}

Unevaluated[2]Unevaluated[f[2-1]]
Times
0
203(2f[2-1])
{}

60(2f[2-1])
60
{1}

60
Times
1
2f[2-1]
{2}

Unevaluated[2]Unevaluated[f[2-1]]
Times
0
60(2f[2-1])
{}

602f[2-1]
60
{1}

60
2
{2}

2
2
{3,1,1}

2
-1
{3,1,2}

-1
Plus
0
2-1
{3,1}

1
1
{3,1}

1
f
0
f[1]
{3}

1f[1-1]
Times
1
1f[1-1]
{3}

f[1-1]
1
{3,1,1}

1
-1
{3,1,2}

-1
Plus
0
1-1
{3,1}

0
0
{3,1}

0
f
0
f[0]
{3}

0f[0-1]
Times
1
0f[0-1]
{3}

0
0
{3}

0
Times
0
6020
{}

0
0
{}

0
In[]:=
SMP[f[5]]
Out[]=
Hold[0]
In[]:=
ResourceFunction["TraceGraph"][SMP[f[5]],_SMP,TraceOriginal->Automatic,TraceForward->True]
Out[]=

Fibonacci

Ordering