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