jeudi soir. still on mls2obc.

compiler/global/clocks.ml

@@ -90,13 +90,10 @@ and unify_list t1_list t2_list =
 let rec skeleton ck = function
   | Tprod ty_list ->
       (match ty_list with
-        | [] ->
-            Format.eprintf "Internal error, an exp with invalid type@.";
-            assert false;
+        | [] -> Ck ck
         | _ -> Cprod (List.map (skeleton ck) ty_list))
   | Tarray (t, _) -> skeleton ck t
-  | Tmutable t -> skeleton ck t
-  | Tid _ | Tunit -> Ck ck
+  | Tid _ | Tinvalid -> Ck ck
 
 (* TODO here it implicitely says that the base clock is Cbase
     and that all tuple is on Cbase *)

compiler/global/global_mapfold.ml

@@ -57,10 +57,7 @@ and ty funs acc t = match t with
       let t, acc = ty_it funs acc t in
       let se, acc = static_exp_it funs acc se in
       Tarray (t, se), acc
-  | Tmutable t ->
-      let t, acc = ty_it funs acc t in
-      Tmutable t, acc
-  | Tunit -> t, acc
+  | Tinvalid -> t, acc
 (*
 and ct_it funs acc c = try funs.ct funs acc c with Fallback -> ct funs acc t
 and ct funs acc c = match c with

compiler/global/global_printer.ml

@@ -64,15 +64,12 @@ and print_static_exp_tuple ff l =
   fprintf ff "@[<2>%a@]" (print_list_r print_static_exp "("","")") l
 
 and print_type ff = function
-  | Tprod [] -> fprintf ff "INVALID TYPE"
+  | Tinvalid -> fprintf ff "INVALID TYPE"
   | Tprod ty_list ->
       fprintf ff "@[<hov2>%a@]" (print_list_r print_type "(" " *" ")") ty_list
   | Tid id -> print_qualname ff id
   | Tarray (ty, n) ->
       fprintf ff "@[<hov2>%a^%a@]" print_type ty print_static_exp n
-  | Tmutable ty ->
-      fprintf ff "@[<hov2>mutable %a@]" print_type ty
-  | Tunit -> fprintf ff "unit"
 
 let print_field ff field =
   fprintf ff "@[%a: %a@]" print_qualname field.f_name  print_type field.f_type

compiler/global/initial.ml

@@ -28,13 +28,13 @@ let tfloat = Types.Tid pfloat
 let mk_pervasives s = { qual = Pervasives; name = s }
 
 let mk_static_int_op op args =
-  mk_static_exp ~ty:tint (Sop (op,args))
+  mk_static_exp tint (Sop (op,args))
 
 let mk_static_int i =
-  mk_static_exp ~ty:tint (Sint i)
+  mk_static_exp tint (Sint i)
 
 let mk_static_bool b =
-  mk_static_exp ~ty:tbool (Sbool b)
+  mk_static_exp tbool (Sbool b)
 
 
 

compiler/global/modules.ml

@@ -291,8 +291,7 @@ let rec unalias_type t = match t with
       with Not_found -> raise (Undefined_type ty_name))
   | Tarray (ty, n) -> Tarray(unalias_type ty, n)
   | Tprod ty_list -> Tprod (List.map unalias_type ty_list)
-  | Tmutable t -> Tmutable (unalias_type t)
-  | Tunit -> Tunit
+  | Tinvalid -> Tinvalid
 
 
 (** Return the current module as a [module_object] *)

compiler/heptagon/analysis/typing.ml

@@ -257,7 +257,6 @@ let build_subst names values =
 let rec subst_type_vars m = function
   | Tarray(ty, e) -> Tarray(subst_type_vars m ty, simplify m e)
   | Tprod l -> Tprod (List.map (subst_type_vars m) l)
-  | Tmutable t -> Tmutable (subst_type_vars m t)
   | t -> t
 
 let add_distinct_env id ty env =
@@ -392,9 +391,7 @@ let rec check_type const_env = function
   | Tid ty_name -> Tid ty_name (* TODO bug ? should check that ty_name exists ? *)
   | Tprod l ->
       Tprod (List.map (check_type const_env) l)
-  | Tmutable t ->
-      Tmutable (check_type const_env t)
-  | Tunit -> Tunit
+  | Tinvalid -> Tinvalid
 
 and typing_static_exp const_env se =
   try

compiler/heptagon/parsing/hept_scoping.ml

@@ -181,7 +181,7 @@ let static_app_from_app app args=
 let rec translate_static_exp se =
   try
     let se_d = translate_static_exp_desc se.se_desc in
-    Types.mk_static_exp ~loc:se.se_loc se_d
+    Types.mk_static_exp Tinvalid ~loc:se.se_loc se_d
   with
     | ScopingError err -> message se.se_loc err
 

compiler/heptagon/transformations/automata.ml

@@ -40,7 +40,7 @@ let mk_exp_fby_false e =
     (Tid Initial.pbool)
 
 let mk_constructor constr ty =
