diff --git a/src/ast2lic.ml b/src/ast2lic.ml
index 0842be14812d4bf4f7bd98f48f7d7a3df04107ea..25753eab61334ed0cbb62c95acbacb831a0cf513 100644
--- a/src/ast2lic.ml
+++ b/src/ast2lic.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 06/02/2013 (at 18:04) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/02/2013 (at 16:06) by Erwan Jahier> *)
open Lxm
@@ -482,17 +482,20 @@ and (translate_val_exp : Lic.id_solver -> UnifyClock.subst -> AstCore.val_exp
s, vef
)
and translate_by_name_op id_solver op s =
+ let get_pack_name idref =
+ match Ident.pack_of_idref idref with
+ | None -> (* If no pack name is provided, we lookup it in the symbol table *)
+ let id = Ident.of_idref idref in
+ let pn = AstTabSymbol.find_pack_of_type id_solver.global_symbols id op.src in
+ pn
+ | Some pn -> pn
+ in
let s, nop =
match op.it with
- | STRUCT_anonymous_n -> s,STRUCT_anonymous
- | STRUCT_n idref ->
- match Ident.pack_of_idref idref with
- | None ->
- (* If no pack name is provided, we lookup it in the symbol table *)
- let id = Ident.of_idref idref in
- let pn = AstTabSymbol.find_pack_of_type id_solver.global_symbols id op.src in
- s, STRUCT (pn, idref)
- | Some pn -> s,STRUCT (pn, idref)
+ | STRUCT_anonymous_n -> s, STRUCT_anonymous
+ | STRUCT_n idref -> s, STRUCT (get_pack_name idref, idref, None)
+ | STRUCT_WITH_n (idref1, idref2) ->
+ s, STRUCT (get_pack_name idref1,idref1, Some(idref2))
in
s, flagit nop op.src
@@ -500,21 +503,21 @@ and translate_field id_solver s (id, ve) =
let s, ve = translate_val_exp id_solver s ve in
s, (id, ve)
- (* XXX autre nom, autre module ?
- node_of_static_arg : appelé QUAND ON SAIT qu'un sarg doit etre un NODE
- const_of_static_arg : appelé QUAND ON SAIT qu'un sarg doit etre une CONST
+(* XXX autre nom, autre module ?
+ node_of_static_arg : appelé QUAND ON SAIT qu'un sarg doit etre un NODE
+ const_of_static_arg : appelé QUAND ON SAIT qu'un sarg doit etre une CONST
- -> sert pour les macros predefs
- ca fait partie de la definition des iterateurs d'une certaine maniere...
- -> créer 2 modules, Iterator + IteratorSemantics
- *)
+ -> sert pour les macros predefs
+ ca fait partie de la definition des iterateurs d'une certaine maniere...
+ -> créer 2 modules, Iterator + IteratorSemantics
+*)
and const_of_static_arg id_solver const_or_const_ident lxm =
match const_or_const_ident with
| StaticArgConst(c) -> (
match EvalConst.f id_solver c with
| [x] -> x
| xl ->
- (* EvalConst.f ne fabrique PAS de tuple, on le fait ici *)
+ (* EvalConst.f ne fabrique PAS de tuple, on le fait ici *)
Tuple_const_eff xl
)
| StaticArgIdent(id) -> id_solver.id2const id lxm
diff --git a/src/astCore.ml b/src/astCore.ml
index b54519677ef5b5ab901c9855f40ad4f58f2baa25..2a21a6b138886e1652846c235378e809245a1559 100644
--- a/src/astCore.ml
+++ b/src/astCore.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 06/02/2013 (at 16:56) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/02/2013 (at 16:06) by Erwan Jahier> *)
(** (Raw) Abstract syntax tree of source Lustre Core programs. *)
@@ -132,6 +132,7 @@ and operands = Oper of val_exp list
and by_name_op =
| STRUCT_n of Ident.idref
+ | STRUCT_WITH_n of Ident.idref * Ident.idref
| STRUCT_anonymous_n
(* for backward compatibility with lv4 *)
diff --git a/src/astV6Dump.ml b/src/astV6Dump.ml
index 1c6474dd9c0f50358b90106baded8b4b21694a2c..8dc549d5eaf9c1f7ab476839ba70bb51aaccbecf 100644
--- a/src/astV6Dump.ml
+++ b/src/astV6Dump.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 06/02/2013 (at 17:00) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/02/2013 (at 16:06) by Erwan Jahier> *)
open Lxm
@@ -568,9 +568,11 @@ and dump_by_name_exp
(
match (oper, pars) with
| (STRUCT_n id, pl) -> (
- fprintf os "%s{@,%a@,}"
- (Ident.string_of_idref id)
- dump_named_pars pl
+ fprintf os "%s{@,%a@,}" (Ident.string_of_idref id) dump_named_pars pl
+ )
+ | (STRUCT_WITH_n (id1,id2), pl) -> (
+ fprintf os "%s{ %s with @,%a@,}" (Ident.string_of_idref id1)
+ (Ident.string_of_idref id2) dump_named_pars pl
)
| (STRUCT_anonymous_n, pl) -> (
fprintf os "{@,%a@,}" dump_named_pars pl
diff --git a/src/evalClock.ml b/src/evalClock.ml
index f59e797dab1413b30db908cb8882c0cfacffe4d0..c31ec820af532619d4e95464b89951115d9988d4 100644
--- a/src/evalClock.ml
+++ b/src/evalClock.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 06/02/2013 (at 17:55) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/02/2013 (at 14:52) by Erwan Jahier> *)
open AstPredef
@@ -429,7 +429,7 @@ and (eval_by_name_clock : Lic.id_solver -> Lic.by_name_op -> Lxm.t ->
fun id_solver namop lxm namargs s ->
match namop with
| Lic.STRUCT_anonymous -> assert false (* cf EvalType.E *)
- | Lic.STRUCT _ ->
+ | Lic.STRUCT(_, _, dft_opt) ->
let apply_subst s (id,clk) = id, UnifyClock.apply_subst s clk in
let args = List.map (fun (id,ve) -> ve) namargs in
(* XXX The 3 following lines duplicates the code of TUPLE_eff and co *)
@@ -438,4 +438,8 @@ and (eval_by_name_clock : Lic.id_solver -> Lic.by_name_op -> Lxm.t ->
let _,flat_clk_args = List.split flat_clk_args in
let clk,s = UnifyClock.list lxm flat_clk_args s in
let clk_list = List.map (apply_subst s) (List.hd clk_args) in
- clk_list, s
+ match dft_opt with
+ | None -> clk_list, s
+ | Some(idref) ->
+ (* XXX should i do something here ??? *)
+ clk_list, s
diff --git a/src/evalConst.ml b/src/evalConst.ml
index d9f6b3ac168f51be4c2c1048b39b56f486acf609..c4c6d63d998f152ad29dea605a53026ffaeca29b 100644
--- a/src/evalConst.ml
+++ b/src/evalConst.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 06/02/2013 (at 17:01) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/02/2013 (at 16:07) by Erwan Jahier> *)
open Printf
@@ -91,70 +91,59 @@ let (make_array_const : Lic.const list list -> Lic.const) =
(** Utilitaire : fabriquer si possible une constante structure
-N.B. Par construction on sait que nops n'a pas de doublons
+N.B. Par construction on sait que arg_tab n'a pas de doublons
*)
-let make_struct_const
- (teff : Lic.type_)
+let make_struct_const (teff : Lic.type_) (id_opt : Ident.idref option)
(arg_tab : (Ident.t, Lxm.t * Lic.const) Hashtbl.t) =
- (
- (* on verifie qu'on a bien un type struct *)
- match teff with
- Struct_type_eff (tnm, flst) -> (
+ (* on verifie qu'on a bien un type struct *)
+ (match teff with
+ Struct_type_eff (tnm, flst) -> (
+ let make_eff_field ((fn: Ident.t),((ft:Lic.type_),(fv:Lic.const option))) =
(* on construit la liste dans le BON ordre *)
- let make_eff_field ((fn: Ident.t),((ft:Lic.type_),(fv:Lic.const option))) = (
- try (
- (* on prend en priorité dans arg_tab *)
- match (Hashtbl.find arg_tab fn) with
- (lxm, v) -> (
- (* effet de bord : on vire la valeur de arg_tab *)
- Hashtbl.remove arg_tab fn ;
- let vt = Lic.type_of_const v in
- if (vt = ft) then (fn, v) (*ok*)
- else raise (Compile_error(
- lxm ,
- sprintf
- "\n*** type error in struct %s, %s instead of %s"
- (Ident.string_of_long2 tnm)
- (Lic.string_of_type vt)
- (Lic.string_of_type ft)
- ))
- )
- ) with Not_found -> (
- (* sinon la valeur par défaut *)
- match fv with
- Some v -> (fn, v) (* ok : v correcte par construction *)
- | None ->
- raise (EvalConst_error(
- sprintf
- "bad struct expression, no value given for field %s"
- (Ident.to_string fn)
- ))
+ try
+ (* on prend en priorité dans arg_tab *)
+ let lxm, v = Hashtbl.find arg_tab fn in
+ (* effet de bord : on vire la valeur de arg_tab *)
+ Hashtbl.remove arg_tab fn ;
+ let vt = Lic.type_of_const v in
+ if (vt = ft) then (fn, v) (*ok*)
+ else raise (Compile_error(
+ lxm ,
+ sprintf "\n*** type error in struct %s, %s instead of %s"
+ (Ident.string_of_long2 tnm)
+ (Lic.string_of_type vt)
+ (Lic.string_of_type ft) ))
+ with Not_found ->
+ (* sinon la valeur par défaut *)
+ (match fv,id_opt with
+ | Some v,_ -> (fn, v) (* ok : v correcte par construction *)
+ | None,Some _ ->
+ finish_me " eval const with 'with'";
+ assert false
+ | None,None ->
+ raise (EvalConst_error(
+ sprintf "bad struct expression, no value given for field %s"
+ (Ident.to_string fn)))
)
- ) in
- (* on mappe flst pour avoir la liste dans le bon ordre *)
- let eff_fields = List.map make_eff_field flst in
- (* si arg_tab n'est pas vide, erreur sur le premier *)
- let raise_error (id : Ident.t) ((lxm : Lxm.t), (veff : Lic.const))
- = raise(Compile_error(
- lxm,
- sprintf
- "\n*** %s is not a field of struct %s"
- (Ident.to_string id)
- (Lic.string_of_type(teff))
- ))
- in
- Hashtbl.iter raise_error arg_tab ;
- (* ok : tout s'est bien passé ! *)
- Struct_const_eff (eff_fields, teff)
- )
- | _ -> raise (EvalConst_error(
- sprintf
- "struct type expected instead of %s"
- (Lic.string_of_type teff)
- ))
+ in
+ (* on mappe flst pour avoir la liste dans le bon ordre *)
+ let eff_fields = List.map make_eff_field flst in
+ (* si arg_tab n'est pas vide, erreur sur le premier *)
+ let raise_error (id : Ident.t) ((lxm : Lxm.t), (veff : Lic.const))
+ = raise(Compile_error(
+ lxm, sprintf "\n*** %s is not a field of struct %s"
+ (Ident.to_string id)
+ (Lic.string_of_type(teff))))
+ in
+ Hashtbl.iter raise_error arg_tab; (* ok : tout s'est bien passé ! *)
+ Struct_const_eff (eff_fields, teff)
+ )
+ | _ -> raise (EvalConst_error(
+ sprintf "struct type expected instead of %s" (Lic.string_of_type teff)
+ )
+ )
)
-
(*----------------------------------------------------
Evaluation récursive des expressions constantes
------------------------------------------------------
@@ -332,9 +321,9 @@ let rec f
| Predef_n(op) ->
let effargs = (List.map rec_eval_const args) in
- LicEvalConst.f env op.it lxm [] effargs
-
-
+ LicEvalConst.f env op.it lxm [] effargs
+
+
) (* FIN DE : eval_by_pos_const *)
(*-------------------------------------*)
(* Fonction récursive secondaire *)
@@ -344,43 +333,39 @@ let rec f
(*-------------------------------------*)
and eval_by_name_const
(namop : by_name_op) (* l'operateur *)
- (lxm : Lxm.t) (* source de l'opérateur *)
- (namargs : (Ident.t srcflagged * val_exp) list) (* arguments *)
+ (lxm : Lxm.t) (* source de l'opérateur *)
+ (namargs : (Ident.t srcflagged * val_exp) list) (* arguments *)
= (
+ let arg_tab = Hashtbl.create 50 in
+ let treat_one_arg opid ((pid:Ident.t srcflagged), (pexp:val_exp)) =
+ if Hashtbl.mem arg_tab pid.it
+ then
+ raise(EvalConst_error(
+ sprintf "multiple definition of param %s in %s call"
+ (Ident.to_string pid.it) (Ident.string_of_idref opid)))
+ else
+ let v = rec_eval_const pexp in
+ match v with
+ | [x] -> Hashtbl.add arg_tab pid.it (pid.src, x)
+ | _ ->
+ raise(EvalConst_error(
+ sprintf "unexpected tuple value for param %s in %s call"
+ (Ident.to_string pid.it) (Ident.string_of_idref opid)))
+ in
match namop with
- | STRUCT_anonymous_n ->
- finish_me "anonymous struct";
- assert false
+ | STRUCT_anonymous_n -> finish_me "anonymous struct"; assert false
+ (* effet de bord : on tabule les parametres effectifs *)
| STRUCT_n opid -> (
- (* effet de bord : on tabule les param effectif *)
- let arg_tab = Hashtbl.create 50 in
- let treat_one_arg ((pid:Ident.t srcflagged), (pexp:val_exp)) =
- if
- (Hashtbl.mem arg_tab pid.it)
- then
- raise(EvalConst_error(
- sprintf
- "multiple definition of param %s in %s call"
- (Ident.to_string pid.it)
- (Ident.string_of_idref opid)))
- else
- let v = rec_eval_const pexp in
- match v with
- | [x] -> Hashtbl.add arg_tab pid.it (pid.src, x)
- | _ ->
- raise(
- EvalConst_error(
- sprintf
- "unexpected tuple value for param %s in %s call"
- (Ident.to_string pid.it)
- (Ident.string_of_idref opid)
- ))
- in
- List.iter treat_one_arg namargs ;
- (* pour l'instant, on ne traite que les constructions de struct *)
- let teff = env.id2type opid lxm in
- [make_struct_const teff arg_tab]
+ List.iter (treat_one_arg opid) namargs ;
+ (* pour l'instant, on ne traite que les constructions de struct *)
+ let teff = env.id2type opid lxm in
+ [make_struct_const teff None arg_tab]
+ )
+ | STRUCT_WITH_n (opid,opid2) -> (
+ List.iter (treat_one_arg opid) namargs ;
+ let teff = env.id2type opid lxm in
+ [make_struct_const teff (Some opid2) arg_tab]
)
) (* FIN DE : eval_by_name_const *)
(*-------------------------------------*)
diff --git a/src/evalType.ml b/src/evalType.ml
index c4e5072dcdfa291f9cbe8637e0f6f3a59ef250a4..4c23dd819695b69584b06e77689728dc4ac1e70f 100644
--- a/src/evalType.ml
+++ b/src/evalType.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 06/02/2013 (at 17:55) by Erwan Jahier> *)
+(** Time-stamp: <modified the 07/02/2013 (at 15:48) by Erwan Jahier> *)
open AstPredef
@@ -67,12 +67,12 @@ let rec (f : Lic.id_solver -> Lic.val_exp -> Lic.val_exp * Lic.type_ list) =
{ ve_core = ve_core; ve_typ = tl ; ve_clk = ve.ve_clk }, tl
and eval_by_pos_type
- (id_solver: Lic.id_solver)
+ (id_solver: Lic.id_solver)
(posop: Lic.by_pos_op)
(lxm: Lxm.t)
(args: Lic.val_exp list)
: (
- Lic.by_pos_op option (* For op that hold a val_exp, we return the modified op *)
+ Lic.by_pos_op option (* For op that hold a val_exp, we return the modified op *)
* Lic.val_exp list (* The args with type info added *)
* Lic.type_ list (* The type of the val_exp "posop(args)" *)
) =
@@ -291,7 +291,7 @@ and eval_by_name_type (id_solver: Lic.id_solver) (namop: Lic.by_name_op) (lxm:
finish_me "anonymous struct not yet supported";
assert false
- | Lic.STRUCT (pn,opid) ->
+ | Lic.STRUCT (pn,opid,dft_opt) ->
let struct_type = id_solver.id2type opid lxm in
match struct_type with
| Struct_type_eff(sn, fl) ->
@@ -309,8 +309,66 @@ and eval_by_name_type (id_solver: Lic.id_solver) (namop: Lic.by_name_op) (lxm:
else raise_type_error fv_type [ft]
("while checking struct field "^(Lxm.details fn.src))
in
- let namargs = List.map do_field_assign namargs
- in (namargs, [struct_type])
+ let namargs = List.map do_field_assign namargs in
+ let namargs =
+ List.map
+ (fun (id,_) ->
+ let l = List.filter (fun (idf,_) -> id=idf.it) namargs in
+ match dft_opt, l with
+ | _,[x] -> x
+ | _,_::_ -> assert false
+ | None,[] -> (
+ try
+ let const =
+ match snd(List.assoc id fl) with
+ | None -> raise Not_found
+ | Some const -> const
+ in
+ let ve = snd (UnifyClock.const_to_val_eff
+ lxm true UnifyClock.empty_subst const)
+ in
+ (flagit id lxm), ve
+ with Not_found ->
+ let msg = Printf.sprintf
+ "Error: the field '%s' of structure '%s' is undefined"
+ (id) (Ident.string_of_idref opid)
+ in
+ raise (Compile_error(lxm, msg))
+ )
+ | Some (idref),[] ->
+
+ let (type_of_struct_field : Ident.t -> Lic.type_ -> Lic.type_) =
+ fun id t ->
+ match t with
+ | Struct_type_eff(l,fl) ->
+ (try fst(List.assoc id fl) with Not_found -> assert false)
+ | _ -> assert false
+ in
+ let (get_field_of_idref : Ident.idref -> Ident.t -> Lxm.t ->
+ Ident.t Lxm.srcflagged * Lic.val_exp) =
+ fun idref id lxm ->
+ let vi = id_solver.id2var idref lxm in
+ let dft_ve =
+ {ve_core = CallByPosLic
+ ((flagit (VAR_REF (Ident.of_idref idref)) lxm),OperLic[]);
+ ve_typ = [vi.var_type_eff];
+ ve_clk = [snd vi.var_clock_eff]
+ }
+ in
+ let ve =
+ {ve_core = CallByPosLic ((flagit (STRUCT_ACCESS id) lxm),
+ OperLic [dft_ve]);
+ ve_typ = [type_of_struct_field id vi.var_type_eff];
+ ve_clk = [snd vi.var_clock_eff]
+ }
+ in
+ (flagit id lxm), ve
+ in
+ get_field_of_idref idref id lxm
+ )
+ fl
+ in
+ (namargs, [struct_type])
| _ -> raise (Compile_error(lxm, "type error: a structure is expected"))
and (eval_merge : Lic.id_solver -> Ident.t -> Lxm.t ->
@@ -322,7 +380,7 @@ and (eval_merge : Lic.id_solver -> Ident.t -> Lxm.t ->
(fun (acc,tl_opt) (c,ve) ->
(* check that id is of type tclk *)
let id_type =
-(* let c = id_solver.id2const (Ident.idref_of_long id.it) id.src in *)
+ (* let c = id_solver.id2const (Ident.idref_of_long id.it) id.src in *)
type_of_const c.it
in
if id_type <> tclk then (
@@ -350,5 +408,5 @@ and (eval_merge : Lic.id_solver -> Ident.t -> Lxm.t ->
nargs
in
let tl = match tl_opt with Some tl -> tl | None -> assert false in
- Merge({it=clk; src=lxm}, nargs), tl
+ Merge({it=clk; src=lxm}, nargs), tl
diff --git a/src/l2lExpandArrays.ml b/src/l2lExpandArrays.ml
index d3ce379d4469a8db85fdfa82e7c1196123d055ca..e98abfcc2f1828608abfa02ac1e2a636c7c8288f 100644
--- a/src/l2lExpandArrays.ml
+++ b/src/l2lExpandArrays.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 06/02/2013 (at 17:56) by Erwan Jahier> *)
+(** Time-stamp: <modified the 07/02/2013 (at 11:40) by Erwan Jahier> *)
(* Replace structures and arrays by as many variables as necessary.
Since structures can be recursive, it migth be a lot of new variables...
@@ -471,8 +471,7 @@ and (expand_val_exp: local_ctx -> acc -> val_exp -> val_exp * acc) =
with (Not_found | Failure _) ->
assert false (* just a defense against nth and assoc *)
in
- TUPLE, acc, flatten_var_tree vt
-
+ TUPLE, acc, flatten_var_tree vt
in
let newve = CallByPosLic(Lxm.flagit by_pos_op lxm, OperLic vel) in
let newve = { ve with ve_core = newve } in
@@ -500,7 +499,7 @@ and (expand_val_exp: local_ctx -> acc -> val_exp -> val_exp * acc) =
match const_opt with
| None -> assert false
(* ougth to have been checked before *)
- | Some const ->
+ | Some const ->
let s, ve_const = (* XXX *)
UnifyClock.const_to_val_eff lxm true
UnifyClock.empty_subst const
@@ -516,7 +515,7 @@ and (expand_val_exp: local_ctx -> acc -> val_exp -> val_exp * acc) =
let newve = {
ve_typ = ve.ve_typ;
ve_clk = ve.ve_clk;
- ve_core=CallByPosLic({ src=lxm ; it=TUPLE }, OperLic (List.rev vel))
+ ve_core= CallByPosLic({ src=lxm ; it=TUPLE }, OperLic (List.rev vel))
}
in
(* if newve.core <> ve.core then ( *)
diff --git a/src/lic.ml b/src/lic.ml
index 99ca2cca9ed1d1750f2706f5f672b3e3d2a63c82..8ed26cf37986b09008204df1eee6e5e654ebd616 100644
--- a/src/lic.ml
+++ b/src/lic.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/02/2013 (at 09:48) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/02/2013 (at 16:09) by Erwan Jahier> *)
(** Define the Data Structure representing Compiled programs. *)
@@ -195,10 +195,10 @@ and val_exp_core =
and operands = OperLic of val_exp list
and by_name_op =
- | STRUCT of Ident.pack_name * Ident.idref
+ | STRUCT of Ident.pack_name * Ident.idref *
+ Ident.idref option (* 'Some' if the struct is defined via a 'with' *)
| STRUCT_anonymous
-
and by_pos_op =
| PREDEF_CALL of AstPredef.op
| CALL of node_key srcflagged
diff --git a/src/licDump.ml b/src/licDump.ml
index f746982dca4200a5374d4de913bf6b7cf6cfb3bd..3432f7a657c74736cd2875c05797a9348c432745 100644
--- a/src/licDump.ml
+++ b/src/licDump.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 07/02/2013 (at 09:57) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/02/2013 (at 15:55) by Erwan Jahier> *)
open Errors
open Printf
@@ -513,7 +513,7 @@ and string_of_val_exp_eff_core ve_core =
)
| CallByNameLic(by_name_op_eff, fl) ->
(match by_name_op_eff.it with
- | STRUCT (pn,idref) -> (
+ | STRUCT (pn,idref, _dft_opt) -> (
match Ident.pack_of_idref idref with
| Some pn -> Ident.string_of_idref idref
| None ->
diff --git a/src/parser.mly b/src/parser.mly
index abddbd20e39b9c93e39992b39c809c86ee46e866..21deda835ddf513579e1a081096c588cf7262d40 100644
--- a/src/parser.mly
+++ b/src/parser.mly
@@ -481,7 +481,7 @@ OneTypeDecl:
}
/* type structure à champs nommés */
/* WARNING ! la liste est déjà à l'endroit */
- | Ident TK_EQ OptStruct TK_OPEN_BRACE TypedValuedIdents TK_CLOSE_BRACE
+ | Ident TK_EQ OptStruct TK_OPEN_BRACE TypedValuedIdents OptSemicol TK_CLOSE_BRACE
{
let typinfo = StructType (make_struct_type_info $1 $5) in
($1, typinfo)
@@ -1088,8 +1088,10 @@ donc pas de soucis d'
*/
CallByNameExpression:
/* WARNING ! il faut remettre la liste à l'endroit */
- IdentRef TK_OPEN_BRACE CallByNameParamList OptSemicol TK_CLOSE_BRACE
+ | IdentRef TK_OPEN_BRACE CallByNameParamList OptSemicol TK_CLOSE_BRACE
{ bynameexp $1.src (STRUCT_n $1.it) (List.rev $3) }
+ | IdentRef TK_OPEN_BRACE IdentRef TK_WITH CallByNameParamList OptSemicol TK_CLOSE_BRACE
+ { bynameexp $1.src (STRUCT_WITH_n ($1.it,$3.it)) (List.rev $5) }
/* on peut avoir une liste vide */
| IdentRef TK_OPEN_BRACE TK_CLOSE_BRACE
{ bynameexp $1.src (STRUCT_n $1.it) ([]) }
diff --git a/src/parserUtils.ml b/src/parserUtils.ml
index 73c815c08b25ae4a6124ee2cc76527b3656a69f2..55365893d3fc6dd175a9c194c4090f735168e529 100644
--- a/src/parserUtils.ml
+++ b/src/parserUtils.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 06/02/2013 (at 17:03) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/02/2013 (at 10:24) by Erwan Jahier> *)
(** *)
diff --git a/src/unifyClock.ml b/src/unifyClock.ml
index 92ad572daf6de7ca391d1a24a9f51d87a45898bb..e52a73094a3faa2eac23710a043a3b610d8a3555 100644
--- a/src/unifyClock.ml
+++ b/src/unifyClock.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 06/02/2013 (at 16:33) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/02/2013 (at 14:32) by Erwan Jahier> *)
open LicDump
@@ -329,7 +329,7 @@ let rec (const_to_val_eff: Lxm.t -> bool -> subst -> const -> subst * val_exp) =
| _ -> assert false
in
let pack = Ident.pack_of_long sname in
- let name_op_flg = flagit (STRUCT(pack, Ident.idref_of_long sname)) lxm in
+ let name_op_flg = flagit (STRUCT(pack, Ident.idref_of_long sname, None)) lxm in
let s, fl =
List.fold_left
(fun (s,fl) (id,const) ->
diff --git a/test/lus2lic.log.ref b/test/lus2lic.log.ref
index 20681a6af628ad57ad57be3b0821a1d5720fc8d4..83fff7e8dbe3c9aa8585e2de621af57be7267aab 100644
--- a/test/lus2lic.log.ref
+++ b/test/lus2lic.log.ref
@@ -1,4 +1,4 @@
-Test Run By jahier on Mon Feb 4 21:18:05 2013
+Test Run By jahier on Thu Feb 7 15:49:50 2013
Native configuration is i686-pc-linux-gnu
=== lus2lic tests ===
@@ -373,6 +373,12 @@ spawn ./lus2lic -ec -o /tmp/bascule.ec should_work/bascule.lus
PASS: ./lus2lic {-ec -o /tmp/bascule.ec should_work/bascule.lus}
spawn ./ec2c -o /tmp/bascule.c /tmp/bascule.ec
PASS: ./ec2c {-o /tmp/bascule.c /tmp/bascule.ec}
+spawn ./lus2lic -o /tmp/struct_with.lic should_work/struct_with.lus
+PASS: ./lus2lic {-o /tmp/struct_with.lic should_work/struct_with.lus}
+spawn ./lus2lic -ec -o /tmp/struct_with.ec should_work/struct_with.lus
+PASS: ./lus2lic {-ec -o /tmp/struct_with.ec should_work/struct_with.lus}
+spawn ./ec2c -o /tmp/struct_with.c /tmp/struct_with.ec
+PASS: ./ec2c {-o /tmp/struct_with.c /tmp/struct_with.ec}
spawn ./lus2lic -o /tmp/test_node_expand.lic should_work/test_node_expand.lus
PASS: ./lus2lic {-o /tmp/test_node_expand.lic should_work/test_node_expand.lus}
spawn ./lus2lic -ec -o /tmp/test_node_expand.ec should_work/test_node_expand.lus
@@ -1748,11 +1754,11 @@ spawn ./lus2lic -o /tmp/activation1.lic should_fail/semantics/broken/activation1
XPASS: Test bad programs (semantics): lus2lic {-o /tmp/activation1.lic should_fail/semantics/broken/activation1.lus}
spawn ./lus2lic -o /tmp/bug.lic should_fail/semantics/broken/bug.lus
XPASS: Test bad programs (semantics): lus2lic {-o /tmp/bug.lic should_fail/semantics/broken/bug.lus}
-testcase ./lus2lic.tests/progression.exp completed in 0 seconds
+testcase ./lus2lic.tests/progression.exp completed in 1 seconds
=== lus2lic Summary ===
-# of expected passes 741
+# of expected passes 744
# of unexpected successes 11
# of expected failures 37
-runtest completed at Mon Feb 4 21:18:29 2013
+runtest completed at Thu Feb 7 15:50:15 2013
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index 48e6204b486b83863155f87c8c54b7126fa4c804..0aece9bbd02cf34a46d19032bcb80c55b9972316 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,4 +1,4 @@
-Test Run By jahier on Thu Feb 7 09:53:07 2013
+Test Run By jahier on Thu Feb 7 16:10:22 2013
Native configuration is i686-pc-linux-gnu
=== lus2lic tests ===
@@ -189,6 +189,9 @@ PASS: ./ec2c {-o /tmp/call04.c /tmp/call04.ec}
PASS: ./lus2lic {-o /tmp/bascule.lic should_work/bascule.lus}
PASS: ./lus2lic {-ec -o /tmp/bascule.ec should_work/bascule.lus}
PASS: ./ec2c {-o /tmp/bascule.c /tmp/bascule.ec}
+PASS: ./lus2lic {-o /tmp/struct_with.lic should_work/struct_with.lus}
+PASS: ./lus2lic {-ec -o /tmp/struct_with.ec should_work/struct_with.lus}
+PASS: ./ec2c {-o /tmp/struct_with.c /tmp/struct_with.ec}
PASS: ./lus2lic {-o /tmp/test_node_expand.lic should_work/test_node_expand.lus}
PASS: ./lus2lic {-ec -o /tmp/test_node_expand.ec should_work/test_node_expand.lus}
PASS: ./ec2c {-o /tmp/test_node_expand.c /tmp/test_node_expand.ec}
@@ -801,6 +804,6 @@ XPASS: Test bad programs (semantics): lus2lic {-o /tmp/bug.lic should_fail/seman
=== lus2lic Summary ===
-# of expected passes 741
+# of expected passes 744
# of unexpected successes 11
# of expected failures 37
diff --git a/test/should_fail/struct.lus b/test/should_fail/struct.lus
new file mode 100644
index 0000000000000000000000000000000000000000..37a4a266e89c00b7c09be14ff71d3b4c4fe417a3
--- /dev/null
+++ b/test/should_fail/struct.lus
@@ -0,0 +1,8 @@
+type complex = struct {
+ re : real;
+ im : real
+};
+node plus_im (a : real; b : complex) returns (c : complex);
+let
+ c = complex { im = a+b.im };
+tel
diff --git a/test/should_fail/struct_incomplete.lus b/test/should_fail/struct_incomplete.lus
new file mode 100644
index 0000000000000000000000000000000000000000..2acb7d8f2061ca1b16f57ead4989f79d83c1560a
--- /dev/null
+++ b/test/should_fail/struct_incomplete.lus
@@ -0,0 +1,9 @@
+type Toto = struct {
+ x : int = 1;
+ y : int
+};
+
+node bibi (dummy : int) returns (z : Toto);
+let
+ z = Toto { x = 3 };
+tel
diff --git a/test/should_work/struct_with.lus b/test/should_work/struct_with.lus
new file mode 100644
index 0000000000000000000000000000000000000000..cfbf83dfddfe12f85a749a0335cb8ab22654aab9
--- /dev/null
+++ b/test/should_work/struct_with.lus
@@ -0,0 +1,13 @@
+type complex = struct {
+ re : real = 42.0;
+ im : real = 42.0;
+};
+node plus_im (a : real; b : complex) returns (c : complex);
+let
+ c = complex { b with im = a+b.im };
+-- c = complex { re=b.re im = a+b.im };
+tel
+node plus_im_1 (b : complex) returns (c : complex);
+let
+ c = complex { b with im = 1.0+b.im };
+tel
diff --git a/todo.org b/todo.org
index a7816e26f897f6d4bd883df64f71cdd651df1a8b..e09a4718a586e505c8d4e9949946cb98509f60a7 100644
--- a/todo.org
+++ b/todo.org
@@ -65,17 +65,6 @@ file:~/lus2lic/src/uglyStuff.ml
QU: Pascal l'a fait ?
-** TODO Dans file:src/eff.ml::195 on pourrait virer la notion de call by name
-qui ne sert que pour les structures. Mais au niveau du Eff, on
-pourrait s'en être débarrassé au profit d'un appel par position. A
-faire au moment de la compilation des expressions.
-
-question : est-ce que cela nous prive d'une optim pour le traitement
-du with ?
-comment fait caml ?
- - State "TODO" from "" [2012-10-26 Fri 14:59]
-
-
* Languages issues
** TODO Verifier les boucles combinatoires meme quand on ne genere pas de ec
- State "TODO" from "STARTED" [2013-01-29 Tue 09:49]
@@ -85,9 +74,6 @@ comment fait caml ?
On pourrait utiliser file:src/misc.ml pour prendre finement en compte les
struct et les arrays.
-** TODO Rajouter le with à la caml pour les structures
- - State "TODO" from "" [2012-10-26 Fri 14:59]
-
** TODO operateurs iterables
- State "TODO" from "" [2012-03-30 Fri 17:03]
- mettre dans la doc
@@ -135,7 +121,7 @@ let
tel
#+END_CENTER
-
+
* Divers
** STARTED Intégrer le résultat de mly2bnf dans le manuel
** TODO lic2c : le jour ou on genere du code C, y'a peut-etre des trucs a recuperer
@@ -222,3 +208,14 @@ Mouais. C'est pas clair. Si on regarde par exemple ici :
file:src/ast2lic.ml:407
On voit qu'on n'y fait pas le même traitement.
À voir avec Pascal.
+
+** TODO Dans file:src/eff.ml::195 on pourrait virer la notion de call by name
+qui ne sert que pour les structures. Mais au niveau du Eff, on
+pourrait s'en être débarrassé au profit d'un appel par position. A
+faire au moment de la compilation des expressions.
+
+question : est-ce que cela nous prive d'une optim pour le traitement
+du with ?
+comment fait caml ?
+ - State "TODO" from "" [2012-10-26 Fri 14:59]
+
diff --git a/todo.org_archive b/todo.org_archive
index d2b53f84ab609db361ae1c61558a68dd7501e762..064882592ea8060e5aa333803a78abc0fafa372b 100644
--- a/todo.org_archive
+++ b/todo.org_archive
@@ -429,6 +429,20 @@ mouarf, pourquoi pas en fait.
:END:
cf le XXX file:src/lic.ml::655
+* TODO Rajouter le with à la caml pour les structures
+ - State "TODO" from "" [2012-10-26 Fri 14:59]
+ :PROPERTIES:
+ :ARCHIVE_TIME: 2013-02-07 Thu 16:10
+ :ARCHIVE_FILE: ~/lus2lic/todo.org
+ :ARCHIVE_OLPATH: Languages issues
+ :ARCHIVE_CATEGORY: lv6
+ :ARCHIVE_TODO: TODO
+ :END:
+
+main peut-on l'appeller with ?
+file:test/should_work/struct_with.lus
+
+
diff --git a/utils/lustre.el b/utils/lustre.el
index 79ade4aaa5017d216180736e967f1423f7ea5e1b..71460910104779436fdd950805be85694fc735be 100644
--- a/utils/lustre.el
+++ b/utils/lustre.el
@@ -227,7 +227,7 @@
(regexp-opt '("/" "*" "#" "=" "+" "-" "*" "<" ">")) "\\|"
(regexp-opt '("node" "const" "function" "include" "let"
"returns" "tel" "type" "var" "if" "with"
- "then" "else" "and" "or" "xor" "assert"
+ "then" "else" "and" "or" "xor" "assert" "with" "struct"
"pre" "not" "when"
"current") 'words)) 0 ,kw t)