Added Sfield to differentiate from Sconstructor.

compiler/global/global_mapfold.ml

@@ -29,7 +29,7 @@ and static_exp_desc_it funs acc sd =
   with Fallback -> static_exp_desc funs acc sd
 
 and static_exp_desc funs acc sd = match sd with
-  | Svar _ | Sint _ | Sfloat _ | Sbool _ | Sconstructor _ -> sd, acc
+  | Svar _ | Sint _ | Sfloat _ | Sbool _ | Sconstructor _ | Sfield _ -> sd, acc
   | Stuple se_l ->
       let se_l, acc = mapfold (static_exp_it funs) acc se_l in
       Stuple se_l, acc

compiler/global/global_printer.ml

@@ -9,6 +9,7 @@ open Pp_tools
 let print_qualname ff qn = match qn with
   | { qual = "Pervasives"; name = n } -> print_name ff n
   | { qual = m; name = n } when m = g_env.current_mod -> print_name ff n
+  | { qual = m; name = n } when m = local_qualname -> print_name ff n
   | { qual = m; name = n } -> fprintf ff "%s.%a" m print_name n
 
 
@@ -17,6 +18,7 @@ let rec print_static_exp ff se = match se.se_desc with
   | Sbool b -> fprintf ff "%b" b
   | Sfloat f -> fprintf ff "%f" f
   | Sconstructor ln -> print_qualname ff ln
+  | Sfield ln -> print_qualname ff ln
   | Svar id -> fprintf ff "%a" print_qualname id
   | Sop (op, se_list) ->
       if is_infix (shortname op)

compiler/global/types.ml

@@ -19,6 +19,7 @@ and static_exp_desc =
   | Sfloat of float
   | Sbool of bool
   | Sconstructor of constructor_name
+  | Sfield of field_name
   | Stuple of static_exp list
   | Sarray_power of static_exp * static_exp (** power : 0^n : [0,0,0,0,0,..] *)
   | Sarray of static_exp list (** [ e1, e2, e3 ] *)

compiler/heptagon/analysis/typing.ml

@@ -426,11 +426,10 @@ and typing_static_exp const_env se =
         (try (* this can be a global const*)
            let cd = Modules.find_const ln in
              Svar ln, cd.Signature.c_type
-(* TODO verifier... *)
          with Not_found -> (* or a static parameter *)
            Svar ln, QualEnv.find ln const_env)
-    | Sconstructor c ->
-      Sconstructor c, Tid (find_constrs c)
+    | Sconstructor c -> Sconstructor c, Tid (find_constrs c)
+    | Sfield c -> Sfield c, Tid (find_field c)
     | Sop (op, se_list) ->
         let ty_desc = find_value op in
         let typed_se_list = typing_static_args const_env
@@ -648,7 +647,7 @@ and typing_app const_env h op e_list =
     | { a_op = Efield; a_params = [f] }, [e] ->
         let fn =
           (match f.se_desc with
-             | Sconstructor fn -> fn
+             | Sfield fn -> fn
              | _ -> assert false) in
         let typed_e, t1 = typing const_env h e in
         let q, fields = struct_info t1 in
@@ -660,7 +659,7 @@ and typing_app const_env h op e_list =
         let q, fields = struct_info t1 in
         let fn =
           (match f.se_desc with
-             | Sconstructor fn -> fn
+             | Sfield fn -> fn
              | _ -> assert false) in
         let t2 = field_type const_env fn fields t1 e1.e_loc in
         let typed_e2 = expect const_env h t2 e2 in

compiler/heptagon/parsing/hept_parser.mly

@@ -395,7 +395,7 @@ _simple_exp:
   | LBRACKET array_exp_list RBRACKET { mk_call Earray $2 }
   | LPAREN tuple_exp RPAREN          { mk_call Etuple $2 }
   | simple_exp DOT c=qualname
-      { mk_call ~params:[mk_constructor_exp c (Loc($startpos(c),$endpos(c)))]
+      { mk_call ~params:[mk_field_exp c (Loc($startpos(c),$endpos(c)))]
                 Efield [$1] }
 ;
 
@@ -469,7 +469,7 @@ _exp:
       { mk_iterator_call $1 $3 $5 $9 $12 }
 /*Records operators */
   | LBRACE simple_exp WITH DOT c=qualname EQUAL exp RBRACE
-      { mk_call ~params:[mk_constructor_exp c (Loc($startpos(c),$endpos(c)))]
+      { mk_call ~params:[mk_field_exp c (Loc($startpos(c),$endpos(c)))]
                 Efield_update [$2; $7] }
 ;
 

compiler/heptagon/parsing/hept_parsetree.ml

@@ -32,6 +32,7 @@ and static_exp_desc =
   | Sfloat of float
   | Sbool of bool
   | Sconstructor of constructor_name
+  | Sfield of field_name
   | Stuple of static_exp list
   | Sarray_power of static_exp * static_exp (** power : 0^n : [0,0,0,0,0,..] *)
   | Sarray of static_exp list (** [ e1, e2, e3 ] *)
@@ -215,6 +216,9 @@ let mk_static_exp ?(ty = invalid_type) desc loc =
 let mk_constructor_exp f loc =
   mk_exp (Econst (mk_static_exp (Sconstructor f) loc)) loc
 
+let mk_field_exp f loc =
+  mk_exp (Econst (mk_static_exp (Sfield f) loc)) loc
+
 let mk_type_dec name desc loc =
   { t_name = name; t_desc = desc; t_loc = loc }
 

compiler/heptagon/parsing/hept_scoping.ml

@@ -191,6 +191,7 @@ and translate_static_exp_desc local_const ed =
     | Sfloat f -> Types.Sfloat f
     | Sbool b -> Types.Sbool b
     | Sconstructor c -> Types.Sconstructor (qualify_constrs c)
+    | Sfield c -> Types.Sfield (qualify_field c)
     | Stuple se_list -> Types.Stuple (List.map t se_list)
     | Sarray_power (se,sn) -> Types.Sarray_power (t se, t sn)
     | Sarray se_list -> Types.Sarray (List.map t se_list)

compiler/main/mls2obc.ml

@@ -93,7 +93,7 @@ let rec translate map (si, j, s) e =
             f_e_list
         in Estruct (type_name, f_e_list)
     | Minils.Eapp ({ Minils.a_op = Minils.Efield;
-                    Minils.a_params = [{ se_desc = Sconstructor f }] },
+                    Minils.a_params = [{ se_desc = Sfield f }] },
                    [e], _) ->
         let e = translate map (si, j, s) e in
           Elhs (mk_lhs (Lfield (lhs_of_exp e, f)))
@@ -208,7 +208,7 @@ and translate_act map context pat
 
     | Minils.Evarpat x,
           Minils.Eapp ({ Minils.a_op = Minils.Efield_update;
-                   Minils.a_params = [{ se_desc = Sconstructor f }] },
+                   Minils.a_params = [{ se_desc = Sfield f }] },
                   [e1; e2], _) ->
         let x = var_from_name map x in
         let copy = Aassgn (x, translate map context e1) in