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_lib.erl 16%% Author : Robert Virding 17%% Purpose : Lisp Flavoured Erlang library of miscellaneous functions. 18 19-module(lfe_lib). 20 21%% General library functions. 22-export([is_symb/1,is_symb_list/1,is_proper_list/1,is_doc_string/1]). 23 24-export([proc_forms/3,proc_forms/4]). 25 26%% Miscellaneous useful LFE functions. 27-export([split_name/1]). 28 29-export([format_exception/6,format_stacktrace/3]). 30 31%% -compile([export_all]). 32 33%% is_symb(Sexpr) -> bool(). 34%% is_symb_list(Sexprs) -> bool(). 35%% is_proper_list(Sexprs) -> bool(). 36%% is_doc_string(Doc) -> bool(). 37 38is_symb(S) -> is_atom(S). 39 40is_symb_list([S|Ss]) when is_atom(S) -> 41 is_symb_list(Ss); 42is_symb_list([]) -> true; 43is_symb_list(_) -> false. %Might not be a proper list 44 45is_proper_list([_|Ss]) -> is_proper_list(Ss); 46is_proper_list([]) -> true; 47is_proper_list(_) -> false. 48 49is_doc_string(Doc) -> 50 is_binary(Doc) or io_lib:char_list(Doc). 51 52%% proc_forms(FormFun, Forms, State) -> {Forms,State}. 53%% proc_forms(FormFun, Forms, Line, State) -> {Forms,State}. 54%% Process a (progn ... ) nested list of forms where top level list 55%% has elements {Form,LineNumber}. Return a flat list of results and 56%% passes through State. All the elements are processed left to 57%% right. The accumulator is in reverse order! 58 59proc_forms(Fun, Fs, St) -> proc_top_forms(Fun, Fs, [], St). 60 61proc_forms(Fun, Fs, L, St0) -> 62 {Rs,St1} = proc_progn_forms(Fun, Fs, L, [], St0), 63 {lists:reverse(Rs),St1}. 64 65proc_top_forms(Fun, [{['progn'|Bs],L}|Fs], Rs0, St0) -> 66 {Rs1,St1} = proc_progn_forms(Fun, Bs, L, Rs0, St0), 67 proc_top_forms(Fun, Fs, Rs1, St1); 68proc_top_forms(Fun, [{F,L}|Fs], Rs, St0) -> 69 {Frs,St1} = Fun(F, L, St0), 70 proc_top_forms(Fun, Fs, lists:reverse(Frs, Rs), St1); 71proc_top_forms(_, [], Rs, St) -> {lists:reverse(Rs),St}. 72 73proc_progn_forms(Fun, [['progn'|Bbs]|Bs], L, Rs0, St0) -> 74 {Rs1,St1} = proc_progn_forms(Fun, Bbs, L, Rs0, St0), 75 proc_progn_forms(Fun, Bs, L, Rs1, St1); 76proc_progn_forms(Fun, [B|Bs], L, Rs, St0) -> 77 {Frs,St1} = Fun(B, L, St0), 78 proc_progn_forms(Fun, Bs, L, lists:reverse(Frs, Rs), St1); 79proc_progn_forms(_, [], _, Rs, St) -> 80 {Rs,St}. 81 82%% proc_top_forms(Fun, [{['progn'|Bs],L}|Fs], Rs, St) -> 83%% proc_progn_forms(Fun, Bs, L, [], Fs, Rs, St); 84%% proc_top_forms(Fun, [{F,L}|Fs], Rs, St0) -> 85%% {Frs,St1} = Fun(F, L, St0), 86%% proc_top_forms(Fun, Fs, lists:reverse(Frs, Rs), St1); 87%% proc_top_forms(_, [], Rs, St) -> {lists:reverse(Rs),St}. 88 89%% proc_progn_forms(Fun, [['progn'|Bs1]|Bs], L, Bss, Fs, Rs, St) -> 90%% proc_progn_forms(Fun, Bs1, L, [Bs|Bss], Fs, Rs, St); 91%% proc_progn_forms(Fun, [B|Bs], L, Bss, Fs, Rs, St0) -> 92%% {Frs,St1} = Fun(B, L, St0), 93%% proc_progn_forms(Fun, Bs, L, Bss, Fs, lists:reverse(Frs, Rs), St1); 94%% proc_progn_forms(Fun, [], L, [Bs|Bss], Fs, Rs, St) -> 95%% proc_progn_forms(Fun, Bs, L, Bss, Fs, Rs, St); 96%% proc_progn_forms(Fun, [], _, [], Fs, Rs, St) -> 97%% proc_top_forms(Fun, Fs, Rs, St). 98 99%% Miscellaneous useful LFE functions. 100 101%% split_name(Name) -> [Mod] | [Mod,Func] | [Mod,Func,Arity]. 102%% Split a name into its parts. Don't handle the case where there is 103%% no module. 104 105split_name('=:=/2') -> ['=:=',2]; 106split_name(Name) -> 107 Str = atom_to_list(Name), 108 case string:chr(Str, $:) of 109 0 -> [Name]; %Only module 110 C when C > 1 -> %Don't allow empty module name 111 Mod = list_to_atom(string:substr(Str, 1, C-1)), 112 Rest = string:substr(Str, C+1), 113 case string:rchr(Rest, $/) of 114 0 -> [Mod,list_to_atom(Rest)]; %Module and function 115 S -> %Module, function and arity 116 [Mod,list_to_atom(string:substr(Rest, 1, S-1)), 117 list_to_integer(string:substr(Rest, S+1))] 118 end 119 end. 120 121%% format_exception(Class, Error, Stacktrace, SkipFun, FormatFun, Indentation) 122%% -> DeepCharList. 123%% Format an exception. Class, Error and Stacktrace describe the 124%% exception; SkipFun is used to trim the end of stack; FormatFun is 125%% used to format terms; and Indentation is the current column. 126 127format_exception(Cl, Error0, St0, Skip, Format, I) -> 128 Cs = case Cl of %Class type as string 129 throw -> "throw"; 130 exit -> "exit"; 131 error -> "error" 132 end, 133 {Error1,St1} = case is_stacktrace(St0) of 134 true -> {Error0,St0}; 135 false -> {{Error0,St0},[]} 136 end, 137 P = "exception " ++ Cs ++ ": ", %Class description string 138 [P,format_reason(Error1, length(P)+I-1),"\n", 139 format_stacktrace(St1, Skip, Format)]. 140 141%% format_reason(Error, Indentation) -> DeepCharList. 142%% Format an error giving a little better information. 143 144format_reason(badarg, _I) -> <<"bad argument">>; 145format_reason(badarith, _I) -> <<"error in arithmetic expression">>; 146format_reason({badmatch,V}, I) -> 147 lfe_io:format1(<<"no match of value ~.*P">>, [I+18,V,10]); 148format_reason(function_clause, _I) -> <<"no function clause matching">>; 149format_reason({case_clause,V}, I) -> 150 lfe_io:format1(<<"no case clause matching ~.*P">>, [I+24,V,10]); 151format_reason(if_clause, _I) -> <<"no if clause matching">>; 152format_reason(undef, _I) -> <<"undefined function">>; 153%% Some LFE eval specific errors. 154format_reason({unbound_symb,S}, _I) -> 155 lfe_io:format1(<<"symbol ~w is unbound">>, [S]); 156format_reason(illegal_guard, _I) -> <<"illegal guard">>; 157format_reason({undefined_func,{F,A}}, _I) -> 158 lfe_io:format1(<<"undefined function ~w/~w">>, [F,A]); 159format_reason(if_expression, _I) -> <<"non-boolean if test">>; 160format_reason({illegal_pattern,Pat}, _I) -> 161 lfe_io:format1(<<"illegal pattern ~w">>, [Pat]); 162format_reason({illegal_literal,Lit}, I) -> 163 lfe_io:format1(<<"illegal literal value ~.*P">>, [I+22,Lit,10]); 164format_reason(bad_arity, _I) -> <<"arity mismatch">>; 165%% Default catch-all 166format_reason(Error, I) -> %Default catch-all 167 lfe_io:prettyprint1(Error, 10, I). 168 169%% format_stacktrace(Stacktrace, SkipFun, FormatFun) -> DeepCharList. 170%% Format a stacktrace. SkipFun is used to trim the end of stack; 171%% FormatFun is used to format terms. 172 173format_stacktrace(St0, Skip, Format) -> 174 St1 = lists:reverse(lists:dropwhile(Skip, lists:reverse(St0))), 175 Print = fun (F) -> format_stackcall(F, Format) end, 176 lists:map(Print, St1). 177 178format_stackcall({M,F,A}, _) when is_integer(A) -> %Pre R15 179 lfe_io:format1(" in ~w:~w/~w\n", [M,F,A]); 180format_stackcall({M,F,A}, Format) -> 181 [" in ",Format([M,':',F|A], 5),"\n"]; 182format_stackcall({M,F,A,Loc},_) when is_integer(A) -> %R15 and later. 183 lfe_io:format1(" in ~w:~w/~w ~s\n", [M,F,A,location(Loc)]); 184format_stackcall({M,F,A,_}, Format) -> 185 [" in ",Format([M,':',F|A], 5),"\n"]. 186 187location(Loc) -> 188 File = proplists:get_value(file, Loc), 189 Line = proplists:get_value(line, Loc), 190 if File =/= undefined, Line =/= undefined -> 191 lfe_io:format1("(~s, line ~w)", [File,Line]); 192 true -> "" 193 end. 194 195is_stacktrace([{M,F,A}|Fs]) %Pre R15 196 when is_atom(M), is_atom(F), is_integer(A) -> is_stacktrace(Fs); 197is_stacktrace([{M,F,As}|Fs]) 198 when is_atom(M), is_atom(F), length(As) >= 0 -> is_stacktrace(Fs); 199is_stacktrace([{M,F,A,I}|Fs]) %R15 and later 200 when is_atom(M), is_atom(F), is_integer(A), is_list(I) -> is_stacktrace(Fs); 201is_stacktrace([{M,F,As,I}|Fs]) 202 when is_atom(M), is_atom(F), length(As) >= 0, is_list(I) -> is_stacktrace(Fs); 203is_stacktrace([]) -> true; 204is_stacktrace(_) -> false. 205