-  mk_static_exp ~ty:ty (Sconstructor constr)
+  mk_static_exp ty (Sconstructor constr)
 
 (* Be sure that [initial] is of the right type [e.e_ty] before using this *)
 let mk_exp_fby_state initial e =

compiler/main/mls2obc.ml

@@ -11,6 +11,7 @@
 open Misc
 open Names
 open Idents
+open Clocks
 open Signature
 open Obc
 open Obc_utils
@@ -32,7 +33,7 @@ let fresh_it () =
 
 let gen_obj_ident n = Idents.gen_var "mls2obc" ((shortname n) ^ "_inst")
 let fresh_for = fresh_for "mls2obc"
-let copy_array = copy_array "mls2obc"
+(*let copy_array = copy_array "mls2obc"*)
 
 let op_from_string op = { qual = Pervasives; name = op; }
 
@@ -72,7 +73,7 @@ let rec bound_check_expr idx_list bounds =
         let e1 = mk_exp_bool (Eop (op_from_string "<",
                                  [idx; mk_exp_int (Econst n)])) in
         let e2 = mk_exp_bool (Eop (op_from_string "<=",
-                                 [mk_exp_int (Econst (Sint 0)); idx])) in
+                                 [mk_exp_int (Econst (mk_static_int 0)); idx])) in
           mk_exp_bool (Eop (op_from_string "&", [e1;e2]))
   in
   match (idx_list, bounds) with
@@ -85,28 +86,24 @@ let rec bound_check_expr idx_list bounds =
 
 (** Creates the action list that copies [src] to [dest],
     updating the value at index [idx_list] with the value [v]. *)
-let rec update_array dest src idx_list v = match dest.l_ty, idx_list with
+let rec update_array dest src idx_list v = match dest.pat_ty, idx_list with
   | Tarray (t, n), idx::idx_list ->
       (*Body of the copy loops*)
       let copy i =
         let src_i = mk_pattern_exp t (Larray (src, i)) in
         let dest_i = mk_pattern t (Larray (dest, i)) in
-          [Aassgn(dest_i, src_i)]
+        [Aassgn(dest_i, src_i)]
       in
-
       (*Copy values < idx*)
       let a_lower = fresh_for (mk_static_int 0) idx copy in
-
       (* Update the correct element*)
-      let src_idx = mk_pattern_exp t (Larray (src, idx)) in
-      let dest_idx = mk_pattern t (Larray (dest, idx)) in
-      let a_update = update_array dest_idx src_idx v idx_list in
-
+      let src_idx = mk_pattern t (Larray (src, mk_exp_int (Econst idx))) in
+      let dest_idx = mk_pattern t (Larray (dest, mk_exp_int (Econst idx))) in
+      let a_update = update_array dest_idx src_idx idx_list v in
       (*Copy values > idx*)
       let idx_plus_one = mk_static_int_op (mk_pervasives "+") [idx; mk_static_int 1] in
       let a_upper = fresh_for idx_plus_one n copy in
-        [a_lower] @ a_update @ [a_upper]
-
+      [a_lower] @ a_update @ [a_upper]
   | _, _ ->
       [Aassgn(dest, v)]
 
@@ -121,9 +118,11 @@ let update_record dest src f v =
     else
       Aassgn(dest_l, src_l)
   in
-  let n = struct_name dest.l_ty in
-  let fields = find_struct n in
-    List.map assgn_act fields
+  let fields = match dest.pat_ty with
+    | Tid n -> Modules.find_struct n
+    | _ -> Misc.internal_error "mls2obc field of nonstruct" 1
+  in
+  List.map assgn_act fields
 
 let rec control map ck s =
   match ck with
@@ -149,23 +148,23 @@ let translate_var_dec l =
   List.map one_var l
 
 let rec translate_extvalue map w =
-  let desc = match w.w_desc with
-  | Wconst v -> Econst v
-  | Wvar x -> Epattern (var_from_name map n)
-  | Wfield (w1, f) ->
-      let w1 = translate_extvalue map (assert_1 e_list) in
-        Epattern (mk_pattern e.e_ty (Lfield (pattern_of_exp e, f)))
-  | Wwhen (w1, c, x) ->
-      let e1 = translate_extvalue map w1 in
+  let desc = match w.Minils.w_desc with
+    | Minils.Wconst v -> Econst v
+    | Minils.Wvar x -> Epattern (var_from_name map x)
+    | Minils.Wfield (w1, f) ->
+        let e = translate_extvalue map w1 in
+        Epattern (mk_pattern w.Minils.w_ty (Lfield (pattern_of_exp e, f)))
+    | Minils.Wwhen (w1, c, x) ->
+        let e1 = translate_extvalue map w1 in
         e1.e_desc
   in
-    mk_exp e.Minils.e_ty desc
+  mk_exp w.Minils.w_ty desc
 
 (* [translate e = c] *)
 let rec translate map e =
   let desc = match e.Minils.e_desc with
     | Minils.Eextvalue w ->
