From 0d1aef8c782702d752457a3508f8058706dd66ef Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gwena=C3=ABl=20Delaval?= <gwenael.delaval@inria.fr>
Date: Fri, 27 Feb 2015 15:39:39 +0100
Subject: [PATCH] Bug correction: support of enumerated types as input for
 simulation

- use of a buffer to translate enumerated types from string to enum value
- hepts : correct interface with main
---
 compiler/main/hepts.ml  |  7 +++----
 compiler/obc/c/c.ml     |  9 +++++++++
 compiler/obc/c/cmain.ml | 16 ++++++++--------
 3 files changed, 20 insertions(+), 12 deletions(-)

diff --git a/compiler/main/hepts.ml b/compiler/main/hepts.ml
index 3b51d8a..941121f 100644
--- a/compiler/main/hepts.ml
+++ b/compiler/main/hepts.ml
@@ -145,12 +145,11 @@ class enum_input mod_name value_list (table:GPack.table) n : input =
 
   let _ = List.iter
     (fun (v,b) ->
-       let prefixed_value = mod_name ^ "_" ^ v in
        let click () =
    if not !click_processed then
      begin
        click_processed := true;
-       value := prefixed_value;
+       value := v;
        !active_button#set_active false;
        b#set_active true;
        active_button := b;
@@ -260,13 +259,13 @@ let create_input v_name v_ty n (table:GPack.table) =
   match v_ty with
   | Tid{ qual = Pervasives; name = "int" } ->
       new scale_input
-        0.0 0. 120.float_of_string
+        0. (-60.) 60. float_of_string
         (fun v ->
           string_of_int (int_of_float v))
         0
         table n
   | Tid{ qual = Pervasives; name = "float" } ->
-      new scale_input 0. 0. 100. float_of_string string_of_float 1 table n
+      new scale_input 0. (-100.) 100. float_of_string string_of_float 1 table n
   | Tid{ qual = Pervasives; name = "bool" } ->
       new boolean_input table n
   | Tid(name) ->
diff --git a/compiler/obc/c/c.ml b/compiler/obc/c/c.ml
index fefbbad..082f0f5 100644
--- a/compiler/obc/c/c.ml
+++ b/compiler/obc/c/c.ml
@@ -380,3 +380,12 @@ let rec array_base_ctype ty idx_list =
     | Cty_arr (_, ty), _::idx_list -> array_base_ctype ty idx_list
     | _ ->
       assert false
+
+(** Convert C expression to left-hand side *)
+let rec clhs_of_cexpr cexpr =
+  match cexpr with
+  | Cvar v -> CLvar v
+  | Cderef e -> CLderef (clhs_of_cexpr e) 
+  | Cfield (e,qn) -> CLfield (clhs_of_cexpr e, qn)
+  | Carray (e1,e2) -> CLarray (clhs_of_cexpr e1, e2)
+  | _ -> failwith("C expression not translatable to LHS")
diff --git a/compiler/obc/c/cmain.ml b/compiler/obc/c/cmain.ml
index a01ee77..ce3ea97 100644
--- a/compiler/obc/c/cmain.ml
+++ b/compiler/obc/c/cmain.ml
@@ -162,12 +162,10 @@ let main_def_of_class_def cd =
                   (vn ^ "." ^ (shortname fn), args)
               | _ -> assert false in
             let (prompt, args_format_s) = mk_prompt lhs in
-            let scan_exp =
+            let scan_exp e =
               let printf_s = Format.sprintf "%s ? " prompt in
               let format_s = format_for_type ty in
-              let exp_scanf = Cfun_call ("scanf",
-                                         [Cconst (Cstrlit format_s);
-                                          Caddrof lhs]) in
+              let exp_scanf = Cfun_call ("scanf", [Cconst (Cstrlit format_s); e]) in
               let body =
                 if !Compiler_options.hepts_simulation
                 then (* hepts: systematically test and quit when EOF *)
@@ -186,12 +184,14 @@ let main_def_of_class_def cd =
               Csblock { var_decls = [];
                         block_body = body; } in
             match need_buf_for_ty ty with
-            | None -> ([scan_exp], [])
+            | None -> ([scan_exp (Caddrof lhs)], [])
             | Some tyn ->
                 let varn = fresh "buf" in
-                ([scan_exp;
-                  Csexpr (Cfun_call (tyn ^ "_of_string",
-                                     [Cvar varn]))],
+		let lhs = clhs_of_cexpr lhs in
+                ([scan_exp (Cvar varn);
+                  Caffect (lhs,
+			   (Cfun_call (tyn ^ "_of_string",
+                                     [Cvar varn])))],
                  [(varn, Cty_arr (20, Cty_char))])
         end
     | Tprod _ | Tinvalid -> failwith("read_lhs_of_ty: untranslatable type")