Making an expression to Iceberg-like object?

Question

Can we construct a function Iceberg,
which maps a given expression X to Iceberg[X]
satisfying 1. and 2. and 3. ?

1. From Iceberg[X],
it is not possible to inspect/extract a part of X with usual method.
It would be better if there is no part of Iceberg[X].
Applying Iceberg to X is like putting X into an iceberg.

ex) It is not difficult to extract 3rd part of {101,102,103,104,105},
from Hold[{101,102,103,104,105}].

    In[1]  Hold[{101,102,103,104,105}][[1]][[3]] 

    Out[1] 103

So Hold is not like Iceberg.

Likewise, for HoldComplete, Unevaluate, Defer, Inactivate, ... and combinations of these commands, similar method can extract any part of X.

So they are not like Iceberg.

2. From Iceberg[X], there is a unique way to comeback to X.

In[2]  Icemelt[Iceberg[{101,102,103,104,105}]]
Out[2]  {101,102,103,104,105}

No function other than 'Icemelt', can do it.

3. In fact there is a function satisfying 1. and 2. :
Iceberg = ToString
Icemelt = ToExpression

But I ask you to find another solution.

I believe ToString/ToExpression is the only solution.

Answer 1

ClearAll@Iceberg;
expr : HoldPattern[Iceberg[x_]] /; ! AtomQ[Unevaluated[expr]] := 
 System`Private`SetNoEntry[Unevaluated[expr]];
Iceberg /: MakeBoxes[v_Iceberg?AtomQ, fmt_] := 
 InterpretationBox[
  RowBox[{"Iceberg", "[", "\[LeftAngleBracket]", "\[RightAngleBracket]", "]"}], v];
Icemelt[HoldPattern[Iceberg[x_]]] := x

Now you can do

Iceberg[{1,2,3}]

I believe it satisfies the other requirements

In[80]:= Iceberg[{101, 102, 103, 104, 105}][[1]][[3]]

During evaluation of In[80]:= Part::partd: Part specification Iceberg[\[LeftAngleBracket]\[RightAngleBracket]][[1]] is longer than depth of object.

During evaluation of In[80]:= Part::partw: Part 3 of Iceberg[\[LeftAngleBracket]\[RightAngleBracket]][[1]] does not exist.

Out[80]= Iceberg[{101, 102, 103, 104, 105}][[1]][[3]]

In[81]:= Icemelt[Iceberg[{101, 102, 103, 104, 105}]]

Out[81]= {101, 102, 103, 104, 105}

Answer 2

Silly, but fun

X = {101, 102, 103, 104, 105};

img = Rasterize[X];

ToExpression[TextRecognize[img]] === X
(* True *)

Answer 3

So this seems to come close to satisfying all the properties, including Icemelt uniqueness. I don't know any method to hack this Iceberg at this point, but I'll think about it more. If someone knows a hack please let me know:

(* hold attribute helpers *)

HoldPosition[sym_Symbol[args___]] := With[{attrs = Attributes[sym], len = Length @ Unevaluated @ {args}},
    Which[
        MemberQ[attrs, HoldFirst],
        {1},
        MemberQ[attrs, HoldRest],
        Range[2, len],
        MemberQ[attrs, HoldAll | HoldAllComplete],
        Range @ len,
        True,
        {}
    ]
]

HoldPosition[_] := Missing["Position"]

HoldPositionQ[expr_, i_] := With[{pos = HoldPosition[Unevaluated[expr]]}, MissingQ[pos] || MemberQ[pos, i]]

SequenceHoldQ[sym_Symbol[___]] := MemberQ[Attributes[sym], SequenceHold]
SequenceHoldQ[_] := False


(* Icemelt *)

(* always melt with StackComplete  *)
Icemelt[Verbatim[Iceberg][data_]] /; MemberQ[Stack[], StackComplete] := data
Icemelt[iceberg_Iceberg] := StackComplete[Icemelt[iceberg]]
Icemelt[expr___] := $Failed


(* Iceberg *)

Iceberg::unbrk = "is unbreakable with ``";
Iceberg::symbol = "attempt at reading iceberg symbol is detected";

(* run this if anything except Icemelt is executed with Iceberg in it *)
Iceberg /: expr : (f : Except[Icemelt])[left___, iceberg_Iceberg, right___] /; ! SequenceHoldQ[Unevaluated[expr]] :=
With[{
    i = Length[HoldComplete[left]] + 1
},
    (
        Message[Iceberg::unbrk, HoldForm[DisableFormatting[f[left, Iceberg["\[Ellipsis]"], right]]]];
        $Failed
    ) /; ! HoldPositionQ[Unevaluated[expr], i]
]

(* formatting *)
Iceberg /: MakeBoxes[iceberg_Iceberg, fmt___] := With[{data = StackComplete @ Icemelt[iceberg]},
    BoxForm`ArrangeSummaryBox["Iceberg", "Iceberg"["\[Ellipsis]"], Style["🧊", 48], {{}}, {{data}}, fmt]
]

(* make Iceberg atomic *)
Iceberg /: iceberg_Iceberg /; System`Private`HoldEntryQ[iceberg] := System`Private`HoldSetNoEntry[iceberg]

(* make an Iceberg with protected symbol that only returns its data inside Icemelt *)
iceberg : Iceberg[data_] /; System`Private`HoldNotValidQ[iceberg] := Module[{var},
    var := If[MemberQ[Stack[], Icemelt], data, Message[Iceberg::"symbol"]; $Failed];
    SetAttributes[var, {Protected, ReadProtected, Locked}];
    System`Private`HoldSetValid[Iceberg[var]]
]

(* protect and lock it *)
SetAttributes[Iceberg, {ReadProtected, Protected, Locked, HoldAllComplete}]

Here is notebook with an example: https://www.wolframcloud.com/obj/nikm/Published/Iceberg.nb