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:
parent
3f7564aaa6
commit
778dfdb3f9
|
@ -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).*)
|
||||||
|
|
|
@ -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 =
|
||||||
|
|
Loading…
Reference in a new issue