From 609870755c62f99f2f145a1c9a93aa1faaf09d58 Mon Sep 17 00:00:00 2001 From: Benjamin Loison Date: Mon, 19 Dec 2022 13:56:48 +0100 Subject: [PATCH] Remove debugging symbols in `failwith` As running `OCAMLRUNPARAM=b ./_build/main.native ...` provides in case of `failwith` a better stacktrace. This enables moving `failwith`s from a file to the other without adapting them. --- src/cprint.ml | 10 +++++----- src/ctranslation.ml | 14 +++++++------- src/main.ml | 2 +- src/passes.ml | 4 ++-- 4 files changed, 15 insertions(+), 15 deletions(-) diff --git a/src/cprint.ml b/src/cprint.ml index e1e25c6..484f2ca 100644 --- a/src/cprint.ml +++ b/src/cprint.ml @@ -105,7 +105,7 @@ let rec cp_value fmt (value, (hloc: (ident * bool, string * int) Hashtbl.t)) = | BOp_mod -> "%" | BOp_and -> "&&" | BOp_or -> "||" - | BOp_arrow -> failwith "[cprint.ml] string_of_binop undefined on (->)" + | BOp_arrow -> failwith "string_of_binop undefined on (->)" in let string_of_compop = function | COp_eq -> "==" @@ -128,7 +128,7 @@ let rec cp_value fmt (value, (hloc: (ident * bool, string * int) Hashtbl.t)) = | CVStored (arr, idx) -> begin match find_varname hloc (arr, idx) with - | None -> failwith "[cprint.ml] This varname should be defined." + | None -> failwith "This varname should be defined." | Some (n, _) -> n end | CVInput n -> n) in @@ -144,7 +144,7 @@ let rec cp_value fmt (value, (hloc: (ident * bool, string * int) Hashtbl.t)) = Format.fprintf fmt "(%a) %s (%a)" cp_value (v, hloc) (string_of_compop op) cp_value (v', hloc) | CMonOp (MOp_pre, _) -> - failwith "[cprint.ml] The linearization should have removed this case." + failwith "The linearization should have removed this case." let prefix_ = ref "\t" @@ -163,7 +163,7 @@ and cp_expression fmt (expr, hloc) = Format.fprintf fmt "%sstate->%s[%d] = %a;\n" prefix arr idx cp_value (value, hloc) end - | CAssign (CVInput _, _) -> failwith "[cprint.ml] never assign an input." + | CAssign (CVInput _, _) -> failwith "never assign an input." | CSeq (e, e') -> Format.fprintf fmt "%a%a" cp_expression (e, hloc) @@ -186,7 +186,7 @@ and cp_expression fmt (expr, hloc) = aux_node_st.nt_name (nb-1) arr' idx'; i+1 - | CVInput _ -> failwith "[cprint.ml] Impossible!") + | CVInput _ -> failwith "Impossible!") 0 destl in () end | CIf (v, b1, []) -> diff --git a/src/ctranslation.ml b/src/ctranslation.ml index b9a7997..41a3f55 100644 --- a/src/ctranslation.ml +++ b/src/ctranslation.ml @@ -15,7 +15,7 @@ let rec iexpression_to_cvalue e = | IEReset _ | IETuple _ | IEApp _ - | IETriOp _ -> failwith "[ctranslation.ml] Should not happened." + | IETriOp _ -> failwith "Should not happened." let rec equation_to_expression (node_st, node_sts, (vl, expr)) = let hloc = node_st.nt_map in @@ -27,7 +27,7 @@ let rec equation_to_expression (node_st, node_sts, (vl, expr)) = | None -> CVInput (Utils.name_of_var v) | Some (arr, idx) -> CVStored (arr, idx) end - | _ -> failwith "[ctranslation.ml] This should not happened." + | _ -> failwith "This should not happened." in match expr with | IEVar vsrc -> @@ -54,9 +54,9 @@ let rec equation_to_expression (node_st, node_sts, (vl, expr)) = List.map (function | IEVar v -> v - | _ -> failwith "[ctranslation.ml] should not happened due to the linearization pass." + | _ -> failwith "should not happened due to the linearization pass." ) l - | _ -> failwith "[ctranslation.ml] should not happened due to the linearization pass." + | _ -> failwith "should not happened due to the linearization pass." in let vl = List.map @@ -67,7 +67,7 @@ let rec equation_to_expression (node_st, node_sts, (vl, expr)) = vl in CApplication (node.n_name,i , al, vl, node_sts) - | IETuple _ -> failwith "[ctranslation.ml] linearization should have \ + | IETuple _ -> failwith "linearization should have \ transformed the tuples of the right members." | IEWhen (expr, cond) -> begin @@ -76,12 +76,12 @@ let rec equation_to_expression (node_st, node_sts, (vl, expr)) = []) end | IETriOp (TOp_if, _, _, _) -> - failwith "[ctranslation.ml] A pass should have turned conditionnals into merges." + failwith "A pass should have turned conditionnals into merges." | IETriOp (TOp_merge, c, e, e') -> CIf (iexpression_to_cvalue c, [equation_to_expression (node_st, node_sts, (vl, e))], [equation_to_expression (node_st, node_sts, (vl, e'))]) - | IEReset _ -> failwith "[ctranslation.ml] A pass should have removed resets." + | IEReset _ -> failwith "A pass should have removed resets." diff --git a/src/main.ml b/src/main.ml index db2008f..f7fe8c8 100644 --- a/src/main.ml +++ b/src/main.ml @@ -35,7 +35,7 @@ let exec_passes ast verbose debug passes f = "Current AST (after %s):\n%a\n" n Lustre_pp.pp_ast ast); aux ast passes) end with - | _ -> failwith ("[main.ml] The pass "^n^" should have catched me!") + | _ -> failwith ("The pass "^n^" should have catched me!") in aux ast passes diff --git a/src/passes.ml b/src/passes.ml index 43d0e94..c303cc0 100644 --- a/src/passes.ml +++ b/src/passes.ml @@ -356,7 +356,7 @@ let pass_linearization_app verbose debug = | _ -> (** Need for a new var. *) let ty = match type_exp e with | [ty] -> ty - | _ -> failwith "[passes.ml] One should not provide + | _ -> failwith "One should not provide tuples as arguments to an auxiliary node." in let nvar: string = Format.sprintf "_applin%d" !applin_count in @@ -373,7 +373,7 @@ let pass_linearization_app verbose debug = (neq_patt, neq_expr)::eqs'@eqs, vars, EVar([ty], nvar) :: l) l ([], vars, []) in eqs, vars, EApp (tout, n, ETuple (tin, l)) - | EApp _ -> failwith "[passes.ml] Should not happened (parser)" + | EApp _ -> failwith "Should not happened (parser)" in (** [aux_linearization_app] applies the previous function to every equation *) let aux_linearization_app node =