In[]:=
initify[s_]:=StringReplace[s,x:(Except["["|"]"|"<"|">"]..)"<"<>x<>">"]
In[]:=
mergify[s_]:=StringReplace[s,"<"~~x_~~"><"~~y__~~">""<"~~x~~y~~">"]
In[]:=
escapify[s_String]:=StringReplace[s,"[<"~~x:(Except["<"|">"]..)~~">]""<["<>x<>"]>"]
In[]:=
rulify[s_String]:=StringReplace[s,Shortest[StartOfString~~"<s><["~~x__~~"]><["~~y__~~"]><"~~z__~~">"]~~w___x<>z<>"["<>y<>z<>"]"<>StringDelete[w,"<"|">"]]
In[]:=
sIfy[s_String]:=StringReplace[s,StartOfString~~"<s><["~~x:Except[">"]..~~"]><["~~y:Except[">"]..~~"]><"~~z:Except[">"]..~~">"~~w___x<>z<>"["<>y<>z<>"]"<>StringDelete[w,"<"|">"]]
In[]:=
kIfy[s_String]:=StringReplace[s,StartOfString~~"<k><["~~x:Except[">"]..~~"]><"~~y:Except[">"]..~~">"~~w___x<>StringDelete[w,"<"|">"]]
In[]:=
mergify[s_String]:=StringReplace[s,Shortest["[<"~~Shortest[x__]~~"><"~~y__~~">"~~z:"["|"]"]"[<"<>x<>y<>">"<>z]
In[]:=
tryIfy[s_String]:=kIfy[sIfy[escapify[mergify[s]]]]
In[]:=
nextIfy[s_String]:=StringReplace[s,"<"~~"s"|"k"~~">"~~x:("<"~~__~~">"..)x]
In[]:=
parenize[s_String]:=StringReplace[s,{"<""{",">""}"}]
In[]:=
innerStep[s_String]:=StringReplace[s,Shortest["{["~~x__~~"]}"]"{["<>step[x]<>"]}"]
In[]:=
orderedApply[{},expr_]:={expr}
In[]:=
orderedApply[{f_,fs___},expr_]:={expr,Splice[orderedApply[{fs},f[expr]]]}
In[]:=
trace[s_String]:=orderedApply[{initify,mergify,escapify,rulify,mergify,escapify,rulify,mergify,escapify,rulify,parenize,innerStep,StringDelete["{"|"}"]},s]
In[]:=
step[s_String]:=StringDelete["{"|"}"|"<"|">"][innerStep[parenize[FixedPoint[tryIfy,initify[s]]]]]
In[]:=
trace["s[k][k[s][k]]"]//Column
Out[]=
s[k][k[s][k]]
<s>[<k>][<k>[<s>][<k>]]
<s>[<k>][<k>[<s>][<k>]]
<s><[k]>[<k><[s]><[k]>]
<s><[k]>[<k><[s]><[k]>]
<s><[k]>[<k[s]><[k]>]
<s><[k]>[<k[s]><[k]>]
<s><[k]>[<k[s]><[k]>]
<s><[k]>[<k[s][k]>]
<s><[k]><[k[s][k]]>
<s><[k]><[k[s][k]]>
{s}{[k]}{[k[s][k]]}
{s}{[k]}{[s]}
s[k][s]
In[]:=
trace["s[s[s]][s][k][k]"]//Column
Out[]=
s[s[s]][s][k][k]
<s>[<s>[<s>]][<s>][<k>][<k>]
<s>[<s>[<s>]][<s>][<k>][<k>]
<s>[<s><[s]>]<[s]><[k]><[k]>
<s>[<s><[s]>]<[s]><[k]><[k]>
<s>[<s[s]>]<[s]><[k]><[k]>
<s><[s[s]]><[s]><[k]><[k]>
s[s][k][s[k]][k]
s[s][k][s[k]][k]
s[s][k][s[k]][k]
s[s][k][s[k]][k]
s[s][k][s[k]][k]
s[s][k][s[k]][k]
s[s][k][s[k]][k]
In[]:=
FixedPointList[step,"s[s][k][s][k]"]//Column
Out[]=
s[s][k][s][k]
s[s][k[s]][k]
s[k][k[s][k]]
s[k][s]
s[k][s]