From 778dfdb3f9d83a5acf0f8f7becaf2846387a9ab5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?C=C3=A9dric=20Pasteur?= <cedric.pasteur@m4x.org>
Date: Fri, 16 Jul 2010 12:04:51 +0200
Subject: [PATCH] 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
---
 compiler/global/static.ml | 45 +++++++++++++++++++++------------------
 compiler/obc/c/cgen.ml    | 14 ++++++++++--
 2 files changed, 36 insertions(+), 23 deletions(-)

diff --git a/compiler/global/static.ml b/compiler/global/static.ml
index 5bfd18a..b4edbda 100644
--- a/compiler/global/static.ml
+++ b/compiler/global/static.ml
@@ -31,19 +31,6 @@ let op_from_app_name ln =
     | Modname { qual = "Pervasives" } -> ln
     | _ -> 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
     variables values taken from env (mapping vars to integers).
     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)
                   | 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) ->
-        { 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 ->
         { se with se_desc = Sarray (List.map (simplify env) se_list) }
     | Sarray_power (se, n) ->
@@ -80,6 +61,28 @@ let rec simplify env se =
         { se with se_desc = Srecord
             (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
     [e] in the environment [env], mapping vars to integers. Raises
     Instanciation_failed if it cannot be computed (if a var has no value).*)
diff --git a/compiler/obc/c/cgen.ml b/compiler/obc/c/cgen.ml
index 64913dd..9496828 100644
--- a/compiler/obc/c/cgen.ml
+++ b/compiler/obc/c/cgen.ml
@@ -27,6 +27,7 @@ struct
     | Enode of string
     | Eno_unnamed_output
     | Ederef_not_pointer
+    | Estatic_exp_compute_failed
 
   let message loc kind = (match kind with
     | Evar name ->
@@ -40,7 +41,11 @@ struct
           output_location loc
     | Ederef_not_pointer ->
         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
 end
 
@@ -261,7 +266,12 @@ let rec cexpr_of_static_exp se =
           let { info = cd } = find_const ln in
             cexpr_of_static_exp (Static.simplify NamesEnv.empty cd.c_value)
         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. *)
 let rec cexpr_of_exp var_env exp =