How to replace the first Head of a currying expression like "a" in a[b,c][d]?

y = a[b, c][d];
y[[0, 0]] = w;
y

(*  w[b, c][d]  *)

For arbitrarily nested heads I would use recursion and pattern matching, like this:

ClearAll[replaceFirstHead]
replaceFirstHead[head_[body___], newHead_] := replaceFirstHead[head, newHead][body]
replaceFirstHead[head_, newHead_] := newHead

replaceFirstHead[a[1][2][3][4, 5, 6], x]
(* x[1][2][3][4, 5, 6] *)

There is no need to test for _Symbol or _?AtomQ on the head but the order of definitions is critical.

I find this paradigm very natural for Mathematica. Pattern matching and multiple definitions are often more convenient than explicit If and explicit extraction or structure manipulation (Part, Head, ReplacePart, etc.)

---

As @Itai notes in the comments, this function will replace atomic expressions, e.g.

replaceFirstHead[1, x]

Whether this is desirable or not depends on the particular applications. The following wrapper can prevent this for atoms that cannot be decomposed into a head and arguments using pattern matching:

replaceFirstHead2[arg : _[___], newHead_] := replaceFirstHead[arg, newHead]
replaceFirstHead2[arg_, newHead_] := arg

Do keep in mind though that some atoms act as if they were compound in some pattern matching operations. The basic examples are Rational and Complex. Thus:

replaceFirstHead2[1/2, h]
(* h[1, 2] *)

replaceFirstHead2[I, h]
(* h[0, 1] *)

Other atoms cannot be decomposed by pattern matching, even though their InputForm appears compound. One example is Graph:

replaceFirstHead2[ Graph[{1 <-> 2}], h ]
(* output: unchanged graph *)

When dealing with atoms in Mathematica, there are no consistent rules. Therefore it is hard to make a clear decision about what should be considered the "correct behaviour". It is best to think about the particular way that this function will be used, and consider special cases.

The following wrapper simply prevents it from operating on any atom, but may not be the best solution for all applications:

replaceFirstHead3[atom_?AtomQ, newHead_] := atom
replaceFirstHead3[compound_, newHead_] := replaceFirstHead[compound, newHead]

One can use Operate[] with Apply[]:

Operate[w @@ # &, a[b, c][d]]
 (*  w[b, c][d]  *)

Or leave out Apply and write:

Operate[w &, a[b, c][d], 2]
 (*  w[b, c][d]  *)

With deeper expressions:

Operate[w &, a[b][c][d], 3]
 (*  w[b][c][d]  *)