Эффективный способ удаления пустых списков из списков без оценки удерживаемых выражений?

В предыдущем потоке эффективный способ удаления пустых списков ( {} ) из списков было предложено:

Replace[expr, x_List :> DeleteCases[x, {}], {0, Infinity}]

Используя метод оценки на месте Тротта-Стржебонски , этот метод можно обобщить для работы также с удерживаемыми выражениями:

f1[expr_] := 
 Replace[expr, 
  x_List :> With[{eval = DeleteCases[x, {}]}, eval /; True], {0, Infinity}]

Это решение более эффективнее, чем выражение, основанное на ReplaceRepeated :

f2[expr_] := expr //. {left___, {}, right___} :> {left, right}

Но у него есть один недостаток: он оценивает удерживаемые выражения, если они заключены в List :

In[20]:= f1[Hold[{{}, 1 + 1}]]

Out[20]= Hold[{2}]

Итак, мой вопрос: что такое самый эффективный способ удалить все пустые списки ( {} ) из списков без оценки удерживаемых выражений? Пустой объект List [] должен быть удален только , если он является элементом другого List .

Вот некоторые моменты времени:

In[76]:= expr = Tuples[Tuples[{{}, {}}, 3], 4];
First@Timing[#[expr]] & /@ {f1, f2, f3}
pl = Plot3D[Sin[x y], {x, 0, Pi}, {y, 0, Pi}]; 
First@Timing[#[pl]] & /@ {f1, f2, f3}

Out[77]= {0.581, 0.901, 5.027}

Out[78]= {0.12, 0.21, 0.18}

Определения :

Clear[f1, f2, f3];
f3[expr_] := 
  FixedPoint[
   Function[e, Replace[e, {a___, {}, b___} :> {a, b}, {0, Infinity}]], expr];
f1[expr_] := 
  Replace[expr, 
   x_List :> With[{eval = DeleteCases[x, {}]}, eval /; True], {0, Infinity}];
f2[expr_] := expr //. {left___, {}, right___} :> {left, right};