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_env.erl
16%% Author  : Robert Virding
17%% Purpose : Lisp Flavoured Erlang environment functions.
18
19-module(lfe_env).
20
21-export([new/0,add_env/2,
22         get_vars/1,clr_vars/1,set_vars/2,fold_vars/3,
23         get_funs/1,clr_funs/1,set_funs/2,fold_funs/3,fold_macros/3,
24         add_vbinding/3,add_vbindings/2,is_vbound/2,get_vbinding/2,
25         fetch_vbinding/2,del_vbinding/2,
26         add_fbinding/4,add_fbindings/2,
27         is_fbound/3,get_fbinding/3,add_ibinding/5,
28         add_mbinding/3,add_mbindings/2,
29         is_mbound/2,get_mbinding/2]).
30
31%% Define access macros depending on whether we have maps.
32-ifdef(HAS_MAPS).
33-define(NEW(), #{}).
34-define(IS_KEY(K, D), maps:is_key(K, D)).
35-define(GET(K, D), maps:get(K, D)).
36-define(FIND(K, D), maps:find(K, D)).
37-define(PUT(K, V, D), maps:put(K, V, D)).
38-define(ERASE(K, D), maps:remove(K, D)).
39-define(FOLD(F, A, D), maps:fold(F, A, D)).
40-define(UPDATE(K, UPD, DEF, D),                 %This is slightly complex
41        begin (fun (___K, {ok,___V}) ->
42                       maps:put(___K, UPD(___V), D);
43                   (___K, error) ->
44                       maps:put(___K, DEF, D)
45               end)(K, maps:find(K, D)) end).
46-else.
47-define(NEW(), orddict:new()).
48-define(IS_KEY(K, D), orddict:is_key(K, D)).
49-define(GET(K, D), orddict:fetch(K, D)).
50-define(FIND(K, D), orddict:find(K, D)).
51-define(PUT(K, V, D), orddict:store(K, V, D)).
52-define(ERASE(K, D), orddict:erase(K, D)).
53-define(FOLD(F, A, D), orddict:fold(F, A, D)).
54-define(UPDATE(K, UPD, DEF, D), orddict:update(K, UPD, DEF, D)).
55-endif.
56
57%% The environment structure.
58-record(env, {vars=null,funs=null}).
59
60%% -compile([export_all]).
61
62%% new() -> Env.
63%% add_env(Env1, Env2) -> Env.
64%% get_vars(Env) -> Vars.
65%% clr_vars(Env) -> Env.
66%% set_vars(Vars, Env) -> Env.
67%% fold_vars(Fun, Acc, Env) -> Acc.
68%% get_funs(Env) -> Funs.
69%% clr_funs(Env) -> Env.
70%% set_funs(Funs, Env) -> Env.
71%% fold_funs(Fun, Acc, Env) -> Acc.
72%% fold_macros(Fun, Acc, Env) -> Acc.
73%% add_vbinding(Name, Val, Env) -> Env.
74%% add_vbindings([{Name,Val}], Env) -> Env.
75%% is_vbound(Symb, Env) -> bool().
76%% get_vbinding(Name, Env) -> {yes,Val} | no.
77%% fetch_vbinding(Name, Env) -> Val.
78%% del_vbinding(Name, Env) -> Env.
79%% add_fbinding(Name, Arity, Val, Env) -> Env.
80%% add_fbindings([{Name,Arity,Val}], Env) -> Env.
81%% add_ibinding(Mod, Name, Arity, LocalName, Env) -> Env.
82%% is_fbound(Symb, Arity, Env) -> bool().
83%% get_fbinding(Name, Arity, Env) -> {yes,Val} | {yes,Mod,Name} | no.
84%% add_mbinding(Name, Macro, Env) -> Env.
85%% add_mbindings([{Name,Macro}], Env) -> Env.
86%% is_mbound(Symb, Env) -> bool().
87%% get_mbinding(Name, Env) -> {yes,Macro} | no.
88%%
89%%  The dictionary is in two parts: the variable bindings and the
90%%  function/macro bindings, the vars and the funs fields respectively
91%%  in the env record. The variables are kept in an orddict with the
92%%  name as key.
93%%
94%%  For the functions/macros it is a little more complex due to
95%%  shadowing. Defining a macro effectively shadows all the function
96%%  bindings with the same name while defining a function effectively
97%%  shadows a macro with the same name or replaces a function
98%%  definition with the same name and arity. Functions are kept an
99%%  orddict with the name as key and the value is either the macro
100%%  definition or a dict of arity definition.
101
102new() -> #env{vars=?NEW(),funs=?NEW()}.
103
104-ifdef(HAS_MAPS).
105add_env(#env{vars=Vs1,funs=Fs1}, #env{vars=Vs2,funs=Fs2}) ->
106    #env{vars=maps:merge(Vs2, Vs1),             %Always take left env
107         funs=maps:merge(Fs2, Fs1)}.
108-else.
109add_env(#env{vars=Vs1,funs=Fs1}, #env{vars=Vs2,funs=Fs2}) ->
110    Merge = fun (_, V1, _) -> V1 end,           %Always take left env
111    #env{vars=orddict:merge(Merge, Vs1, Vs2),
112         funs=orddict:merge(Merge, Fs1, Fs2)}.
113-endif.
114
115%% Accessing the variable table.
116
117get_vars(Env) -> Env#env.vars.
118clr_vars(Env) -> Env#env{vars=?NEW()}.
119set_vars(Vars, Env) -> Env#env{vars=Vars}.
120fold_vars(Fun, Acc, Env) ->
121    ?FOLD(Fun, Acc, Env#env.vars).
122
123%% Accessing the function/macro table.
124
125get_funs(Env) -> Env#env.funs.
126clr_funs(Env) -> Env#env{funs=?NEW()}.
127set_funs(Funs, Env) -> Env#env{funs=Funs}.
128
129%% Fold over functions and macros.
130
131fold_funs(Fun, Acc, Env) ->
132    Ofun = fun (F, {function,Fs}, Ac) ->        %Function
133                   Ffun = fun ({Ar,Def}, A) ->
134                                  Fun(F, Ar, Def, A)
135                          end,
136                   lists:foldl(Ffun, Ac, Fs);
137               (_, _, A) -> A                   %Macro
138           end,
139    ?FOLD(Ofun, Acc, Env#env.funs).
140
141fold_macros(Fun, Acc, Env) ->
142    Ofun = fun (F, {macro,Def}, A) ->           %Macro
143                   Fun(F, Def, A);
144               (_, _, A) -> A                   %Function
145           end,
146    ?FOLD(Ofun, Acc, Env#env.funs).
147
148%% Variables.
149
150add_vbinding(N, V, #env{vars=Vs}=Env) ->
151    Env#env{vars=?PUT(N, V, Vs)}.
152
153add_vbindings(Vbs, #env{vars=Vs0}=Env) ->
154    Vs1 = lists:foldl(fun ({N,V}, Vs) -> ?PUT(N, V, Vs) end, Vs0, Vbs),
155    Env#env{vars=Vs1}.
156
157is_vbound(N, #env{vars=Vs}) ->
158    ?IS_KEY(N, Vs).
159
160get_vbinding(N, #env{vars=Vs}) ->
161    case ?FIND(N, Vs) of
162        {ok,V} -> {yes,V};
163        error -> no
164    end.
165
166fetch_vbinding(N, #env{vars=Vs}) ->
167    ?GET(N, Vs).
168
169del_vbinding(N, #env{vars=Vs}=Env) ->
170    Env#env{vars=?ERASE(N, Vs)}.
171
172%% Functions.
173
174add_fbinding(N, A, V, #env{funs=Fs0}=Env) ->
175    Fs1 = add_fbinding_1(N, A, {A,V}, Fs0),
176    Env#env{funs=Fs1}.
177
178add_fbinding_1(N, A, T, Fs) ->
179    Def = {function,[T]},                       %We KNOW!
180    Upd = fun ({function,Fas}) ->
181                  {function,lists:keystore(A, 1, Fas, T)};
182              (_) -> Def                        %Overwrite macros
183          end,
184    ?UPDATE(N, Upd, Def, Fs).
185
186add_fbindings(Fbs, #env{funs=Fs0}=Env) ->
187    Fs1 = lists:foldl(fun ({N,A,V}, Fs) -> add_fbinding_1(N, A, {A,V}, Fs) end,
188		      Fs0, Fbs),
189    Env#env{funs=Fs1}.
190
191add_ibinding(M, R, A, L, #env{funs=Fs0}=Env) ->
192    Fs1 = add_fbinding_1(L, A, {A,M,R}, Fs0),
193    Env#env{funs=Fs1}.
194
195is_fbound(N, A, #env{funs=Fs}) ->
196    case ?FIND(N, Fs) of
197        {ok,{function,Fas}} ->
198            case lists:keyfind(A, 1, Fas) of
199                false -> false;
200                _ -> true
201            end;
202        _ -> false                              %A macro or not found
203    end.
204
205get_fbinding(N, A, #env{funs=Fs}) ->
206    case ?FIND(N, Fs) of
207        {ok,{function,Fas}} ->
208            case lists:keyfind(A, 1, Fas) of
209                {A,M,F} -> {yes,M,F};
210                {A,V} -> {yes,V};
211                false -> no
212            end;
213        _ -> no                                 %A macro or not found
214    end.
215
216%% Macros.
217
218add_mbinding(N, V, #env{funs=Fs}=Env) ->
219    Env#env{funs=?PUT(N, {macro,V}, Fs)}.
220
221add_mbindings(Fbs, #env{funs=Fs0}=Env) ->
222    Fs1 = lists:foldl(fun ({N,V}, Fs) -> ?PUT(N, {macro,V}, Fs) end,
223		      Fs0, Fbs),
224    Env#env{funs=Fs1}.
225
226is_mbound(N, #env{funs=Fs}) ->
227    case ?FIND(N, Fs) of
228        {ok,{macro,_}} -> true;
229        _ -> false
230    end.
231
232get_mbinding(N, #env{funs=Fs}) ->
233    case ?FIND(N, Fs) of
234        {ok,{macro,V}} -> {yes,V};
235        _ -> no
236    end.
237