Commit ccd4eaae authored by Erwan Jahier's avatar Erwan Jahier
Browse files

Synchronise with lus2lic of sha cc1ab2b7c0f92a4b8ca77c302144fb7826eebd49

parent 4f1ab1c3
......@@ -214,4 +214,20 @@ examples/lutin/alice/
examples/lutin/comon/
test_old/
source/debug/
doc/lurette-man-old/*
\ No newline at end of file
doc/lurette-man-old/*
ditaa/
doc/lurette-man/comon-header-xxx.tex
doc/lurette-man/lurette-man.bbl
doc/lurette-man/lurette-man.blg
doc/lurette-man/lurette-man.org_archive
doc/lurette-man/lurette-man.tex
doc/lurette-man/lurette-man.toc
doc/lurette-man/lurette.batch
doc/lurette-man/xxx.org
doc/lurette-man/xxx.tex
doc/lurette-man/xxx.toc
examples/lutin/xlurette/heater_control
figs/
obj/
png/
sh/
......@@ -93,6 +93,7 @@ let rec (update_val : v -> v -> access list -> v) =
match pre_v,access with
| _,[] -> v
| A a, (Sle(f,l,s,w))::access -> (
let a = Array.copy a in
let j = ref 0 in
let sub_array = Array.make w U in
for i = f to l do
......@@ -112,6 +113,10 @@ let rec (update_val : v -> v -> access list -> v) =
A a
)
| A a, (Idx i)::access ->
let a = Array.copy a
(* necessary for arrays of arrays. It would probably more
clever to only copy a_i though. *)
in
let a_i = update_val a.(i) v access in
a.(i) <- a_i;
A a
......
(* Time-stamp: <modified the 28/05/2013 (at 08:33) by Erwan Jahier> *)
(* Time-stamp: <modified the 05/06/2013 (at 14:41) by Erwan Jahier> *)
open Lxm
......@@ -469,12 +469,21 @@ and (translate_val_exp : IdSolver.t -> UnifyClock.subst -> AstCore.val_exp
(id_solver.id2const idref lxm)
in
s, const.ve_core
)
)
| CURRENT_n -> s, mk_by_pos_op Lic.CURRENT
| PRE_n -> s, mk_by_pos_op Lic.PRE
| ARROW_n -> s, mk_by_pos_op Lic.ARROW
| FBY_n -> s, mk_by_pos_op Lic.FBY
| FBY_n -> (* XXX temporary crutch: translate "e1 fby e2" into "e2 -> pre(e2)" *)
(match vel_eff with
| [e1;e2] ->
let ve_pre = CallByPosLic(flagit Lic.PRE lxm, [e2]) in
let ve_pre = { e2 with ve_core=ve_pre } in
s,CallByPosLic(flagit Lic.ARROW lxm, [e1;ve_pre])
| _ -> assert false
)
(* | FBY_n -> s, mk_by_pos_op Lic.FBY *)
| CONCAT_n -> s, mk_by_pos_op Lic.CONCAT
| TUPLE_n -> s, mk_by_pos_op Lic.TUPLE
| ARRAY_n -> s, CallByPosLic(flagit Lic.ARRAY lxm, vel_eff)
......
(* Time-stamp: <modified the 23/05/2013 (at 15:23) by Erwan Jahier> *)
(* Time-stamp: <modified the 25/09/2013 (at 10:58) by Erwan Jahier> *)
open AstPredef
......@@ -71,6 +71,11 @@ open UnifyClock
In order to check that this call is correct, we check that both
terms are unifiable.
It also modifies the substitution s (acculumated all along the
clock checking of the node) such that:
- the clock var in the callee parameters migth be be substituted
- ??? what else
*)
......@@ -79,8 +84,10 @@ let (check_args : Lxm.t -> subst -> Lic.id_clock list -> Lic.id_clock list -> su
assert (List.length cil_par = List.length cil_arg);
let idl_par,cil_par = List.split cil_par
and idl_arg,cil_arg = List.split cil_arg in
let s = List.fold_left2 (UnifyClock.f lxm) s cil_arg cil_par in
s
let ns = List.fold_left2 (UnifyClock.f lxm) s cil_arg cil_par in
(* should UnifyClock.f modify the *)
(fst s,snd ns)
(* ns *)
(** Checking expression result
--------------------------
......
(** Time-stamp: <modified the 11/04/2013 (at 17:33) by Erwan Jahier> *)
(** Time-stamp: <modified the 04/06/2013 (at 14:43) by Erwan Jahier> *)
open Lxm
open Lic
......@@ -104,6 +104,22 @@ let (binop_to_val_exp : Ident.t -> val_exp -> val_exp -> val_exp) =
ve_typ = ve1.ve_typ;
ve_core = CallByPosLic(op, [ve1; ve2])
}
let (fby_to_val_exp : val_exp -> val_exp -> val_exp) =
fun ve1 ve2 ->
let op = { it = FBY ; src = lxm } in
{
ve_clk = ve1.ve_clk;
ve_typ = ve1.ve_typ;
ve_core = CallByPosLic(op, [ve1; ve2])
}
let (tuple_to_val_exp : val_exp list -> val_exp) =
fun vel ->
let op = { it = TUPLE ; src = lxm } in
{
ve_clk = List.flatten (List.map (fun ve -> ve.ve_clk) vel);
ve_typ = List.flatten (List.map (fun ve -> ve.ve_typ) vel);
ve_core = CallByPosLic(op, vel)
}
let (ite_to_val_exp : val_exp -> val_exp -> val_exp -> val_exp) =
fun ve1 ve2 ve3 ->
let ite_op = { it = PREDEF_CALL({src=lxm;it=("Lustre","if"),[]}); src = lxm } in
......@@ -340,15 +356,14 @@ node condact_plus_0(i0:bool; i1:int; i2:int) returns (o0:int) = Lustre::condact<
node condact_plus_0(i0:bool; i1:int; i2:int) returns (o0:int) =
let
o0 = if i0 then Lustre::plus(i1,i2) else 0;
o0 = if i0 then Lustre::plus(i1,i2) else (0 fby o0);
tel
Lustre::condact<<Lustre::plus, 0>>;
*)
let node,c = match List.sort compare sargs with
| [ConstStaticArgLic(_, c);TypeStaticArgLic(_);NodeStaticArgLic(_, node_key)]
| [ConstStaticArgLic(_, c) ; NodeStaticArgLic(_, node_key)]
->
node_key,c
-> node_key,c
| _ -> assert false
in
let cond_exp, inputs =
......@@ -361,7 +376,12 @@ tel
List.map (fun x -> x.Lic.var_type_eff) lctx.node.Lic.outlist_eff in
let node_exp = node_to_val_exp node node_out_type_list inputs
and const_exp = val_exp_of_const c in
let rigth = ite_to_val_exp cond_exp node_exp const_exp in
let out_exp = match lctx.node.Lic.outlist_eff with
[o] -> val_exp_of_var_info o
| _ -> tuple_to_val_exp (List.map val_exp_of_var_info lctx.node.Lic.outlist_eff)
in
let else_exp = fby_to_val_exp const_exp out_exp in
let rigth = ite_to_val_exp cond_exp node_exp else_exp in
let eq = { src = lxm ; it = (left, rigth) } in
{ asserts_eff = []; eqs_eff = [eq] }, []
......@@ -392,10 +412,10 @@ let rec (create_meta_op_body: local_ctx -> Lic.node_key -> Lic.node_body * var_
)
| "Lustre", "diese" -> (
(* a diese is a particular kind of boolred:
#(A,...,an) = boolred(1,1,n)([a1,...,an])
#(A,...,an) = boolred(0,1,n)([a1,...,an])
*)
let n = List.length lctx.node.Lic.inlist_eff in
create_boolred_body lctx 1 1 n
create_boolred_body lctx 0 1 n
)
| "Lustre", "nor" -> (
(* a nor is a particular kind of boolred too:
......
(* Time-stamp: <modified the 22/05/2013 (at 11:17) by Erwan Jahier> *)
(* Time-stamp: <modified the 24/09/2013 (at 10:56) by Erwan Jahier> *)
open Lxm
......@@ -31,7 +31,9 @@ let new_var str lctx type_eff clock_eff =
var_clock_eff = clock_eff;
}
in
var
(* let clk_str = string_of_clock (snd clock_eff) in *)
(* print_string (" ===> creating "^id^ " from " ^ str^ " with clock " ^clk_str ^ "\n");flush stdout; *)
var
(********************************************************************************)
let get_locals node =
......@@ -271,7 +273,6 @@ and (expand_eq_aux: local_ctx -> Lic.eq_info -> local_ctx * acc option)=
in
let clks = List.map (fun v -> substitute_clock (snd v.var_clock_eff)) node_locs in
let fresh_locs = List.map2 (mk_fresh_loc lctx) node_locs clks in
let ls = mk_loc_subst node_locs fresh_locs in
let s = List.rev_append is (List.rev_append os ls) in
let fresh_locs = (* substitute the new vars in clocks *)
......@@ -320,7 +321,7 @@ and (expand_node : local_ctx -> Lic.node_exp -> local_ctx * Lic.node_exp) =
let lctx,acc = List.fold_left expand_eq (lctx, ([],[],locs)) b.eqs_eff in
let lctx,acc = List.fold_left expand_assert (lctx, acc) b.asserts_eff in
let (asserts,neqs, nv) = acc in
let nb = {
let nb = {
eqs_eff = neqs ;
asserts_eff = asserts
}
......
(* Time-stamp: <modified the 16/05/2013 (at 16:02) by Erwan Jahier> *)
(* Time-stamp: <modified the 04/06/2013 (at 14:59) by Erwan Jahier> *)
(** Define the Data Structure representing Compiled programs. *)
......@@ -550,6 +550,7 @@ let (types_of_const: const -> type_ list) =
| Tuple_const_eff cl -> List.map type_of_const cl
| c -> [type_of_const c]
(* const list *)
(* Ignore the abstraction layer (necessary when expanding struct) *)
......
(** Time-stamp: <modified the 17/05/2013 (at 17:46) by Erwan Jahier> *)
(** Time-stamp: <modified the 06/06/2013 (at 10:13) by Erwan Jahier> *)
open Lxm
open Lic
......@@ -261,7 +261,9 @@ let soc_profile_of_node: Lic.node_exp -> Soc.var list * Soc.var list =
let (make_soc_key_of_node_exp : Lic.node_key -> Lic.slice_info option -> Data.t list -> Soc.key) =
fun nk si_opt vl ->
LicDump.string_of_node_key_rec false nk, vl,
(match si_opt with None -> None | Some si -> Some(si.Lic.se_first,si.Lic.se_last,si.Lic.se_step))
(match si_opt with
| None -> Soc.Nomore
| Some si -> Soc.Slic(si.Lic.se_first,si.Lic.se_last,si.Lic.se_step))
let (soc_key_of_node_exp : Lic.node_exp -> Soc.key) =
fun n ->
......@@ -398,7 +400,7 @@ let (make_instance :
| [] -> (
match soc.Soc.have_mem with
| None -> ctx, None
| Some (_,_) -> (* pre/fby *)
| Some (_) -> (* pre/fby *)
let ctx, m = create_instance_from_soc ctx soc in
ctx, Some(m)
)
......@@ -510,15 +512,19 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
(List.flatten (List.map (fun ve -> ve.ve_typ) val_exp_list))
in
let res_type = List.map lic_to_data_type expr.ve_typ in
(* let res_type = get_exp_type lpl in *)
(* let res_type = get_exp_type lpl in *)
let full_profile = args_types @ res_type in
let si_opt = match by_pos_op_flg.it with
Lic.ARRAY_SLICE si -> Some si | _ -> None
in
let sk = make_soc_key_of_node_exp (("",id),[]) si_opt full_profile in
let fby_init_opt =
let (sk_name, sk_prof,_) = sk in
let sk,fby_init_opt =
let init = val_exp_to_filter ctx.prg (List.hd val_exp_list) in
if by_pos_op_flg.it = Lic.FBY then Some init else None
if by_pos_op_flg.it = Lic.FBY then
(sk_name, sk_prof, Soc.MemInit init), Some init
else
sk, None
in
try Soc.SocMap.find sk soc_tbl
with Not_found ->
......@@ -542,7 +548,7 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
List.map lic_to_data_type
(List.flatten (List.map (fun (_,ve) -> ve.ve_typ) cl))
in
(* let res_type = List.map lic_to_data_type expr.ve_typ in *)
(* let res_type = List.map lic_to_data_type expr.ve_typ in *)
let res_type = get_exp_type lpl in
let full_profile = args_types @ res_type in
let sk = make_soc_key_of_node_exp (("Lustre","merge"),[]) None full_profile in
......@@ -566,7 +572,7 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
| [] -> assert false
| x::t -> if x = c1 then 0,1 else if x = c2 then 1,0 else aux t
in
aux l
aux l
in
let long_of_const = function Enum_const_eff(l,_) -> l | _ -> assert false in
let compare_enum_case ({it=c1},_) ({it=c2},_) =
......@@ -681,7 +687,7 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
| Undef_soc (sk,lxm,pos_op, types, fby_init_opt) -> (
let soc = SocPredef.soc_interface_of_pos_op lxm pos_op types fby_init_opt in
if sk<>soc.key then (
if ( sk)<>( soc.key) then (
print_string ("Soc key mismatch :\n\t" ^
(SocUtils.string_of_soc_key sk) ^ "\n<>\n\t" ^
(SocUtils.string_of_soc_key soc.key) ^ "\n");
......@@ -816,6 +822,7 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
Soc.have_mem = None;
Soc.precedences = [];
}
in
Some(ctx, soc, soc_tbl)
)
......
......@@ -207,7 +207,8 @@ let to_file (opt: Lv6MainArgs.t) (this:t) (main_node: Ident.idref option) =
(fun (key,_) nexp -> (
match main_node with
| Some { Ident.id_pack = None ; Ident.id_id= name } ->
if Ident.of_long key = name then raise (Print_me nexp)
if Ident.of_long key = name && Ident.pack_of_long key <> "Lustre"
then raise (Print_me nexp)
| Some idref ->
if Ident.long_of_idref idref = key then raise (Print_me nexp)
| None -> (
......
(* Time-stamp: <modified the 16/05/2013 (at 11:05) by Erwan Jahier> *)
(* Time-stamp: <modified the 23/09/2013 (at 17:47) by Erwan Jahier> *)
open Lxm
......@@ -161,38 +161,38 @@ let (create : AstTab.t -> t) =
*)
let x_check
(* tab find_x x_check_do lookup_x_eff pack_of_x_key name_of_x_key this x_key lxm = *)
(tab : ('x_key, 'x_eff Lic.check_flag) Hashtbl.t)
(find_x : AstTabSymbol.t -> Ident.t -> Lxm.t -> ('x_info Lxm.srcflagged) AstTabSymbol.elt)
(x_check_do : t -> 'x_key -> Lxm.t -> AstTabSymbol.t -> bool -> Ident.pack_name -> 'x_info srcflagged -> 'x_eff)
(x_builtin : t -> 'x_key -> Lxm.t -> 'x_eff)
(lookup_x_eff : ('x_key, 'x_eff Lic.check_flag) Hashtbl.t -> 'x_key -> Lxm.t -> 'x_eff)
(pack_of_x_key : 'x_key -> string )
(name_of_x_key : 'x_key -> string)
(this : t)
(x_key : 'x_key)
(lxm : Lxm.t)
: 'x_eff =
Verbose.exe ~flag:dbg (fun () -> Printf.printf "#DBG: licTab.x_check '%s'\n" (Lxm.details lxm));
try lookup_x_eff tab x_key lxm
with Not_found -> (
let res = try x_builtin this x_key lxm
with Not_found ->
Hashtbl.add tab x_key Lic.Checking;
let (x_pack,xn) = (pack_of_x_key x_key, name_of_x_key x_key) in
let x_pack_symbols = AstTab.pack_body_env this.src_tab x_pack in
let x_def = match find_x x_pack_symbols xn lxm with
| AstTabSymbol.Local x_def -> x_def
| AstTabSymbol.Imported (lid,_) ->
print_string ("*** " ^ (Ident.string_of_long2 lid) ^ "???\n" ^
(Lxm.details lxm));
assert false (* should not occur *)
in
x_check_do this x_key lxm x_pack_symbols false x_pack x_def
in
Hashtbl.replace tab x_key (Lic.Checked res);
res
)
(* tab find_x x_check_do lookup_x_eff pack_of_x_key name_of_x_key this x_key lxm = *)
(tab : ('x_key, 'x_eff Lic.check_flag) Hashtbl.t)
(find_x : AstTabSymbol.t -> Ident.t -> Lxm.t -> ('x_info Lxm.srcflagged) AstTabSymbol.elt)
(x_check_do : t -> 'x_key -> Lxm.t -> AstTabSymbol.t -> bool -> Ident.pack_name -> 'x_info srcflagged -> 'x_eff)
(x_builtin : t -> 'x_key -> Lxm.t -> 'x_eff)
(lookup_x_eff : ('x_key, 'x_eff Lic.check_flag) Hashtbl.t -> 'x_key -> Lxm.t -> 'x_eff)
(pack_of_x_key : 'x_key -> string )
(name_of_x_key : 'x_key -> string)
(this : t)
(x_key : 'x_key)
(lxm : Lxm.t)
: 'x_eff =
Verbose.exe ~flag:dbg (fun () -> Printf.printf "#DBG: licTab.x_check '%s'\n" (Lxm.details lxm));
try lookup_x_eff tab x_key lxm
with Not_found -> (
let res = try x_builtin this x_key lxm
with Not_found ->
Hashtbl.add tab x_key Lic.Checking;
let (x_pack,xn) = (pack_of_x_key x_key, name_of_x_key x_key) in
let x_pack_symbols = AstTab.pack_body_env this.src_tab x_pack in
let x_def = match find_x x_pack_symbols xn lxm with
| AstTabSymbol.Local x_def -> x_def
| AstTabSymbol.Imported (lid,_) ->
print_string ("*** " ^ (Ident.string_of_long2 lid) ^ "???\n" ^
(Lxm.details lxm));
assert false (* should not occur *)
in
x_check_do this x_key lxm x_pack_symbols false x_pack x_def
in
Hashtbl.replace tab x_key (Lic.Checked res);
res
)
let x_check_interface
tab find_x x_check x_check_interface_do x_builtin lookup_x_eff
......
(** Automatically gen erated from Makefile *)
let tool = "lus2lic"
let branch = "master"
let commit = "411"
let sha_1 = "3c00916648ddbc995723802996de35748b98eb52"
let branch = "(no"
let commit = "421"
let sha_1 = "f64805fd1bc330c02ddc9b5bb6a1f7b40c1cf9e3"
let str = (branch ^ "." ^ commit ^ " (" ^ sha_1 ^ ")")
let maintainer = "jahier@imag.fr"
(* Time-stamp: <modified the 17/05/2013 (at 17:41) by Erwan Jahier> *)
(* Time-stamp: <modified the 04/06/2013 (at 17:43) by Erwan Jahier> *)
(** Synchronous Object Component *)
......@@ -10,13 +10,6 @@ type ident = string
type var = ident * Data.t
type key =
ident *
Data.t list * (* I/O type list *)
(int * int * int) option (* to deal with slices (unused FTTB) *)
type instance = ident * key
(* Variable denotation *)
type var_expr =
| Var of var
......@@ -25,6 +18,19 @@ type var_expr =
| Index of var_expr * int * Data.t
| Slice of var_expr * int * int * int * int * Data.t (* first, last, step, width *)
type key_opt =
| Nomore
| Slic of int * int * int (* for slices *)
| MemInit of var_expr (* for fby *)
type key =
ident *
Data.t list * (* I/O type list *)
key_opt
type instance = ident * key
let (data_type_of_var_expr : var_expr -> Data.t) =
function
| Var(_,vt)
......@@ -81,8 +87,8 @@ type t = {
step : step_method list; (* the order in the list is a valid w.r.t.
the partial order defined in precedences *)
precedences : precedence list; (* partial order over step methods *)
have_mem : (Data.t * var_expr option) option;
(* Do this soc have a memory (pre, fby) + its type + default value *)
have_mem : Data.t option;
(* Do this soc have a memory (pre, fby) + its type *)
}
......
(* Time-stamp: <modified the 31/05/2013 (at 13:59) by Erwan Jahier> *)
(* Time-stamp: <modified the 06/06/2013 (at 10:29) by Erwan Jahier> *)
open Soc
open Data
......@@ -32,7 +32,9 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
let soc_name,_,_ = soc.key in
match step.impl with
| Predef -> (
try SocExecEvalPredef.get soc.key ctx
try
let ctx = SocExecEvalPredef.get soc.key ctx in
ctx
with Not_found -> (* Not a predef op *) print_string (
"*** internal error in "^soc_name^". Is it defined in SocExecEvalPredef?\n");
flush stdout; assert false
......@@ -70,8 +72,8 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
let ctx =
if clk = B true then
let node_step = match node_soc.step with [step] -> step | _ -> assert false in
let ctx = { ctx with s = sadd ctx.s ("$first_step"::ctx.cpath) (B false) } in
let ctx = do_step inst_name node_step ctx soc_tbl node_soc vel_in vel_out in
let ctx = { ctx with s = sadd ctx.s ("$first_step"::ctx.cpath) (B false) } in
{ ctx with cpath=path_saved }
else
let first_step = Var ("$first_step",Bool) in
......@@ -81,8 +83,8 @@ let rec (soc_step : Soc.step_method -> Soc.tbl -> Soc.t -> SocExecValue.ctx
and the output will keep their previous value. *)
{ ctx with cpath=path_saved }
else
(* We are on the first step of node_soc;
- we assign the output var to the default values *)
(* We are on the first step of node_soc;
- we assign the output var to the default values *)
let ctx = { ctx with cpath=path_saved } in
List.fold_left2 assign_expr ctx dft_cst vel_out
in
......@@ -127,12 +129,16 @@ and (do_gao : Lxm.t -> Soc.tbl -> SocExecValue.ctx -> gao -> SocExecValue.ctx)
try
let id_val = get_enum id ctx in
let gaol = List.assoc id_val id_gao_l in
List.fold_left (do_gao lxm soc_tbl) ctx gaol
let ctx = List.fold_left (do_gao lxm soc_tbl) ctx gaol in
ctx
with Not_found -> ctx
)
| Call(vel_out, Assign, vel_in) -> (
try List.fold_left2 assign_expr ctx vel_in vel_out
with _ -> assert false
let ctx =
try List.fold_left2 assign_expr ctx vel_in vel_out
with _ -> assert false
in
ctx
)
| Call(vel_out, Procedure sk, vel_in) -> (
let (proc_name,_,_) = sk in
......@@ -301,7 +307,6 @@ let rec (loop_step : Lv6MainArgs.t -> Soc.tbl -> Soc.var list -> Data.vntl -> Da
let step = match soc.step with [step] -> step | _ -> assert false in
let ctx = soc_step step soc_tbl soc ctx in
let ctx = { ctx with s = sadd ctx.s ("$first_step"::ctx.cpath) (B false)} in
(* dump_substs ctx.s; *)
let s = SocExecValue.filter_top_subst ctx.s in
let s = List.flatten(List.map expand_subst s) in
let f2s = SocUtils.my_string_of_float_precision opt.Lv6MainArgs.precision in
......
(* Time-stamp: <modified the 28/05/2013 (at 15:03) by Erwan Jahier> *)
(* Time-stamp: <modified the 05/06/2013 (at 11:07) by Erwan Jahier> *)
open SocExecValue
open Data
......@@ -247,7 +247,7 @@ let lustre_slice tl si_opt ctx =
in
let (vn,vv) =
match ([get_val "x" ctx], si_opt) with
| [A a],Some(b,e,step) ->
| [A a],Slic(b,e,step) ->
let a_res = Array.make size a.(0) in
let j=ref 0 in
for i = b to e do
......@@ -289,7 +289,6 @@ let lustre_arrow ctx =
in
{ ctx with s = sadd ctx.s vn vv }
let lustre_hat tl ctx =
let i = match tl with
| [_;Data.Array(_,i)] -> i
......
(* Time-stamp: <modified the 29/05/2013 (at 10:11) by Erwan Jahier> *)
(* Time-stamp: <modified the 05/06/2013 (at 09:59) by Erwan Jahier> *)
let dbg = (Verbose.get_flag "exec")
......@@ -96,7 +96,8 @@ let (sadd_partial : substs -> var_expr -> path -> Data.v -> substs) =
| _,[] -> assert false
| Leaf(_),_ -> assert false
in
aux ct (List.rev x,v)
let res = aux ct (List.rev x,v) in
res
(* let rec (sadd : substs -> subst -> substs) = *)
(* fun ct (x,v) -> *)
......@@ -328,7 +329,11 @@ let (substitute_params_and_args : var list -> var_expr list -> ctx -> substs) =
fun params args ctx ->
assert (List.length args = List.length params);
let s = List.fold_left2
(fun acc arg (pn,_) -> sadd_partial acc arg (List.tl ctx.cpath) (get_val pn ctx) )
(fun acc arg (pn,_) ->
let path = List.tl ctx.cpath in
let v = get_val pn ctx in
sadd_partial acc arg path v
)
ctx.s args params
in
s
......@@ -344,16 +349,18 @@ let rec (create_ctx : Soc.tbl -> Soc.t -> ctx) =
let rec (init_soc: Soc.t -> ident list -> substs -> substs) =
fun soc cpath mem ->
let mem =
match soc.have_mem with
| Some(vt, Some(dft_value)) ->
match soc.have_mem, soc.key with
| Some(vt), (_,_,MemInit dft_value) -> (
let name = (SocPredef.get_mem_name soc.key vt)::cpath in
let value = get_value empty_ctx dft_value in
sadd mem name value
| Some(vt, None) ->
)
| Some(vt), _ -> (
let name = (SocPredef.get_mem_name soc.key vt)::cpath in
let value = U in
sadd mem name value
| None -> mem
)
| None,_ -> mem
in
List.fold_left (init_instances cpath) mem soc.instances
......
(* Time-stamp: <modified the 28/05/2013 (at 10:48) by Erwan Jahier> *)
(* Time-stamp: <modified the 04/06/2013 (at 17:48) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
......@@ -64,7 +64,8 @@ let make_soc key profile steps = {
}
let first_instant = Var("first_instant", Bool)