ATS preforking echo server

staload "libc/SATS/signal.sats"
staload "libc/SATS/stdio.sats"
staload "libc/SATS/unistd.sats"
staload "libc/sys/SATS/wait.sats"
staload "libc/sys/SATS/types.sats"
staload "libc/sys/SATS/socket.sats"
staload "libc/netinet/SATS/in.sats"
staload "libc/arpa/SATS/inet.sats"
staload "prelude/DATS/array0.dats"

%{
ats_ptr_type fdopen_exn (ats_int_type id, ats_ptr_type mode) {
  FILE *fil = fdopen((int)id, (char*)mode) ;
  if (!fil) {
    perror ("fdopen") ; atspre_exit_prerrf (
      1, "exit(ATS): [fdopen(\"%d\", \"%s\")] failed\n", id, mode
    ) ;
  }
  return fil ;
}
%}

extern fun fdopen_exn {m:fm}
  (id: int, m: file_mode m):<!exnref> FILEref
  = "fdopen_exn"

fun fork_child {fd:int} (pf_sock: !socket_v(fd,listen) | fd:int fd, 
                         f: (!socket_v(fd,listen) | int fd,pid_t) -<fun1> void): pid_t = let
  val pid = fork_exn();
  val ipid = int_of_pid(pid);
in
  if ipid = 0 then begin
    f (pf_sock | fd, pid);
    exit(0);    
  end else pid
end;

extern fun child {fd:int} (pf_sock: !socket_v(fd,listen) | fd: int fd, pid: pid_t):<fun1> void

implement child {fd} (pf_sock | fd, pid) = let
  val ipid:int = int_of_pid(getpid());
  val (pf_sock_c | client) = accept_null_exn(pf_sock | fd);
  val file = fdopen_exn(client, $extval (file_mode rw, "\"r+\""));
  val () = fprintf(file, "Child %d echo> ", @(ipid));
  val () = fflush_exn(file);
  val line = input_line(file);
  val () = assert_errmsg(stropt_is_some line, #LOCATION);
  val () = output_line(file, stropt_unsome(line));
  val () = socket_close_exn(pf_sock_c | client);
in
  child (pf_sock | fd, pid)
end ;  

fun make_server_socket (port: int) : [fd:int] (socket_v(fd,listen) | int fd) = let
  val (pf_sock_s | sockfd) = socket_family_type_exn (AF_INET, SOCK_STREAM);
  var servaddr: sockaddr_in_struct_t;
  val servport = in_port_nbo_of_int (port);
  val in4addr = in_addr_nbo_of_hbo (INADDR_ANY);
  val () = sockaddr_ipv4_init (servaddr, AF_INET, in4addr, servport);
  val () = bind_ipv4_exn (pf_sock_s | sockfd, servaddr);
  val () = listen_exn (pf_sock_s | sockfd, 10);
in
  (pf_sock_s | sockfd)
end;


implement main () = let
  val (pf_sock_s | sockfd) = make_server_socket (5000);
  val children = array0_make_arraysize($arrsz{pid_t} (fork_child(pf_sock_s | sockfd, child),
                                                      fork_child(pf_sock_s | sockfd, child)));
  val () = array0_foreach(children, lam(pid) => $effmask_all(printf("Forked: %d\n", @(int_of_pid(pid)))));
  var status:int = 0;
    val () = array0_foreach(children, lam(pid) => let 
                                        var status:int = 0; 
                                        val p = $effmask_all(waitpid(pid, status, WNONE))  
                                      in 
                                       () 
                                      end); 
  val () = socket_close_exn(pf_sock_s | sockfd);
in
  ()
end;