-        let e = translate_ext_value map e in e.e_desc
+        let e = translate_extvalue map w   in e.e_desc
     | Minils.Eapp ({ Minils.a_op = Minils.Eequal }, e_list, _) ->
         Eop (op_from_string "=", List.map (translate_extvalue map ) e_list)
     | Minils.Eapp ({ Minils.a_op = Minils.Efun n }, e_list, _)
@@ -189,10 +188,10 @@ let rec translate map e =
   (* Already treated cases when translating the [eq] *)
     | Minils.Eiterator _ | Minils.Emerge _ | Minils.Efby _
     | Minils.Eapp ({Minils.a_op=(Minils.Enode _|Minils.Efun _|Minils.Econcat
-                                 |Minils.Eupdate|Minils.Eselect_dyn
-                                 |Minils.Eselect_trunc|Minils.Eselect_slice
-                                 |Minils.Earray_fill|Minils.Efield_update
-                                 |Minils.Eifthenelse|Minils.Etuple)}, _, _) ->
+                                |Minils.Eupdate|Minils.Eselect_dyn
+                                |Minils.Eselect_trunc|Minils.Eselect_slice
+                                |Minils.Earray_fill|Minils.Efield_update
+                                |Minils.Eifthenelse|Minils.Etuple)}, _, _) ->
         internal_error "mls2obc" 5
   in
     mk_exp e.Minils.e_ty desc
@@ -204,7 +203,8 @@ and translate_act map pat
     | Minils.Etuplepat p_list,
         Minils.Eapp ({ Minils.a_op = Minils.Etuple }, act_list, _) ->
         List.flatten (List.map2 (translate_act map) p_list act_list)
-    | Minils.Etuplepat p_list, Minils.Econst { se_desc = Stuple se_list } ->
+    | Minils.Etuplepat p_list,
+      Minils.Eextvalue { Minils.w_desc = Minils.Wconst { se_desc = Stuple se_list }} ->
         let const_list = Mls_utils.exp_list_of_static_exp_list se_list in
         List.flatten (List.map2 (translate_act map) p_list const_list)
    (* When Merge *)

compiler/main/mls2seq.ml

@@ -41,8 +41,8 @@ let write_obc_file p =
 let no_conf () = ()
 
 let targets = [ "c",(Obc_no_params Cmain.program, no_conf);
-                "java", (Obc_scalar Java_main.program, java_conf);
-                "obc", (Obc write_obc_file, no_conf;
+                "java", (Obc Java_main.program, java_conf);
+                "obc", (Obc write_obc_file, no_conf);
                 "obc_np", (Obc_no_params write_obc_file, no_conf);
                 "epo", (Minils write_object_file, no_conf) ]
 

compiler/minils/minils.ml

@@ -40,7 +40,7 @@ and tdesc =
   | Type_struct of structure
 
 and extvalue = {
-  w_desc      : edesc;
+  w_desc      : extvalue_desc;
   mutable w_ck: ck;
   w_ty        : ty;
   w_loc       : location }
@@ -82,7 +82,6 @@ and op =
   | Efun of fun_name   (** "Stateless" longname <<a_params>> (args) reset r *)
   | Enode of fun_name  (** "Stateful" longname <<a_params>> (args) reset r *)
   | Eifthenelse        (** if arg1 then arg2 else arg3 *)
-  | Efield             (** arg1.a_param1 *)
   | Efield_update      (** { arg1 with a_param1 = arg2 } *)
   | Earray             (** [ args ] *)
   | Earray_fill        (** [arg1^a_param1] *)
@@ -150,7 +149,7 @@ let mk_extvalue ~ty ?(clock = fresh_clock()) ?(loc = no_location) desc =
   { w_desc = desc; w_ty = ty;
     w_ck = clock; w_loc = loc }
 
-let mk_exp ~ty ?(clock = fresh_clock()) ?(loc = no_location) desc =
+let mk_exp ty ?(clock = fresh_clock()) ?(loc = no_location) desc =
   { e_desc = desc; e_ty = ty;
     e_ck = clock; e_loc = loc }
 
@@ -189,4 +188,4 @@ let mk_program o n t c =
   { p_modname = Module ""; p_format_version = "";
     p_opened = o; p_nodes = n; p_types = t; p_consts = c }
 
-let void = mk_exp ~ty:Types.Tunit (Eapp (mk_app Etuple, [], None))
+let void = mk_exp (Types.Tprod []) (Eapp (mk_app Etuple, [], None))

compiler/minils/mls_mapfold.ml

@@ -17,22 +17,23 @@ open Minils
   either yours either the default version named according to the type. *)
 
 type 'a mls_it_funs = {
