1%% ``Licensed under the Apache License, Version 2.0 (the "License");
2%% you may not use this file except in compliance with the License.
3%% You may obtain a copy of the License at
4%%
5%%     http://www.apache.org/licenses/LICENSE-2.0
6%%
7%% Unless required by applicable law or agreed to in writing, software
8%% distributed under the License is distributed on an "AS IS" BASIS,
9%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
10%% See the License for the specific language governing permissions and
11%% limitations under the License.
12%%
13%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
14%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
15%% AB. All Rights Reserved.''
16%%
17%%     $Id: core_pp.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $
18%%
19%% Purpose : Core Erlang (naive) prettyprinter
20
21-module(core_pp).
22
23-export([format/1]).
24
25-include("core_parse.hrl").
26
27%% ====================================================================== %%
28%% format(Node) -> Text
29%%	Node = coreErlang()
30%%	Text = string() | [Text]
31%%
32%%	Prettyprint-formats (naively) an abstract Core Erlang syntax
33%%	tree.
34
35-record(ctxt, {class = term,
36	       indent = 0,
37	       item_indent = 2,
38	       body_indent = 4,
39	       tab_width = 8,
40	       line = 0}).
41
42format(Node) -> case catch format(Node, #ctxt{}) of
43		    {'EXIT',_} -> io_lib:format("~p",[Node]);
44		    Other -> Other
45		end.
46
47maybe_anno(Node, Fun, Ctxt) ->
48    As = core_lib:get_anno(Node),
49    case get_line(As) of
50	none ->
51	    maybe_anno(Node, Fun, Ctxt, As);
52	Line ->
53	    if  Line > Ctxt#ctxt.line ->
54		    [io_lib:format("%% Line ~w",[Line]),
55		     nl_indent(Ctxt),
56		     maybe_anno(Node, Fun, Ctxt#ctxt{line = Line}, As)
57		    ];
58		true ->
59		    maybe_anno(Node, Fun, Ctxt, As)
60	    end
61    end.
62
63maybe_anno(Node, Fun, Ctxt, As) ->
64    case strip_line(As) of
65	[] ->
66	    Fun(Node, Ctxt);
67	List ->
68	    Ctxt1 = add_indent(Ctxt, 2),
69	    Ctxt2 = add_indent(Ctxt1, 3),
70	    ["( ",
71	     Fun(Node, Ctxt1),
72	     nl_indent(Ctxt1),
73	     "-| ",format_1(core_lib:make_literal(List), Ctxt2)," )"
74	    ]
75    end.
76
77strip_line([A | As]) when integer(A) ->
78    strip_line(As);
79strip_line([A | As]) ->
80    [A | strip_line(As)];
81strip_line([]) ->
82    [].
83
84get_line([L | _As]) when integer(L) ->
85    L;
86get_line([_ | As]) ->
87    get_line(As);
88get_line([]) ->
89    none.
90
91format(Node, Ctxt) ->
92    maybe_anno(Node, fun format_1/2, Ctxt).
93
94format_1(#c_char{val=C}, _) -> io_lib:write_char(C);
95format_1(#c_int{val=I}, _) -> integer_to_list(I);
96format_1(#c_float{val=F}, _) -> float_to_list(F);
97format_1(#c_atom{val=A}, _) -> core_atom(A);
98format_1(#c_nil{}, _) -> "[]";
99format_1(#c_string{val=S}, _) -> io_lib:write_string(S);
100format_1(#c_var{name=V}, _) ->
101    %% Internal variable names may be:
102    %%     - atoms representing proper Erlang variable names, or
103    %%     any atoms that may be printed without single-quoting
104    %%     - nonnegative integers.
105    %% It is important that when printing variables, no two names
106    %% should ever map to the same string.
107    if atom(V) ->
108	    S = atom_to_list(V),
109	    case S of
110		[C | _] when C >= $A, C =< $Z ->
111		    %% Ordinary uppercase-prefixed names are
112		    %% printed just as they are.
113		    S;
114		[$_ | _] ->
115		    %% Already "_"-prefixed names are prefixed
116		    %% with "_X", e.g. '_foo' => '_X_foo', to
117		    %% avoid generating things like "____foo" upon
118		    %% repeated writing and reading of code.
119		    %% ("_X_X_X_foo" is better.)
120		    [$_, $X | S];
121		_ ->
122		    %% Plain atoms are prefixed with a single "_".
123		    %% E.g. foo => "_foo".
124		    [$_ | S]
125	    end;
126       integer(V) ->
127	    %% Integers are also simply prefixed with "_".
128	    [$_ | integer_to_list(V)]
129    end;
130format_1(#c_binary{segments=Segs}, Ctxt) ->
131    ["#{",
132     format_vseq(Segs, "", ",", add_indent(Ctxt, 2),
133		 fun format_bitstr/2),
134     "}#"
135    ];
136format_1(#c_tuple{es=Es}, Ctxt) ->
137    [${,
138     format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
139     $}
140    ];
141format_1(#c_cons{hd=H,tl=T}, Ctxt) ->
142    Txt = ["["|format(H, add_indent(Ctxt, 1))],
143    [Txt|format_list_tail(T, add_indent(Ctxt, width(Txt, Ctxt)))];
144format_1(#c_values{es=Es}, Ctxt) ->
145    format_values(Es, Ctxt);
146format_1(#c_alias{var=V,pat=P}, Ctxt) ->
147    Txt = [format(V, Ctxt)|" = "],
148    [Txt|format(P, add_indent(Ctxt, width(Txt, Ctxt)))];
149format_1(#c_let{vars=Vs,arg=A,body=B}, Ctxt) ->
150    Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.body_indent),
151    ["let ",
152     format_values(Vs, add_indent(Ctxt, 4)),
153     " =",
154     nl_indent(Ctxt1),
155     format(A, Ctxt1),
156     nl_indent(Ctxt),
157     "in  "
158     | format(B, add_indent(Ctxt, 4))
159    ];
160format_1(#c_letrec{defs=Fs,body=B}, Ctxt) ->
161    Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.body_indent),
162    ["letrec",
163     nl_indent(Ctxt1),
164     format_funcs(Fs, Ctxt1),
165     nl_indent(Ctxt),
166     "in  "
167     | format(B, add_indent(Ctxt, 4))
168    ];
169format_1(#c_seq{arg=A,body=B}, Ctxt) ->
170    Ctxt1 = add_indent(Ctxt, 4),
171    ["do  ",
172     format(A, Ctxt1),
173     nl_indent(Ctxt1)
174     | format(B, Ctxt1)
175    ];
176format_1(#c_case{arg=A,clauses=Cs}, Ctxt) ->
177    Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.item_indent),
178    ["case ",
179     format(A, add_indent(Ctxt, 5)),
180     " of",
181     nl_indent(Ctxt1),
182     format_clauses(Cs, Ctxt1),
183     nl_indent(Ctxt)
184     | "end"
185    ];
186format_1(#c_receive{clauses=Cs,timeout=T,action=A}, Ctxt) ->
187    Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.item_indent),
188    ["receive",
189     nl_indent(Ctxt1),
190     format_clauses(Cs, Ctxt1),
191     nl_indent(Ctxt),
192     "after ",
193     format(T, add_indent(Ctxt, 6)),
194     " ->",
195     nl_indent(Ctxt1),
196     format(A, Ctxt1)
197    ];
198format_1(#c_fname{id=I,arity=A}, _) ->
199    [core_atom(I),$/,integer_to_list(A)];
200format_1(#c_fun{vars=Vs,body=B}, Ctxt) ->
201    Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.body_indent),
202    ["fun (",
203     format_hseq(Vs, ",", add_indent(Ctxt, 5), fun format/2),
204     ") ->",
205     nl_indent(Ctxt1)
206     | format(B, Ctxt1)
207    ];
208format_1(#c_apply{op=O,args=As}, Ctxt0) ->
209    Ctxt1 = add_indent(Ctxt0, 6),		%"apply "
210    Op = format(O, Ctxt1),
211    Ctxt2 = add_indent(Ctxt0, 4),
212    ["apply ",Op,
213     nl_indent(Ctxt2),
214     $(,format_hseq(As, ", ", add_indent(Ctxt2, 1), fun format/2),$)
215    ];
216format_1(#c_call{module=M,name=N,args=As}, Ctxt0) ->
217    Ctxt1 = add_indent(Ctxt0, 5),		%"call "
218    Mod = format(M, Ctxt1),
219    Ctxt2 = add_indent(Ctxt1, width(Mod, Ctxt1)+1),
220    Name = format(N, Ctxt2),
221    Ctxt3 = add_indent(Ctxt0, 4),
222    ["call ",Mod,":",Name,
223     nl_indent(Ctxt3),
224     $(,format_hseq(As, ", ", add_indent(Ctxt3, 1), fun format/2),$)
225    ];
226format_1(#c_primop{name=N,args=As}, Ctxt0) ->
227    Ctxt1 = add_indent(Ctxt0, 7),		%"primop "
228    Name = format(N, Ctxt1),
229    Ctxt2 = add_indent(Ctxt0, 4),
230    ["primop ",Name,
231     nl_indent(Ctxt2),
232     $(,format_hseq(As, ", ", add_indent(Ctxt2, 1), fun format/2),$)
233    ];
234format_1(#c_catch{body=B}, Ctxt) ->
235    Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.body_indent),
236    ["catch",
237     nl_indent(Ctxt1),
238     format(B, Ctxt1)
239    ];
240format_1(#c_try{arg=E,vars=Vs,body=B,evars=Evs,handler=H}, Ctxt) ->
241    Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.body_indent),
242    ["try",
243     nl_indent(Ctxt1),
244     format(E, Ctxt1),
245     nl_indent(Ctxt),
246     "of ",
247     format_values(Vs, add_indent(Ctxt, 3)),
248     " ->",
249     nl_indent(Ctxt1),
250     format(B, Ctxt1),
251     nl_indent(Ctxt),
252     "catch ",
253     format_values(Evs, add_indent(Ctxt, 6)),
254     " ->",
255     nl_indent(Ctxt1)
256     | format(H, Ctxt1)
257    ];
258format_1(#c_def{name=N,val=V}, Ctxt) ->
259    Ctxt1 = add_indent(set_class(Ctxt, expr), Ctxt#ctxt.body_indent),
260    [format(N, Ctxt),
261     " =",
262     nl_indent(Ctxt1)
263     | format(V, Ctxt1)
264    ];
265format_1(#c_module{name=N,exports=Es,attrs=As,defs=Ds}, Ctxt) ->
266    Mod = ["module ", format(N, Ctxt)],
267    [Mod," [",
268     format_vseq(Es,
269		 "", ",",
270		 add_indent(set_class(Ctxt, term), width(Mod, Ctxt)+2),
271		 fun format/2),
272     "]",
273     nl_indent(Ctxt),
274     "    attributes [",
275     format_vseq(As,
276		 "", ",",
277		 add_indent(set_class(Ctxt, def), 16),
278		 fun format/2),
279     "]",
280     nl_indent(Ctxt),
281     format_funcs(Ds, Ctxt),
282     nl_indent(Ctxt)
283     | "end"
284    ];
285format_1(Type, _) ->
286    ["** Unsupported type: ",
287     io_lib:write(Type)
288     | " **"
289    ].
290
291format_funcs(Fs, Ctxt) ->
292    format_vseq(Fs,
293		"", "",
294		set_class(Ctxt, def),
295		fun format/2).
296
297format_values(Vs, Ctxt) ->
298    [$<,
299     format_hseq(Vs, ",", add_indent(Ctxt, 1), fun format/2),
300     $>].
301
302format_bitstr(#c_bitstr{val=V,size=S,unit=U,type=T,flags=Fs}, Ctxt0) ->
303    Vs = [S, U, T, Fs],
304    Ctxt1 = add_indent(Ctxt0, 2),
305    Val = format(V, Ctxt1),
306    Ctxt2 = add_indent(Ctxt1, width(Val, Ctxt1) + 2),
307    ["#<", Val, ">(", format_hseq(Vs,",", Ctxt2, fun format/2), $)].
308
309format_clauses(Cs, Ctxt) ->
310    format_vseq(Cs, "", "", set_class(Ctxt, clause),
311		fun format_clause/2).
312
313format_clause(Node, Ctxt) ->
314    maybe_anno(Node, fun format_clause_1/2, Ctxt).
315
316format_clause_1(#c_clause{pats=Ps,guard=G,body=B}, Ctxt) ->
317    Ptxt = format_values(Ps, Ctxt),
318    Ctxt2 = add_indent(Ctxt, Ctxt#ctxt.body_indent),
319    [Ptxt,
320     " when ",
321     format_guard(G, add_indent(set_class(Ctxt, expr),
322				 width(Ptxt, Ctxt) + 6)),
323     " ->",
324     nl_indent(Ctxt2)
325     | format(B, set_class(Ctxt2, expr))
326    ].
327
328format_guard(Node, Ctxt) ->
329    maybe_anno(Node, fun format_guard_1/2, Ctxt).
330
331format_guard_1(#c_call{module=M,name=N,args=As}, Ctxt0) ->
332    Ctxt1 = add_indent(Ctxt0, 5),		%"call "
333    Mod = format(M, Ctxt1),
334    Ctxt2 = add_indent(Ctxt1, width(Mod, Ctxt1)+1),
335    Name = format(N, Ctxt2),
336    Ctxt3 = add_indent(Ctxt0, 4),
337    ["call ",Mod,":",Name,
338     nl_indent(Ctxt3),
339     $(,format_vseq(As, "",",", add_indent(Ctxt3, 1), fun format_guard/2),$)
340    ];
341format_guard_1(E, Ctxt) -> format_1(E, Ctxt).	%Anno already done
342
343%% format_hseq([Thing], Separator, Context, Fun) -> Txt.
344%%  Format a sequence horizontally on the same line with Separator between.
345
346format_hseq([H], _, Ctxt, Fun) ->
347    Fun(H, Ctxt);
348format_hseq([H|T], Sep, Ctxt, Fun) ->
349    Txt = [Fun(H, Ctxt)|Sep],
350    Ctxt1 = add_indent(Ctxt, width(Txt, Ctxt)),
351    [Txt|format_hseq(T, Sep, Ctxt1, Fun)];
352format_hseq([], _, _, _) -> "".
353
354%% format_vseq([Thing], LinePrefix, LineSuffix, Context, Fun) -> Txt.
355%%  Format a sequence vertically in indented lines adding LinePrefix
356%%  to the beginning of each line and LineSuffix to the end of each
357%%  line.  No prefix on the first line or suffix on the last line.
358
359format_vseq([H], _Pre, _Suf, Ctxt, Fun) ->
360    Fun(H, Ctxt);
361format_vseq([H|T], Pre, Suf, Ctxt, Fun) ->
362    [Fun(H, Ctxt),Suf,nl_indent(Ctxt),Pre|
363     format_vseq(T, Pre, Suf, Ctxt, Fun)];
364format_vseq([], _, _, _, _) -> "".
365
366format_list_tail(#c_nil{anno=[]}, _) -> "]";
367format_list_tail(#c_cons{anno=[],hd=H,tl=T}, Ctxt) ->
368    Txt = [$,|format(H, Ctxt)],
369    Ctxt1 = add_indent(Ctxt, width(Txt, Ctxt)),
370    [Txt|format_list_tail(T, Ctxt1)];
371format_list_tail(Tail, Ctxt) ->
372    ["|",format(Tail, add_indent(Ctxt, 1)),"]"].
373
374indent(Ctxt) -> indent(Ctxt#ctxt.indent, Ctxt).
375
376indent(N, _) when N =< 0 -> "";
377indent(N, Ctxt) ->
378    T = Ctxt#ctxt.tab_width,
379    string:chars($\t, N div T, string:chars($\s, N rem T)).
380
381nl_indent(Ctxt) -> [$\n|indent(Ctxt)].
382
383
384unindent(T, Ctxt) ->
385    unindent(T, Ctxt#ctxt.indent, Ctxt, []).
386
387unindent(T, N, _, C) when N =< 0 ->
388    [T|C];
389unindent([$\s|T], N, Ctxt, C) ->
390    unindent(T, N - 1, Ctxt, C);
391unindent([$\t|T], N, Ctxt, C) ->
392    Tab = Ctxt#ctxt.tab_width,
393    if N >= Tab ->
394	    unindent(T, N - Tab, Ctxt, C);
395       true ->
396	    unindent([string:chars($\s, Tab - N)|T], 0, Ctxt, C)
397    end;
398unindent([L|T], N, Ctxt, C) when list(L) ->
399    unindent(L, N, Ctxt, [T|C]);
400unindent([H|T], _, _, C) ->
401    [H|[T|C]];
402unindent([], N, Ctxt, [H|T]) ->
403    unindent(H, N, Ctxt, T);
404unindent([], _, _, []) -> [].
405
406
407width(Txt, Ctxt) ->
408    case catch width(Txt, 0, Ctxt, []) of
409	{'EXIT',_} -> exit({bad_text,Txt});
410	Other -> Other
411    end.
412
413width([$\t|T], A, Ctxt, C) ->
414    width(T, A + Ctxt#ctxt.tab_width, Ctxt, C);
415width([$\n|T], _, Ctxt, C) ->
416    width(unindent([T|C], Ctxt), Ctxt);
417width([H|T], A, Ctxt, C) when list(H) ->
418    width(H, A, Ctxt, [T|C]);
419width([_|T], A, Ctxt, C) ->
420    width(T, A + 1, Ctxt, C);
421width([], A, Ctxt, [H|T]) ->
422    width(H, A, Ctxt, T);
423width([], A, _, []) -> A.
424
425add_indent(Ctxt, Dx) ->
426    Ctxt#ctxt{indent = Ctxt#ctxt.indent + Dx}.
427
428set_class(Ctxt, Class) ->
429    Ctxt#ctxt{class = Class}.
430
431core_atom(A) -> io_lib:write_string(atom_to_list(A), $').
432