Making simplified MakeBoxes

Question

What is the simplest way to make an analog of MakeBoxes which will reproduce only on aspect of its behavior: converting correct expressions involving only symbols without FormatValues to BoxForms:

Trace[MakeBoxes[graphics[disk[]], StandardForm], TraceInternal -> True]

This function should be recursive as MakeBoxes is. What is really confusing is how to convert disk[] to RowBox[{"disk", "[", "]"}] avoiding parsing of string representation of the original expression.

P.S. This question comes from the previous question.

Answer 1

I don't think you can avoid parsing or string conversion in one way or another - at the end you need strings, and you start with symbols. Either you somehow reuse MakeBoxes, or you have to deal with strings. Dragging my code around: the following simple box-making function is based on the Mathematica parser posted here (my second post there, at the bottom of the page):

Clear[toBoxes];
toBoxes[expr_] :=
  First[parse[tokenize[ToString@FullForm[expr]]] //. {
    head_String[elem_] :>    RowBox[{head, "[", elem, "]"}], 
    head_String[elems___] :>  RowBox[{head, "[", RowBox[Riffle[{elems}, ","]], "]"}]}]

If you don't want to parse but don't mind ToString, then a slight variation of the above will do:

toBoxesAlt[expr_] := 
  expr /. s_Symbol :> ToString[s] //. {
     head_String[elem_] :> RowBox[{head, "[", elem, "]"}], 
     head_String[elems___] :>  RowBox[{head, "[", RowBox[Riffle[{elems}, ","]], "]"}]}

Note that this last function does not involve any parsing.Then, we need:

Clear[MakeBoxesStopAlt];
MakeBoxesStopAlt /: MakeBoxes[MakeBoxesStopAlt[expr_], form_] :=  toBoxes[expr]

For example:

In[327]:= MakeBoxesStopAlt[Graphics[Disk[]]]

Out[327]= Graphics[Disk[List[0, 0]]]

You may want to re-implement the parser if my implementation looks too complicated, although mine is rather efficient.

EDIT

Here is a very simplistic and probably slow approach to parsing: the function tokenize is the same as before, and I will repost it here for convenience:

tokenize[code_String] :=
 Module[{n = 0, tokenrules}, 
   tokenrules = {"[" :> {"Open", ++n}, "]" :> {"Close", n--}, 
     Whitespace | "" ~~ "," ~~ Whitespace | ""};
   DeleteCases[StringSplit[code, tokenrules], "", Infinity]];

Here is the parsing function:

parseSimple[tokenized_] :=
  First[tokenized //. {left___, 
     Shortest[
       PatternSequence[h_, {"Open", n_}, elems___, {"Close", n_}]], right___} :> 
       {left, h[elems], right}];

You may use it in place of parse, and these two functions then form a self-contained solution for the parser.

The same comment as for my answer to your previous question is in order: if you want to handle /disallow expression evaluation, add appropriate attributes and Unevaluated wrappers where needed.

EDIT2

Here is a version of makeBoxes that does not involve parsing, does not leak evaluation and does handle nested heads correctly (at least for some simple tests):

Clear[handleElems];
handleElems[] := Sequence[];
handleElems[el_] := el;
handleElems[els__] := RowBox[Riffle[{els}, ","]];

