Fix EIO, tcsetpgrp and better error messages

src/lib/ast.ml

···
     Yojson.Safe.pretty_print ppf yjs
 end
 
-let of_string s =
-  let f = Morbig.parse_string "-" s in
-  (* Fmt.pr "MORBIG====\n%!"; *)
-  (* Morbig.JsonHelpers.save_as_json true Out_channel.stdout f;  *)
-  (* Fmt.pr "MORBIG====\n%!"; *)
+let () =
+  Printexc.register_printer (function
+    | Morbig.Errors.DuringParsing pos ->
+        Some
+          (Fmt.str "Error during parsing (potentially non-POSIX): %s"
+             (Morbig.string_of_lexing_position pos))
+    | Morbig.Errors.DuringLexing (pos, s) ->
+        Some
+          (Fmt.str "Error during lexing of \"%s\": %s" s
+             (Morbig.string_of_lexing_position pos))
+    | Morbig.Errors.DuringAliasing (pos, s) ->
+        Some
+          (Fmt.str "Error during aliasing of \"%s\": %s" s
+             (Morbig.string_of_lexing_position pos))
+    | _ -> None)
+
+let of_string ?(filename = "-") s =
+  let f = Morbig.parse_string filename s in
   of_program f
 
 let of_file path =
   let fname = Eio.Path.native_exn path in
-
-  let f = Eio.Path.load path |> Morbig.parse_string fname in
-  (* Fmt.pr "MORBIG====\n%!"; *)
-  (* Morbig.JsonHelpers.save_as_json true Out_channel.stdout f;  *)
-  (* Fmt.pr "MORBIG====\n%!"; *)
-  of_program f
+  Eio.Path.load path |> of_string ~filename:fname
 
 let rec word_component_to_string : word_component -> string = function
   | WordName s -> s

src/lib/ast.mli

···
 val of_program : Morbig.CST.program -> t
 (** An AST from a Morbig program *)
 
-val of_string : string -> t
+val of_string : ?filename:string -> string -> t
 (** Construct an AST from a string *)
 
 val of_file : _ Eio.Path.t -> t

src/lib/eunix.ml

···
   let host = Unix.gethostname () in
   Fmt.str "%s@%s" name host
 
+external getpgrp : unit -> int = "caml_merry_getpgrp"
+external tcgetpgrp : Unix.file_descr -> int = "caml_merry_tcgetpgrp"
 external tcsetpgrp : int -> int -> int = "caml_merry_tcsetpgrp"
 
 let delegate_control ~pgid fn =
   let shell_pid = Unix.getpid () in
   Fun.protect
     ~finally:(fun () ->
+      Fmt.pr "Back to the shell\n%!";
       let _ : int = tcsetpgrp 0 shell_pid in
       ())
     (fun () ->
+      Fmt.pr "Delegating...\n%!";
       match tcsetpgrp (Obj.magic Unix.stdin : int) pgid with
       | 0 -> fn ()
       | n -> Fmt.failwith "tcsetpgrp: %i" n)
 
 external setpgrp : int -> int -> int = "caml_merry_setpgid"
 
-let make_process_group () = match setpgrp 0 0 with 0 -> () | n -> exit n
+let make_process_group () =
+  let pgrp = getpgrp () in
+  let fg_prgp = tcgetpgrp Unix.stdin in
+  if Int.equal pgrp fg_prgp then
+    match setpgrp 0 0 with
+    | 0 -> ()
+    | _ -> assert false
+    | exception Unix.Unix_error (Unix.EPERM, _, _) -> ()
 
 let background () =
   let _pgrid = Unix.getpid () in

src/lib/eval.ml

···
 
   and run ctx ast =
     (* Make the shell its own process group *)
-    (* Eunix.make_process_group (); *)
+    Eunix.make_process_group ();
     let ctx, cs =
       let rec loop_commands (ctx, cs) (c : Ast.complete_commands) =
         match c with

src/lib/merry_stubs.c

···
 #include <caml/memory.h>
 #include <caml/alloc.h>
 #include <caml/fail.h>
+#include <caml/unixsupport.h>
 
 #include <unistd.h>
 #include <signal.h>
···
   res = tcsetpgrp(Int_val(v_fd), Long_val(v_pid_t));
   
   CAMLreturn(Val_int(res));
+}
+
+value caml_merry_tcgetpgrp(value v_fd) {
+  CAMLparam1(v_fd);
+  int res;
+
+  res = tcgetpgrp(Long_val(v_fd));
+  
+  CAMLreturn(Val_long(res));
 }
 
 value caml_merry_setpgid(value v_fd, value v_pid_t) {
···
   int res;
 
   res = setpgid(Long_val(v_fd), Long_val(v_pid_t));
+
+  if (res == -1) caml_uerror("setpgid", Nothing);
   
   CAMLreturn(Val_int(res));
 }
 
+value caml_merry_getpgrp (value v_unit) {
+  CAMLparam1(v_unit);
+  int res;
+
+  res = getpgrp();
+
+  CAMLreturn(Val_long(res));
+}