-  app:        'a mls_it_funs -> 'a -> Minils.app -> Minils.app * 'a;
-  edesc:      'a mls_it_funs -> 'a -> Minils.edesc -> Minils.edesc * 'a;
-  eq:         'a mls_it_funs -> 'a -> Minils.eq -> Minils.eq * 'a;
-  eqs:        'a mls_it_funs -> 'a -> Minils.eq list -> Minils.eq list * 'a;
-  exp:        'a mls_it_funs -> 'a -> Minils.exp -> Minils.exp * 'a;
-  pat:        'a mls_it_funs -> 'a -> Minils.pat -> Minils.pat * 'a;
-  var_dec:    'a mls_it_funs -> 'a -> Minils.var_dec -> Minils.var_dec * 'a;
-  var_decs:   'a mls_it_funs -> 'a -> Minils.var_dec list
-                                   -> Minils.var_dec list * 'a;
-  contract:   'a mls_it_funs -> 'a -> Minils.contract -> Minils.contract * 'a;
-  node_dec:   'a mls_it_funs -> 'a -> Minils.node_dec -> Minils.node_dec * 'a;
-  const_dec:  'a mls_it_funs -> 'a -> Minils.const_dec -> Minils.const_dec * 'a;
-  type_dec:   'a mls_it_funs -> 'a -> Minils.type_dec -> Minils.type_dec * 'a;
-  tdesc:      'a mls_it_funs -> 'a -> Minils.tdesc -> Minils.tdesc * 'a;
-  program:    'a mls_it_funs -> 'a -> Minils.program -> Minils.program * 'a;
-  global_funs:'a Global_mapfold.global_it_funs }
+  app:           'a mls_it_funs -> 'a -> Minils.app -> Minils.app * 'a;
+  edesc:         'a mls_it_funs -> 'a -> Minils.edesc -> Minils.edesc * 'a;
+  eq:            'a mls_it_funs -> 'a -> Minils.eq -> Minils.eq * 'a;
+  eqs:           'a mls_it_funs -> 'a -> Minils.eq list -> Minils.eq list * 'a;
+  exp:           'a mls_it_funs -> 'a -> Minils.exp -> Minils.exp * 'a;
+  extvalue:      'a mls_it_funs -> 'a -> Minils.extvalue -> Minils.extvalue * 'a;
+  extvalue_desc: 'a mls_it_funs -> 'a -> Minils.extvalue_desc -> Minils.extvalue_desc * 'a;
+  pat:           'a mls_it_funs -> 'a -> Minils.pat -> Minils.pat * 'a;
+  var_dec:       'a mls_it_funs -> 'a -> Minils.var_dec -> Minils.var_dec * 'a;
+  var_decs:      'a mls_it_funs -> 'a -> Minils.var_dec list -> Minils.var_dec list * 'a;
+  contract:      'a mls_it_funs -> 'a -> Minils.contract -> Minils.contract * 'a;
+  node_dec:      'a mls_it_funs -> 'a -> Minils.node_dec -> Minils.node_dec * 'a;
+  const_dec:     'a mls_it_funs -> 'a -> Minils.const_dec -> Minils.const_dec * 'a;
+  type_dec:      'a mls_it_funs -> 'a -> Minils.type_dec -> Minils.type_dec * 'a;
+  tdesc:         'a mls_it_funs -> 'a -> Minils.tdesc -> Minils.tdesc * 'a;
+  program:       'a mls_it_funs -> 'a -> Minils.program -> Minils.program * 'a;
+  global_funs:   'a Global_mapfold.global_it_funs }
 
 
 let rec exp_it funs acc e = funs.exp funs acc e
@@ -41,43 +42,59 @@ and exp funs acc e =
   let ed, acc = edesc_it funs acc e.e_desc in
   { e with e_desc = ed; e_ty = e_ty }, acc
 
+and extvalue_it funs acc w = funs.extvalue funs acc w
+and extvalue funs acc w =
+  let w_ty, acc = ty_it funs.global_funs acc w.w_ty in
+  let wd, acc = extvalue_desc_it funs acc w.w_desc in
+  { w with w_desc = wd; w_ty = w_ty }, acc
+
+and extvalue_desc_it funs acc wd =
+  try funs.extvalue_desc funs acc wd
+  with Fallback -> extvalue_desc funs acc wd
+and extvalue_desc funs acc wd = match wd with
+  | Wconst se ->
+      let se, acc = static_exp_it funs.global_funs acc se in
+      Wconst se, acc
+  | Wvar _ -> wd, acc
+  | Wfield (w,f) ->
+      let w, acc = extvalue_it funs acc w in
+      Wfield (w,f), acc
+  | Wwhen (w, c, v) ->
+      let w, acc = extvalue_it funs acc w in
+      Wwhen (w,c,v), acc
 
 and edesc_it funs acc ed =
   try funs.edesc funs acc ed
   with Fallback -> edesc funs acc ed
 and edesc funs acc ed = match ed with
-  | Econst se ->
-      let se, acc = static_exp_it funs.global_funs acc se in
-        Econst se, acc
-  | Evar _ -> ed, acc
-  | Efby (se, e) ->
+  | Eextvalue w ->
+      let w, acc = extvalue_it funs acc w in
+      Eextvalue w, acc
+  | Efby (se, w) ->
       let se, acc = optional_wacc (static_exp_it funs.global_funs) acc se in
