evaluation - Replacing parts of a held expression with held parts of another expression

I'm applying the Trott-Strzebonski technique in order to replace inside a held expression.

x = Hold[1 + 1, 2 + 2, 3 + 3];
y = Hold[foo@bar[2]];
y /. bar[j_] :> With[{eval = x[[j]]}, eval /; True]
(* Hold[foo[4]] *)

However, I'd like the replacing expression to remain held during substitution:

(* Hold[foo[2 + 2]] *)

The unwanted evaluation of 2 + 2 seemed to be occurring during the Part statement, x[[j]]. So, I tried using Extract instead:

y /. bar[j_] :> With[{eval = Extract[x, {j}, Unevaluated]}, eval /; True]
(* Hold[foo[Unevaluated[2 + 2]]] *)

I thought Unevaluated would disappear as an argument of the Set function, but this was not so. (Perhaps I still don't quite understand Unevaluated.)

I then thought of removing that head, Unevaluated, through another replacement, but that seems rather convoluted.

Succinctly, how does one replace parts of a held expression with held parts of another expression?

Answer

One way to achieve this is to use a "vanishing" wrapper. The idea is to temporarily wrap the substituted expression with a holding symbolic head, and then remove that head in a second replacement:

Module[{h}
, SetAttributes[h, HoldAll]

; y /. bar[j_] :> RuleCondition[Extract[x, {j}, h]] /. h[x_] :> x
]

(* Hold[foo[2+2]] *)

Module is used to ensure that the vanishing symbol does not conflict with any of the symbols in the target expression. This solution is essentially equivalent to the exhibited use of Unevaluated, but forcibly removes the wrapper explicitly instead of relying upon the evaluator to do it.

This trick can be especially handy in more complex substitutions and can be scaled to use multiple wrappers, each with more elaborate semantics than simple vanishing.

The single-wrapper idiom can be made more convenient with a helper macro:

SetAttributes[vanishing, HoldAll]
vanishing[{h_}, body_] :=

  Module[{h}
  , SetAttributes[h, HoldAll]
  ; body /. h[x_] :> x
  ]

It is used thus:

vanishing[{h}, y /. bar[j_] :> RuleCondition[Extract[x, {j}, h]]]

(* Hold[foo[2+2]] *)