1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2019. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20%% Purpose: Prepare Core Erlang not generated by v3_core.
21
22-module(sys_core_prepare).
23-export([module/2]).
24
25-include("core_parse.hrl").
26
27-spec module(cerl:c_module(), [compile:option()]) ->
28        {'ok',cerl:c_module(),[]}.
29
30module(Mod0, _Opts) ->
31    Count = cerl_trees:next_free_variable_name(Mod0),
32    {Mod,_} = cerl_trees:mapfold(fun rewrite_recv/2, Count, Mod0),
33    {ok,Mod,[]}.
34
35rewrite_recv(#c_receive{clauses=[],timeout=Timeout0,action=Action}, Count0) ->
36    %% Lower a receive with only an after blcok to its primitive operations.
37    False = #c_literal{val=false},
38    True = #c_literal{val=true},
39
40    {TimeoutVal,Count1} = new_var(Count0),
41    {LoopName,Count2} = new_func_varname(Count1),
42    LoopFun = #c_var{name={LoopName,0}},
43    ApplyLoop = #c_apply{op=LoopFun,args=[]},
44
45    TimeoutCs = [#c_clause{pats=[True],guard=True,
46                           body=#c_seq{arg=primop(timeout),
47                                       body=Action}},
48                 #c_clause{pats=[False],guard=True,
49                           body=ApplyLoop}],
50    {TimeoutBool,Count4} = new_var(Count2),
51    TimeoutCase = #c_case{arg=TimeoutBool,clauses=TimeoutCs},
52    TimeoutLet = #c_let{vars=[TimeoutBool],
53                        arg=primop(recv_wait_timeout, [TimeoutVal]),
54                        body=TimeoutCase},
55
56    Fun = #c_fun{vars=[],body=TimeoutLet},
57
58    Letrec = #c_letrec{anno=[letrec_goto],
59                       defs=[{LoopFun,Fun}],
60                       body=ApplyLoop},
61
62    OuterLet = #c_let{vars=[TimeoutVal],arg=Timeout0,body=Letrec},
63    {OuterLet,Count4};
64rewrite_recv(#c_receive{clauses=Cs0,timeout=Timeout0,action=Action}, Count0) ->
65    %% Lower receive to its primitive operations.
66    False = #c_literal{val=false},
67    True = #c_literal{val=true},
68
69    {TimeoutVal,Count1} = new_var(Count0),
70    {LoopName,Count2} = new_func_varname(Count1),
71    LoopFun = #c_var{name={LoopName,0}},
72    ApplyLoop = #c_apply{op=LoopFun,args=[]},
73
74    Cs1 = rewrite_cs(Cs0),
75    RecvNext = #c_seq{arg=primop(recv_next),
76                      body=ApplyLoop},
77    RecvNextC = #c_clause{anno=[compiler_generated],
78                          pats=[#c_var{name='Other'}],guard=True,body=RecvNext},
79    Cs = Cs1 ++ [RecvNextC],
80    {Msg,Count3} = new_var(Count2),
81    MsgCase = #c_case{arg=Msg,clauses=Cs},
82
83    TimeoutCs = [#c_clause{pats=[True],guard=True,
84                           body=#c_seq{arg=primop(timeout),
85                                       body=Action}},
86                 #c_clause{pats=[False],guard=True,
87                           body=ApplyLoop}],
88    {TimeoutBool,Count4} = new_var(Count3),
89    TimeoutCase = #c_case{arg=TimeoutBool,clauses=TimeoutCs},
90    TimeoutLet = #c_let{vars=[TimeoutBool],
91                        arg=primop(recv_wait_timeout, [TimeoutVal]),
92                        body=TimeoutCase},
93
94    {PeekSucceeded,Count5} = new_var(Count4),
95    PeekCs = [#c_clause{pats=[True],guard=True,
96                        body=MsgCase},
97              #c_clause{pats=[False],guard=True,
98                        body=TimeoutLet}],
99    PeekCase = #c_case{arg=PeekSucceeded,clauses=PeekCs},
100    PeekLet = #c_let{vars=[PeekSucceeded,Msg],
101                     arg=primop(recv_peek_message),
102                     body=PeekCase},
103    Fun = #c_fun{vars=[],body=PeekLet},
104
105    Letrec = #c_letrec{anno=[letrec_goto],
106                       defs=[{LoopFun,Fun}],
107                       body=ApplyLoop},
108
109    OuterLet = #c_let{vars=[TimeoutVal],arg=Timeout0,body=Letrec},
110    {OuterLet,Count5};
111rewrite_recv(Tree, Count) ->
112    {Tree,Count}.
113
114rewrite_cs([#c_clause{body=B0}=C|Cs]) ->
115    B = #c_seq{arg=primop(remove_message),body=B0},
116    [C#c_clause{body=B}|rewrite_cs(Cs)];
117rewrite_cs([]) -> [].
118
119primop(Name) ->
120    primop(Name, []).
121
122primop(Name, Args) ->
123    #c_primop{name=#c_literal{val=Name},args=Args}.
124
125new_var(Count) ->
126    {#c_var{name=Count},Count+1}.
127
128new_func_varname(Count) ->
129    Name = list_to_atom("@pre" ++ integer_to_list(Count)),
130    {Name,Count+1}.
131