Do not loop forever during code generation

- Detect when the computation of the static exp
using simplif failed and abort.
- Added a better way to compute operators in
Static
This commit is contained in:
Cédric Pasteur 2010-07-16 12:04:51 +02:00
parent 3f7564aaa6
commit 778dfdb3f9
2 changed files with 36 additions and 23 deletions

View file

@ -31,19 +31,6 @@ let op_from_app_name ln =
| Modname { qual = "Pervasives" } -> ln | Modname { qual = "Pervasives" } -> ln
| _ -> raise Not_static | _ -> raise Not_static
(** Applies the operator [op] to the two integers [n1] and [n2]
and returns the reslt as a static exp. *)
let apply_int_op op n1 n2 =
match op with
| Modname { qual = "Pervasives"; id = "+" } -> Sint (n1 + n2)
| Modname { qual = "Pervasives"; id = "-" } -> Sint (n1 - n2)
| Modname { qual = "Pervasives"; id = "*" } -> Sint (n1 * n2)
| Modname { qual = "Pervasives"; id = "/" } ->
let n = if n2 = 0 then raise Instanciation_failed else n1 / n2 in
Sint n
| _ -> (* unknown operator, reconstrcut the op *)
Sop (op, [mk_static_exp (Sint n1); mk_static_exp (Sint n2)]) (*TODO CP*)
(** [simplify env e] returns e simplified with the (** [simplify env e] returns e simplified with the
variables values taken from env (mapping vars to integers). variables values taken from env (mapping vars to integers).
Variables are replaced with their values and every operator Variables are replaced with their values and every operator
@ -61,15 +48,9 @@ let rec simplify env se =
| Name n -> (try simplify env (NamesEnv.find n env) with | _ -> se) | Name n -> (try simplify env (NamesEnv.find n env) with | _ -> se)
| Modname _ -> se) | Modname _ -> se)
) )
| Sop (op, [e1; e2]) ->
let e1 = simplify env e1 in
let e2 = simplify env e2 in
(match e1.se_desc, e2.se_desc with
| Sint n1, Sint n2 -> { se with se_desc = apply_int_op op n1 n2 }
| _, _ -> { se with se_desc = Sop (op, [e1; e2]) }
)
| Sop (op, se_list) -> | Sop (op, se_list) ->
{ se with se_desc = Sop (op, List.map (simplify env) se_list) } let se_list = List.map (simplify env) se_list in
{ se with se_desc = apply_op op se_list }
| Sarray se_list -> | Sarray se_list ->
{ se with se_desc = Sarray (List.map (simplify env) se_list) } { se with se_desc = Sarray (List.map (simplify env) se_list) }
| Sarray_power (se, n) -> | Sarray_power (se, n) ->
@ -80,6 +61,28 @@ let rec simplify env se =
{ se with se_desc = Srecord { se with se_desc = Srecord
(List.map (fun (f,se) -> f, simplify env se) f_se_list) } (List.map (fun (f,se) -> f, simplify env se) f_se_list) }
and apply_op op se_list =
match se_list with
| [{ se_desc = Sint n1 }; { se_desc = Sint n2 }] ->
(match op with
| Modname { qual = "Pervasives"; id = "+" } ->
Sint (n1 + n2)
| Modname { qual = "Pervasives"; id = "-" } ->
Sint (n1 - n2)
| Modname { qual = "Pervasives"; id = "*" } ->
Sint (n1 * n2)
| Modname { qual = "Pervasives"; id = "/" } ->
let n = if n2 = 0 then raise Instanciation_failed else n1 / n2 in
Sint n
| _ -> assert false (*TODO: add missing operators*)
)
| [{ se_desc = Sint n }] ->
(match op with
| Modname { qual = "Pervasives"; id = "~-" } -> Sint (-n)
| _ -> assert false (*TODO: add missing operators*)
)
| _ -> Sop(op, se_list)
(** [int_of_static_exp env e] returns the value of the expression (** [int_of_static_exp env e] returns the value of the expression
[e] in the environment [env], mapping vars to integers. Raises [e] in the environment [env], mapping vars to integers. Raises
Instanciation_failed if it cannot be computed (if a var has no value).*) Instanciation_failed if it cannot be computed (if a var has no value).*)

View file

@ -27,6 +27,7 @@ struct
| Enode of string | Enode of string
| Eno_unnamed_output | Eno_unnamed_output
| Ederef_not_pointer | Ederef_not_pointer
| Estatic_exp_compute_failed
let message loc kind = (match kind with let message loc kind = (match kind with
| Evar name -> | Evar name ->
@ -40,7 +41,11 @@ struct
output_location loc output_location loc
| Ederef_not_pointer -> | Ederef_not_pointer ->
eprintf "%aCode generation : Trying to deference a non pointer type.\n" eprintf "%aCode generation : Trying to deference a non pointer type.\n"
output_location loc ); output_location loc
| Estatic_exp_compute_failed ->
eprintf "%aCode generation : Computation of the value of the static \
expression failed.\n"
output_location loc);
raise Misc.Error raise Misc.Error
end end
@ -261,7 +266,12 @@ let rec cexpr_of_static_exp se =
let { info = cd } = find_const ln in let { info = cd } = find_const ln in
cexpr_of_static_exp (Static.simplify NamesEnv.empty cd.c_value) cexpr_of_static_exp (Static.simplify NamesEnv.empty cd.c_value)
with Not_found -> assert false) with Not_found -> assert false)
| Sop _ -> cexpr_of_static_exp (Static.simplify NamesEnv.empty se) | Sop _ ->
let se' = Static.simplify NamesEnv.empty se in
if se = se' then
Error.message se.se_loc Error.Estatic_exp_compute_failed
else
cexpr_of_static_exp se'
(** [cexpr_of_exp exp] translates the Obj action [exp] to a C expression. *) (** [cexpr_of_exp exp] translates the Obj action [exp] to a C expression. *)
let rec cexpr_of_exp var_env exp = let rec cexpr_of_exp var_env exp =