1%% Copyright (c) 2008-2015 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_write.erl
16%% Author  : Robert Virding
17%% Purpose : Basic write functions for Lisp Flavoured Erlang.
18
19-module(lfe_io_write).
20
21-export([term/1,term/2,symbol/1,string/2,bitstring/2]).
22
23%% -compile(export_all).
24
25%% Define IS_MAP/1 macro for is_map/1 bif.
26-ifdef(HAS_MAPS).
27-define(IS_MAP(T), is_map(T)).
28-else.
29-define(IS_MAP(T), false).
30-endif.
31
32%% print([IoDevice], Sexpr) -> ok.
33%% print1(Sexpr) -> [char()].
34%% print1(Sexpr, Depth) -> [char()].
35%%  A simple print function. Does not pretty-print but stops at Depth.
36
37term(S) -> term(S, -1).                         %All the way
38
39term(_, 0) -> "...";
40term(Symb, _) when is_atom(Symb) -> symbol(Symb);
41term(Numb,_ ) when is_integer(Numb) -> integer_to_list(Numb);
42term(Numb, _) when is_float(Numb) -> io_lib_format:fwrite_g(Numb);
43term(List, D) when is_list(List) ->
44    [$(,list(List, D-1),$)];
45term({}, _) -> "#()";
46term(Vec, D) when is_tuple(Vec) ->
47    Es = tuple_to_list(Vec),
48    ["#(",list(Es, D-1),")"];
49term(Bit, _) when is_bitstring(Bit) ->
50    bitstring(Bit);
51term(Map, D) when ?IS_MAP(Map) -> map(Map, D);
52term(Other, D) ->                               %Use standard Erlang for rest
53    io_lib:write(Other, D).
54
55%% symbol(Symbol) -> [char()].
56
57symbol(Symb) ->
58    Cs = atom_to_list(Symb),
59    case quote_symbol(Symb, Cs) of
60        true -> string(Cs , $|);
61        false -> Cs
62    end.
63
64%% bitstring(Bitstring) -> [char()]
65%% bitstring(Bitstring, Depth) -> [char()]
66%%  Print the bytes in a bitstring. Print bytes except for last which
67%%  we add size field if not 8 bits big.
68
69bitstring(Bit) -> bitstring(Bit, -1).
70
71bitstring(Bit, D) ->
72    ["#B(",bytes(Bit, D),$)].
73
74bytes(_, 0) -> "...";
75bytes(<<B:8>>, _) -> integer_to_list(B);       %Catch last binary byte
76bytes(<<B:8,Bs/bitstring>>, N) ->
77    [integer_to_list(B),$\s|bytes(Bs, N-1)];
78bytes(<<>>, _) -> [];
79bytes(Bits, _) ->                               %0 < Size < 8
80    N = bit_size(Bits),
81    <<B:N>> = Bits,
82    io_lib:format("(~w (size ~w))", [B,N]).
83
84%% list(List, Depth) -> Chars.
85%%  Print the elements in a list. We handle the empty list and depth=0.
86
87list([], _) -> [];
88list(_, 0) -> "...";
89list([Car|Cdr], D) ->
90    [term(Car, D)|list_tail(Cdr, D-1)].
91
92%% list_tail(Tail, Depth)
93%%  Print the tail of a list decrasing the depth for each element. We
94%%  know about dotted pairs.
95
96list_tail([], _) -> "";
97list_tail(_, 0) -> [$\s|"..."];
98list_tail([S|Ss], D) ->
99    [$\s,term(S, D)|list_tail(Ss, D-1)];
100list_tail(S, D) -> [" . "|term(S, D)].
101
102%% map(Map, Depth)
103
104map(Map, D) ->
105    [$#,$M,$(,map_body(maps:to_list(Map), D), $)].
106
107map_body([], _) -> [];
108map_body(_, D) when D =:= 0; D =:= 1 -> "...";
109map_body([KV], D) -> map_assoc(KV, D);
110map_body([KV|KVs], D) ->
111    Massoc = map_assoc(KV, D),
112    [Massoc,$\s|map_body(KVs, D-1)].
113
114map_assoc({K,V}, D) ->
115    [term(K, D-1),$\s,term(V, D-1)].
116
117%% quote_symbol(Symbol, SymbChars) -> bool().
118%%  Check if symbol needs to be quoted when printed. If it can read as
119%%  a number then it must be quoted.
120
121quote_symbol('.', _) -> true;                   %Needs quoting
122quote_symbol(_, [C|Cs]=Cs0) ->
123    case catch {ok,list_to_float(Cs0)} of
124        {ok,_} -> true;
125        _ -> case catch {ok,list_to_integer(Cs0)} of
126                 {ok,_} -> true;
127                 _ -> not (lfe_scan:start_symbol_char(C) andalso
128                           symbol_chars(Cs))
129             end
130    end;
131quote_symbol(_, []) -> true.
132
133symbol_chars(Cs) -> lists:all(fun lfe_scan:symbol_char/1, Cs).
134
135%% string([Char], QuoteChar) -> [Char]
136%%  Generate the list of characters needed to print a string.
137
138string(S, Q) ->
139    [Q,string_chars(S, Q)].
140
141string_chars([], Q) -> [Q];
142string_chars([C|Cs], Q) ->
143    string_char(C, Q, string_chars(Cs, Q)).
144
145string_char(Q, Q, Tail) -> [$\\,Q|Tail];        %Must check these first!
146string_char($\\, _, Tail) -> [$\\,$\\|Tail];
147string_char($\b, _, Tail) -> [$\\,$b|Tail];     %\b = BS
148string_char($\t, _, Tail) -> [$\\,$t|Tail];     %\t = TAB
149string_char($\n, _, Tail) -> [$\\,$n|Tail];     %\n = LF
150string_char($\v, _, Tail) -> [$\\,$v|Tail];     %\v = VT
151string_char($\f, _, Tail) -> [$\\,$f|Tail];     %\f = FF
152string_char($\r, _, Tail) -> [$\\,$r|Tail];     %\r = CR
153string_char($\e, _, Tail) -> [$\\,$e|Tail];     %\e = ESC
154string_char($\d, _, Tail) -> [$\\,$d|Tail];     %\d = DEL
155string_char(C, _, Tail) -> [C|Tail].
156