sort
#x:action-sort
#x:modeling-sort
#x:enum-sort
#x:reply-sort
#x:event-sort

provides_ports = struct no_port?no_port_is#x:provides-port-construct;

requires_ports = struct no_requires #x:requires-port-construct;

reply_values = struct replies (#x:reply-values);

requires_events
 = struct no_event
#x:requires-sort-construct
 ;

map

QueueLength : Nat;
DeferQueueLength : Nat;
ExternalQueueLength : Nat;

list2set : List(provides_ports) -> Set(provides_ports);

remove_port : provides_ports # List (provides_ports) -> List(provides_ports);

remove_async : requires_events # List (requires_events) -> List(requires_events);
find_async : requires_events # List (requires_events) -> Bool;

var p, car: provides_ports;
    l, cdr: List(provides_ports);
    e, h: requires_events;
    t: List(requires_events);

eqn

QueueLength = #x:makreel:queue-length;
DeferQueueLength = #x:makreel:defer-queue-length;
ExternalQueueLength = #x:makreel:external-queue-length;

l == [] -> list2set(l) = {};
l != [] -> list2set(l) = {head(l)} + list2set(tail(l));

remove_port(p, []) = [];
p == car -> remove_port(p, car |> cdr) = cdr;
p != car -> remove_port(p, car |> cdr) = car |> remove_port(p,cdr);

remove_async(e, []) = [];
e == h -> remove_async(e, h |> t) = t;
e != h -> remove_async(e, h |> t) = h |> remove_async(e,t);

find_async(e, []) = false;
e == h -> find_async(e, h |> t) = true;
e != h -> find_async(e, h |> t) = find_async(e, t);

act
#x:event-act
#x:makreel:model-name end;
#x:makreel:model-name end';
#x:makreel:model-name other_end;
#x:makreel:model-name other_end';
async_not_pending;
async_not_pending';
async_pending;
async_pending';
queue_full;
queue_empty;
queue_empty';
queue_not_empty;
queue_not_empty';

%%%%%%%%%%%%%%%%% INTERFACE %%%%%%%%%%%%%%%%%

#x:interface-proc-memo

%%%%%%%%%%%%%% PORT PROCESSES %%%%%%%%%%%%%%%

#x:interface-action-proc

%%%%%%%%%%%%%%%%%%%%%%% PROVIDES %%%%%%%%%%%%%%%%%%%%%%%%%%

proc
provides_r2c(ports: Set(provides_ports))
 = #x:provides-r2c-proc #x:provides-r2c-blocking-proc
 ;

provides_out(ports: Set(provides_ports))
 = #x:provides-out
 ;

provides_parallel = #x:provides-port-parallel-proc || provides_r2c({});

provides_comm = comm ({
#x:provides-comm
 }, provides_parallel);

provides_allow = allow ({
   declarative_illegal
 , illegal
 , missing_reply
 , range_error
 , second_reply
 , tau_void
#x:provides-allow
 }, provides_comm);

provides_rename = rename ({
#x:provides-rename
 }, provides_allow);

provides = hide ({
   tau_void
 , #x:allow-tau
 }, provides_rename);

%%%%%%%%%%%%%%%%%%% COMPONENT %%%%%%%%%%%%%%%%%%%

act

defer_end;
defer_end';
defer_q_empty;
defer_q_empty';
defer_qin: DeferContext;
defer_qin': DeferContext;
defer_qout: Locals;
defer_qout': Locals;
defer_skip: State;
defer_skip': State;


map

prune_deferred : State # List (DeferContext) -> List(DeferContext);
state_current : State # DeferContext -> Bool;

var current : State;
    context : DeferContext;
    defer_state: State;
    defer_head: DeferContext;
    defer_tail: List(DeferContext);

eqn

state_current(current, context) = (#x:defer-predicate-true #x:defer-predicate);

prune_deferred(defer_state, []) = [];
(!state_current(defer_state, defer_head))
  -> prune_deferred(defer_state, defer_head |> defer_tail) = prune_deferred(defer_state, defer_tail);
(state_current(defer_state, defer_head))
  -> prune_deferred(defer_state, defer_head |> defer_tail) = defer_head |> prune_deferred(defer_state, defer_tail);

proc

defer_queue (l: List (DeferContext))
 = (##l == DeferQueueLength) -> (sum dc: DeferContext . defer_qin(dc) . queue_full . Illegal)
 + (##l < DeferQueueLength) -> (sum dc: DeferContext . defer_qin(dc) . defer_queue(l = l <| dc))
 + (l != []) -> defer_qout(locals(head(l))) . defer_queue(l = tail(l))
 + (l == []) -> defer_q_empty . defer_queue(l)
 + sum s : State . defer_skip(s) . defer_queue (prune_deferred (s,l))
 ;

#x:proc

%% defer continuation identifiers are determined by x:proc above,
%% therefore this defer related sort must be here

sort

State = struct state_vector #x:state-vector;
Selection = struct selection_empty #x:defer-select-member;
Locals = struct empty #x:defer-locals-sort;
DeferContext = struct defer_context(state: State, select: Set(Selection), locals: Locals);

proc

component_behavior_comm = comm ({
   defer_qin | defer_qin -> defer_qin'
 , defer_qout | defer_qout -> defer_qout'
 , defer_skip | defer_skip -> defer_skip'
}, #x:type-check  #x:makreel:model-name behavior #x:member-init || defer_queue([]));

component_behavior_allow = allow({
   declarative_illegal
 , defer_end
 , defer_q_empty
 , defer_qin'
 , defer_qout'
 , defer_skip'
 , illegal
 , queue_full
 , range_error
 , recurse
 , return
   #x:component-behavior-allow-provides
   #x:component-behavior-allow-requires
 , #x:makreel:model-name end }, component_behavior_comm);

component_behavior_rename = rename({
  defer_qout' -> defer_qout
  #x:component-behavior-rename-requires }, component_behavior_allow);

component_behavior = hide({
   defer_skip'
 , defer_qin'}, component_behavior_rename);



%%%%%%%%%%%%%%%%%%%%%%%%% FUNCTIONS %%%%%%%%%%%%%%%%%%%%%%%%%

#x:function

#x:function-return-proc

#x:return-type-sort

#x:call-continuation-sort

%%%%%%%%%%%%%%%%%%%% Q %%%%%%%%%%%%%%%%%%%%%%

proc
#x:queue-proc
#x:no-queue-proc

async (l: List (requires_events))
 = (l != []) -> async_pending . async()
 + (l == []) -> async_not_pending . async()
#x:async-parallel-port
 ;

%%%%%%%%%%%%%%%%%%%%%%%%% SEMANTICS %%%%%%%%%%%%%%%%%%%%%%%%%%%

semantics_main
 = semantics_provides
#x:semantics-requires
 ;

semantics_provides
 = #x:semantics-provides
 ;

semantics_provides_unblocked(reply: reply_values)
 = #x:semantics-provides-unblocked
 + #x:makreel:model-name end
 . (queue_empty
   . ((#x:semantics-provides-unblocked-missing-replies) -> missing_reply . delta
      #x:semantics-provides-unblocked-replies)
      #x:semantics-provides-flush)
 #x:semantics-provides-unblocked-switch-context
 ;

semantics_provides_unblocked_switch_context(reply: reply_values, switch: requires_ports)
 = delta #x:semantics-provides-unblocked-modeling
 ;

semantics_provides_blocking(blocking: Set(provides_ports), released: List(provides_ports), reply: reply_values)
= (blocking - list2set(released) != {}) -> #x:makreel:model-name end . (queue_empty . (semantics_blocked_rtc() + semantics_provides_skip_blocked()) + queue_not_empty . semantics_provides_skip_blocked())
+ (blocking - list2set(released) == {}) -> #x:makreel:model-name end . (queue_empty . (semantics_provides_skip_blocked() + (#x:reordered) . async_not_pending . #x:semantics-provides-blocking-defer) + queue_not_empty . semantics_provides_skip_blocked())
 #x:semantics-provides-blocking-provides
 #x:semantics-provides-blocking-requires
 ;

semantics_provides_skip_blocked(blocking: Set(provides_ports), released: List(provides_ports), reply: reply_values)
= #x:semantics-provides-skip-blocked-replies
 + !(#x:semantics-port-in-released-or) -> #x:makreel:model-name end
 . (semantics_blocked_rtc ()
  #x:semantics-provides-skip-blocked-requires)
 #x:semantics-provides-skip-blocked-requires
 + sum l : Locals . defer_qout(l) . semantics_provides_skip_blocked ()
 + defer_end . semantics_provides_skip_blocked ()
 ;

semantics_provides_blocked(rtc: provides_ports, blocking: Set(provides_ports), released: List(provides_ports), reply: reply_values)
= (blocking == {} && released == []) -> (async_not_pending . #x:semantics-provides-blocked-defer
                                       +async_pending . (semantics_async_allow_ack(port=no_port)
                                                        +semantics_provides))
 + #x:makreel:model-name end
 . ((released == []) -> queue_empty . semantics_blocked_rtc() <> queue_empty . semantics_reply()
  #x:semantics-provides-blocked-requires)
 #x:semantics-provides-blocked-provides
 #x:semantics-provides-blocked-replies
 #x:semantics-provides-blocked-ports
 #x:semantics-provides-blocked-async
 #x:semantics-provides-blocked-requires
 ;

semantics_reply(rtc: provides_ports, blocking: Set(provides_ports), released: List(provides_ports), reply: reply_values)
= (blocking == {} && released == []) -> semantics_provides_blocked ()
+ (blocking - list2set(released) != {} && rtc == no_port) -> semantics_blocked_rtc ()
+ #x:semantics-reply
;

semantics_blocked_rtc(blocking: Set(provides_ports),released: List(provides_ports), reply: reply_values)
= (blocking == {}) -> async_not_pending . #x:semantics-blocked-rtc-defer
+ (blocking != {}) ->
 (#x:semantics-blocked-rtc-provides
  #x:semantics-blocked-rtc-requires
  + async_pending . semantics_async_allow_ack(port=no_port))
 ;

semantics_async(blocking: Set(provides_ports), released: List(provides_ports), reply: reply_values, port: provides_ports)
 = #x:makreel:model-name end . (queue_empty . (async_not_pending . (no_port_is(port) -> #x:semantics-async-defer #x:semantics-async-requires-flush)
                                              +async_pending . (no_port_is(port) -> semantics_async_allow_ack() #x:semantics-async-flush))
                               +queue_not_empty . (async_not_pending . semantics_async ()
                                                   +async_pending . semantics_async()))

#x:semantics-async
#x:semantics-async-qout
#x:semantics-async-requires
+ defer_end . semantics_async ()
;

semantics_async_switch_context (blocking: Set(provides_ports), released: List(provides_ports), reply: reply_values, port: provides_ports, switch: requires_ports)
 = delta #x:semantics-async-modeling
 ;

semantics_async_allow_ack(blocking: Set(provides_ports), released: List(provides_ports), reply: reply_values, port: provides_ports)
= #x:semantics-async-allow-ack #x:semantics-no-async
 ;

component_semantics_parallel = component_behavior || semantics_main;

component_semantics_comm = comm({
   defer_end | defer_end -> defer_end'
 , defer_q_empty | defer_q_empty -> defer_q_empty'
 , defer_qout | defer_qout -> defer_qout'
 , #x:makreel:model-name end | #x:makreel:model-name end -> #x:makreel:model-name end'
   #x:semantics-comm-provides
   #x:semantics-comm-requires
 }, component_semantics_parallel);

component_semantics_allow = allow({
   #x:makreel:model-name end'
 , #x:allow-tau
   #x:semantics-allow-provides
   #x:semantics-allow-requires
   #x:semantics-allow-async
 , async_not_pending
 , async_pending
 , declarative_illegal
 , defer_end'
 , defer_q_empty'
 , defer_qout'
 , illegal
 , missing_reply
 , queue_empty
 , queue_full
 , queue_not_empty
 , range_error
 , recurse
 , return
 , second_reply
 , tau_void
 }, component_semantics_comm);

component_semantics = rename({
   defer_qout' -> defer_qout
 , #x:makreel:model-name end' -> #x:makreel:model-name end
   #x:semantics-rename-provides
   #x:semantics-rename-requires
 }, component_semantics_allow);

%%%%%%%%%%%%%%%%%%%%% COMPONENT ASSEMBLY %%%%%%%%%%%%%%%%%%%%%%

component_parallel = component_semantics || req_and_queue;

component_comm = comm({
   async_not_pending | async_not_pending -> async_not_pending'
 , async_pending | async_pending -> async_pending'
 , queue_empty | queue_empty -> queue_empty'
 , queue_not_empty | queue_not_empty -> queue_not_empty'
   #x:component-comm-requires
   #x:component-comm-async
 }, component_parallel);

component_allow = allow({
   #x:makreel:model-name end
 , #x:allow-tau
   #x:component-allow-provides
   #x:component-allow-requires
   #x:component-allow-async
 , async_not_pending'
 , async_pending'
 , declarative_illegal
 , defer_q_empty'
 , defer_qout
 , defer_end'
 , illegal
 , missing_reply
 , queue_empty'
 , queue_not_empty'
 , queue_full
 , range_error
 , recurse
 , return
 , second_reply
 , tau_void
 }, component_comm);

component_rename = rename({
   async_not_pending' -> async_not_pending
 , async_pending' -> async_pending
 , queue_empty' -> queue_empty
 , queue_not_empty' -> queue_not_empty
   #x:component-rename-provides
   #x:component-rename-requires
   #x:component-rename-async
 }, component_allow);

component = hide({
   #x:makreel:model-name end
 , #x:allow-tau
   #x:component-hide-provides
   #x:component-hide-requires
   #x:component-hide-async
 , async_not_pending
 , async_pending
 , defer_q_empty'
 , defer_end'
 , queue_empty
 , queue_not_empty
 , recurse
 , return
 , tau_void
 }, component_rename);
