From 6233a722d2d68c4c206aea4fcff68b8c854e4f9f Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Mon, 11 Mar 2013 09:10:13 +0100
Subject: [PATCH] More work on SocExec and lic2soc. Now all memoryless stuff
seems to work includind node call.
---
Makefile | 2 +
src/compile.ml | 5 +-
src/lic2soc.ml | 213 +++++++++++++++++----------------
src/lic2soc.mli | 4 +-
src/soc.ml | 53 +++++++--
src/socExecEvalPredef.ml | 239 ++++++++++++++++----------------------
src/socExecEvalPredef.mli | 5 +-
src/socExecValue.ml | 21 +++-
src/socExecValue.mli | 17 ++-
src/socPredef.ml | 84 ++++++++------
src/socPredef.mli | 4 +-
src/socUtils.ml | 106 +++++++++--------
src/socUtils.mli | 10 +-
test/lus2lic.sum | 2 +-
test/lus2lic.time | 4 +-
15 files changed, 414 insertions(+), 355 deletions(-)
diff --git a/Makefile b/Makefile
index 4fb387b5..5dedb078 100644
--- a/Makefile
+++ b/Makefile
@@ -197,6 +197,8 @@ lus2lic:
TESTDIR=./test
.PHONY: diff test log
+dif:
+ git --no-pager diff --color-words
diff:
rm -f diff_lv6.diff; git diff --ignore-all-space > diff_lv6.diff ; ls -l diff_lv6.diff
diff --git a/src/compile.ml b/src/compile.ml
index 1cbdd419..55efd6d9 100644
--- a/src/compile.ml
+++ b/src/compile.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 05/03/2013 (at 16:39) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/03/2013 (at 14:25) by Erwan Jahier> *)
open Lxm
open Errors
@@ -78,7 +78,6 @@ let (doit : AstV6.pack_or_model list -> Ident.idref option -> LicPrg.t) =
| Some main_node ->
let msk, zesoc = Lic2soc.f zelic (Lic.node_key_of_idref main_node) in
SocExec.f zesoc msk
- );
-
+ );
zelic
diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index d3a9bf7c..4c7de092 100644
--- a/src/lic2soc.ml
+++ b/src/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 04/03/2013 (at 18:03) by Erwan Jahier> *)
+(** Time-stamp: <modified the 07/03/2013 (at 18:15) by Erwan Jahier> *)
open Lxm
open Lic
@@ -62,10 +62,16 @@ Mieux vaudrait utiliser le meme mechanisme que celui utilis
actuellement lors des l2l*.ml
???
*)
+
+ (* R1: je vire le "_" parce que ca m'emmerde ce truc.
+ On verra plus tard les clash de nom...*)
+let user_var_prefix = "_"
+let user_var_prefix = ""
+
let rename_user_var: (string -> string) = fun s ->
- let prefix = "_" in
+ let prefix = user_var_prefix in
let suffix = "" in
- prefix ^ s ^ suffix
+ prefix ^ s ^ suffix
let is_predefined_const: string -> Lic.type_ option =
function
@@ -315,14 +321,14 @@ let (val_exp_to_filter: LicPrg.t -> Lic.val_exp -> Soc.var_expr) =
)
(*********************************************************************************)
-type memory = Soc.memory * action list (* mémoire + initialisation *)
+type memory = Soc.instance * action list (* mémoire + initialisation *)
(** Créé une opération à partir d'un nom de méthode d'un composant. *)
-let component_meth_to_operation:
+let soc_meth_to_operation:
Soc.t -> string -> memory option -> Soc.atomic_operation =
fun comp func_name -> function
| None -> Soc.Procedure comp.Soc.socc_key
- | Some (m, _) -> Soc.Method(m, comp.Soc.socc_key)
+ | Some (i,_) -> Soc.Method(i)
(* Créé une action concernant un appel de procédure ou de méthode. *)
let (action_of_method: Lxm.t -> Soc.t -> Lic.clock -> Soc.var_expr list ->
@@ -339,42 +345,41 @@ let (action_of_method: Lxm.t -> Soc.t -> Lic.clock -> Soc.var_expr list ->
in
let inputs = List.map (fun i -> nth i il) m.Soc.socm_inputs in
let outputs = List.map (fun i -> nth i ol) m.Soc.socm_outputs in
- let call_action = component_meth_to_operation c m.Soc.socm_name mem in
+ let call_action = soc_meth_to_operation c m.Soc.socm_name mem in
(clk, inputs, outputs, call_action, lxm)
-(** Créé un nouveau nom pour une mémoire. *)
-let create_new_memory: (ctx -> ctx * string) = fun ctx ->
+(** Créé un nouveau nom pour une instance. *)
+let create_new_instance_name: (ctx -> ctx * string) = fun ctx ->
let prefix = "m" in
let suffix = "" in
let make id = Format.sprintf "%s%d%s" prefix id suffix in
let new_ctx = {ctx with last_mem = ctx.last_mem + 1 } in
new_ctx, make new_ctx.last_mem
- (** Créé une nouvelle mémoire pour être utilisée dans un composant.
+ (** Créé une nouvelle instance pour être utilisée dans un composant.
Pendant la traduction d'un opérateur, on s'apercoit que cet opérateur
- dispose d'une mémoire.
+ dispose d'une (ou plusieur) mémoire.
Il faut donc qu'on créé une mémoire représentant ce composant (issue de la
traduction de cet opérateur), afin de garder son état dans le composant
résultant de ce noeud. *)
-let create_memory_from_component: (ctx -> Soc.t -> ctx * Soc.memory) =
+let create_instance_from_soc: (ctx -> Soc.t -> ctx * Soc.instance) =
fun ctx c ->
- let ctx, mem_name = create_new_memory ctx in
- ctx, Soc.CompMem(mem_name, c.Soc.socc_key)
+ let ctx, mem_name = create_new_instance_name ctx in
+ ctx, (mem_name, c.Soc.socc_key)
let (make_memory : Lxm.t -> Lic.clock -> ctx -> Soc.t ->
- Soc.var_expr list -> Soc.var_expr list -> ctx * memory option) =
- fun lxm clk ctx component inputs lpl ->
- match component.Soc.socc_memories with
+ Soc.var_expr list -> Soc.var_expr list -> ctx * memory option) =
+ fun lxm clk ctx soc inputs lpl ->
+ match soc.Soc.socc_memories with
| [] -> ctx, None
| _ ->
- let ctx, m = create_memory_from_component ctx component in
- let init_actions = match component.Soc.socc_init with
- | Some i -> [action_of_method lxm component clk inputs lpl (Some (m, [])) i]
- | None -> assert false
- (* memory component do have a memory... *)
- in
- ctx, Some(m, init_actions)
+ let ctx, m = create_instance_from_soc ctx soc in
+ let init_actions = match soc.Soc.socc_init with
+ | Some i -> [action_of_method lxm soc clk inputs lpl (Some (m, [])) i]
+ | None -> assert false
+ in
+ ctx, Some(m, init_actions)
(*********************************************************************************)
(** Transforme une expression en action(s), et retourne la liste des variables
@@ -400,7 +405,8 @@ let by_pos_op_to_soc_ident = function
| CURRENT -> "Lustre::current"
| CONCAT-> "Lustre::concat"
| ARRAY -> "Lustre::array"
- | _ -> assert false
+ | CALL n -> string_of_node_key n.it
+ | _ -> assert false
let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
Lic.clock -> Soc.var_expr list -> e2a_acc -> Lic.val_exp -> e2a_acc) =
@@ -420,7 +426,7 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
que nécessaire. *)
let lxm = by_name_op_flg.src in
let filter_to_field filter field ftype =
- let ftype = match ftype with [x] -> x | _ -> assert false in
+ let ftype = match ftype with [x] -> x | _ -> assert false in
let filter = match filter with [x] -> x | _ -> assert false in
Soc.Field(filter, (field, lic_to_soc_type ftype))
in
@@ -478,13 +484,13 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
(* ctx, actions_reclocked, outputs, mems, deps *)
)
- | CALL _ -> assert false (* XXX todo *)
| HAT _ -> assert false (* XXX todo *)
| ARRAY -> assert false (* XXX todo *)
+ | CALL _
| PREDEF_CALL _
| PRE | ARROW | FBY | CURRENT | CONCAT -> (
- (* build the component of "expr" *)
- let component : Soc.t =
+ (* build the soc of "expr" *)
+ let soc : Soc.t =
let id = by_pos_op_to_soc_ident by_pos_op_flg.it in
let args_types : Soc.var_type list =
List.map lic_to_soc_type
@@ -492,7 +498,7 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
in
let exp_type = List.hd(List.rev args_types) in
let args_types_plus =
- (* Add the type of the expression (indeed, ege, if ARROW has
+ (* Add the type of the expression (indeed, eg, if ARROW has
2 args of the same type t, its profile is "t -> t -> t"
hence we add the missing t in
*)
@@ -513,27 +519,27 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
raise (Undef_soc (sk, lxm, by_pos_op_flg.it, args_types))
in
- (* Use that component to build the corresponding
+ (* Use that soc to build the corresponding
- actions
- memories
- action dependances
*)
let inputs : Soc.var_expr list =
List.map (val_exp_to_filter ctx.prg) val_exp_list in
- let ctx, mem_opt = make_memory lxm clk ctx component inputs lpl in
+ let ctx, mem_opt = make_memory lxm clk ctx soc inputs lpl in
let actions =
- let m2act = action_of_method lxm component clk inputs lpl mem_opt in
- List.map m2act component.Soc.socc_step
+ let m2act = action_of_method lxm soc clk inputs lpl mem_opt in
+ List.map m2act soc.Soc.socc_step
in
let dependances : ActionsDeps.t =
let (prefixed_actions : (Soc.ident * action) list) = List.map2
- (fun s a -> s.Soc.socm_name,a) component.Soc.socc_step actions
+ (fun s a -> s.Soc.socm_name,a) soc.Soc.socc_step actions
in
ActionsDeps.generate_deps_from_step_policy
- component.Soc.socc_precedences prefixed_actions
+ soc.Soc.socc_precedences prefixed_actions
in
- let mem = match mem_opt with Some m -> [m] | None -> [] in
- (ctx, actions, lpl, mem, dependances)
+ let ml = match mem_opt with Some m -> m::ml | None -> ml in
+ (ctx, actions, lpl, ml, dependances)
)
)
)
@@ -578,16 +584,16 @@ let (actions_of_equation: Lxm.t -> Soc.tbl -> ctx -> Lic.eq_info ->
(*********************************************************************************)
(** Traduit un noeud en composant Soc. *)
-let rec (component_of_node: LicPrg.t -> Lic.node_exp -> Soc.tbl -> (ctx * Soc.t) option) =
+let rec (soc_of_node: LicPrg.t -> Lic.node_exp -> Soc.tbl -> (ctx * Soc.t) option) =
fun licprg node soc_tbl ->
match node.Lic.def_eff with
| ExternLic -> None
| MetaOpLic node_key -> None
| AbstractLic None -> None (* None if extern in the provide part *)
- | AbstractLic (Some node_exp) -> component_of_node licprg node_exp soc_tbl
+ | AbstractLic (Some node_exp) -> soc_of_node licprg node_exp soc_tbl
| BodyLic b ->
let lxm = node.lxm in
- let ctx = create_context licprg in
+ let ctx = create_context licprg in
let ctx, actions, mems, deps =
(* on itere sur la liste des équations *)
List.fold_left
@@ -642,68 +648,71 @@ open Soc
(* exported *)
let f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
fun prog mnk ->
- let rec (process_node : Lic.node_key -> Lic.node_exp -> Soc.tbl -> Soc.key * Soc.tbl) =
- fun nk node acc_comp ->
+ let rec (process_node : Lic.node_key -> Soc.tbl -> Soc.key * Soc.tbl) =
+ fun nk acc_comp ->
+ let node =
+ match LicPrg.find_node prog nk with
+ | None -> assert false
+ | Some node_exp -> node_exp
+ in
let sk = soc_key_of_node_exp node in
let acc_comp =
- if SocMap.mem sk acc_comp then acc_comp else
- try
- (match LicPrg.find_node prog nk with
- | None -> assert false
- | Some node_def ->
- (match component_of_node prog node_def acc_comp with
- | Some(_,soc) -> SocMap.add sk soc acc_comp
- | None ->
- print_string ("Undefined soc : " ^ (string_of_node_key nk) ^ "\n");
- flush stdout;
- acc_comp
- )
- )
- with
- | Undef_soc (sk,lxm,pos_op, types) ->
- (* Il manque une dépendance, on essaie de la
- traduire puis de retraduire le noeud courant. *)
- let soc = SocPredef.component_interface_of_pos_op lxm pos_op types in
- let acc_comp = SocMap.add soc.socc_key soc acc_comp in
- snd (process_node nk node acc_comp)
- in
+ if SocMap.mem sk acc_comp then acc_comp else
+ try
+ (match LicPrg.find_node prog nk with
+ | None -> assert false
+ | Some node_def ->
+ (match soc_of_node prog node_def acc_comp with
+ | Some(_,soc) -> SocMap.add sk soc acc_comp
+ | None ->
+ print_string ("Undefined soc : " ^ (string_of_node_key nk) ^ "\n");
+ flush stdout;
+ acc_comp
+ )
+ )
+ with
+ (* Il manque une dépendance, on essaie de la
+ traduire puis de retraduire le noeud courant. *)
+ | Undef_soc (sk,lxm,Lic.CALL { it = nk2 }, types) ->
+ let acc_comp = snd (process_node nk2 acc_comp) in
+ snd (process_node nk acc_comp)
+
+ | Undef_soc (sk,lxm,pos_op, types) ->
+ let soc = SocPredef.soc_interface_of_pos_op lxm pos_op types in
+ let acc_comp = SocMap.add soc.socc_key soc acc_comp in
+ snd (process_node nk acc_comp)
+ in
sk, acc_comp
-
-
-
-
-(* try *)
-(* *)
-(* let soc = SocPredef.of_soc_key sk in *)
-(* *)
-(* (match SocPredef.of_soc_key sk with *)
-(* | Some soc -> SocMap.add sk soc acc_comp *)
-(* | None -> *)
-(* try *)
-(* (match LicPrg.find_node prog nk with *)
-(* | None -> assert false *)
-(* | Some node_def -> *)
-(* (match component_of_node prog node_def acc_comp with *)
-(* | Some(_,soc) -> SocMap.add sk soc acc_comp *)
-(* | None -> *)
-(* print_string ("Undefined soc : " ^ (string_of_node_key nk) ^ "\n"); *)
-(* flush stdout; *)
-(* acc_comp *)
-(* ) *)
-(* ) *)
-(* with *)
-(* | Undef_soc (sk,lxm,pos_op, types) -> *)
-(* (* Il manque une dépendance, on essaie de la *)
-(* traduire puis de retraduire le noeud courant. *) *)
-(* let soc = SocPredef.component_interface_of_pos_op lxm pos_op types in *)
-(* let acc_comp = SocMap.add sk soc acc_comp in *)
-(* snd (process_node nk node acc_comp) *)
-(* ) *)
-(* in *)
-(* sk, acc_comp *)
- in
- match LicPrg.find_node prog mnk with
- | None -> assert false
- | Some node_exp ->
- process_node mnk node_exp SocMap.empty
+
+ (* try *)
+ (* *)
+ (* let soc = SocPredef.of_soc_key sk in *)
+ (* *)
+ (* (match SocPredef.of_soc_key sk with *)
+ (* | Some soc -> SocMap.add sk soc acc_comp *)
+ (* | None -> *)
+ (* try *)
+ (* (match LicPrg.find_node prog nk with *)
+ (* | None -> assert false *)
+ (* | Some node_def -> *)
+ (* (match soc_of_node prog node_def acc_comp with *)
+ (* | Some(_,soc) -> SocMap.add sk soc acc_comp *)
+ (* | None -> *)
+ (* print_string ("Undefined soc : " ^ (string_of_node_key nk) ^ "\n"); *)
+ (* flush stdout; *)
+ (* acc_comp *)
+ (* ) *)
+ (* ) *)
+ (* with *)
+ (* | Undef_soc (sk,lxm,pos_op, types) -> *)
+ (* (* Il manque une dépendance, on essaie de la *)
+ (* traduire puis de retraduire le noeud courant. *) *)
+ (* let soc = SocPredef.soc_interface_of_pos_op lxm pos_op types in *)
+ (* let acc_comp = SocMap.add sk soc acc_comp in *)
+ (* snd (process_node nk node acc_comp) *)
+ (* ) *)
+ (* in *)
+ (* sk, acc_comp *)
+ in
+ process_node mnk SocMap.empty
diff --git a/src/lic2soc.mli b/src/lic2soc.mli
index 70ea308c..4787a331 100644
--- a/src/lic2soc.mli
+++ b/src/lic2soc.mli
@@ -1,4 +1,6 @@
-(** Time-stamp: <modified the 01/03/2013 (at 15:29) by Erwan Jahier> *)
+(** Time-stamp: <modified the 07/03/2013 (at 18:16) by Erwan Jahier> *)
val f: LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl
+
+val user_var_prefix:string
diff --git a/src/soc.ml b/src/soc.ml
index 9ed4d07b..f6218f72 100644
--- a/src/soc.ml
+++ b/src/soc.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 05/03/2013 (at 15:28) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/03/2013 (at 10:47) by Erwan Jahier> *)
(** Synchronous Object Component *)
@@ -23,10 +23,7 @@ type key =
var_type list * (* I/O type list *)
(int * int * int) option (* to deal with slices (useful?) *)
-
-type memory =
- | CompMem of ident * key (* Memory name * instanciated component key *)
- | VarMem of var
+type instance = ident * key
(* Variable denotation *)
type var_expr =
@@ -37,7 +34,7 @@ type var_expr =
type atomic_operation =
| Assign (* Wire *)
- | Method of memory * key (* step call *)
+ | Method of instance (* node step call *)
| Procedure of key (* memoryless method made explicit (a good idea?) *)
@@ -65,10 +62,41 @@ type precedence = ident * ident list
opening.
*)
-type t = {
+
+(* type t = string (* unique *) * key *)
+
+type memory =
+ | CompMem of ident * key (* Memory name * instanciated component key *)
+ | VarMem of var
+(* for pre and fby. Is it a good idea to make this distinction ?
+
+I should rather use the following def to make thing morehomogeneous :
+
+type memory = ident * key
+
+Actually, such a memory is a soc instance!
+
+I could therefore call it 'instance' (as Pascal in licc BTW)
+
+
+*)
+
+
+type t = {
+(*
+les memoires de l'objet sont calculées par l'interpreteur (ou l'objet C)
+
+ key
+ ins
+ outs
+ locs
+ init
+ steps
+ precedences
+*)
socc_key : key;
socc_profile : var list * var list;
- socc_memories : memory list;
+ socc_memories : instance list;
socc_init : step_method option;
socc_step : step_method list; (* the order in the list is a valid w.r.t.
the partial order defined in
@@ -76,6 +104,7 @@ type t = {
socc_precedences : precedence list; (* partial order over socc_step methods *)
}
+(* SocKeyMap ? *)
module SocMap = Map.Make(
struct
type t = key
@@ -83,5 +112,13 @@ module SocMap = Map.Make(
end
)
+
type tbl = t SocMap.t
+let cpt = ref 0
+let (make: key -> instance) =
+ fun sk ->
+ let (id,_,_) = sk in
+ let instance = Printf.sprintf "%s%03d" id !cpt in
+ incr cpt;
+ instance,sk
diff --git a/src/socExecEvalPredef.ml b/src/socExecEvalPredef.ml
index da23c485..bb898337 100644
--- a/src/socExecEvalPredef.ml
+++ b/src/socExecEvalPredef.ml
@@ -1,213 +1,180 @@
-(* Time-stamp: <modified the 05/03/2013 (at 17:53) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/03/2013 (at 16:51) by Erwan Jahier> *)
open SocExecValue
open Soc
(* A boring but simple module... *)
-let (lustre_iplus:substs -> var_expr list -> var_expr list -> subst) =
- fun s vei veo ->
- let values = List.map (get_value s) vei in
- match values,veo with
- | [I i1; I i2], [Var(id,Int)] -> id,I(i1+i2)
+let (lustre_iplus : substs -> subst) =
+ fun s ->
+ match (List.map snd s) with
+ | [I i1; I i2] -> "z",I(i1+i2)
| _ -> assert false
-let (lustre_rplus:substs -> var_expr list -> var_expr list -> subst) =
- fun s vei veo ->
- let values = List.map (get_value s) vei in
- match values,veo with
- | [F i1; F i2], [Var(id,Real)] -> id,F(i1+.i2)
+let (lustre_rplus:substs -> subst) =
+ fun s ->
+ match (List.map snd s) with
+ | [F i1; F i2] -> "z",F(i1+.i2)
| _ -> assert false
-let lustre_itimes s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [I x1; I x2], [Var(id,_)] -> id,I(x1 * x2)
+let lustre_itimes s =
+ match (List.map snd s) with
+ | [I x1; I x2] -> "z",I(x1 * x2)
| _ -> assert false
-let lustre_rtimes s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [F x1; F x2], [Var(id,_)] -> id,F(x1 *. x2)
+let lustre_rtimes s =
+ match (List.map snd s) with
+ | [F x1; F x2] -> "z",F(x1 *. x2)
| _ -> assert false
-let lustre_idiv s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [I x1; I x2], [Var(id,_)] -> id,I(x1 / x2)
+let lustre_idiv s =
+ match (List.map snd s) with
+ | [I x1; I x2] -> "z",I(x1 / x2)
| _ -> assert false
-let lustre_rdiv s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [F x1; F x2], [Var(id,_)] -> id,F(x1 /. x2)
+let lustre_rdiv s =
+ match (List.map snd s) with
+ | [F x1; F x2] -> "z",F(x1 /. x2)
| _ -> assert false
-let lustre_iminus s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [I x1; I x2], [Var(id,_)] -> id,I(x1 - x2)
+let lustre_iminus s =
+ match (List.map snd s) with
+ | [I x1; I x2] -> "z",I(x1 - x2)
| _ -> assert false
-let lustre_rminus s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [F x1; F x2], [Var(id,_)] -> id,F(x1 -. x2)
+let lustre_rminus s =
+ match (List.map snd s) with
+ | [F x1; F x2] -> "z",F(x1 -. x2)
| _ -> assert false
-let lustre_mod s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [I x1; I x2], [Var(id,_)] -> id,I(x1 mod x2)
+let lustre_mod s =
+ match (List.map snd s) with
+ | [I x1; I x2] -> "z",I(x1 mod x2)
| _ -> assert false
-let lustre_ieq s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [I x1; I x2], [Var(id,_)] -> id,B(x1 = x2)
+let lustre_ieq s =
+ match (List.map snd s) with
+ | [I x1; I x2] -> "z",B(x1 = x2)
| _ -> assert false
-let lustre_req s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [F x1; F x2], [Var(id,_)] -> id,B(x1 = x2)
+let lustre_req s =
+ match (List.map snd s) with
+ | [F x1; F x2] -> "z",B(x1 = x2)
| _ -> assert false
-let lustre_iuminus s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [I x1], [Var(id,_)] -> id,I(- x1)
+let lustre_iuminus s =
+ match (List.map snd s) with
+ | [I x1] -> "z",I(- x1)
| _ -> assert false
-let lustre_ruminus s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [F x1], [Var(id,_)] -> id,F(-. x1)
+let lustre_ruminus s =
+ match (List.map snd s) with
+ | [F x1] -> "z",F(-. x1)
| _ -> assert false
-let lustre_real2int s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [F x1], [Var(id,_)] -> id,I(int_of_float x1)
+let lustre_real2int s =
+ match (List.map snd s) with
+ | [F x1] -> "z",I(int_of_float x1)
| _ -> assert false
-let lustre_int2real s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [I x1], [Var(id,_)] -> id,F(float_of_int x1)
+let lustre_int2real s =
+ match (List.map snd s) with
+ | [I x1] -> "z",F(float_of_int x1)
| _ -> assert false
-let lustre_not s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [B x1], [Var(id,_)] -> id,B(not x1)
+let lustre_not s =
+ match (List.map snd s) with
+ | [B x1] -> "z",B(not x1)
| _ -> assert false
-let lustre_ilt s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [I x1; I x2], [Var(id,_)] -> id,B(x1 < x2)
+let lustre_ilt s =
+ match (List.map snd s) with
+ | [I x1; I x2] -> "z",B(x1 < x2)
| _ -> assert false
-let lustre_rlt s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [F x1; F x2], [Var(id,_)] -> id,B(x1 < x2)
+let lustre_rlt s =
+ match (List.map snd s) with
+ | [F x1; F x2] -> "z",B(x1 < x2)
| _ -> assert false
-let lustre_igt s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [I x1; I x2], [Var(id,_)] -> id,B(x1 > x2)
+let lustre_igt s =
+ match (List.map snd s) with
+ | [I x1; I x2] -> "z",B(x1 > x2)
| _ -> assert false
-let lustre_rgt s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [F x1; F x2], [Var(id,_)] -> id,B(x1 > x2)
+let lustre_rgt s =
+ match (List.map snd s) with
+ | [F x1; F x2] -> "z",B(x1 > x2)
| _ -> assert false
-let lustre_ilte s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [I x1; I x2], [Var(id,_)] -> id,B(x1 <= x2)
+let lustre_ilte s =
+ match (List.map snd s) with
+ | [I x1; I x2] -> "z",B(x1 <= x2)
| _ -> assert false
-let lustre_rlte s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [F x1; F x2], [Var(id,_)] -> id,B(x1 <= x2)
+let lustre_rlte s =
+ match (List.map snd s) with
+ | [F x1; F x2] -> "z",B(x1 <= x2)
| _ -> assert false
-let lustre_igte s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [I x1; I x2], [Var(id,_)] -> id,B(x1 >= x2)
+let lustre_igte s =
+ match (List.map snd s) with
+ | [I x1; I x2] -> "z",B(x1 >= x2)
| _ -> assert false
-let lustre_rgte s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [F x1; F x2], [Var(id,_)] -> id,B(x1 >= x2)
+let lustre_rgte s =
+ match (List.map snd s) with
+ | [F x1; F x2] -> "z",B(x1 >= x2)
| _ -> assert false
-let lustre_and s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [B x1; B x2], [Var(id,_)] -> id,B(x1 && x2)
+let lustre_and s =
+ match (List.map snd s) with
+ | [B x1; B x2] -> "z",B(x1 && x2)
| _ -> assert false
-let lustre_beq s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [B x1; B x2], [Var(id,_)] -> id,B(x1 = x2)
+let lustre_beq s =
+ match (List.map snd s) with
+ | [B x1; B x2] -> "z",B(x1 = x2)
| _ -> assert false
-let lustre_neq s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [B x1; B x2], [Var(id,_)] -> id,B(x1 <> x2)
+let lustre_neq s =
+ match (List.map snd s) with
+ | [B x1; B x2] -> "z",B(x1 <> x2)
| _ -> assert false
-let lustre_or s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [B x1; B x2], [Var(id,_)] -> id,B(x1 || x2)
+let lustre_or s =
+ match (List.map snd s) with
+ | [B x1; B x2] -> "z",B(x1 || x2)
| _ -> assert false
-let lustre_impl s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [B x1; B x2], [Var(id,_)] -> id,B(not x1 or x2)
+let lustre_impl s =
+ match (List.map snd s) with
+ | [B x1; B x2] -> "z",B(not x1 or x2)
| _ -> assert false
-let lustre_xor s vei veo =
- let values = List.map (get_value s) vei in
- let id = match veo with [Var(id,_)] -> id | _ -> assert false in
+let lustre_xor s =
+ let values = List.map snd s in
let l = List.filter (fun x -> x=B true) values in
- id,B(List.length l = 1)
+ "z",B(List.length l = 1)
-let lustre_iif s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [B c; I x1; I x2], [Var(id,_)] -> id,I(if c then x1 else x2)
+let lustre_iif s =
+ match (List.map snd s) with
+ | [B c; I x1; I x2] -> "z",I(if c then x1 else x2)
| _ -> assert false
-let lustre_rif s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [B c; F x1; F x2], [Var(id,_)] -> id,F(if c then x1 else x2)
+let lustre_rif s =
+ match (List.map snd s) with
+ | [B c; F x1; F x2] -> "z",F(if c then x1 else x2)
| _ -> assert false
-let lustre_bif s vei veo =
- let values = List.map (get_value s) vei in
- match values,veo with
- | [B c; B x1; B x2], [Var(id,_)] -> id,B(if c then x1 else x2)
+let lustre_bif s =
+ match (List.map snd s) with
+ | [B c; B x1; B x2] -> "z",B(if c then x1 else x2)
| _ -> assert false
(* exported *)
-let (get: Soc.key -> (substs -> var_expr list -> var_expr list -> subst)) =
+let (get: Soc.key -> (substs -> subst)) =
fun (n,_,_) ->
match n with
| "Lustre::iplus" -> lustre_iplus
diff --git a/src/socExecEvalPredef.mli b/src/socExecEvalPredef.mli
index 12b3925a..e96a3b5c 100644
--- a/src/socExecEvalPredef.mli
+++ b/src/socExecEvalPredef.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 05/03/2013 (at 17:10) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/03/2013 (at 16:52) by Erwan Jahier> *)
(** Returns a predef operator interpreter. Raises Not_found if the
@@ -7,5 +7,4 @@
The interpreper supposes that the substitution do replace all inputs
by values, and that types and arities are correct.
*)
-val get: Soc.key ->
- (SocExecValue.substs -> Soc.var_expr list -> Soc.var_expr list -> SocExecValue.subst)
+val get: Soc.key -> (SocExecValue.substs -> SocExecValue.subst)
diff --git a/src/socExecValue.ml b/src/socExecValue.ml
index f2cfab87..67913536 100644
--- a/src/socExecValue.ml
+++ b/src/socExecValue.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 05/03/2013 (at 17:40) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/03/2013 (at 18:16) by Erwan Jahier> *)
open Soc
@@ -33,7 +33,7 @@ let (read_value : var -> t) =
let (read_soc_input : Soc.t -> substs) =
fun soc ->
- List.map (fun var -> "_"^(fst var), read_value var) (fst soc.socc_profile)
+ List.map (fun var -> Lic2soc.user_var_prefix^(fst var), read_value var) (fst soc.socc_profile)
let (string_of_substs :substs -> string) =
fun s ->
@@ -73,4 +73,19 @@ let (dump_substs : var list * var list -> substs -> unit) =
flush stdout
-
+(* exported *)
+let (substitute_args_and_params : var_expr list -> var list -> substs -> substs) =
+ fun args params s ->
+ assert (List.length args = List.length params);
+ List.map2 (fun arg (pn,_) -> pn, get_value s arg) args params
+
+let (substitute_params_and_args : var list -> var_expr list -> substs -> substs) =
+ fun params args s ->
+ assert (List.length args = List.length params);
+ List.map2
+ (fun arg par ->
+ match arg,par with
+ | Var(vn,_), (pn,_) -> vn, get_val pn s
+ | _,_ -> assert false
+ )
+ args params
diff --git a/src/socExecValue.mli b/src/socExecValue.mli
index 0c698448..0e54c90f 100644
--- a/src/socExecValue.mli
+++ b/src/socExecValue.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 05/03/2013 (at 15:28) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/03/2013 (at 16:19) by Erwan Jahier> *)
(** Manipulating data in the Soc interpreter *)
@@ -19,3 +19,18 @@ val dump_substs : Soc.var list * Soc.var list -> substs -> unit
val read_enum : Soc.ident list -> Soc.ident
val read_value : Soc.var -> t
val read_soc_input : Soc.t -> substs
+
+(* if
+ args = [Var("x",Int); Const("3.14",Real) ]
+ pars = [("a",Int); ("b",Real)]
+ s = [ "x",I(42) ; ... ]
+
+then I want to output the follwing substitution :
+
+ s = [ "a",I(42) ; "b",R(3.14) ]
+
+nb : args and pars order matters
+
+*)
+val substitute_args_and_params : Soc.var_expr list -> Soc.var list -> substs -> substs
+val substitute_params_and_args : Soc.var list -> Soc.var_expr list -> substs -> substs
diff --git a/src/socPredef.ml b/src/socPredef.ml
index 783e4a39..773fb6c7 100644
--- a/src/socPredef.ml
+++ b/src/socPredef.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 05/03/2013 (at 18:05) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/03/2013 (at 17:58) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
@@ -16,8 +16,8 @@ let r = Soc.Real
let bb = ["x", b], ["z", b]
let ii = ["x", i], ["z", i]
let rr = ["x", r], ["z", r]
-let ri = ["r", r], ["i", i]
-let ir = ["i", i], ["r", r ]
+let ri = ["x", r], ["z", i]
+let ir = ["x", i], ["z", r ]
let bbb = ["x", b; "y", b], ["z", b]
let iii = ["x", i; "y", i], ["z", i]
@@ -125,7 +125,7 @@ let of_soc_key : Soc.key -> Soc.t =
| "Lustre::fby" -> {
socc_key = sk;
socc_profile = (sp tl);
- socc_memories = [VarMem("m", snd (List.hd (snd (sp tl))))];
+ socc_memories = [("fby_mem", sk)];
socc_step = [
{
socm_name = "get";
@@ -155,7 +155,7 @@ let of_soc_key : Soc.key -> Soc.t =
| "Lustre::pre" -> {
socc_key = sk;
socc_profile = (sp tl);
- socc_memories = [VarMem("m", snd (List.hd (snd (sp tl))))];
+ socc_memories = [("pre_mem", sk)];
socc_step = [
{
socm_name = "get";
@@ -181,17 +181,25 @@ let of_soc_key : Soc.key -> Soc.t =
socm_impl = None;
};
}
- | "Lustre::arrow" -> {
+ | "Lustre::arrow" ->
+ let prof = sp tl in
+ let v1,v2,vout = match prof with ([v1;v2],[vout]) -> v1,v2,vout | _ -> assert false in
+ let _,tl,_ = sk in
+ let t = List.hd tl in
+ let init = Var("arrow_init", Bool) in
+ {
socc_key = sk;
- socc_profile = (sp tl);
- socc_memories = [];
+ socc_profile = prof;
+ socc_memories = [("arrow_init",sk)];
socc_step = [
{
socm_name = "step";
socm_lxm = Lxm.dummy "predef soc";
- socm_inputs = [1];
+ socm_inputs = [0;1];
socm_outputs = [0];
- socm_impl = None; (* XXX do something ? *)
+ socm_impl = Some([],[Call([Var(vout)],
+ Procedure ("Lustre::if", [Bool;t;t;t],None),
+ [init;Var(v1);Var(v2)])]);
};
];
socc_precedences = [];
@@ -199,10 +207,10 @@ let of_soc_key : Soc.key -> Soc.t =
socm_name = "init";
socm_lxm = Lxm.dummy "predef soc";
socm_inputs = [0];
- socm_outputs = [];
- socm_impl = None; (* XXX do something ? *)
+ socm_outputs = [0];
+ socm_impl = Some([],[Call([init], Assign, [Const("false",Bool)])]);
};
- }
+ }
| "Lustre::if" -> {
socc_key = sk;
@@ -235,7 +243,7 @@ let (instanciate_name : string -> Soc.var_type -> string) =
(** Instancie un composant polymorphe avec un type concret. *)
-let instanciate_component: Soc.t -> Soc.var_type -> Soc.t =
+let instanciate_soc: Soc.t -> Soc.var_type -> Soc.t =
fun c concrete_type ->
let rec instanciate_type vt =
match vt with
@@ -249,15 +257,14 @@ let instanciate_component: Soc.t -> Soc.var_type -> Soc.t =
List.map (fun (vn,vt) -> vn, instanciate_type vt) (fst c.socc_profile),
List.map (fun (vn,vt) -> vn, instanciate_type vt) (snd c.socc_profile)
in
- let (key1, key2, key3) = c.socc_key in
- let new_key = (instanciate_name key1 concrete_type,
- List.map instanciate_type key2,
- key3)
+ let instanciate_key (key1, key2, key3) =
+ (instanciate_name key1 concrete_type,
+ List.map instanciate_type key2,
+ key3)
in
- let new_memories =
- List.map
- (function | VarMem(n, t) -> VarMem(n, instanciate_type t) | _ -> assert false)
- c.socc_memories
+ let new_key = instanciate_key c.socc_key in
+ let new_memories =
+ List.map (fun (id,sk) -> (id,instanciate_key sk)) c.socc_memories
in
{
c with
@@ -270,7 +277,7 @@ let instanciate_component: Soc.t -> Soc.var_type -> Soc.t =
(*
XXX Faut-il definir une version générique des composants tranches ?
- Je les ai défini directement via "make_slice_component", ce qui
+ Je les ai défini directement via "make_slice_soc", ce qui
n'est pas homogene avec la facon dont sont traités les autres
composants génériques style 'fby'.
@@ -288,7 +295,7 @@ let instanciate_component: Soc.t -> Soc.var_type -> Soc.t =
idem pour "x^n" (Hat_n).
*)
-let make_slice_component: Lic.slice_info -> Soc.var_type -> Soc.t =
+let make_slice_soc: Lic.slice_info -> Soc.var_type -> Soc.t =
fun si t ->
let (f,l,step) = (si.Lic.se_first, si.Lic.se_last,si.Lic.se_step) in
let sub_array_type =
@@ -316,7 +323,7 @@ let make_slice_component: Lic.slice_info -> Soc.var_type -> Soc.t =
}
-let make_array_component: int -> Soc.var_type -> Soc.t =
+let make_array_soc: int -> Soc.var_type -> Soc.t =
fun i t ->
let array_type =
match t with
@@ -342,7 +349,7 @@ let make_array_component: int -> Soc.var_type -> Soc.t =
-let component_interface_of_predef:
+let soc_interface_of_predef:
Lxm.t -> AstPredef.op -> Soc.var_type list -> Soc.t =
fun lxm op types ->
match (op, types) with (* utile de re-vérifier le type ? *)
@@ -397,7 +404,7 @@ let component_interface_of_predef:
| AstPredef.IF_n, [Bool; a ; b ] ->
let concrete_type = a in
let comp = of_soc_key (("Lustre::if"), types@[concrete_type], None) in
- instanciate_component comp concrete_type
+ instanciate_soc comp concrete_type
(* « incorrect lic » *)
| AstPredef.IF_n, _ -> assert false
@@ -437,40 +444,41 @@ let component_interface_of_predef:
| AstPredef.NOT_n, _ -> assert false
-let (component_interface_of_pos_op:
+let (soc_interface_of_pos_op:
Lxm.t -> Lic.by_pos_op -> Soc.var_type list -> Soc.t) =
fun lxm op types ->
match (op, types) with
- | Lic.PREDEF_CALL op, _ -> component_interface_of_predef lxm op types
-
- | Lic.CALL op, _ -> assert false (* XXX todo *)
+ | Lic.PREDEF_CALL op, _ -> soc_interface_of_predef lxm op types
| Lic.FBY, _ ->
let concrete_type = List.nth types 0 in
let comp = of_soc_key (("Lustre::fby"), types@[concrete_type], None) in
- instanciate_component comp concrete_type
+ instanciate_soc comp concrete_type
| Lic.PRE, _ ->
let concrete_type = List.nth types 0 in
let comp = of_soc_key (("Lustre::pre"), types@[concrete_type], None) in
- instanciate_component comp concrete_type
+ instanciate_soc comp concrete_type
| Lic.CURRENT, _ ->
let concrete_type = List.nth types 0 in
let comp = of_soc_key (("Lustre::current"), types@[concrete_type], None) in
- instanciate_component comp concrete_type
+ instanciate_soc comp concrete_type
| Lic.ARROW, _ ->
let concrete_type = List.nth types 0 in
let comp = of_soc_key (("Lustre::arrow"), types@[concrete_type], None) in
- let soc = instanciate_component comp concrete_type in
- SocUtils.string_of_component_ff soc Format.std_formatter;
+ let soc = instanciate_soc comp concrete_type in
+ SocUtils.string_of_soc_ff soc Format.std_formatter;
soc
| Lic.HAT i,_ ->
let elt_type = List.nth types 0 in
- (make_array_component i elt_type)
+ (make_array_soc i elt_type)
| Lic.ARRAY, _-> finish_me lxm ; assert false
| Lic.CONCAT ,_-> finish_me lxm ; assert false
- (* Those are not components *)
+ | Lic.CALL _,_ -> assert false (* XXX todo *)
+
+
+ (* Those are not soc *)
| Lic.ARRAY_SLICE sinfo,_ -> assert false
| Lic.VAR_REF _, _ -> assert false
diff --git a/src/socPredef.mli b/src/socPredef.mli
index cffbcbe9..14bf10c8 100644
--- a/src/socPredef.mli
+++ b/src/socPredef.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 04/03/2013 (at 16:13) by Erwan Jahier> *)
+(* Time-stamp: <modified the 07/03/2013 (at 11:11) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
@@ -11,7 +11,7 @@ val of_soc_key : Soc.key -> Soc.t
Le type des opérandes permet de traiter les opérateurs surchargés.
*)
-val component_interface_of_pos_op:
+val soc_interface_of_pos_op:
Lxm.t -> Lic.by_pos_op -> Soc.var_type list -> Soc.t
diff --git a/src/socUtils.ml b/src/socUtils.ml
index 70d19de2..330e68d6 100644
--- a/src/socUtils.ml
+++ b/src/socUtils.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 01/03/2013 (at 16:14) by Erwan Jahier> *)
+(** Time-stamp: <modified the 07/03/2013 (at 11:12) by Erwan Jahier> *)
open Soc
@@ -93,6 +93,12 @@ let string_of_memory_ff: (memory -> Format.formatter -> unit) = fun v ff ->
let string_of_memory: (memory -> string) = fun v ->
call_fun_ff (string_of_memory_ff v)
+let string_of_instance_ff: (instance -> Format.formatter -> unit) =
+ fun (name,sk) ff ->
+ fprintf ff "%s" name
+
+let string_of_instance: (instance -> string) = fun (name,sk) -> name
+
(* Déclaration d'une mémoire *)
let string_of_memory_decl_ff: (memory -> Format.formatter -> unit) = fun v ff -> match v with
| CompMem(id, key) -> fprintf ff "%s : %s" id (string_of_soc_key key)
@@ -105,7 +111,7 @@ let string_of_memory_decl: (memory -> string) = fun v ->
(* Opération *)
let string_of_operation_ff: (atomic_operation -> Format.formatter -> unit) = fun v ff -> match v with
| Assign -> () (* On suppose qu'il est déjà affiché dans string_of_gao *)
- | Method(obj, meth) -> fprintf ff "%s.%s" (string_of_memory obj) (string_of_soc_key meth)
+ | Method(n, sk) -> fprintf ff "%s.%s" n (string_of_soc_key sk)
| Procedure proc -> fprintf ff "%s" (string_of_soc_key proc)
let string_of_operation: (atomic_operation -> string) = fun v ->
@@ -222,11 +228,11 @@ let string_of_profile: Soc.var list * Soc.var list -> string = fun profile ->
(* Convertion des éléments d'un composant *)
(* Convertion du profil ... *)
-let string_of_component_profile_ff: (Soc.t -> Format.formatter -> unit) = fun comp ff ->
+let string_of_soc_profile_ff: (Soc.t -> Format.formatter -> unit) = fun comp ff ->
string_of_profile_ff comp.socc_profile ff
-let string_of_component_profile: (Soc.t -> string) = fun comp ->
- call_fun_ff (string_of_component_profile_ff comp)
+let string_of_soc_profile: (Soc.t -> string) = fun comp ->
+ call_fun_ff (string_of_soc_profile_ff comp)
(* ... des contraintes *)
let string_of_comp_constraints_ff: (Soc.t -> Format.formatter -> unit) = fun comp ff ->
@@ -237,79 +243,79 @@ let string_of_comp_constraints_ff: (Soc.t -> Format.formatter -> unit) = fun com
fprintf ff "%s@]"
(String.concat "; " (List.map string_of_precedence comp.socc_precedences))
-let string_of_component_factory_ff: (
+let string_of_soc_factory_ff: (
Soc.t -> Format.formatter ->
- (Soc.t -> step_method -> Format.formatter -> unit) -> (* Formatage des méthodes *)
- (memory -> Format.formatter -> unit) option -> (* Formatage des mémoires *)
- unit
+ (Soc.t -> step_method -> Format.formatter -> unit) -> (* Formatage des méthodes *)
+ (instance -> Format.formatter -> unit) option -> (* Formatage des mémoires *)
+ unit
) = fun comp ff format_meth format_mem ->
let display_mem () =
match format_mem with
| None -> ()
| Some f -> (
- fprintf ff "@[<v 2>memories:@,";
- List.iter (
- fun m ->
- f m ff;
- fprintf ff ";@,"
- ) comp.socc_memories
- )
+ fprintf ff "@[<v 2>memories:@,";
+ List.iter (
+ fun m ->
+ f m ff;
+ fprintf ff ";@,"
+ ) comp.socc_memories
+ )
in
let display_init () =
match comp.socc_init with
| None -> fprintf ff "@[<v 2>init: -@]"
| Some m -> (
- fprintf ff "@[<v 2>init:@,";
- format_meth comp m ff;
- fprintf ff "@]"
- )
+ fprintf ff "@[<v 2>init:@,";
+ format_meth comp m ff;
+ fprintf ff "@]"
+ )
in
- fprintf ff "@[<v>@[<v 2>component ";
- string_of_soc_key_ff comp.socc_key ff;
- fprintf ff ":@,@[<v>";
+ fprintf ff "@[<v>@[<v 2>soc ";
+ string_of_soc_key_ff comp.socc_key ff;
+ fprintf ff ":@,@[<v>";
- string_of_component_profile_ff comp ff;
- fprintf ff "@]@,@[<v>";
+ string_of_soc_profile_ff comp ff;
+ fprintf ff "@]@,@[<v>";
- display_mem();
- fprintf ff "@]@,@[<v>";
+ display_mem();
+ fprintf ff "@]@,@[<v>";
- string_of_comp_constraints_ff comp ff;
- fprintf ff "@]@,@[<v>";
+ string_of_comp_constraints_ff comp ff;
+ fprintf ff "@]@,@[<v>";
- display_init();
- fprintf ff "@]@,@[<v>";
+ display_init();
+ fprintf ff "@]@,@[<v>";
- fprintf ff "@[<v 2>steps:@,";
- List.iter (
- fun s ->
- fprintf ff "@[";
- format_meth comp s ff;
- fprintf ff "@]@,"
- ) comp.socc_step;
+ fprintf ff "@[<v 2>steps:@,";
+ List.iter (
+ fun s ->
+ fprintf ff "@[";
+ format_meth comp s ff;
+ fprintf ff "@]@,"
+ ) comp.socc_step;
- fprintf ff "@]@]@]@]@."
+ fprintf ff "@]@]@]@]@."
(* Interface d'un composant *)
-let string_interface_of_component_ff: (Soc.t -> Format.formatter -> unit) = fun comp ff ->
- string_of_component_factory_ff comp ff
+let string_interface_of_soc_ff: (Soc.t -> Format.formatter -> unit) = fun comp ff ->
+ string_of_soc_factory_ff comp ff
string_interface_of_method_ff
None
-let string_interface_of_component: (Soc.t -> string) = fun v ->
- call_fun_ff (string_interface_of_component_ff v)
+let string_interface_of_soc: (Soc.t -> string) = fun v ->
+ call_fun_ff (string_interface_of_soc_ff v)
(* Composant complet *)
-let string_of_component_ff: (Soc.t -> Format.formatter -> unit) = fun comp ff ->
- string_of_component_factory_ff comp ff
+let string_of_soc_ff: (Soc.t -> Format.formatter -> unit) = fun comp ff ->
+ string_of_soc_factory_ff comp ff
string_of_method_ff
- (Some string_of_memory_decl_ff)
+ (Some string_of_instance_ff)
-let string_of_component: (Soc.t -> string) = fun v ->
- call_fun_ff (string_of_component_ff v)
+let string_of_soc: (Soc.t -> string) = fun v ->
+ call_fun_ff (string_of_soc_ff v)
let dump_entete oc =
@@ -349,14 +355,14 @@ let dump_entete oc =
let output: (bool -> string -> Soc.t list -> unit) =
- fun no_header pkg_name components ->
+ fun no_header pkg_name socs ->
let header = "Package '" ^ pkg_name ^ "' :" in
let deco = (String.make (String.length header) '=') in
if no_header then () else dump_entete stdout ;
print_string (deco ^ "\n" ^ header ^ "\n" ^ deco ^ "\n" ^ "\n");
print_string (
- String.concat "\n\n" (List.map string_of_component components)
+ String.concat "\n\n" (List.map string_of_soc socs)
);
flush stdout
diff --git a/src/socUtils.mli b/src/socUtils.mli
index 95b791d7..3ba38cf2 100644
--- a/src/socUtils.mli
+++ b/src/socUtils.mli
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 01/03/2013 (at 16:10) by Erwan Jahier> *)
+(** Time-stamp: <modified the 07/03/2013 (at 11:12) by Erwan Jahier> *)
(** Donne toute les méthodes d'un composant. *)
@@ -18,8 +18,8 @@ val string_of_method : Soc.t -> Soc.step_method -> string
val string_interface_of_method : Soc.t -> Soc.step_method -> string
val string_of_precedence : Soc.precedence -> string
val string_of_profile : Soc.var list * Soc.var list -> string
-val string_interface_of_component : Soc.t -> string
-val string_of_component : Soc.t -> string
+val string_interface_of_soc : Soc.t -> string
+val string_of_soc : Soc.t -> string
val string_of_type_ref_ff : Soc.var_type -> Format.formatter -> unit
val string_of_soc_key_ff : Soc.key -> Format.formatter -> unit
@@ -32,8 +32,8 @@ val string_of_method_ff : Soc.t -> Soc.step_method -> Format.form
val string_interface_of_method_ff : Soc.t -> Soc.step_method -> Format.formatter -> unit
val string_of_precedence_ff : string * string list -> Format.formatter -> unit
val string_of_profile_ff : Soc.var list * Soc.var list -> Format.formatter -> unit
-val string_interface_of_component_ff : Soc.t -> Format.formatter -> unit
-val string_of_component_ff : Soc.t -> Format.formatter -> unit
+val string_interface_of_soc_ff : Soc.t -> Format.formatter -> unit
+val string_of_soc_ff : Soc.t -> Format.formatter -> unit
(** [output header_flag pack_name] dumps the soc list into a
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index d88bcb5d..416b8e56 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,4 +1,4 @@
-Test Run By jahier on Tue Mar 5 17:11:54 2013
+Test Run By jahier on Wed Mar 6 09:43:09 2013
Native configuration is i686-pc-linux-gnu
=== lus2lic tests ===
diff --git a/test/lus2lic.time b/test/lus2lic.time
index bc1f18b2..1dd26366 100644
--- a/test/lus2lic.time
+++ b/test/lus2lic.time
@@ -1,2 +1,2 @@
-testcase ./lus2lic.tests/non-reg.exp completed in 53 seconds
-testcase ./lus2lic.tests/progression.exp completed in 0 seconds
+testcase ./lus2lic.tests/non-reg.exp completed in 24 seconds
+testcase ./lus2lic.tests/progression.exp completed in 1 seconds
--
GitLab