ClearAll[makeBoxes];
SetAttributes[makeBoxes, HoldAllComplete];
makeBoxes[ex_] :=
 Block[{makeBoxes},
   SetAttributes[makeBoxes, HoldAllComplete];
   makeBoxes[expr_ /;!FreeQ[Unevaluated[expr],
        s_ /; AtomQ[Unevaluated[s]] && ! StringQ[Unevaluated[s]]]] :=    
     makeBoxes[#] &@(Unevaluated[expr] /. 
          s_ /; AtomQ[Unevaluated[s] && ! StringQ[Unevaluated[s]]] :> 
                  ToString[Unevaluated[s]]);

   makeBoxes[a_ /; AtomQ[Unevaluated[a]]] := a;

   makeBoxes[expr_] /; MatchQ[expr, h_String[___]] :=
        expr //. {
           (h : ("Rule" | "RuleDelayed"))[l_, r_] :>
                 RowBox[{l, h /. {
                           "Rule" -> "\[Rule]", 
                           "RuleDelayed" -> "\[RuleDelayed]"
                         }, r}], 
           "List"[elems___] :> RowBox[{"{", handleElems[elems], "}"}], 
           head_String[elems___] :> RowBox[{head, "[", handleElems[elems], "]"}]
        };

   makeBoxes[expr_] := 
       RowBox[{makeBoxes[#] &@Head[expr], "[", 
           handleElems @@ (makeBoxes @@@ expr), "]"}];

   makeBoxes @@ (HoldComplete[ex] /. s_String :> 
       With[{eval = StringJoin["\"", s, "\""]}, eval /; True])   
];

Example of use:

In[228]:= a=1;b=2;c = 3;

In[229]:= makeBoxes[a:>b]
Out[229]= RowBox[{a,:>,b}]

In[230]:= makeBoxes[a->b]
Out[230]= RowBox[{a,->,b}]

In[231]:= makeBoxes[{a,{b,c}}]
Out[231]= RowBox[{{,RowBox[{a,,,RowBox[{{,RowBox[{b,,,c}],}}]}],}}]

In[232]:= makeBoxes[a[b][c]]
Out[232]= RowBox[{RowBox[{a,[,b,]}],[,c,]}]

In[233]:= makeBoxes[a[b[e[],f[]],c[g[],h[]]][x,y]]

Out[233]= RowBox[{RowBox[{a,[,RowBox[{RowBox[{b,[,RowBox[{RowBox[{e,
   [,]}],,,RowBox[{f,[,]}]}],]}],,,RowBox[{c,[,RowBox[{RowBox[{g,[,]}],,,
    RowBox[{h,[,]}]}],]}]}],]}],[,RowBox[{x,,,y}],]}]

In all cases tested, the output is the same as that of MakeBoxes.

Answer 2

Here is my implementation of simplified MakeBoxes without conversion of the original expression to string:

ClearAll[SimpleMakeBoxes, SimpleMakeBoxesRules];
SetAttributes[SimpleMakeBoxes, HoldAll];
SimpleMakeBoxesRules = {h_Symbol[] :> RowBox[{ToString@h, "[", "]"}], 
   h_Symbol[expr_] :> 
    RowBox[{ToString@h, "[", Unevaluated[expr] /. SimpleMakeBoxesRules, "]"}],
   h_Symbol[expr__] :> 
    RowBox[{ToString@h, "[", 
      RowBox[Riffle[
        List @@ Replace[Hold[expr], 
          x_ :> (Unevaluated[x] /. SimpleMakeBoxesRules), {1}], ","]], "]"}],
   a:(_Real | _Integer | _String) :> ToString[FullForm@a]};
SimpleMakeBoxes[expr_] := 
 Unevaluated[expr] /. 
   SimpleMakeBoxesRules //. {RowBox[{"List", "[", elems___, "]"}] :> 
    RowBox[{"{", elems, "}"}], 
   RowBox[{"Rule", "[", RowBox[{lhs_, ",", rhs_}], "]"}] :> 
    RowBox[{lhs, "\[Rule]", rhs}], 
   RowBox[{"RuleDelayed", "[", RowBox[{lhs_, ",", rhs_}], "]"}] :> 
    RowBox[{lhs, "\[RuleDelayed]", rhs}]}

Usage example:

In[7]:= SimpleMakeBoxes@Graphics[Disk[]]
RawBoxes@%
Out[7]= RowBox[{Graphics,[,RowBox[{Disk,[,]}],]}]
Out[8]= Graphics[Disk[]]