1%% Copyright (c) 2008-2016 Robert Virding 2%% 3%% Licensed under the Apache License, Version 2.0 (the "License"); 4%% you may not use this file except in compliance with the License. 5%% You may obtain a copy of the License at 6%% 7%% http://www.apache.org/licenses/LICENSE-2.0 8%% 9%% Unless required by applicable law or agreed to in writing, software 10%% distributed under the License is distributed on an "AS IS" BASIS, 11%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12%% See the License for the specific language governing permissions and 13%% limitations under the License. 14 15%% File : lfe_io_pretty.erl 16%% Author : Robert Virding 17%% Purpose : Pretty printer for Lisp Flavoured Erlang. 18 19-module(lfe_io_pretty). 20 21-export([term/1,term/2,term/3,term/4]). 22 23-compile(export_all). 24 25-import(lists, [reverse/1,reverse/2,flatlength/1]). 26 27%% Define IS_MAP/1 macro for is_map/1 bif. 28-ifdef(HAS_MAPS). 29-define(IS_MAP(T), is_map(T)). 30-else. 31-define(IS_MAP(T), false). 32-endif. 33 34%% term(Sexpr [, Depth [, Indentation [, LineLength]]]) -> [char()]. 35%% A relatively simple pretty print function, but with some 36%% customisation. N.B. We know about the standard character macros 37%% and use them instead of their expanded forms. 38 39term(S) -> term(S, -1, 0, 80). 40 41term(S, D) -> term(S, D, 0, 80). 42 43term(S, D, I) -> term(S, D, I, 80). 44 45term(_, 0, _, _) -> "..."; 46term(Symb, _, _, _) when is_atom(Symb) -> lfe_io_write:symbol(Symb); 47term(Numb, _, _, _) when is_integer(Numb) -> integer_to_list(Numb); 48term(Numb, _, _, _) when is_float(Numb) -> io_lib_format:fwrite_g(Numb); 49%% Handle some default special cases, standard character macros. These 50%% don't increase depth as they really should. 51term([quote,E], D, I, L) -> ["'",term(E, D, I+1, L)]; 52term([backquote,E], D, I, L) -> ["`",term(E, D, I+1, L)]; 53term([comma,E], D, I, L) -> [",",term(E, D, I+1, L)]; 54term(['comma-at',E], D, I, L) -> [",@",term(E, D, I+2, L)]; 55term([map|MapBody], D, I, L) -> %Special case map form 56 Mcs = map_body(MapBody, D, I+5, L), 57 ["(map ",Mcs,$)]; 58term([Car|_]=List, D, I, L) -> 59 %% Handle printable lists specially. 60 case io_lib:printable_unicode_list(List) of 61 true -> lfe_io_write:string(List, $"); %" 62 false -> 63 case list_max(List, D-1, I+1, L-1) of 64 {yes,Print} -> ["(",Print,")"]; 65 no -> 66 %% Customise printing of lists. 67 case indent_type(Car) of 68 none -> %Normal lists. 69 ["(",list(List, D-1, I+1, L-1),")"]; 70 defun -> %Special case for defuns 71 defun(List, D, I, L); 72 N when is_integer(N) -> %Special N first elements 73 type(List, D, I, L, N) 74 end 75 end 76 end; 77term([], _, _, _) -> "()"; 78term({}, _, _, _) -> "#()"; 79term(Tup, D, I, L) when is_tuple(Tup) -> 80 Es = tuple_to_list(Tup), 81 case list_max(Es, D-1, I+2, L-1) of 82 {yes,Print} -> ["#(",Print,")"]; 83 no -> ["#(",list(Es, D-1, I+2, L),")"] 84 end; 85term(Bit, D, _, _) when is_bitstring(Bit) -> 86 bitstring(Bit, D); %First D bytes 87term(Map, D, I, L) when ?IS_MAP(Map) -> 88 %% This will return kv pairs in reverse order to from_list, but 89 %% this dooesn't really matter here. 90 Fun = fun (K, V, Acc) -> [K,V|Acc] end, 91 Mcs = map_body(maps:fold(Fun, [], Map), D, I+3, L), 92 ["#M(",Mcs,$)]; 93term(Other, _, _, _) -> 94 lfe_io_write:term(Other). %Use standard LFE for rest 95 96%% bitstring(Bitstring, Depth) -> [char()] 97%% Print the bytes in a bitstring. Print bytes except for last which 98%% we add size field if not 8 bits big. 99 100bitstring(Bit, D) -> 101 try 102 Chars = unicode:characters_to_list(Bit, utf8), 103 true = io_lib:printable_unicode_list(Chars), 104 [$#|lfe_io_write:string(Chars, $")] 105 catch 106 _:_ -> lfe_io_write:bitstring(Bit, D) 107 end. 108 109%% defun(List, Depth, Indentation, LineLength) -> [char()]. 110%% Print a defun depending on whether it is traditional or matching. 111 112defun([Def,Name,Args|Rest], D, I, L) when is_atom(Name), (D > 3) or (D < 0) -> 113 Dcs = atom_to_list(Def), %Might not actually be defun 114 Ncs = atom_to_list(Name), 115 case lfe_lib:is_symb_list(Args) of 116 true -> %Traditional 117 Acs = term(Args, D-2, I + length(Dcs) + length(Ncs) + 3, L), 118 Tcs = list_tail(Rest, D-3, I+2, L), 119 ["(",Dcs," ",Ncs," ",Acs,Tcs,")"]; 120 false -> %Matching 121 Tcs = list_tail([Args|Rest], D-2, I+2, L), 122 ["(",Dcs," ",Ncs,Tcs,")"] 123 end; 124defun(List, D, I, L) -> 125 %% Too short to get worked up about, or not a "proper" defun or 126 %% not enough depth. 127 ["(",list(List, D-1, I+1, L),")"]. 128 129%% type(List, Depth, Indentation, LineLength, TypeCount) -> [char()]. 130%% Print a special type form indenting first TypeCount elements afer 131%% type and rest indented 2 steps. 132 133type([Car|Cdr], D, I, L, N) when (D > 2) or (D < 0) -> 134 %% Handle special lists, we KNOW Car is an atom. 135 Cs = atom_to_list(Car), 136 NewI = I + length(Cs) + 2, 137 {Spec,Rest} = split(N, Cdr), 138 Tcs = [list(Spec, D-1, NewI, L), 139 list_tail(Rest, D-2, I+2, L)], 140 ["(" ++ Cs," ",Tcs,")"]; 141type(List, D, I, L, _) -> 142 %% Too short to get worked up about or not enough depth. 143 [$(,list(List, D-1, I+1, L),$)]. 144 145%% split(N, List) -> {List1,List2}. 146%% Split a list into two lists, the first containing the first N 147%% elements and the second the rest. Be tolerant of too few elements. 148 149split(0, L) -> {[],L}; 150split(_, []) -> {[],[]}; 151split(N, [H|T]) -> 152 {H1,T1} = split(N-1, T), 153 {[H|H1],T1}. 154 155%% list_max(List, Depth, Indentation, LineLength) -> {yes,Chars} | no. 156%% Maybe print a list on one line, but abort if it goes past 157%% LineLength. 158 159list_max([], _, _, _) -> {yes,[]}; 160list_max(_, 0, _, _) -> {yes,"..."}; 161list_max([Car|Cdr], D, I, L) -> 162 Cs = term(Car, D, 0, 99999), %Never break the line 163 tail_max(Cdr, D-1, I + flatlength(Cs), L, [Cs]). 164 165%% tail_max(Tail, Depth, Indentation, LineLength) -> {yes,Chars} | no. 166%% Maybe print the tail of a list on one line, but abort if it goes 167%% past LineLength. We know about dotted pairs. When we reach depth 0 168%% we just quit as we know necessary "..." will have come from an 169%% earlier print1 at same depth. 170 171tail_max(_, _, I, L, _) when I >= L -> no; %No more room 172tail_max([], _, _, _, Acc) -> {yes,reverse(Acc)}; 173tail_max(_, 0, _, _, Acc) -> {yes,reverse(Acc, [" ..."])}; 174tail_max([Car|Cdr], D, I, L, Acc) -> 175 Cs = term(Car, D, 0, 99999), %Never break the line 176 tail_max(Cdr, D-1, I + flatlength(Cs) + 1, L, [Cs," "|Acc]); 177tail_max(S, D, I, L, Acc) -> 178 Cs = term(S, D, 0, 99999), %Never break the line 179 tail_max([], D-1, I + flatlength(Cs) + 3, L, [Cs," . "|Acc]). 180 181%% list(List, Depth, Indentation, LineLength) 182%% Print a list, one element per line but print multiple atomic 183%% elements on one line. No leading/trailing (). 184 185list([], _, _, _) -> []; 186list(_, 0, _, _) -> "..."; 187list([Car|Cdr], D, I, L) -> 188 case list_element(Car, I, D, I, L) of 189 {join,Ccs,Cl} -> %Atomic that fits 190 [Ccs|list_tail(Cdr, I+Cl, D, I, L)]; 191 {break,Ccs,_} -> %Atomic that does not fit 192 [Ccs|list_tail(Cdr, L, D, I, L)]; 193 {break,Ccs} -> %Non-atomic 194 %% Force a break after not an atomic. 195 [Ccs|list_tail(Cdr, L, D, I, L)] 196 end. 197 198%% list_tail(Tail, Depth, Indentation, LineLength) 199%% list_tail(Tail, CurrentLength, Depth, Indentation, LineLength) 200%% Print the tail of a list decreasing the depth for each element. We 201%% print multiple atomic elements on one line and we know about 202%% dotted pairs. 203 204list_tail(Tail, D, I, L) -> 205 list_tail(Tail, L, D, I, L). %Force a break 206 207list_tail([], _, _, _, _) -> ""; 208list_tail(_, _, 0, _, _) -> " ..."; 209list_tail([Car|Cdr], CurL, D, I, L) -> 210 case list_element(Car, CurL+1, D, I, L) of 211 {join,Ccs,Cl} -> %Atomic that fits 212 [$\s,Ccs,list_tail(Cdr, CurL+1+Cl, D-1, I, L)]; 213 {break,Ccs,Cl} -> %Atomic that does not fit 214 [newline(I, Ccs),list_tail(Cdr, I+Cl, D-1, I, L)]; 215 {break,Ccs} -> %Non-atomic 216 %% Force a break after not an atomic. 217 [newline(I, Ccs),list_tail(Cdr, L, D-1, I, L)] 218 end; 219list_tail(Cdr, CurL, D, I, L) -> 220 case list_element(Cdr, CurL+3, D, I, L) of 221 {join,Ccs,_} -> [" . "|Ccs]; %Atomic that fits 222 {break,Ccs,_} -> %Atomic that does not fit 223 [" .\n",blanks(I, Ccs)]; 224 {break,Ccs} -> %Non-atomic 225 [" .\n",blanks(I, Ccs)] 226 end. 227 228list_element(E, CurL, D, _, L) when is_number(E); 229 is_atom(E); 230 is_pid(E); 231 is_reference(E); 232 is_port(E); 233 is_function(E); 234 E =:= [] -> 235 Ecs = lfe_io_write:term(E, D), 236 El = flatlength(Ecs), 237 if CurL+El =< L - 10 -> {join,Ecs,El}; %Don't make the line too wide 238 true -> {break,Ecs,El} 239 end; 240list_element(E, _, D, I, L) -> 241 {break,term(E, D, I, L)}. 242 243blanks(N, Tail) -> string:chars($\s, N, Tail). 244 245newline(N) -> newline(N, []). 246 247newline(N, Tail) -> 248 [$\n|blanks(N, Tail)]. 249 250%% indent_type(Form) -> N | none. 251%% Defines special indentation. None means default, N is number of 252%% sexprs in list which are indented *after* Form while all following 253%% that end up at indent+2. 254 255%% Old style forms. 256indent_type('define') -> 1; 257indent_type('define-syntax') -> 1; 258indent_type('define-record') -> 1; 259indent_type('begin') -> 0; 260indent_type('let-syntax') -> 1; 261indent_type('syntax-rules') -> 0; 262indent_type('macro') -> 0; 263%% New style forms. 264indent_type('defmodule') -> 1; 265indent_type('defun') -> defun; 266indent_type('defmacro') -> defun; 267indent_type('defsyntax') -> 1; 268indent_type('defrecord') -> 1; 269indent_type('deftest') -> 1; 270%% Core forms. 271indent_type('progn') -> 0; 272indent_type('lambda') -> 1; 273indent_type('match-lambda') -> 0; 274indent_type('let') -> 1; 275indent_type('let-function') -> 1; 276indent_type('letrec-function') -> 1; 277indent_type('let-macro') -> 1; 278indent_type('if') -> 1; 279indent_type('case') -> 1; 280indent_type('receive') -> 0; 281indent_type('catch') -> 0; 282indent_type('try') -> 1; 283indent_type('funcall') -> 1; 284indent_type('call') -> 2; 285indent_type('eval-when-compile') -> 0; 286indent_type('define-function') -> 1; 287indent_type('define-macro') -> 1; 288indent_type('define-module') -> 1; 289indent_type('extend-module') -> 0; 290indent_type('define-type') -> 1; 291indent_type('define-opaque-type') -> 1; 292indent_type('define-function-spec') -> 1; 293%% Core macros. 294indent_type(':') -> 2; 295indent_type('cond') -> 999; %All following forms 296indent_type('let*') -> 1; 297indent_type('flet') -> 1; 298indent_type('flet*') -> 1; 299indent_type('fletrec') -> 1; 300indent_type(macrolet) -> 1; 301indent_type(syntaxlet) -> 1; 302indent_type('do') -> 2; 303indent_type('lc') -> 1; %List comprehensions 304indent_type('list-comp') -> 1; 305indent_type('bc') -> 1; %Binary comprehensions 306indent_type('binary-comp') -> 1; 307indent_type('match-spec') -> 0; 308indent_type(_) -> none. 309 310%% map(KVs, Depth, Indentation, LineLength). 311%% map_body(KVs, CurrentLineIndent, Depth, Indentation, LineLength) 312%% Don't include the start and end of the map as this is called from 313%% differenct functions. 314 315map_body(KVs, D, I, L) -> 316 map_body(KVs, I, D, I, L-1). 317 318map_body([K,V|KVs], CurL, D, I, L) -> 319 case map_assoc(K, V, CurL, D, I, L) of 320 {curr_line,KVcs,KVl} -> %Both fit on current line 321 [KVcs,map_rest(KVs, CurL+KVl, D-1, I, L)]; 322 {one_line,KVcs,KVl} -> %Both fit on one line 323 [KVcs,map_rest(KVs, I+KVl, D-1, I, L)]; 324 {sep_lines,Kcs,Vcs} -> %On separate lines 325 %% Force a break after K/V split. 326 [Kcs,newline(I, Vcs),map_rest(KVs, L, D-1, I, L)] 327 end; 328map_body(E, CurL, D, I, L) -> 329 map_last(E, CurL, D, I, L). 330 331%% map_rest(KVs, Depth, Indentation, LineLength) 332%% map_rest(KVs, CurrentLineIndent, Depth, Indentation, LineLength) 333 334map_rest(KVs, D, I, L) -> 335 map_rest(KVs, I, D, I, L-1). 336 337map_rest(_, _, 0, _, _) -> " ..."; %Reached our depth 338map_rest([K,V|KVs], CurL, D, I, L) -> 339 case map_assoc(K, V, CurL+1, D, I, L) of 340 {curr_line,KVcs,KVl} -> %Both fit on current line 341 [$\s,KVcs,map_rest(KVs, CurL+KVl+1, D-1, I, L)]; 342 {one_line,KVcs,KVl} -> %Both fit on one line 343 [newline(I, KVcs),map_rest(KVs, I+KVl, D-1, I, L)]; 344 {sep_lines,Kcs,Vcs} -> %On separate lines 345 %% Force a break after K/V split. 346 [newline(I, Kcs),newline(I, Vcs),map_rest(KVs, L, D-1, I, L)] 347 end; 348map_rest(E, CurL, D, I, L) -> 349 map_last(E, CurL, D, I, L). 350 351%% Print any remaining element as list element. 352map_last(Tail, CurL, D, I, L) -> 353 list_tail(Tail, CurL, D, I, L). 354 355map_assoc(K, V, CurL, D, I, L) -> 356 Kcs = term(K, D, 0, 99999), %Never break the line 357 Kl = flatlength(Kcs), 358 Vcs = term(V, D, 0, 99999), %Never break the line 359 Vl = flatlength(Vcs), 360 if CurL+Kl+Vl < L-10 -> %Both fit on current line 361 {curr_line,[Kcs,$\s,Vcs],Kl+1+Vl}; 362 I+Kl+Vl < L-10 -> %Both fit on one line 363 {one_line,[Kcs,$\s,Vcs],Kl+1+Vl}; 364 true -> %On separate lines 365 %% Try to reuse flat prints if they fit on one line. 366 Ks = if I+Kl < L-10 -> Kcs; 367 true -> term(K, D, I, L) 368 end, 369 Vs = if I+Vl < L-10 -> Vcs; 370 true -> term(V, D, I, L) 371 end, 372 {sep_lines,Ks,Vs} 373 end. 374 375%% last_length(Chars) -> Length. 376%% last_length(Chars, CurrentLine) -> Length. 377%% Return the length of the last line in the text. 378 379last_length(S) -> last_length(S, 0). 380 381last_length([H|T], L0) when is_list(H) -> 382 L1 = last_length(H, L0), %Must go left-to-right 383 last_length(T, L1); 384last_length([$\n|T], _) -> 385 last_length(T, 0); 386last_length([_|T], L) -> 387 last_length(T, L+1); 388last_length([], L) -> L. 389