%%
%% %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}.