Added Sfield to differentiate from Sconstructor.

This commit is contained in:
Léonard Gérard 2010-09-13 12:05:10 +02:00
parent d00ad67abb
commit 412425301a
8 changed files with 17 additions and 10 deletions

View file

@ -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

View file

@ -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)

View file

@ -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 ] *)

View file

@ -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

View file

@ -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] }
;

View file

@ -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 }

View file

@ -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)

View file

@ -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