Show exception on marshal open failure

Kappa-Dev · Sep 13, 2024 · aa2ebef · aa2ebef
1 parent a85bc40
commit aa2ebef
Show file tree

Hide file tree

Showing 7 changed files with 59 additions and 24 deletions.
diff --git a/core/cli/cli_init.ml b/core/cli/cli_init.ml
@@ -209,10 +209,12 @@ let get_pack_from_marshalizedfile ~warning kasim_args cli_args marshalized_file
       }
   with
   | ExceptionDefn.Malformed_Decl _ as e -> raise e
-  | _exn ->
+  | exn ->
     Format.printf
       "Simulation package seems to have been created with a different version \
        of KaSim, aborting...";
+    Format.eprintf "Exception raised when opening marshalized file: ";
+    Utils.pp_exception Format.err_formatter exn;
     exit 1
 
 let get_compilation_from_pack ~warning kasim_args cli_args

diff --git a/core/cli/dune b/core/cli/dune
@@ -8,6 +8,7 @@
    from
    (labltk.jpf -> superargTk.tk.ml)
    (-> superargTk.notk.ml))
+  kappa_utils
   kappa_grammar
   kappa-library.runtime
   kappa_version)
@@ -18,6 +19,8 @@
    -open
    Kappa_version
    -open
+   Kappa_utils
+   -open
    Kappa_data_structures
    -open
    Kappa_site_graphs
@@ -26,4 +29,5 @@
    -open
    Kappa_grammar
    -open
-   Kappa_runtime)))
+   Kappa_runtime
+   )))
diff --git a/core/parameters/dune b/core/parameters/dune
@@ -5,11 +5,14 @@
   result
   kappa_version
   kappa_cli
+  kappa_utils
   kappa-library.generic
   kappa_classical_graphs)
  (flags
   (:standard)
   -open
+  Kappa_utils
+  -open
   Kappa_cli
   -open
   Kappa_version

diff --git a/core/parameters/exception_without_parameter.ml b/core/parameters/exception_without_parameter.ml
@@ -154,31 +154,10 @@ let raise_exception file_name _key message exn =
   raise (Uncaught_exception { file_name; message; alarm = exn })
 
 let rec pp_exception f = function
-  | Exit -> Format.pp_print_string f "Exit"
-  | Not_found -> Format.pp_print_string f "Not_found"
-  | Arg.Bad x -> Format.fprintf f "Arg.Bad(%s)" x
-  | Sys.Break -> Format.pp_print_string f "Sys.Break"
-  | Stack.Empty -> Format.pp_print_string f "Stack.Empty"
-  | Queue.Empty -> Format.pp_print_string f "Queue.Empty"
-  | Stream.Error x -> Format.fprintf f "Stream.Error %s" x
-  | Stream.Failure -> Format.pp_print_string f "Stream.Failure"
-  | Arg.Help x -> Format.fprintf f "Arg.Help(%s)" x
-  | Parsing.Parse_error -> Format.pp_print_string f "Parsing.Parse_error"
-  | Scanf.Scan_failure x -> Format.fprintf f "Scanf.Scan.failure(%s)" x
-  | Lazy.Undefined -> Format.pp_print_string f "Lazy.Undefined"
-  | UnixLabels.Unix_error (er, x, y) ->
-    Format.fprintf f "UnixLabels.Unix_error(%s,%s,%s)"
-      (UnixLabels.error_message er)
-      x y
-  | Unix.Unix_error (er, x, y) ->
-    Format.fprintf f "Unix.Unix_error(%s,%s,%s)" (Unix.error_message er) x y
-  | Failure x -> Format.fprintf f "Failure(%s)" x
-  | Stack_overflow -> Format.pp_print_string f "Stack_overflow"
   | Uncaught_exception x ->
     Format.fprintf f "Uncaught_exception(%a)" pp_uncaught x
   | Caught_exception x -> Format.fprintf f "Caught_exception(%a)" pp_caught x
-  | exc -> Format.pp_print_string f (Printexc.to_string exc)
-
+  | exc -> Utils.pp_exception f exc
 and pp_uncaught f x =
   let with_space = false in
   Format.fprintf f "@[<h>%a%aexception:@ %a@]"

diff --git a/core/utils/dune b/core/utils/dune
@@ -0,0 +1,6 @@
+(library
+ (name kappa_utils)
+ (libraries unix yojson result logs stdlib-shims bigarray camlp-streams)
+ (public_name kappa-library.utils)
+ (flags
+  (:standard -w @a)))
diff --git a/core/utils/utils.ml b/core/utils/utils.ml
@@ -0,0 +1,31 @@
+(******************************************************************************)
+(*  _  __ * The Kappa Language                                                *)
+(* | |/ / * Copyright 2010-2020 CNRS - Harvard Medical School - INRIA - IRIF  *)
+(* | ' /  *********************************************************************)
+(* | . \  * This file is distributed under the terms of the                   *)
+(* |_|\_\ * GNU Lesser General Public License Version 3                       *)
+(******************************************************************************)
+
+let pp_exception f = function
+  | Exit -> Format.pp_print_string f "Exit"
+  | Not_found -> Format.pp_print_string f "Not_found"
+  | Arg.Bad x -> Format.fprintf f "Arg.Bad(%s)" x
+  | Sys.Break -> Format.pp_print_string f "Sys.Break"
+  | Stack.Empty -> Format.pp_print_string f "Stack.Empty"
+  | Queue.Empty -> Format.pp_print_string f "Queue.Empty"
+  | Stream.Error x -> Format.fprintf f "Stream.Error %s" x
+  | Stream.Failure -> Format.pp_print_string f "Stream.Failure"
+  | Arg.Help x -> Format.fprintf f "Arg.Help(%s)" x
+  | Parsing.Parse_error -> Format.pp_print_string f "Parsing.Parse_error"
+  | Scanf.Scan_failure x -> Format.fprintf f "Scanf.Scan.failure(%s)" x
+  | Lazy.Undefined -> Format.pp_print_string f "Lazy.Undefined"
+  | UnixLabels.Unix_error (er, x, y) ->
+    Format.fprintf f "UnixLabels.Unix_error(%s,%s,%s)"
+      (UnixLabels.error_message er)
+      x y
+  | Unix.Unix_error (er, x, y) ->
+    Format.fprintf f "Unix.Unix_error(%s,%s,%s)" (Unix.error_message er) x y
+  | Failure x -> Format.fprintf f "Failure(%s)" x
+  | Stack_overflow -> Format.pp_print_string f "Stack_overflow"
+  | exc -> Format.pp_print_string f (Printexc.to_string exc)
+
diff --git a/core/utils/utils.mli b/core/utils/utils.mli
@@ -0,0 +1,10 @@
+(******************************************************************************)
+(*  _  __ * The Kappa Language                                                *)
+(* | |/ / * Copyright 2010-2020 CNRS - Harvard Medical School - INRIA - IRIF  *)
+(* | ' /  *********************************************************************)
+(* | . \  * This file is distributed under the terms of the                   *)
+(* |_|\_\ * GNU Lesser General Public License Version 3                       *)
+(******************************************************************************)
+
+
+val pp_exception : Format.formatter -> exn -> unit