-      let e, acc = exp_it funs acc e in
-        Efby (se, e), acc
+      let w, acc = extvalue_it funs acc w in
+        Efby (se, w), acc
   | Eapp(app, args, reset) ->
       let app, acc = app_it funs acc app in
-      let args, acc = mapfold (exp_it funs) acc args in
+      let args, acc = mapfold (extvalue_it funs) acc args in
         Eapp (app, args, reset), acc
-  | Ewhen(e, c, x) ->
-      let e, acc = exp_it funs acc e in
-        Ewhen(e, c, x), acc
-  | Emerge(x, c_e_list) ->
-      let aux acc (c,e) =
-        let e, acc = exp_it funs acc e in
-          (c,e), acc in
-      let c_e_list, acc = mapfold aux acc c_e_list in
-        Emerge(x, c_e_list), acc
-  | Estruct n_e_list ->
-      let aux acc (n,e) =
-        let e, acc = exp_it funs acc e in
-          (n,e), acc in
-      let n_e_list, acc = mapfold aux acc n_e_list in
-        Estruct n_e_list, acc
+  | Emerge(x, c_w_list) ->
+      let aux acc (c,w) =
+        let w, acc = extvalue_it funs acc w in
+          (c,w), acc in
+      let c_w_list, acc = mapfold aux acc c_w_list in
+        Emerge(x, c_w_list), acc
+  | Estruct n_w_list ->
+      let aux acc (n,w) =
+        let w, acc = extvalue_it funs acc w in
+          (n,w), acc in
+      let n_w_list, acc = mapfold aux acc n_w_list in
+        Estruct n_w_list, acc
   | Eiterator (i, app, param, pargs, args, reset) ->
       let app, acc = app_it funs acc app in
       let param, acc = static_exp_it funs.global_funs acc param in
-      let pargs, acc = mapfold (exp_it funs) acc pargs in
-      let args, acc = mapfold (exp_it funs) acc args in
+      let pargs, acc = mapfold (extvalue_it funs) acc pargs in
+      let args, acc = mapfold (extvalue_it funs) acc args in
         Eiterator (i, app, param, pargs, args, reset), acc
 
 
