diff --git a/Makefile b/Makefile
index e90b861fcd7b5258ce1850542b77fca29d6246d1..0aff698f256b5a99467b833549934d657b9c5c62 100644
--- a/Makefile
+++ b/Makefile
@@ -124,15 +124,7 @@ SOURCES = \
LDBG_SOURCES = \
$(OBJDIR)/lv6version.ml \
- $(COMPILER_SOURCES) \
- $(OBJDIR)/lus2licRun.mli \
- $(OBJDIR)/lus2licRun.ml
-
-
-ln_ldbg: $(OBJDIR) $(LDBG_SOURCES)
-ldbg : ln_ldbg
- make -f Makefile.lib4lurette ncl
- make -f Makefile.lib4lurette bcl
+ $(COMPILER_SOURCES)
#
# Be sure to build those files before doing something else
@@ -162,7 +154,7 @@ debug: nomli dc
ln: $(OBJDIR) $(SOURCES)
-doit: ln nc cp
+doit: ln nc
include $(OCAMLMAKEFILE)
@@ -230,10 +222,45 @@ pull:
git pull git+ssh://jahier@scm.forge.imag.fr/var/lib/gforge/chroot/scmrepos/git/lustre/lus2lic.git
-cp:
- cp $(OBJDIR)/lus2lic*.cm* ../lurette/working/$(HOSTTYPE)/lib/
- cp $(OBJDIR)/lus2lic.a ../lurette/working/$(HOSTTYPE)/lib/
-
scp:
+ chmod u+w ../lurette/source/lus2lic/*
cp $(LDBG_SOURCES) ../lurette/source/lus2lic/
- chmod u-w ../lurette/source/lus2lic/
+ chmod u-w ../lurette/source/lus2lic/*
+
+# Keep those files in sync as they are shared
+# and prevent their modification
+cp_comon_file:
+ chmod u+w src/data.ml
+ chmod u+w src/data.mli
+ chmod u+w src/rif_base.ml
+ chmod u+w src/rif_base.mli
+ chmod u+w src/genlex.ml
+ chmod u+w src/genlex.mli
+ chmod u+w src/verbose.ml
+ chmod u+w src/verbose.mli
+ chmod u+w src/expr.ml
+ chmod u+w src/event.ml
+ chmod u+w src/failure.ml
+ cp ~/lurette/source/common/data.ml src/
+ cp ~/lurette/source/common/data.mli src/
+ cp ~/lurette/source/common/rif_base.ml src/
+ cp ~/lurette/source/common/rif_base.mli src/
+ cp ~/lurette/source/common/genlex.ml src/
+ cp ~/lurette/source/common/genlex.mli src/
+ cp ~/lurette/source/Lutin/verbose.ml src/
+ cp ~/lurette/source/Lutin/verbose.mli src/
+ cp ~/lurette/source/Lurettetop/expr.ml src/
+ cp ~/lurette/source/Lurettetop/event.ml src/
+ cp ~/lurette/source/Lurettetop/failure.ml src/
+ chmod u-w src/data.ml
+ chmod u-w src/data.mli
+ chmod u-w src/rif_base.ml
+ chmod u-w src/rif_base.mli
+ chmod u-w src/genlex.ml
+ chmod u-w src/genlex.mli
+ chmod u-w src/verbose.ml
+ chmod u-w src/verbose.mli
+ chmod u-w src/expr.ml
+ chmod u-w src/event.ml
+ chmod u-w src/failure.ml
+
diff --git a/Makefile.lib4lurette b/Makefile.lib4lurette
deleted file mode 100644
index fb044309d45d5b71c1ad75e3641cfdf88c638f71..0000000000000000000000000000000000000000
--- a/Makefile.lib4lurette
+++ /dev/null
@@ -1,7 +0,0 @@
-
-include ./Makefile
-
-SOURCES = $(LDBG_SOURCES)
-
-
-all: ncl bcl
diff --git a/src/data.ml b/src/data.ml
index ab15d0e86779ef1a26b2f5b83acc7b76fd373c23..72df53537bd29e2b83c225463c9504b3da2967e8 100644
--- a/src/data.ml
+++ b/src/data.ml
@@ -13,17 +13,28 @@ type t =
| Alpha of int
-let rec (val_to_string : v -> string) =
+let rec (val_to_string_type : v -> string) =
+ function
+ | I _ -> "int"
+ | F _ -> "real"
+ | B _ -> "bool"
+ | E (e,_) -> e
+ | S fl -> "struct"
+ | A a -> "array"
+ | U -> "not initialised"
+
+let rec (val_to_string : (float -> string) -> v -> string) =
+ fun s2f ->
function
| I i -> string_of_int i
- | F f -> string_of_float f (* Util.my_string_of_float f *)
+ | F f -> s2f f
| B true -> "t"
| B false -> "f"
| E (e,_) -> e
- | S fl -> String.concat " " (List.map (fun (fn,fv) -> val_to_string fv) fl)
+ | S fl -> String.concat " " (List.map (fun (fn,fv) -> val_to_string s2f fv) fl)
| A a ->
let str = ref "" in
- let f i a = str := !str ^ " " ^ (val_to_string a) in
+ let f i a = str := !str ^ " " ^ (val_to_string s2f a) in
Array.iteri f a;
!str
| U -> "not initialised"
@@ -34,8 +45,8 @@ let rec (type_to_string : t -> string) =
let str =
match v with
| Bool -> "bool"
- | Int -> "int"
- | Real -> "real"
+ | Int -> "int"
+ | Real-> "real"
| Extern s -> s ^ "(*extern*)"
| Enum (s, sl) -> "enum " ^ s ^ " {" ^ (String.concat ", " sl) ^ "}"
| Struct (sid,_) -> sid ^ "(*struct*)"
diff --git a/src/data.mli b/src/data.mli
index 7d26bfd562f41f487cb8c54a126d287aaa4b78c4..1e84704ec6a5eee7fb0e6b29d48395fd7e5d5468 100644
--- a/src/data.mli
+++ b/src/data.mli
@@ -11,7 +11,8 @@ type t =
| Array of (t * int)
| Alpha of int
-val val_to_string : v -> string
+val val_to_string : (float -> string) -> v -> string
+val val_to_string_type : v -> string
val type_to_string : t -> string
val type_of_string : string -> t
diff --git a/src/failure.ml b/src/failure.ml
index ef0beb495c490b7aa55601fda79e6e9d196a17c0..0a615036b68ecde57eef76b9e6171e3439d2a920 100644
--- a/src/failure.ml
+++ b/src/failure.ml
@@ -1,5 +1,8 @@
-(* stub *)
+
+
+(* exported *)
type info =
| Boolean of Expr.t
| Numeric of Expr.t
+
diff --git a/src/lus2licRun.ml b/src/lus2licRun.ml
deleted file mode 100644
index 0fac701412d17fe8111b93d49b35ae1e4ee864e3..0000000000000000000000000000000000000000
--- a/src/lus2licRun.ml
+++ /dev/null
@@ -1,77 +0,0 @@
-
-type vars = (string * string) list
-
-open Lv6MainArgs
-open Soc
-open SocExecValue
-
-let make argv =
- let opt = Lv6MainArgs.parse argv in
- let node = opt.main_node in
-
- if (opt.infiles = []) then (
- Lv6MainArgs.usage stderr opt;
- exit 1
- );
- let new_dft_pack = Filename.basename (Filename.chop_extension (List.hd opt.infiles)) in
- Ident.set_dft_pack_name new_dft_pack;
-
- let main_node =
- if opt.main_node = "" then None else
- Some (Ident.idref_of_string opt.main_node)
- in
- if opt.outfile <> "" then opt.oc <- open_out opt.outfile;
- let nsl = Compile.get_source_list opt opt.infiles in
- let lic_prg = Compile.doit opt nsl main_node in
-
- let first_file = List.hd opt.infiles in
- let nk = (Lic.node_key_of_idref (Ident.to_idref opt.main_node)) in
- let sk, soc_tbl =
- if LicPrg.node_exists lic_prg nk then (
- Lic2soc.f lic_prg nk
- ) else (
- print_string ("Error: cannot find node "^opt.main_node^" in "^
- (String.concat "," opt.infiles)^".\n");
- flush stdout;
- exit 1
- )
- in
- (* SocExec.f zesoc msk *)
-
- let soc = try Soc.SocMap.find sk soc_tbl with Not_found -> assert false in
- let vntl_of_profile = List.map (fun (x,t) -> x,SocUtils.string_of_type_ref t) in
- let (vntl_i:Data.vntl) = vntl_of_profile (fst soc.profile) in
- let (vntl_o:Data.vntl) = vntl_of_profile (snd soc.profile) in
- let oc = stdout in
- Lv6util.dump_entete oc;
- Rif_base.write_interface oc vntl_i vntl_o None None;
- Rif_base.flush oc;
-
- let (to_soc_subst : SocExecValue.substs -> Data.subst list) =
- fun s -> SocExecValue.filter_top_subst s
- in
- let (add_subst : Data.subst list -> SocExecValue.substs -> SocExecValue.substs) =
- fun s ctx_s ->
- List.fold_left (fun acc (id,v) -> SocExecValue.sadd acc [id] v) ctx_s s
- in
- let ctx_ref = ref (SocExecValue.create_ctx soc_tbl soc) in
- let step sl_in =
- let ctx = { !ctx_ref with s = add_subst sl_in !ctx_ref.s } in
- let ctx = SocExec.do_step soc_tbl soc ctx in
- let sl_out = to_soc_subst ctx.s in
- ctx_ref := ctx;
- sl_out
- in
- let step_dbg sl_in ectx cont =
- let cont2 ctx =
- let sl_out = to_soc_subst ctx.s in
- ctx_ref := ctx;
- cont sl_out ectx
- in
- ctx_ref := { !ctx_ref with s = add_subst sl_in !ctx_ref.s };
- SocExec.do_step_dbg soc_tbl soc ectx !ctx_ref cont2
- in
- let (mems_in : Data.subst list) = [] in (* XXX todo *)
- let (mems_out : Data.subst list) = [] in (* XXX todo *)
- vntl_i,vntl_o, (fun _ -> ()), step, step_dbg, mems_in, mems_out
-
diff --git a/src/lus2licRun.mli b/src/lus2licRun.mli
deleted file mode 100644
index 5be04796b6fc04936d090d7989942b2f3a035ad0..0000000000000000000000000000000000000000
--- a/src/lus2licRun.mli
+++ /dev/null
@@ -1,9 +0,0 @@
-
-
-type vars = (string * string) list
-
-val make: string array ->
- vars * vars * (string -> unit)
- * (Data.subst list -> Data.subst list)
- * (Data.subst list -> Event.ctx -> (Data.subst list -> Event.ctx -> Event.t) -> Event.t)
- * Data.subst list * Data.subst list
diff --git a/src/rif_base.ml b/src/rif_base.ml
index bd9371685803c19656934d0fc50f81f81f3e0d17..0e91f96d85db28b424942d106ea8cd5bd863156c 100644
--- a/src/rif_base.ml
+++ b/src/rif_base.ml
@@ -8,6 +8,7 @@
** Author: jahier@imag.fr
*)
+
open List
let lexer = Genlex.make_lexer ["q"; "#"; "x"; "load_luc"; "#@"; "@#"]
@@ -307,12 +308,12 @@ let (write_interface : out_channel -> vntl -> vntl -> vntl option -> vntl option
(*------------------------------------------------------------------------*)
(* exported *)
-let (write_outputs : out_channel -> vntl -> subst list -> unit) =
- fun oc vntl sl ->
+let (write_outputs : out_channel -> (float -> string) -> vntl -> subst list -> unit) =
+ fun oc s2f vntl sl ->
let str =
List.fold_left
(fun acc (vn,vt) ->
- acc^ (try Data.val_to_string (List.assoc vn sl)
+ acc^ (try Data.val_to_string s2f (List.assoc vn sl)
with Not_found ->
print_string ("*** " ^ vn ^ " not found in ");
print_string (String.concat "," (List.map (fun (n,_) -> n) sl));
diff --git a/src/rif_base.mli b/src/rif_base.mli
index 92f18c5519b78d7bde5188bd6a78545d39959311..e5be403d781f6b78d03eb0532b526652fdc1c57a 100644
--- a/src/rif_base.mli
+++ b/src/rif_base.mli
@@ -31,8 +31,8 @@ val read : ?pragma:(string list) -> in_channel -> out_channel option -> Data.vn
val write : out_channel -> string -> unit
-(** [write_outputs oc outputs ] writes the Lucky outputs *)
-val write_outputs : out_channel -> Data.vntl -> Data.subst list -> unit
+(** [write_outputs oc float_to_string outputs ] writes the Lucky outputs *)
+val write_outputs : out_channel -> (float -> string) -> Data.vntl -> Data.subst list -> unit
(** [write_interface oc in_vars_ out_vars loc_vars oracle_vars] writes the input
and output var names and types *)
diff --git a/src/socExec.ml b/src/socExec.ml
index 6ccc9666f450ce1bcc5c2d2bdd8fcd46502fc875..e59a30b7b2053f7c9be4b64d701bafa93b60d486 100644
--- a/src/socExec.ml
+++ b/src/socExec.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 12/04/2013 (at 08:47) by Erwan Jahier> *)
+(* Time-stamp: <modified the 12/04/2013 (at 16:05) by Erwan Jahier> *)
open Soc
open Data
@@ -300,7 +300,7 @@ let rec (loop_step : Soc.tbl -> Soc.var list -> Data.vntl -> Data.vntl
let s = SocExecValue.filter_top_subst ctx.s in
let s = List.flatten(List.map expand_subst s) in
Rif_base.write oc " #outs ";
- Rif_base.write_outputs oc exp_vntl_o_str s;
+ Rif_base.write_outputs oc (SocUtils.my_string_of_float_precision 6) exp_vntl_o_str s;
Rif_base.flush oc;
Verbose.exe ~flag:dbg (fun () -> dump_substs ctx.s; flush stdout);
loop_step soc_tbl vntl_i exp_vntl_i_str exp_vntl_o_str soc ctx (step_nb+1) oc
@@ -353,6 +353,38 @@ let rec (do_step_dbg : Soc.tbl -> Soc.t -> Event.ctx -> SocExecValue.ctx ->
Event.ctx_outputs = List.map fst (snd soc.profile);
}
in
+ let cont2 ctx =
+ let lazy_si = (fun () ->
+ let soc_step = match soc.step with [step] -> step | _ -> assert false in
+ let lxm = soc_step.lxm in
+ [{
+ Event.str = Lxm.str lxm;
+ Event.file = Lxm.file lxm ;
+ Event.line = Lxm.line lxm,Lxm.line lxm;
+ Event.char = Lxm.cstart lxm, Lxm.cend lxm;
+ (* Event.stack = if tl=[] then None else Some (to_src_info tl); *)
+ Event.stack = None; (* XXX stub *)
+ }])
+ in
+ let enb = Event.incr_nb (); Event.get_nb () in
+ {
+ Event.step = ectx.Event.ctx_step;
+ Event.nb = enb;
+ Event.depth = ectx.Event.ctx_depth;
+ Event.kind =
+ Event.Node {
+ Event.lang = "lustre";
+ Event.name = soc_name;
+ Event.port = Event.Exit ("",Expr.True,lazy_si);
+ Event.inputs = ectx.Event.ctx_inputs;
+ Event.outputs = ectx.Event.ctx_outputs;
+ };
+ Event.data = ectx.Event.ctx_data;
+ Event.other = "";
+ Event.next = (fun () -> Event.event_nb := enb; cont ctx);
+ Event.terminate = ectx.Event.ctx_terminate;
+ }
+ in
{
Event.step = ectx.Event.ctx_step;
Event.nb = (Event.incr_nb (); Event.get_nb ());
@@ -371,7 +403,7 @@ let rec (do_step_dbg : Soc.tbl -> Soc.t -> Event.ctx -> SocExecValue.ctx ->
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
- cont ctx
+ cont2 ctx
);
Event.terminate = ectx.Event.ctx_terminate;
}
diff --git a/src/socExecValue.ml b/src/socExecValue.ml
index 3d4b9ac085b8e432b28577ce16ef9e3512f96dfc..ad246462203afd69f6f3363a6a09565515bb79db 100644
--- a/src/socExecValue.ml
+++ b/src/socExecValue.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 11/04/2013 (at 17:31) by Erwan Jahier> *)
+(* Time-stamp: <modified the 12/04/2013 (at 16:03) by Erwan Jahier> *)
let dbg = (Verbose.get_flag "exec")
@@ -147,7 +147,9 @@ let (filter_top_subst : substs -> Data.subst list) =
let (string_of_subst_list : (path * Data.v) list -> string) =
fun s ->
- let values = List.map (fun (var,value) -> (path_to_string var)^"="^(Data.val_to_string value)) s in
+ let values = List.map
+ (fun (var,value) -> (path_to_string var)^"="^(Data.val_to_string string_of_float value)) s
+ in
((String.concat "\n\t" values) ^ "\n")
let (dump_subst_list : (path * Data.v) list -> unit) =
diff --git a/src/socUtils.ml b/src/socUtils.ml
index 952ab4a6fa01180e256500635726ca8e9a473430..0d5f6a9e3473bdd475b6d3ac24517fa26d391273 100644
--- a/src/socUtils.ml
+++ b/src/socUtils.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 11/04/2013 (at 16:29) by Erwan Jahier> *)
+(** Time-stamp: <modified the 12/04/2013 (at 16:06) by Erwan Jahier> *)
open Soc
@@ -330,3 +330,11 @@ let gen_index_list n =
let _ = assert (gen_index_list 5 = [0;1;2;3;4])
+
+external format_float: string -> float -> string = "caml_format_float"
+(* external format_float: string -> float -> string = "format_float" *)
+
+let (my_string_of_float_precision : int -> float -> string) =
+ fun p f ->
+ let precision_str = string_of_int p in
+ format_float ("%." ^ precision_str ^ "f") f
diff --git a/src/socUtils.mli b/src/socUtils.mli
index d0451de57b4674f767c360cdc844be87dfafc73c..96602d5a2f069b4cf93cbd1310ae1a6501e293c0 100644
--- a/src/socUtils.mli
+++ b/src/socUtils.mli
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 08/04/2013 (at 14:10) by Erwan Jahier> *)
+(** Time-stamp: <modified the 12/04/2013 (at 16:06) by Erwan Jahier> *)
(** Donne toute les méthodes d'un composant. *)
@@ -47,3 +47,4 @@ val find_no_exc : Soc.key -> Soc.tbl -> Soc.t
(* gen_index_list 5 = [0;1;2;3;4] *)
val gen_index_list : int -> int list
+val my_string_of_float_precision : int -> float -> string
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index 5d3bf4a814aa1fc20a7a15f8d54f54f5a060099f..bbda5b8569a13587bf6a1ef60f7205d9fc5ce52a 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,4 +1,4 @@
-Test Run By jahier on Thu Apr 11 17:33:42 2013
+Test Run By jahier on Fri Apr 12 16:10:00 2013
Native configuration is i686-pc-linux-gnu
=== lus2lic tests ===