diff --git a/src/Makefile b/src/Makefile
index 327b55f316ac8543215ae0532854814c0facc5e0..1cde6f9a45f885ee8782fb46c9241addaee95ed8 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -26,8 +26,8 @@ SOURCES = \
./lexer.mll \
./syntaxTabUtils.mli \
./syntaxTabUtils.ml \
- ./expandPack.mli \
- ./expandPack.ml \
+ ./instanciateModel.mli \
+ ./instanciateModel.ml \
./symbolTab.mli \
./symbolTab.ml \
./eff.ml \
diff --git a/src/expandPack.ml b/src/expandPack.ml
deleted file mode 100644
index f5822ddf1edb73120a5c8582cfe15a5945c6c5f3..0000000000000000000000000000000000000000
--- a/src/expandPack.ml
+++ /dev/null
@@ -1,171 +0,0 @@
-(** Time-stamp: <modified the 28/08/2008 (at 10:27) by Erwan Jahier> *)
-
-open Lxm
-open SyntaxTree
-open SyntaxTreeCore
-open Errors
-open SyntaxTabUtils
-
-let (doit:
- (Ident.t, SyntaxTree.model_info Lxm.srcflagged) Hashtbl.t ->
- (SyntaxTree.pack_info Lxm.srcflagged) ->
- SyntaxTree.pack_given) =
- fun mtab pdata -> (
- match (pdata.it.pa_def) with
- PackGiven pg -> pg
- (* on garde tel-quel ... *)
-
- | PackInstance pi -> (
- (* recherche du modèle *)
- let mi = try Hashtbl.find mtab pi.pi_model
- with Not_found ->
- let msg = Printf.sprintf "bad pack instance: model %s undeclared"
- (Ident.to_string pi.pi_model)
- in
- raise ( Compile_error (pdata.src, msg))
- in
- (*-----------INIT-----------------------------------*)
- (* On part du packbody du modèle, dont on duplique les tables :*)
- let ctab = Hashtbl.copy mi.it.mo_body.pk_const_table in
- let ttab = Hashtbl.copy mi.it.mo_body.pk_type_table in
- let otab = Hashtbl.copy mi.it.mo_body.pk_node_table in
- (* liste des nouveaux define ... *)
- let newdefs = ref [] in
- (* liste des nouveaux provides ... *)
- let newprov = ref [] in
- (* On met en correspondance les pi_args avec les mo_needs *)
- let args = pi.pi_args in
- let pars = mi.it.mo_needs in
- (*--------------------------------------------------*)
-
- (* la fonction qui traite un couple ... *)
- let (check_arg : static_param srcflagged -> static_arg srcflagged -> unit) =
- fun param arg ->
- (* message d'erreur standard *)
- let instance_error () =
- let msg = Printf.sprintf
- "bad argument in package instance: %s" (Lxm.details param.src)
- in
- raise (Compile_error (arg.src, msg))
- in
- (* on a soit un ident, à checker plus tard, soit une
- expression de la bonne nature *)
- match (param.it) with
- | StaticParamType s -> (
- let te = match (arg.it) with
- StaticArgIdent idr ->
- Lxm.flagit (Named_type_exp idr) arg.src
- | StaticArgType x -> x
- | _ -> instance_error ()
- in
- let ti = AliasedType (s, te) in
- let x = Lxm.flagit (TypeInfo ti) param.src in
- newprov := x::!newprov ;
- let y = Lxm.flagit ti param.src in
- put_in_tab "type" ttab s y ;
- newdefs := (TypeItem s)::!newdefs
- )
- | StaticParamConst (s,te) -> (
- let ce = match (arg.it) with
- | StaticArgIdent idr ->
- ParserUtils.leafexp arg.src (IDENT_n idr)
- | StaticArgConst x -> x
- | _ -> instance_error ()
- in
- let ci = DefinedConst (s, Some te, ce) in
- let x = Lxm.flagit (ConstInfo ci) param.src in
- newprov := x::!newprov ;
- let y = Lxm.flagit ci param.src in
- put_in_tab "const" ctab s y ;
- newdefs := (ConstItem s)::!newdefs
- )
- | StaticParamNode (s, inl, outl, has_memory) -> (
- let by_pos_op = match (arg.it) with
- | StaticArgIdent idr ->
- CALL_n(Lxm.flagit ((idr,[])) arg.src)
- | StaticArgNode by_pos_op -> by_pos_op
- | _ -> instance_error ()
- in
- let sparams = [] in
- let ni = {
- name = s;
- static_params = sparams;
- vars = Some (ParserUtils.build_node_var inl outl None);
- def = Alias (flagit by_pos_op arg.src);
- has_mem = has_memory;
- is_safe = true;
- }
- in
- let x = Lxm.flagit (NodeInfo ni) param.src in
- newprov := x::!newprov ;
- let y = Lxm.flagit ni param.src in
- put_in_tab "node" otab s y ;
- newdefs := (NodeItem (s,sparams))::!newdefs
- )
- (* check_arg *)
- in
- let (sargs_pack : Ident.pack_name srcflagged list) =
- List.fold_left
- (fun acc arg ->
- (match arg.it with
- | StaticArgIdent(idref) ->
- (match Ident.pack_of_idref idref with
- | None -> acc
- | Some p ->
- let p_flagged = Lxm.flagit p arg.src in
- if List.mem p_flagged acc then acc else p_flagged::acc
- )
- | _ -> acc
- )
- )
- []
- args
- in
- let pars_nb = string_of_int (List.length pars)
- and args_nb = string_of_int (List.length args) in
- try (
- (*------------TRAITEMENT---------------------------------*)
- if (pars_nb <> args_nb) then
- raise(Compile_error
- (pdata.src,
- ("\n*** " ^pars_nb ^
- " arguments are expected, but "^args_nb^
- " were provided when defining package "^
- (Ident.pack_name_to_string pdata.it.pa_name)
- )));
- List.iter2 check_arg pars args;
- (* on fabrique un pack_given valide avec les infos récoltées *)
- let body = {
- pk_const_table = ctab ;
- pk_type_table = ttab ;
- pk_node_table = otab ;
- pk_def_list = List.append
- (mi.it.mo_body.pk_def_list)
- (List.rev !newdefs)
- } in
- (* les provides du modèle + les nouveaux de newprov *)
- (* SAUF SI ON EXPORTE DEJA TOUT ! *)
- let prov = match (mi.it.mo_provides) with
- Some l -> (
- Some (List.append l (List.rev !newprov))
- )
- | None -> None
- in
- let pg = {
- (* les uses du modèle + les packages utilisés par les arg statiques *)
- pg_uses = mi.it.mo_uses @ sargs_pack;
- pg_provides = prov ;
- pg_body = body ;
- } in
- pg
- ) with Invalid_argument _ -> (
- let msg = Printf.sprintf
- "bad pack instance: %d args provided while model %s has %d params"
- (List.length args)
- (Ident.to_string pi.pi_model)
- (List.length pars)
- in
- raise ( Compile_error (pdata.src, msg))
- )
- )
- )
diff --git a/src/instanciateModel.ml b/src/instanciateModel.ml
new file mode 100644
index 0000000000000000000000000000000000000000..b2aa1377d9e19439f358081015f515b5955cdd17
--- /dev/null
+++ b/src/instanciateModel.ml
@@ -0,0 +1,165 @@
+(** Time-stamp: <modified the 23/10/2008 (at 10:59) by Erwan Jahier> *)
+
+open Lxm
+open SyntaxTree
+open SyntaxTreeCore
+open Errors
+open SyntaxTabUtils
+
+
+
+let instance_error lxm =
+ let msg = Printf.sprintf
+ "bad argument in package instance: %s" (Lxm.details lxm)
+ in
+ raise (Compile_error (lxm, msg))
+
+
+(* Model instanciation is done via a call by name binding. This
+ function checks whether each parameter matches one of the arguments,
+ and returns (by appending it to an accumulator):
+
+ - the item (const, type, node) corresponding to the parameter:
+ - its definition.
+*)
+type check_arg_acc = item_ident list * item_info srcflagged list
+type tables =
+ (Ident.t, const_info Lxm.srcflagged) Hashtbl.t *
+ (Ident.t, type_info Lxm.srcflagged) Hashtbl.t *
+ (Ident.t, node_info Lxm.srcflagged) Hashtbl.t
+
+let (check_arg : tables -> (Ident.t * static_arg srcflagged) list -> check_arg_acc ->
+ static_param srcflagged -> check_arg_acc) =
+ fun (ctab, ttab, ntab) args (defs, prov) param ->
+
+ let find_arg id =
+ try List.assoc id args with Not_found -> instance_error param.src
+ in
+ match param.it with
+ | StaticParamType s -> (
+ let arg = find_arg s in
+ let te = match arg.it with
+ | StaticArgIdent idr -> Lxm.flagit (Named_type_exp idr) arg.src
+ | StaticArgType x -> x
+ | _ -> instance_error param.src
+ in
+ let ti = AliasedType (s, te) in
+ let x = Lxm.flagit (TypeInfo ti) param.src in
+ let y = Lxm.flagit ti param.src in
+ put_in_tab "type" ttab s y;
+ ((TypeItem s)::defs, x::prov)
+ )
+ | StaticParamConst (s,te) -> (
+ let arg = find_arg s in
+ let ce = match (arg.it) with
+ | StaticArgIdent idr -> ParserUtils.leafexp arg.src (IDENT_n idr)
+ | StaticArgConst x -> x
+ | _ -> instance_error param.src
+ in
+ let ci = DefinedConst (s, Some te, ce) in
+ let x = Lxm.flagit (ConstInfo ci) param.src in
+ let y = Lxm.flagit ci param.src in
+ put_in_tab "const" ctab s y ;
+ ((ConstItem s)::defs, x::prov)
+ )
+ | StaticParamNode (s, inl, outl, has_memory) -> (
+ let arg = find_arg s in
+ let by_pos_op = match (arg.it) with
+ | StaticArgIdent idr -> CALL_n(Lxm.flagit ((idr,[])) arg.src)
+ | StaticArgNode by_pos_op -> by_pos_op
+ | _ -> instance_error param.src
+ in
+ let sparams = [] in
+ let ni = {
+ name = s;
+ static_params = sparams;
+ vars = Some (ParserUtils.build_node_var inl outl None);
+ def = Alias (flagit by_pos_op arg.src);
+ has_mem = has_memory;
+ is_safe = true;
+ }
+ in
+ let x = Lxm.flagit (NodeInfo ni) param.src in
+ let y = Lxm.flagit ni param.src in
+ put_in_tab "node" ntab s y ;
+ ((NodeItem (s,sparams))::defs, x::prov)
+ )
+
+let (f: (Ident.t, SyntaxTree.model_info Lxm.srcflagged) Hashtbl.t ->
+ (SyntaxTree.pack_info Lxm.srcflagged) -> SyntaxTree.pack_given) =
+ fun mtab pdata ->
+ match (pdata.it.pa_def) with
+ | PackGiven pg -> pg
+ | PackInstance pi ->
+ let mi = try Hashtbl.find mtab pi.pi_model with Not_found ->
+ let msg = Printf.sprintf "bad pack instance: model %s undeclared"
+ (Ident.to_string pi.pi_model)
+ in
+ raise ( Compile_error (pdata.src, msg))
+ in
+ (* On part du packbody du modèle, dont on duplique les tables *)
+ let ctab = Hashtbl.copy mi.it.mo_body.pk_const_table in
+ let ttab = Hashtbl.copy mi.it.mo_body.pk_type_table in
+ let ntab = Hashtbl.copy mi.it.mo_body.pk_node_table in
+ let args = pi.pi_args in
+ let pars = mi.it.mo_needs in
+ let (used_packages : Ident.pack_name srcflagged list) =
+ (* We add to the list of used packages the packages that are explicitely
+ used in the model arguments *)
+ List.fold_left
+ (fun acc (_,arg) ->
+ (match arg.it with
+ | StaticArgIdent(idref) ->
+ (match Ident.pack_of_idref idref with
+ | None -> acc
+ | Some p ->
+ let p_flagged = Lxm.flagit p arg.src in
+ if List.mem p_flagged acc then acc else p_flagged::acc
+ )
+ | _ -> acc
+ )
+ )
+ mi.it.mo_uses
+ args
+ in
+ let (newdefs, newprov) =
+ List.fold_left (check_arg (ctab, ttab, ntab) args) ([],[]) pars
+ in
+ let pars_nb = string_of_int (List.length pars)
+ and args_nb = string_of_int (List.length args) in
+ try (
+ (*------------TRAITEMENT---------------------------------*)
+ if (pars_nb <> args_nb) then
+ let msg = "\n*** " ^pars_nb ^ " arguments are expected, but "^args_nb^
+ " were provided when defining package "^
+ (Ident.pack_name_to_string pdata.it.pa_name)
+ in
+ raise(Compile_error (pdata.src, msg))
+ else
+ (* on fabrique un pack_given valide avec les infos récoltées *)
+ let body = {
+ pk_const_table = ctab ;
+ pk_type_table = ttab ;
+ pk_node_table = ntab ;
+ pk_def_list = (mi.it.mo_body.pk_def_list) @ (List.rev newdefs)
+ }
+ in
+ (* les provides du modèle + les nouveaux de newprov *)
+ (* SAUF SI ON EXPORTE DEJA TOUT ! *)
+ let prov = match (mi.it.mo_provides) with
+ | Some l -> Some (l @ (List.rev newprov))
+ | None -> None
+ in
+ {
+ pg_uses = used_packages;
+ pg_provides = prov ;
+ pg_body = body ;
+ }
+ )
+ with Invalid_argument _ ->
+ let msg = Printf.sprintf
+ "bad pack instance: %d args provided while model %s has %d params"
+ (List.length args) (Ident.to_string pi.pi_model) (List.length pars)
+ in
+ raise (Compile_error (pdata.src, msg))
+
diff --git a/src/expandPack.mli b/src/instanciateModel.mli
similarity index 93%
rename from src/expandPack.mli
rename to src/instanciateModel.mli
index 971327947edf880ddcde46babaccc34bf7930693..360a988394eeac94bcfad3ed28a3bc045f54abc4 100644
--- a/src/expandPack.mli
+++ b/src/instanciateModel.mli
@@ -1,7 +1,7 @@
-(** Time-stamp: <modified the 07/02/2008 (at 11:25) by Erwan Jahier> *)
+(** Time-stamp: <modified the 23/10/2008 (at 11:34) by Erwan Jahier> *)
(*----------------------------------------------------------------------
-MODULE : ExpandPack
+MODULE : InstanciateModel
------------------------------------------------------------------------
DESCRIPTION :
@@ -14,7 +14,7 @@ SI BESOIN.
----------------------------------------------------------------------*)
(*----------------------------------------------------------------------
-MODULE : ExpandPack
+MODULE : InstanciateModel
------------------------------------------------------------------------
DESCRIPTION :
@@ -43,7 +43,7 @@ On met en relation les couples (param formel, arg effectif) :
----------------------------------------------------------------------*)
-val doit :
+val f :
(* la table des sources de modeles *)
(Ident.t, SyntaxTree.model_info Lxm.srcflagged) Hashtbl.t ->
(* la def de pack à traiter *)
diff --git a/src/lexer.mll b/src/lexer.mll
index 89099b09a5bb5f430f5eb471586ae52ecb1444e7..625efbb4933f11fec7f2b03bb1c4e6e3853b4681 100644
--- a/src/lexer.mll
+++ b/src/lexer.mll
@@ -143,6 +143,7 @@ let token_code tk = (
| TK_TYPE lxm -> ("TK_TYPE" , lxm)
| TK_VAR lxm -> ("TK_VAR" , lxm)
| TK_WHEN lxm -> ("TK_WHEN" , lxm)
+ | TK_MERGE lxm -> ("TK_MERGE" , lxm)
| TK_WITH lxm -> ("TK_WITH" , lxm)
| TK_XOR lxm -> ("TK_XOR" , lxm)
| TK_MODEL lxm -> ("TK_MODEL" , lxm)
diff --git a/src/main.ml b/src/main.ml
index 85a16b152401cd7719b90be5bb3fddaebae722ae..61254dd577e5e3f9ec2981059b9e05516830b3b6 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 17/09/2008 (at 11:50) by Erwan Jahier> *)
+(** Time-stamp: <modified the 23/10/2008 (at 11:32) by Erwan Jahier> *)
(** Here follows a description of the different modules used by this lus2lic compiler.
@@ -17,7 +17,7 @@ which results into a parse tree containing raw source expressions.
syntaxTab.mli/ml
syntaxTabUtil.ml/mli
- expandPack.mli/ml
+ instanciateModel.mli/ml
symbolTab.mli/ml (type/const/node)
syntaxTab is a kind of layer above syntaxTree to make things easier afterwards.
diff --git a/src/parser.mly b/src/parser.mly
index ce6e640eb25b963b850c24d4aaf2ef92bf7e64d0..d4a5d24cfc8bacfb4bbda9565bdf443932c8ede5 100644
--- a/src/parser.mly
+++ b/src/parser.mly
@@ -345,7 +345,7 @@ sxEq_or_Is:
*/
sxPackEq:
TK_PACKAGE sxIdent sxEq_or_Is sxIdent TK_OPEN_PAR
- sxStaticArgList
+ sxByNameStaticArgList
TK_CLOSE_PAR TK_SEMICOL
{
let pdef = PackInstance {
@@ -930,6 +930,60 @@ sxStaticArg:
| sxSurelyNode
{ {src=$1.src; it=StaticArgNode (CALL_n $1)} }
;
+/* for model arguments (copy-pasted from call by position StaticArg */
+sxByNameStaticArgList:
+ sxByNameStaticArg
+ { [$1] }
+ | sxByNameStaticArgList TK_COMA sxByNameStaticArg
+ { $3::$1 }
+ /* let's be permissive... */
+ | sxByNameStaticArgList TK_SEMICOL sxByNameStaticArg
+ { $3::$1 }
+ ;
+
+/* Faut se tordre l'esprit ici !
+- la nature est explicite,
+ - la nature est immediate (type, const ou node predefini)
+ - la nature est sans ambiguite const (expressions simples)
+ - la nature est compile-time (juste un ident, a résoudre)
+ */
+
+sxByNameStaticArg:
+ /* nature explicite */
+ | TK_TYPE sxIdent TK_EQ sxType
+ { (Lxm.id $2, {src=$1 ; it= StaticArgType $4 }) }
+ | TK_CONST sxIdent TK_EQ sxExpression
+ { (Lxm.id $2, {src=$1 ; it= StaticArgConst $4 }) }
+ | TK_NODE sxIdent TK_EQ sxEffectiveNode
+ { (Lxm.id $2, {src=$1 ; it= StaticArgNode (CALL_n $4) }) }
+ | TK_FUNCTION sxIdent TK_EQ sxEffectiveNode
+ { (Lxm.id $2, {src=$1 ; it= StaticArgNode (CALL_n $4) }) }
+
+
+
+ | sxIdent TK_EQ sxPredefOp
+ { Lxm.id $1, {src=$3.src; it=StaticArgNode $3.it } }
+ /* un ident OU une expression simple (à résoudre) */
+ /* c'est au retour qu'on choisit */
+ | sxIdent TK_EQ sxSimpleExp
+ { Lxm.id $1,
+ match $3 with
+ | CallByPos (op, x) -> (
+ match op.it with
+ | IDENT_n idref -> {src=op.src ; it = StaticArgIdent idref }
+ | _ -> {src=op.src ; it= StaticArgConst $3}
+ )
+ | CallByName _ ->
+ print_string "*** unexpected static argument\n";
+ assert false
+ }
+ /* un type sans ambiguite */
+ | sxIdent TK_EQ sxSurelyType
+ { Lxm.id $1, {src=$3.src; it=StaticArgType $3} }
+ /* un node sans ambiguite */
+ | sxIdent TK_EQ sxSurelyNode
+ { Lxm.id $1, {src=$3.src; it=StaticArgNode (CALL_n $3)} }
+;
sxSurelyNode:
| sxIdentRef TK_OPEN_STATIC_PAR sxStaticArgList TK_CLOSE_STATIC_PAR
diff --git a/src/solveIdent.ml b/src/solveIdent.ml
index 7d5168348d974310ce8db14bdbc8259de0539bde..3417d2a4e184ae8f8da74b91ba93438e93571edd 100644
--- a/src/solveIdent.ml
+++ b/src/solveIdent.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 29/08/2008 (at 09:34) by Erwan Jahier> *)
+(** Time-stamp: <modified the 23/10/2008 (at 10:53) by Erwan Jahier> *)
let (get_predef : Ident.idref -> Predef.op option) =
@@ -50,19 +50,34 @@ and r_pack_given pg = {
pg_body = r_packbody pg.pg_body;
}
-and r_pack_instance pi = { pi with pi_args = List.map (flag r_static_arg) pi.pi_args }
+and r_pack_instance pi = { pi with pi_args = List.map r_by_name_static_arg pi.pi_args }
and r_static_param sp = sp
-and r_static_arg = function
- | StaticArgIdent(idref) -> (
- match get_predef idref with
- | None -> StaticArgIdent idref
- | Some predef -> StaticArgNode (Predef_n (predef,[]))
- )
- | StaticArgConst(ve) -> StaticArgConst(r_val_exp ve)
- | StaticArgType(te) -> StaticArgType(te)
- | StaticArgNode(by_pos_op) -> StaticArgNode(r_by_pos_op by_pos_op)
+and r_by_name_static_arg (id,arg) =
+ let arg_it =
+ match arg.it with
+ | StaticArgIdent(idref) -> (
+ match get_predef idref with
+ | None -> StaticArgIdent idref
+ | Some predef -> StaticArgNode (Predef_n (predef,[]))
+ )
+ | StaticArgConst(ve) -> StaticArgConst(r_val_exp ve)
+ | StaticArgType(te) -> StaticArgType(te)
+ | StaticArgNode(by_pos_op) -> StaticArgNode(r_by_pos_op by_pos_op)
+ in
+ id, Lxm.flagit arg_it arg.src
+
+and r_static_arg arg =
+ match arg with
+ | StaticArgIdent(idref) -> (
+ match get_predef idref with
+ | None -> StaticArgIdent idref
+ | Some predef -> StaticArgNode (Predef_n (predef,[]))
+ )
+ | StaticArgConst(ve) -> StaticArgConst(r_val_exp ve)
+ | StaticArgType(te) -> StaticArgType(te)
+ | StaticArgNode(by_pos_op) -> StaticArgNode(r_by_pos_op by_pos_op)
and r_by_pos_op = function
| Predef_n(op,args) -> Predef_n(op,args) (* assert false *)
diff --git a/src/syntaxTab.ml b/src/syntaxTab.ml
index 9748040625ebaab394dd72020422c8a48acd2466..fe6b49e2c30facea0fc68973227f0d2d3d57520b 100644
--- a/src/syntaxTab.ml
+++ b/src/syntaxTab.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 22/07/2008 (at 16:06) by Erwan Jahier> *)
+(** Time-stamp: <modified the 23/10/2008 (at 11:33) by Erwan Jahier> *)
(**
Table des infos sources : une couche au dessus de SyntaxTree pour mieux
@@ -225,7 +225,7 @@ CREATION
Se fait en plusieurs passes :
1) mise en place des tables "raw" mod et pack (string -> source pack/mod)
-2) instanciations éventuelle des packs (voir ExpandPack)
+2) instanciations éventuelle des packs (voir InstanciateModel)
et initialisation des pack_mng (en particulier des infos pour les users)
3) pour chaque pack, création des symbol_table contextuelles
(pour la partie provide et pour la partie body)
@@ -248,7 +248,7 @@ let rec (create : SyntaxTree.pack_or_model list -> t) =
Verbose.printf ~level:3 "*** SyntaxTab.create pass 2\n";
let init_pack_mng pname pdata = (
Verbose.printf ~level:3 " init pack %s\n" (Ident.pack_name_to_string pname);
- let pg = ExpandPack.doit res.st_raw_mod_tab pdata in
+ let pg = InstanciateModel.f res.st_raw_mod_tab pdata in
Hashtbl.add res.st_pack_mng_tab
pname
(create_pack_mng pdata pg)
diff --git a/src/syntaxTabUtils.mli b/src/syntaxTabUtils.mli
index 51ec01caf0e0f2aa7e62f1108ea7274f4cd40db3..d37cad85e5c4082f1da1ba116b4fba1ccf9da09d 100644
--- a/src/syntaxTabUtils.mli
+++ b/src/syntaxTabUtils.mli
@@ -1,13 +1,6 @@
-(** Time-stamp: <modified the 07/02/2008 (at 11:27) by Erwan Jahier> *)
+(** Time-stamp: <modified the 23/10/2008 (at 11:37) by Erwan Jahier> *)
-(*----------------------------------------------------------------------
-MODULE : compUtils
-------------------------------------------------------------------------
-DESCRIPTION :
-
-Utilitaires pour la compil, au dessus de Lxm et Errors
-
-----------------------------------------------------------------------*)
+(* Utilitaires pour la compil, au dessus de Lxm et Errors *)
(** Insert an item in the lexeme table. Raise [Compile_error] if already defined. *)
diff --git a/src/syntaxTree.ml b/src/syntaxTree.ml
index 5f3b7a8f018d211bf17f1e4840058c35e5bd35b2..e5e611ed1d35312fb2622d5cea1df8696acafd39 100644
--- a/src/syntaxTree.ml
+++ b/src/syntaxTree.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 30/05/2008 (at 10:26) by Erwan Jahier> *)
+(** Time-stamp: <modified the 23/10/2008 (at 10:51) by Erwan Jahier> *)
(** (Raw) Abstract syntax tree of source programs.
@@ -56,7 +56,7 @@ and
and
pack_instance = {
pi_model : Ident.t ;
- pi_args : static_arg srcflagged list ;
+ pi_args : (Ident.t * static_arg srcflagged) list ;
}
(** Collection de noeuds, types const etc.
- une table pour chaque sorte de defs
diff --git a/src/syntaxTreeCore.ml b/src/syntaxTreeCore.ml
index 89c35c4eff50f1f1147de9e3653b1c9e12367f14..b504252bd6ff8febc1e16c0407dde484069097a9 100644
--- a/src/syntaxTreeCore.ml
+++ b/src/syntaxTreeCore.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 04/09/2008 (at 14:40) by Erwan Jahier> *)
+(** Time-stamp: <modified the 22/10/2008 (at 17:38) by Erwan Jahier> *)
(** (Raw) Abstract syntax tree of source programs. *)
diff --git a/src/syntaxTreeDump.ml b/src/syntaxTreeDump.ml
index 6536701af95e6059353166bea9307f74777fea87..de36de22410ee0fc06b1a8dd9fe681e04ceef6a6 100644
--- a/src/syntaxTreeDump.ml
+++ b/src/syntaxTreeDump.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 15/09/2008 (at 15:36) by Erwan Jahier> *)
+(** Time-stamp: <modified the 23/10/2008 (at 10:34) by Erwan Jahier> *)
open Lxm
@@ -511,22 +511,22 @@ and dump_node_exp
and dump_static_arg_list
(os : Format.formatter)
- (lst: static_arg srcflagged list)
+ (lst: (Ident.t * static_arg srcflagged) list)
= (
match lst with
- [] -> ()
+ | [] -> ()
| [sa] -> fprintf os "%a" dump_static_arg sa.it
- | sa::reste ->
+ | sa::reste ->
fprintf os "%a, @,%a" dump_static_arg sa.it dump_static_arg_list reste
)
and dump_static_arg
(os : Format.formatter)
- (sa: static_arg)
- =
+ ((id,sa): Ident.t * static_arg)
+ = (Ident.to_string id) ^ " = " ^
match sa with
- | StaticArgIdent id -> fprintf os "%s" (Ident.string_of_idref id)
+ | StaticArgIdent id -> fprintf os "%s" (Ident.string_of_idref id)
| StaticArgConst ve -> fprintf os "const %a" dump_val_exp ve
- | StaticArgType te -> fprintf os "type %a" dump_type_exp te
+ | StaticArgType te -> fprintf os "type %a" dump_type_exp te
| StaticArgNode op -> fprintf os "node %s" (op2string op)
(* | StaticArgFunc ne -> fprintf os "function %a" dump_node_exp ne *)
diff --git a/src/test/should_work/NONREG/Int.lus b/src/test/should_work/NONREG/Int.lus
index 40de251a631602428026a2fab04ca9dc88b61037..d41add5e893db3ca0c42b528c9e7a5f979ab8f2d 100644
--- a/src/test/should_work/NONREG/Int.lus
+++ b/src/test/should_work/NONREG/Int.lus
@@ -35,7 +35,7 @@ end
-- instances
-----------------------
-package Int8 is Int(8);
+package Int8 is Int(n=8);
package mainPack
uses Int8;
diff --git a/src/test/should_work/NONREG/model.lus b/src/test/should_work/NONREG/model.lus
index c1c4fcb01f704f8e761f27b91270b004aed0b5a4..ff10ad3674d598c432d8c988ebd3726cf52c40b2 100644
--- a/src/test/should_work/NONREG/model.lus
+++ b/src/test/should_work/NONREG/model.lus
@@ -25,4 +25,4 @@ body
end
-package p = m(int, u::egal);
\ No newline at end of file
+package p = m(elementType=int, _isEqualTo_=u::egal);
\ No newline at end of file
diff --git a/src/test/should_work/Pascal/newpacks.lus b/src/test/should_work/Pascal/newpacks.lus
index af7dbdafe15aadb3aeb35c546cf1d297053cb240..8c2833820eb902c3971971e3c5f0f4503eb5fcf8 100644
--- a/src/test/should_work/Pascal/newpacks.lus
+++ b/src/test/should_work/Pascal/newpacks.lus
@@ -19,9 +19,9 @@ end
-----------------------
-- qq instances de modSimple
-----------------------
-package pint is modSimple(int);
-package pbool is modSimple(bool);
-package preal is modSimple(real);
+package pint is modSimple(t=int);
+package pbool is modSimple(t=bool);
+package preal is modSimple(t=real);
--------------------------
@@ -40,11 +40,6 @@ body
-----------------------
-- qq instances de modSimple
-----------------------
- --package pint is modSimple(int);
- --package pbool is modSimple(bool);
- --package preal is modSimple(real);
-
- --package pSel is modSimple( selType{ i: int; b: bool; r: real } );
const n: int = -4;
node preced(in: selType) returns (out, out2: selType);
let
diff --git a/src/test/should_work/Pascal/p.lus b/src/test/should_work/Pascal/p.lus
index 2f584f7c41ad6379612538c66ef32b38ac6360d6..5e18d8bc7da52c8bf1f8905624b415a8b34117b7 100644
--- a/src/test/should_work/Pascal/p.lus
+++ b/src/test/should_work/Pascal/p.lus
@@ -19,9 +19,9 @@ end
-----------------------
-- qq instances de modSimple
-----------------------
-package pint is modSimple(int);
-package pbool is modSimple(bool);
-package preal is modSimple(real);
+package pint is modSimple(t=int);
+package pbool is modSimple(t=bool);
+package preal is modSimple(t=real);
--------------------------
@@ -40,11 +40,11 @@ body
-----------------------
-- qq instances de modSimple
-----------------------
- --package pint is modSimple(int);
- --package pbool is modSimple(bool);
- --package preal is modSimple(real);
+ --package pint is modSimple(t=int);
+ --package pbool is modSimple(t=bool);
+ --package preal is modSimple(t=real);
- --package pSel is modSimple( { i: int; b: bool; r: real } );
+ --package pSel is modSimple( t={ i: int; b: bool; r: real } );
const n: int = -4;
node preced(in: selType) returns (out, out2: selType);
diff --git a/src/test/should_work/Pascal/packs.lus b/src/test/should_work/Pascal/packs.lus
index 07f2eba5f4170aea609350b2a4a823e07bab1fc3..411a8fe1aa8e71ce6792540ee8cc180b1a25352d 100644
--- a/src/test/should_work/Pascal/packs.lus
+++ b/src/test/should_work/Pascal/packs.lus
@@ -14,9 +14,9 @@ end
-----------------------
-- qq instances de modSimple
-----------------------
-package pint is modSimple(int);
-package pbool is modSimple(bool);
-package preal is modSimple(real);
+package pint is modSimple(t=int);
+package pbool is modSimple(t=bool);
+package preal is modSimple(t=real);
--------------------------
diff --git a/src/test/should_work/packEnvTest/Condact.lus b/src/test/should_work/packEnvTest/Condact.lus
index d7c75765c9baecfbf9b89ccb6ab2e33e85e529be..2d9a362583605badecda7fe5ba111e42f93245f8 100644
--- a/src/test/should_work/packEnvTest/Condact.lus
+++ b/src/test/should_work/packEnvTest/Condact.lus
@@ -18,7 +18,7 @@ body
end
-package TestCondact = Condact(int, int, Util::carre);
+package TestCondact = Condact(t1=int, t2=int, n=Util::carre);
model Condact
diff --git a/src/test/should_work/packEnvTest/contractForElementSelectionInArray/main.lus b/src/test/should_work/packEnvTest/contractForElementSelectionInArray/main.lus
index eb8826fb13861d9e6cc7606f9eab43256190fdaa..00c2e8b267dbb7cbc21b7541212d8e45f757ab6d 100644
--- a/src/test/should_work/packEnvTest/contractForElementSelectionInArray/main.lus
+++ b/src/test/should_work/packEnvTest/contractForElementSelectionInArray/main.lus
@@ -13,7 +13,12 @@ end
--package intArray is packageTableau(int, 10, Lustre::eq, Lustre::igt);
--package intArray is packageTableau(int, 10, =, Lustre::igt);
-package intArray = packageTableau(int, 10, Lustre::eq, util::igt);
+package intArray =
+ packageTableau(
+ elementType=int,
+ size=10,
+ _isEqualTo_=Lustre::eq,
+ _isGreaterThan_=util::igt);
package main
uses intArray;--, intArray2, intArray3;
diff --git a/src/test/should_work/packEnvTest/iter.lus b/src/test/should_work/packEnvTest/iter.lus
index 89a7d509623e3baa84579fa4ede660afb0127da9..eebf33eab5e56fede12a5c31254fdcbe67a0874f 100644
--- a/src/test/should_work/packEnvTest/iter.lus
+++ b/src/test/should_work/packEnvTest/iter.lus
@@ -12,8 +12,8 @@ body
tel
end
-package p = iter(3, int, +);
-package p = iter(3, int, Lustre::iplus);
+-- package p = iter(size=3, t=int, n=+);
+package p = iter(size=3, t=int, n=Lustre::iplus);
package main uses p;
provides
diff --git a/src/test/should_work/packEnvTest/model.lus b/src/test/should_work/packEnvTest/model.lus
index ea36f240eccb59bc4a3553a4620a1702b16e5cf5..b26152a329b89fcd8b31c4242d3843958e505cfe 100644
--- a/src/test/should_work/packEnvTest/model.lus
+++ b/src/test/should_work/packEnvTest/model.lus
@@ -6,4 +6,4 @@ body
node fby1(init, fb: t) returns (next: t);
let next = init -> pre fb; tel
end
-package pint is modSimple(int);
+package pint is modSimple(t=int);
diff --git a/src/test/should_work/packEnvTest/modelInst.lus b/src/test/should_work/packEnvTest/modelInst.lus
index f7f463c8da26a3332ca9ca01e83e1c4fcd78b204..49ee39f5dac21f9519e43922d7d9672e87531253 100644
--- a/src/test/should_work/packEnvTest/modelInst.lus
+++ b/src/test/should_work/packEnvTest/modelInst.lus
@@ -19,9 +19,9 @@ tel
-- le package principal definit une instance de "m1" localement
----------------------------------------------------------------
-package Pint = m1( int );
-package Pbool = m1( bool );
-package Preal = m1( real );
+package Pint = m1( t=int );
+package Pbool = m1( t=bool );
+package Preal = m1( t=real );
package main
uses Pint;
diff --git a/src/test/should_work/packEnvTest/packages.lus b/src/test/should_work/packEnvTest/packages.lus
index e45433d58fd28679dc4d41d56bef3fa822eed766..943d819991f299a9adcf6736bec808358dce5b26 100644
--- a/src/test/should_work/packEnvTest/packages.lus
+++ b/src/test/should_work/packEnvTest/packages.lus
@@ -17,9 +17,9 @@ end
-----------------------
-- qq instances de modSimple
-----------------------
-package pint is modSimple(int);
-package pbool is modSimple(bool);
-package preal is modSimple(real);
+package pint is modSimple(t=int);
+package pbool is modSimple(t=bool);
+package preal is modSimple(t=real);
--------------------------
diff --git a/src/test/should_work/packEnvTest/packages2.lus b/src/test/should_work/packEnvTest/packages2.lus
index 1e2361732f660885c07d79292b0311ac8e6cb72a..d8102b271cf90a835f5d212dc4844823096c940c 100644
--- a/src/test/should_work/packEnvTest/packages2.lus
+++ b/src/test/should_work/packEnvTest/packages2.lus
@@ -19,9 +19,9 @@ end
-----------------------
-- qq instances de modSimple
-----------------------
-package pint is modSimple(int);
-package pbool is modSimple(bool);
-package preal is modSimple(real);
+package pint is modSimple(t=int);
+package pbool is modSimple(t=bool);
+package preal is modSimple(t=real);
@@ -42,11 +42,11 @@ type selType = { i: int; b: bool; r: real };
-----------------------
-- qq instances de modSimple
-----------------------
- --package pint is modSimple(int);
- --package pbool is modSimple(bool);
- --package preal is modSimple(real);
+ --package pint is modSimple(t=int);
+ --package pbool is modSimple(t=bool);
+ --package preal is modSimple(t=real);
- --package pSel is modSimple( { i: int; b: bool; r: real } );
+ --package pSel is modSimple( t={ i: int; b: bool; r: real } );
const n: int = -4;
node preced(in: selType) returns (out, out2: selType);
diff --git a/src/test/should_work/packEnvTest/polymorphic_pack.lus b/src/test/should_work/packEnvTest/polymorphic_pack.lus
index 635c8c35d1511eb6ab625a4d685edfab8924ecb2..28495654108b8e19c0602ce3505b94de62333f56 100644
--- a/src/test/should_work/packEnvTest/polymorphic_pack.lus
+++ b/src/test/should_work/packEnvTest/polymorphic_pack.lus
@@ -14,6 +14,6 @@ end
-- generates a type 'o' ! Raler ?
-- Dois-je refuser les packages polymorphes ?
-package p = iter(3, int, +);
+package p = iter(size=3, t=int, n=+);
\ No newline at end of file
diff --git a/src/test/test.res.exp b/src/test/test.res.exp
index 63b9fa6d9f71c7e9bad4af41e06587d658c9f69d..bf06bd74807f9a6e05bdd4bc52c69b4b7107b561 100644
--- a/src/test/test.res.exp
+++ b/src/test/test.res.exp
@@ -18299,9 +18299,25 @@ type A_int_10 = int^10;
----------------------------------------------------------------------
====> ../lus2lic -vl 2 --compile-all-items should_work/packEnvTest/iter.lus
Opening file should_work/packEnvTest/iter.lus
-*** Error in file "should_work/packEnvTest/iter.lus", line 16, col 9 to 9, token 'p':
-*** package already declared in line:15, col:9 to 9
-
+type _p::t = int;
+const p::size = 3;
+node p::n(i1:int; i2:int) returns (o:int);
+let
+ o = Lustre::iplus(i1, i2);
+tel
+-- end of node p::n
+node p::map2(x:A_int_3; y:A_int_3) returns (z:A_int_3);
+let
+ z = map<<p::n, 3>>(x, y);
+tel
+-- end of node p::map2
+node main::main(t1:A_int_3; t2:A_int_3) returns (t12:A_int_3);
+let
+ t12 = p::map2(t1, t2);
+tel
+-- end of node main::main
+-- automatically defined aliases:
+type A_int_3 = int^3;
----------------------------------------------------------------------
====> ../lus2lic -vl 2 --compile-all-items should_work/packEnvTest/model.lus