@@ -183,6 +200,8 @@ let defaults = {
   eq = eq;
   eqs = eqs;
   exp = exp;
+  extvalue = extvalue;
+  extvalue_desc = extvalue_desc;
   pat = pat;
   var_dec = var_dec;
   var_decs = var_decs;

compiler/minils/mls_printer.ml

@@ -68,6 +68,9 @@ and print_node_params ff l =
 and print_exp_tuple ff l =
   fprintf ff "@[<2>(%a)@]" (print_list_r print_exp """,""") l
 
+and print_w_tuple ff l =
+  fprintf ff "@[<2>(%a)@]" (print_list_r print_extvalue """,""") l
+
 and print_vd_tuple ff l =
   fprintf ff "@[<2>%a@]" (print_list_r print_vd "("";"")") l
 
@@ -75,10 +78,10 @@ and print_index ff idx =
   fprintf ff "@[<2>%a@]" (print_list print_static_exp "[""][""]") idx
 
 and print_dyn_index ff idx =
-  fprintf ff "@[<2>%a@]" (print_list print_exp "[""][""]") idx
+  fprintf ff "@[<2>%a@]" (print_list print_extvalue "[""][""]") idx
 
 and print_trunc_index ff idx =
-  fprintf ff "@[<2>%a@]" (print_list print_exp "[>""<][>""<]") idx
+  fprintf ff "@[<2>%a@]" (print_list print_extvalue "[>""<][>""<]") idx
 
 and print_exp ff e =
   if !Compiler_options.full_type_info then
@@ -89,87 +92,90 @@ and print_exp ff e =
 and print_every ff reset =
   print_opt (fun ff id -> fprintf ff " every %a" print_ident id) ff reset
 
+and print_extvalue ff w =
+  if !Compiler_options.full_type_info then
+    fprintf ff "(%a : %a :: %a)"
+      print_extvalue_desc w.w_desc print_type w.w_ty print_ck w.w_ck
+  else fprintf ff "%a" print_extvalue_desc w.w_desc
+
+
+and print_extvalue_desc ff = function
+  | Wconst c -> print_static_exp ff c
+  | Wvar x -> print_ident ff x
+  | Wfield (w,f) -> fprintf ff "%a.%a" print_extvalue w print_qualname f
+  | Wwhen (w, c, n) ->
+      fprintf ff "@[<2>(%a@ when %a(%a))@]" print_extvalue w print_qualname c print_ident n
+
 and print_exp_desc ff = function
-  | Econst c -> print_static_exp ff c
-  | Evar x -> print_ident ff x
-  | Efby ((Some c), e) ->
-      fprintf ff "@[<2>%a fby@ %a@]" print_static_exp c print_exp e
-  | Efby (None, e) -> fprintf ff "pre %a" print_exp e
+  | Eextvalue w -> print_extvalue ff w
+  | Efby ((Some c), w) -> fprintf ff "@[<2>%a fby@ %a@]" print_static_exp c print_extvalue w
+  | Efby (None, w) -> fprintf ff "pre %a" print_extvalue w
   | Eapp (app, args, reset) ->
-      fprintf ff "@[<2>%a@,%a@]"
-        print_app (app, args) print_every reset
-  | Ewhen (e, c, n) ->
-      fprintf ff "@[<2>(%a@ when %a(%a))@]"
-        print_exp e print_qualname c print_ident n
-  | Emerge (x, tag_e_list) ->
-      fprintf ff "@[<2>merge %a@ %a@]"
-        print_ident x print_tag_e_list tag_e_list
-  | Estruct f_e_list ->
-      print_record (print_couple print_qualname print_exp """ = """) ff f_e_list
+      fprintf ff "@[<2>%a@,%a@]" print_app (app, args) print_every reset
+  | Emerge (x, tag_w_list) ->
+      fprintf ff "@[<2>merge %a@ %a@]" print_ident x print_tag_w_list tag_w_list
+  | Estruct f_w_list ->
+      print_record (print_couple print_qualname print_extvalue """ = """) ff f_w_list
   | Eiterator (it, f, param, pargs, args, reset) ->
       fprintf ff "@[<2>(%s (%a)<<%a>>)@,(%a)%a@]%a"
         (iterator_to_string it)
         print_app (f, [])
         print_static_exp param
-        print_exp_tuple pargs
-        print_exp_tuple args
+        print_w_tuple pargs
+        print_w_tuple args
         print_every reset
 
 and print_app ff (app, args) =
   match app.a_op with
     | Eequal ->
       let e1, e2 = assert_2 args in
-        fprintf ff "@[<2>%a@ = %a@]" print_exp e1  print_exp e2
-    | Etuple -> print_exp_tuple ff args
+        fprintf ff "@[<2>%a@ = %a@]" print_extvalue e1  print_extvalue e2
+    | Etuple -> print_w_tuple ff args
     | Efun f | Enode f ->
         fprintf ff "@[%a@,%a@,%a@]"
-          print_qualname f print_params app.a_params  print_exp_tuple args
+          print_qualname f print_params app.a_params  print_w_tuple args
     | Eifthenelse ->
       let e1, e2, e3 = assert_3 args in
         fprintf ff "@[<hv>if %a@ then %a@ else %a@]"
-          print_exp e1 print_exp e2 print_exp e3
-    | Efield ->
-      let r = assert_1 args in
-      let f = assert_1 app.a_params in
-      fprintf ff "%a.%a" print_exp r print_static_exp f
+          print_extvalue e1 print_extvalue e2 print_extvalue e3
     | Efield_update ->
       let r,e = assert_2 args in
       let f = assert_1 app.a_params in
         fprintf ff "@[<2>{%a with .%a =@ %a}@]"
-          print_exp r print_static_exp f print_exp e
-    | Earray -> fprintf ff "@[<2>%a@]" (print_list_r print_exp "["";""]") args
+          print_extvalue r print_static_exp f print_extvalue e
+    | Earray -> fprintf ff "@[<2>%a@]" (print_list_r print_extvalue "["";""]") args
     | Earray_fill ->
       let e = assert_1 args in
       let n = assert_1 app.a_params in
-        fprintf ff "%a^%a" print_exp e print_static_exp n
+        fprintf ff "%a^%a" print_extvalue e print_static_exp n
     | Eselect ->
       let e = assert_1 args in
-        fprintf ff "%a%a" print_exp e print_index app.a_params
+        fprintf ff "%a%a" print_extvalue e print_index app.a_params
     | Eselect_slice ->
       let e = assert_1 args in
       let idx1, idx2 = assert_2 app.a_params in
         fprintf ff "%a[%a..%a]"
-          print_exp e  print_static_exp idx1  print_static_exp idx2
+          print_extvalue e  print_static_exp idx1  print_static_exp idx2
     | Eselect_dyn ->
       let r, d, e = assert_2min args in
         fprintf ff "%a%a default %a"
-          print_exp r  print_dyn_index e  print_exp d
+          print_extvalue r  print_dyn_index e  print_extvalue d
     | Eselect_trunc ->
       let e, idx_list = assert_1min args in
-        fprintf ff "%a%a" print_exp e print_trunc_index idx_list
+        fprintf ff "%a%a" print_extvalue e print_trunc_index idx_list
     | Eupdate ->
       let e1, e2, idx = assert_2min args in
           fprintf ff "@[<2>(%a with %a =@ %a)@]"
-            print_exp e1 print_dyn_index idx print_exp e2
+            print_extvalue e1 print_dyn_index idx print_extvalue e2
     | Econcat ->
       let e1, e2 = assert_2 args in
-        fprintf ff "@[<2>%a@ @@ %a@]" print_exp e1  print_exp e2
+        fprintf ff "@[<2>%a@ @@ %a@]" print_extvalue e1  print_extvalue e2
 
 and print_handler ff c =
-  fprintf ff "@[<2>%a@]" (print_couple print_qualname print_exp "("" -> "")") c
+  fprintf ff "@[<2>%a@]" (print_couple print_qualname print_extvalue "("" -> "")") c
 
-and print_tag_e_list ff tag_e_list =
-  fprintf ff "@[%a@]" (print_list print_handler """""") tag_e_list
+and print_tag_w_list ff tag_w_list =
+  fprintf ff "@[%a@]" (print_list print_handler """""") tag_w_list
 
 
 and print_eq ff { eq_lhs = p; eq_rhs = e } =

compiler/minils/mls_utils.ml

@@ -22,7 +22,9 @@ let err_message ?(exp=void) ?(loc=exp.e_loc) = function
 
 let rec static_exp_of_exp e =
   match e.e_desc with
-    | Econst se -> se
+    | Eextvalue w -> (match w.w_desc with
+      | Wconst se -> se
+      | _ -> err_message ~exp:e Enot_static_exp)
     | _ -> err_message ~exp:e Enot_static_exp
 
 (** @return the list of bounds of an array type*)
@@ -54,7 +56,7 @@ let is_record_type ty = match ty with
 
 let is_op = function
   | { qual = Pervasives; name = _ } -> true | _ -> false
-
+(*
 module Vars =
 struct
   let add x acc = if List.mem x acc then acc else x :: acc
@@ -71,6 +73,7 @@ struct
   let read_exp read_funs (is_left, acc_init) e =
     (* recursive call *)
     let _,(_, acc) = Mls_mapfold.exp read_funs (is_left, acc_init) e in
+
     (* special cases *)
     let acc = match e.e_desc with
       | Evar x | Emerge(x,_) | Ewhen(_, _, x)
@@ -163,3 +166,4 @@ module AllDep = Dep.Make
    end)
 
 let eq_find id = List.find (fun eq -> List.mem id (Vars.def [] eq))
+*)

