Benjamin_Loison/Synchronous_reactive_systems
1
0
Fork 0
Code Issues 7 Pull Requests Packages Projects Releases Wiki Activity

Remove debugging symbols in failwith

Browse Source 
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.
This commit is contained in:
Benjamin Loison 2022-12-19 13:56:48 +01:00
parent 906a3d948b
commit 609870755c
4 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/cprint.ml
View File

@ -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, []) ->

14
src/ctranslation.ml
View File

@ -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."

2
src/main.ml
View File

@ -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

4
src/passes.ml
View File

@ -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 =