Remove["Gr`*"];
SetAttributes[repr, HoldAllComplete]
repr[exp_, code_] :=
    With[{exp2 = MakeBoxes@exp, body = MakeBoxes@code},
      Block[{$ContextPath = {"System`"}, $Context = "Gr`"},
        SetAttributes[Gr`graphic, HoldAllComplete];
        Gr`graphic[a_] := Module[{c = False, x},
            x = Replace[HoldForm[a], x_[t___] :> With[{newHead = If[
                          NameQ["Gr`" <> SymbolName[x]],
                          Symbol["Gr`" <> SymbolName[x]], c = True; x]
                      }, newHead[t] /; True],
                1];
            If[c,

       x = Replace[x, HoldPattern[x_[t___]] :> Gr`display[x[t]], 1];
              ];
            ReleaseHold@x
            ];

        SetAttributes[Gr`display, HoldAllComplete];
        Gr`display[c_] := ToString[Replace[
              HoldForm[c]
              , {
                HoldPattern[x_[t___]] :>
                  With[{new = Symbol[SymbolName[x]]},
                    new[t] /; True],

        HoldPattern[x_Symbol ] :> With[{new = Symbol[SymbolName[x]]},
                    new /; True]
                }, Infinity], InputForm];

        Print@Replace[
            ToExpression[exp2, StandardForm, Hold],

      HoldPattern[SetDelayed[x_[y___], z___]] :> With[{newHead = If[
                      Head[x] === Symbol,
                      Symbol["Gr`" <> SymbolName[x]], x
                      ]},
                SetDelayed[newHead[y], z] /; True], Infinity];

        Print@Replace[
            ToExpression[body, StandardForm,
              Hold], {x_[t___] :>
                With[{new = Symbol[SymbolName[x]]}, new[t] /; True],

       x_Symbol :> With[{new = Symbol[SymbolName[x]]}, new /; True]},
            Infinity]
        ]
      ];

repr[
  SetAttributes[y, HoldAllComplete];
       y[a__] := (
      Graphics[{Circle[],
          Inset[
            graphic[a]
            , Scaled[{0.498, 0.5020000000000002}], Center,
            Scaled[{0.5, 0.5}]]}, ImagePadding -> 0,
    PlotRangePadding -> 0]
      );
  SetAttributes[x, HoldAllComplete];
       x[a___] :=
              Graphics[{RGBColor[1, 0, 0], Rectangle[{0, 0}]},
               ImagePadding -> 0, ImageSize -> {85., Automatic},
      PlotRangePadding -> 0];
  SetAttributes[Times, HoldAllComplete];
       (* Times[a_, b_] :=
             display[Plus[a, b]]; *)
  , graphic[y[y[a*b]]]
  ]