compiler/obc/c/cgen.ml

@@ -101,9 +101,8 @@ let rec ctype_of_otype oty =
     | Types.Tid id when id = Initial.pbool -> Cty_int
     | Tid id -> Cty_id id
     | Tarray(ty, n) -> Cty_arr(int_of_static_exp n, ctype_of_otype ty)
-    | Tmutable t -> ctype_of_otype t
     | Tprod _ -> assert false
-    | Tunit -> assert false
+    | Tinvalid -> assert false
 
 let cvarlist_of_ovarlist vl =
   let cvar_of_ovar vd =

compiler/obc/c/cmain.ml

@@ -88,7 +88,7 @@ let assert_node_res cd =
     statements) needed for a main() function calling [cd]. *)
 let main_def_of_class_def cd =
   let format_for_type ty = match ty with
-    | Tarray _ | Tprod _ | Tmutable _ | Tunit -> assert false
+    | Tarray _ | Tprod _ | Tinvalid -> assert false
     | Types.Tid id when id = Initial.pfloat -> "%f"
     | Types.Tid id when id = Initial.pint -> "%d"
     | Types.Tid id when id = Initial.pbool -> "%d"
@@ -98,7 +98,7 @@ let main_def_of_class_def cd =
   (** Does reading type [ty] need a buffer? When it is the case,
       [need_buf_for_ty] also returns the type's name. *)
   let need_buf_for_ty ty = match ty with
-    | Tarray _ | Tprod _ | Tmutable _ | Tunit -> assert false
+    | Tarray _ | Tprod _ | Tinvalid -> assert false
     | Types.Tid id when id = Initial.pfloat -> None
     | Types.Tid id when id = Initial.pint -> None
     | Types.Tid id when id = Initial.pbool -> None

compiler/obc/java/java.ml

@@ -23,7 +23,6 @@ type ty = Tclass of class_name
         | Tint
         | Tfloat
         | Tarray of ty * exp
-        | Tref of ty
         | Tunit
 
 and classe = { c_protection : protection;
@@ -108,7 +107,6 @@ let rec default_value ty = match ty with
   | Tint -> Sint 0
   | Tfloat -> Sfloat 0.0
   | Tunit -> Evoid
-  | Tref t ->  default_value t
   | Tarray _ -> Enew_array (ty,[])
 
 

compiler/obc/java/java_printer.ml

@@ -42,7 +42,6 @@ let rec _ty size ff t = match t with
   | Tclass n -> class_name ff n
   | Tgeneric (n, ty_l) -> fprintf ff "%a<@[%a@]>" class_name n (print_list_r ty """,""") ty_l
   | Tarray (t,s) -> if size then fprintf ff "%a[%a]" full_ty t exp s else fprintf ff "%a[]" ty t
-  | Tref t -> ty ff t
   | Tunit -> pp_print_string ff "void"
 
 and full_ty ff t = _ty true ff t

compiler/obc/java/obc2java.ml

@@ -114,28 +114,28 @@ let rec static_exp param_env se = match se.Types.se_desc with
   | Types.Sop (f, se_l) -> Efun (qualname_to_class_name f, List.map (static_exp param_env) se_l)
 
 and boxed_ty param_env t = match t with
+  | Types.Tprod [] -> Tunit
   | Types.Tprod ty_l -> tuple_ty param_env ty_l
   | Types.Tid t when t = Initial.pbool -> Tclass (Names.local_qn "Boolean")
   | Types.Tid t when t = Initial.pint -> Tclass (Names.local_qn "Integer")
   | Types.Tid t when t = Initial.pfloat -> Tclass (Names.local_qn "Float")
   | Types.Tid t -> Tclass (qualname_to_class_name t)
   | Types.Tarray (t,size) -> Tarray (boxed_ty param_env t, static_exp param_env size)
-  | Types.Tmutable t -> Tref (boxed_ty param_env t)
-  | Types.Tunit -> Tunit
+  | Types.Tinvalid -> Misc.internal_error "obc2java invalid type" 1
 
 and tuple_ty param_env ty_l =
   let ln = ty_l |> List.length |> Pervasives.string_of_int in
   Tclass (java_pervasive_class ("Tuple"^ln))
 
 and ty param_env t :Java.ty = match t with
+  | Types.Tprod [] -> Tunit
   | Types.Tprod ty_l -> tuple_ty param_env ty_l
   | Types.Tid t when t = Initial.pbool -> Tbool
   | Types.Tid t when t = Initial.pint -> Tint
   | Types.Tid t when t = Initial.pfloat -> Tfloat
   | Types.Tid t -> Tclass (qualname_to_class_name t)
   | Types.Tarray (t,size) -> Tarray (ty param_env t, static_exp param_env size)
-  | Types.Tmutable t -> Tref (ty param_env t)
-  | Types.Tunit -> Tunit
+  | Types.Tinvalid -> Misc.internal_error "obc2java invalid type" 1
 
 and var_dec param_env vd = { vd_type = ty param_env vd.v_type; vd_ident = vd.v_ident }
 

compiler/obc/main/obc_compiler.ml

@@ -16,6 +16,6 @@ let pp p = if !verbose then Obc_printer.print stdout p
 let compile_program p =
   (*Control optimization*)
   let p = pass "Control optimization" true Control.program p pp in
-  (*Scalarize*)
-  let p = pass "Scalarize" !do_scalarize Scalarize.program p pp in
+(*  (*Scalarize*)
+  let p = pass "Scalarize" !do_scalarize Scalarize.program p pp in *)
     p

compiler/obc/obc_utils.ml

@@ -49,7 +49,7 @@ let mk_block ?(locals=[]) eq_list =
     b_body = eq_list }
 
 let mk_ifthenelse cond true_act false_act =
-  Acase (cond, [ ptrue, mk_block [true_act]; pfalse, mk_block [false_act] ])
+  Acase (cond, [ Initial.ptrue, mk_block [true_act]; Initial.pfalse, mk_block [false_act] ])
 
 let rec var_name x =
   match x.pat_desc with
@@ -73,12 +73,10 @@ let rec vd_find n = function
 
 (** Returns the type of a [var_dec list] *)
 let vd_list_to_type vd_l = match vd_l with
-  | [] -> Types.Tunit
   | [vd] -> vd.v_type
   | _ -> Tprod (List.map (fun vd -> vd.v_type) vd_l)
 
 let pattern_list_to_type p_l = match p_l with
-  | [] -> Types.Tunit
   | [p] -> p.pat_ty
   | _ -> Tprod (List.map (fun p -> p.pat_ty) p_l)
 
@@ -178,6 +176,7 @@ let fresh_for pass down up body =
   let ei = mk_evar_int i in
     Afor (id, down, up, mk_block (body ei))
 
+(*
 (** Creates the action copying [src] to [dest].*)
 let rec copy_array pass dest src = match dest.l_ty with
   | Tarray (t, n) ->
@@ -189,3 +188,4 @@ let rec copy_array pass dest src = match dest.l_ty with
         fresh_for pass (mk_static_int 0) n copy
   | _ ->
       Aassgn(dest, Epattern src)
+*)

compiler/obc/transformations/scalarize.ml

@@ -22,7 +22,7 @@ let fresh_for = fresh_for "scalarize"
 let act funs () a = match a with
   | Aassgn (p,e) ->
       (match e.e_ty with
-        | Types.Tarray (t, size) ->
+        | Types.Tarray (t, size) -> (* TODO ayayayaye *)
           (* a reference (alias) to the array, since we could have a full expression *)
           let array_ref = Idents.gen_var "scalarize" "a_ref" in
           let vd_array_ref = mk_var_dec array_ref (Types.Tmutable p.pat_ty) in