diff --git a/core/cli/cli_init.ml b/core/cli/cli_init.ml index dc4b8cfe0..6ffd7e8fe 100644 --- 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 index 3e939b5fd..93060b073 100644 --- 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 index a680334ed..de67c9374 100644 --- 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 index 0b0c213db..6ff75c776 100644 --- 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 "@[%a%aexception:@ %a@]" diff --git a/core/utils/dune b/core/utils/dune new file mode 100644 index 000000000..4fe7de7d5 --- /dev/null +++ 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 new file mode 100644 index 000000000..836958585 --- /dev/null +++ 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 new file mode 100644 index 000000000..97c7a73c5 --- /dev/null +++ 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