From 2fbae5af253e43c97272d46693195dee1b04fb76 Mon Sep 17 00:00:00 2001
From: Pascal Raymond <Pascal.Raymond@imag.fr>
Date: Fri, 6 Jul 2012 17:24:33 +0200
Subject: [PATCH] Redecoupage LazyCompiler (en cours)
---
ALIRE | 22 +++
Makefile | 3 +
src/compile.ml | 31 ++--
src/eff.ml | 18 +-
src/evalType.ml | 2 +-
src/getEff.ml | 20 ++-
src/lazyCompiler.ml | 319 +++++++++++++++++++---------------
src/lazyCompiler.mli | 4 +-
src/licDump.ml | 379 +++++++++++++++++++++--------------------
src/licPrg.ml | 66 +++++++
src/main.ml | 4 +-
src/predefEvalClock.ml | 9 +
src/predefEvalConst.ml | 1 +
src/predefEvalType.ml | 45 +++--
src/predefEvalType.mli | 2 +-
src/syntaxTreeDump.ml | 39 ++++-
src/syntaxTreeDump.mli | 3 +-
src/unifyClock.ml | 4 +
tests/Makefile | 2 +-
tests/test.res.exp | 1 +
tests/test_lv4.res.exp | 14 +-
21 files changed, 608 insertions(+), 380 deletions(-)
create mode 100644 ALIRE
create mode 100644 src/licPrg.ml
diff --git a/ALIRE b/ALIRE
new file mode 100644
index 00000000..488da445
--- /dev/null
+++ b/ALIRE
@@ -0,0 +1,22 @@
+
+Reprise des travaux, juillet 2012 ...
+
+Besoins :
+- intégrer les constructions d'horloge avancées (condact et merge)
+
+En cours :
+- sans tout casser, remettre un peu d'ordre dans la bande
+ Compile/Eff/LasyCompiler, surtout LasyCompiler qui fait
+ un peu trop de choses...
+- Idée, on passe par une forme intermédaire LicPrg :
+ * composée des type "compilés" Eff.xxx
+ * point de sortie de LasyCompiler : son rôle doit
+ être revu à la baisse, il s'occupe de "tirer" les fils
+ (aspect lazy), c'est-à -dire résoudre tout ce qui est
+ packaging et parametres statiques, MAIS PAS PLUS
+ * toutes les autre modifs de type source_2-source sont fait
+ dans des modules dédiés par des fonctions LicPrg -> LicPrg
+ * L'impression proprement dite des progs est un (simple)
+ dump du LicPrg : elle n'est plus faite au fur et à mesure
+ dans LasyCompiler
+
diff --git a/Makefile b/Makefile
index d2826dda..7ab097d5 100644
--- a/Makefile
+++ b/Makefile
@@ -46,6 +46,8 @@ SOURCES = \
$(OBJDIR)/predef.ml \
$(OBJDIR)/syntaxTreeCore.ml \
$(OBJDIR)/syntaxTree.ml \
+ $(OBJDIR)/syntaxTreeDump.mli \
+ $(OBJDIR)/syntaxTreeDump.ml \
$(OBJDIR)/solveIdent.mli \
$(OBJDIR)/solveIdent.ml \
$(OBJDIR)/parserUtils.ml \
@@ -62,6 +64,7 @@ SOURCES = \
$(OBJDIR)/name.ml \
$(OBJDIR)/polymorphism.ml \
$(OBJDIR)/licDump.ml \
+ $(OBJDIR)/licPrg.ml \
$(OBJDIR)/unifyType.mli \
$(OBJDIR)/unifyType.ml \
$(OBJDIR)/unifyClock.mli \
diff --git a/src/compile.ml b/src/compile.ml
index 27557a13..10364727 100644
--- a/src/compile.ml
+++ b/src/compile.ml
@@ -28,25 +28,14 @@ let (doit : SyntaxTree.pack_or_model list -> Ident.idref option -> unit) =
priorité dans l'ordre
*)
let lzcomp = LazyCompiler.create syntax_tab in
- if Verbose.get_level () > 2 then SyntaxTab.dump syntax_tab;
- Ident.set_dft_pack_name (first_pack_in srclist);
+ if Verbose.get_level () > 2 then SyntaxTab.dump syntax_tab;
+ Ident.set_dft_pack_name (first_pack_in srclist);
- match main_node with
- | None -> LazyCompiler.compile_all lzcomp
- | Some main_node ->
- (* la clée "absolue" du main node (pas d'args statiques) *)
- let main_node_key =
- Eff.make_simple_node_key (Ident.long_of_idref main_node)
- in
- Verbose.printf
- "-- MAIN NODE: \"%s\"\n"
- (LicDump.string_of_node_key_rec main_node_key);
-
- if !Global.compile_all_items then
- LazyCompiler.compile_all lzcomp
- else
- ignore(LazyCompiler.node_check lzcomp main_node_key
- (match Ident.pack_of_idref main_node with
- | None -> Lxm.dummy ""
- | Some pn -> Lxm.dummy (Ident.pack_name_to_string pn)))
-
+ let zelic = match main_node with
+ | None -> LazyCompiler.compile_all lzcomp
+ | Some main_node ->
+ if !Global.compile_all_items then
+ LazyCompiler.compile_all lzcomp
+ else
+ LazyCompiler.compile_node lzcomp main_node
+ in ()
diff --git a/src/eff.ml b/src/eff.ml
index 8ce7dd8a..f52d4e2b 100644
--- a/src/eff.ml
+++ b/src/eff.ml
@@ -84,6 +84,7 @@
----------------------------------------------------------------------*)
+open Errors
open Printf
open Lxm
open SyntaxTree
@@ -504,6 +505,8 @@ let rec (is_polymorphic : type_ -> bool) =
List.exists (fun (_,(teff,_)) -> is_polymorphic teff) fl
+(* Ne doit être appelée que pour les constantes simple
+*)
let (type_of_const: const -> type_) =
function
| Bool_const_eff _ -> Bool_type_eff
@@ -514,6 +517,18 @@ let (type_of_const: const -> type_) =
| Enum_const_eff (s, teff) -> teff
| Struct_const_eff (fl, teff) -> teff
| Array_const_eff (ct, teff) -> Array_type_eff (teff, List.length ct)
+ | Tuple_const_eff cl ->
+ print_internal_error "Eff.type_of_const" "should not have been called for a tuple";
+ assert false
+
+(* accepte un UNIQUE niveau de tuple
+*)
+let (types_of_const: const -> type_ list) =
+ function
+ | 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) *)
(* XXX not used anymore. This is very suspect... *)
@@ -543,11 +558,12 @@ let (clock_of_left: left -> clock) =
snd (var_info_of_left left).var_clock_eff
-
+(* RIEN A FAIRE ICI ??
let find_var_info lxm vars id =
try Hashtbl.find vars.SyntaxTreeCore.vartable id
with Not_found ->
raise (Errors.Compile_error (lxm,"\n*** Unknown ident: " ^ (Ident.to_string id)))
+*)
(*---------------------------------------------------------------------
diff --git a/src/evalType.ml b/src/evalType.ml
index 09d3302d..8000c40a 100644
--- a/src/evalType.ml
+++ b/src/evalType.ml
@@ -129,7 +129,7 @@ and (eval_by_pos_type : Eff.id_solver -> Eff.by_pos_op -> Lxm.t ->
(LicDump.string_of_type_eff4msg (List.hd targ))))
)
| [x] -> PredefEvalType.type_error [x] "struct type"
- | x -> PredefEvalType.arity_error x "1"
+ | x -> PredefEvalType.arity_error "" (List.length x) 1
in
None, [arg], [teff_field]
diff --git a/src/getEff.ml b/src/getEff.ml
index 81f2f546..341e8a89 100644
--- a/src/getEff.ml
+++ b/src/getEff.ml
@@ -545,7 +545,13 @@ and translate_field id_solver s (id, ve) =
*)
and get_const id_solver const_or_const_ident lxm =
match const_or_const_ident with
- | StaticArgConst(c) -> List.hd (EvalConst.f id_solver c)
+ | StaticArgConst(c) -> (
+ match EvalConst.f id_solver c with
+ | [x] -> x
+ | xl ->
+ (* EvalConst.f ne fabrique PAS de tuple, on le fait ici *)
+ Tuple_const_eff xl
+ )
| StaticArgIdent(id) -> id_solver.id2const id lxm
| StaticArgType _
| StaticArgNode _ -> raise (Compile_error(lxm, "a constant was expected"))
@@ -684,13 +690,23 @@ and translate_predef_static_args
(* expects 1 node, 1 (tuple) constant *)
match sargs with
| [n; d] ->
+(*
+(match d.it with StaticArgConst ve ->
+ Printf.fprintf stdout "=== default =";
+ SyntaxTreeDump.print_val_exp stdout ve;
+ Printf.fprintf stdout "\n\n";
+);
+*)
+
let node_eff = get_node id_solver n.it n.src in
let node_arg =
node_eff.node_key_eff, node_eff.inlist_eff, node_eff.outlist_eff
in
+ let dflt = get_const id_solver d.it d.src in
+
[
NodeStaticArgEff(Ident.of_string "node", node_arg, node_eff);
- ConstStaticArgEff(Ident.of_string "default", get_const id_solver d.it d.src)
+ ConstStaticArgEff(Ident.of_string "default", dflt)
]
| _ -> raise (Compile_error(lxm, "bad arguments number for condact macro"))
)
diff --git a/src/lazyCompiler.ml b/src/lazyCompiler.ml
index 71233ae2..439af9ad 100644
--- a/src/lazyCompiler.ml
+++ b/src/lazyCompiler.ml
@@ -50,22 +50,22 @@ let (create : SyntaxTab.t -> t) =
let nodes_tbl = Hashtbl.create 0 in
let prov_nodes_tbl = Hashtbl.create 0 in
List.iter
- (fun op ->
+ (fun op ->
let op_str = Predef.op2string op in
let op_eff = PredefEvalType.make_node_exp_eff None op (Lxm.dummy op_str) [] in
let op_key = Predef.op_to_long op, [] in
Hashtbl.add nodes_tbl op_key (Eff.Checked op_eff);
Hashtbl.add prov_nodes_tbl op_key (Eff.Checked op_eff)
- )
- Predef.iterable_op;
+ )
+ Predef.iterable_op;
{
- src_tab = tbl;
- types = Hashtbl.create 0;
- consts = Hashtbl.create 0;
- nodes = nodes_tbl;
- prov_types = Hashtbl.create 0;
- prov_consts = Hashtbl.create 0;
- prov_nodes = prov_nodes_tbl;
+ src_tab = tbl;
+ types = Hashtbl.create 0;
+ consts = Hashtbl.create 0;
+ nodes = nodes_tbl;
+ prov_types = Hashtbl.create 0;
+ prov_consts = Hashtbl.create 0;
+ prov_nodes = prov_nodes_tbl;
}
(******************************************************************************)
@@ -223,16 +223,16 @@ let (lookup_node_exp_eff:
);
node_exp
with
- Not_found ->
- if fst (fst key) = "Lustre" then (
- let msg = (LicDump.string_of_node_key_iter key) ^ ": unknown Lustre operator. "^
- "\n*** Available operators in the current scope are:\n" ^
- (Hashtbl.fold (fun nk _ acc -> acc ^
+ Not_found ->
+ if fst (fst key) = "Lustre" then (
+ let msg = (LicDump.string_of_node_key_iter key) ^ ": unknown Lustre operator. "^
+ "\n*** Available operators in the current scope are:\n" ^
+ (Hashtbl.fold (fun nk _ acc -> acc ^
("\t - "^ (LicDump.string_of_node_key_iter nk) ^ "\n")) tbl "")
- in
+ in
raise (Compile_error(lxm, msg))
- )
- else
+ )
+ else
(
Verbose.exe ~level:3
( fun () ->
@@ -425,6 +425,9 @@ and (const_check_interface_do: t -> Ident.long -> Lxm.t -> SymbolTab.t ->
raise(Compile_error (
const_def.src,
"\n*** provided constant does not match with its definition."))
+ | Eff.Tuple_const_eff _, _ ->
+ print_internal_error "LazyCompiler.const_check_interface_do" "should not have been called for a tuple";
+ assert false
and (type_check_do: t -> Ident.long -> Lxm.t -> SymbolTab.t -> bool ->
@@ -499,6 +502,7 @@ and (type_check_do: t -> Ident.long -> Lxm.t -> SymbolTab.t -> bool ->
&& (not (!Global.expand_structs & is_struct_or_array))
(* && not !Global.ec (* ec does not need type decl at all *) *)
then
+(* ICI IMPRESSION DE TYPE DECL *)
output_string !Global.oc (LicDump.type_decl type_name type_eff);
type_eff
)
@@ -579,9 +583,9 @@ and (const_check_do : t -> Ident.long -> Lxm.t -> SymbolTab.t -> bool ->
)
in
let is_struct_or_array = match const_eff with
- | Struct_const_eff _ -> true
- | Array_const_eff _ -> true
- | _ -> false
+ | Struct_const_eff _ -> true
+ | Array_const_eff _ -> true
+ | _ -> false
in
let is_extern_const =
match const_eff with
@@ -598,6 +602,7 @@ and (const_check_do : t -> Ident.long -> Lxm.t -> SymbolTab.t -> bool ->
&& (not !Global.ec) (* ec does not need constant decl, except extern ones *)
) || is_extern_const
then
+(* ICI IMPRESSION DE CONST DECL *)
output_string !Global.oc (LicDump.const_decl cn const_eff);
const_eff
@@ -725,7 +730,7 @@ and (node_check_do: t -> Eff.node_key -> Lxm.t -> SymbolTab.t ->
try lookup_const local_env id lxm
with Not_found ->
solve_const_idref this symbols provide_flag pack_name id lxm
- );
+ );
id2type =
(fun id lxm ->
try lookup_type local_env id lxm
@@ -745,8 +750,8 @@ and (node_check_do: t -> Eff.node_key -> Lxm.t -> SymbolTab.t ->
(fun id sargs lxm ->
(try
let (node_id,sargs), inlist, outlist = lookup_node local_env id sargs lxm in
- let node_id = Ident.idref_of_long node_id in
- solve_node_idref this symbols provide_flag pack_name node_id sargs lxm
+ let node_id = Ident.idref_of_long node_id in
+ solve_node_idref this symbols provide_flag pack_name node_id sargs lxm
(* node_check this (node_id,[]) lxm *)
with
@@ -771,110 +776,110 @@ and (node_check_do: t -> Eff.node_key -> Lxm.t -> SymbolTab.t ->
(* init intermediate table *)
let sz = List.length node_def.it.loc_consts in
let temp_const_eff_tab : (Ident.long, Eff.const Eff.check_flag) Hashtbl.t =
- Hashtbl.create sz
+ Hashtbl.create sz
in
let temp_const_def_tab :
(Ident.t,(Lxm.t * SyntaxTreeCore.type_exp option * SyntaxTreeCore.val_exp)) Hashtbl.t =
- Hashtbl.create sz
+ Hashtbl.create sz
in
let init_local_const (lxm, cinfo) = (
- match cinfo with
- | DefinedConst (i,topt,ve) -> (
- Verbose.printf ~level:3 " * local const %s will be treated\n" i;
- Hashtbl.add temp_const_def_tab i (lxm,topt,ve)
- )
- | ExternalConst _
- | EnumConst _ -> (
- let msg = "*** abstract constant bot allowed within node "
- in
- raise (Compile_error(lxm, msg))
- )
+ match cinfo with
+ | DefinedConst (i,topt,ve) -> (
+ Verbose.printf ~level:3 " * local const %s will be treated\n" i;
+ Hashtbl.add temp_const_def_tab i (lxm,topt,ve)
+ )
+ | ExternalConst _
+ | EnumConst _ -> (
+ let msg = "*** abstract constant bot allowed within node "
+ in
+ raise (Compile_error(lxm, msg))
+ )
) in
- List.iter init_local_const node_def.it.loc_consts ;
- (* differs from node_id_solver only on id2const *)
- let rec local_id_solver = {
+ List.iter init_local_const node_def.it.loc_consts ;
+ (* differs from node_id_solver only on id2const *)
+ let rec local_id_solver = {
id2var = node_id_solver.id2var;
id2const = local_id2const;
id2type = node_id_solver.id2type;
id2node = node_id_solver.id2node;
symbols = node_id_solver.symbols;
- }
- and treat_local_const id = (
- Verbose.printf ~level:3 " * call treat_local_const %s\n" id;
- let id_key = ("", id) in
- try (
- let ce = lookup_const_eff temp_const_eff_tab id_key lxm in
- Verbose.printf ~level:3 " * const %s already treated = %s\n"
+ }
+ and treat_local_const id = (
+ Verbose.printf ~level:3 " * call treat_local_const %s\n" id;
+ let id_key = ("", id) in
+ try (
+ let ce = lookup_const_eff temp_const_eff_tab id_key lxm in
+ Verbose.printf ~level:3 " * const %s already treated = %s\n"
id (LicDump.string_of_const_eff ce);
- ce
- ) with Not_found -> (
- let (lxmdef, toptdef, vedef) = Hashtbl.find temp_const_def_tab id in
- Verbose.printf ~level:3 " * const %s not yet treated ...\n" id ;
- (* yes, not yet checked *)
- Hashtbl.add temp_const_eff_tab id_key Checking ;
- (* computes the value with EvalConst.f id_solver ve ... *)
- let ce = match (EvalConst.f local_id_solver vedef) with
- | [ceff] -> (
- match toptdef with
- | None -> ceff
- | Some texp -> (
- let tdecl = GetEff.typ local_id_solver texp in
- let teff = Eff.type_of_const ceff in
- if (tdecl = teff ) then ceff else
- raise (Compile_error (
+ ce
+ ) with Not_found -> (
+ let (lxmdef, toptdef, vedef) = Hashtbl.find temp_const_def_tab id in
+ Verbose.printf ~level:3 " * const %s not yet treated ...\n" id ;
+ (* yes, not yet checked *)
+ Hashtbl.add temp_const_eff_tab id_key Checking ;
+ (* computes the value with EvalConst.f id_solver ve ... *)
+ let ce = match (EvalConst.f local_id_solver vedef) with
+ | [ceff] -> (
+ match toptdef with
+ | None -> ceff
+ | Some texp -> (
+ let tdecl = GetEff.typ local_id_solver texp in
+ let teff = Eff.type_of_const ceff in
+ if (tdecl = teff ) then ceff else
+ raise (Compile_error (
lxmdef, Printf.sprintf
- " this constant is declared as '%s' but evaluated as '%s'"
- (LicDump.string_of_type_eff4msg tdecl)
- (LicDump.string_of_type_eff4msg teff)
- )))
- )
- | [] -> assert false (* should not occur *)
- | _::_ -> raise (Compile_error(lxmdef, "bad constant value: tuple not allowed"))
- in
- Verbose.printf ~level:3 " * const %s evaluated to %s\n"
+ " this constant is declared as '%s' but evaluated as '%s'"
+ (LicDump.string_of_type_eff4msg tdecl)
+ (LicDump.string_of_type_eff4msg teff)
+ )))
+ )
+ | [] -> assert false (* should not occur *)
+ | _::_ -> raise (Compile_error(lxmdef, "bad constant value: tuple not allowed"))
+ in
+ Verbose.printf ~level:3 " * const %s evaluated to %s\n"
id (LicDump.string_of_const_eff ce);
- Hashtbl.replace temp_const_eff_tab id_key (Checked ce) ;
- ce
- )
- )
- and local_id2const idrf lxm = (
- (* is id a local const ? *)
- try (
- (* certainly NOT if id has a pack *)
- let id = if (Ident.pack_of_idref idrf = None)
- then Ident.name_of_idref idrf
- else raise Not_found
- in
- let ce = treat_local_const id in
- ce
- ) with Not_found -> (
- (* not a local constant -> search in global env *)
- Verbose.printf ~level:3 " * %s not a local const, should be global ?" (Ident.string_of_idref idrf);
- let ce = node_id_solver.id2const idrf lxm in
- Verbose.printf ~level:3 " YES -> %s\n" (LicDump.string_of_const_eff ce);
- ce
- )
- ) in
- (* iters local_id2const n eeach declared constant *)
- Hashtbl.iter (fun id _ -> let _ = treat_local_const id in ()) temp_const_def_tab ;
- (* Finally, adds each local const to ICI *)
- let add_local_const idref ceck = (
- Verbose.printf ~level:3 " * add_local_const %s = %s\n"
- (snd idref)
- (match ceck with
- | Checking -> "Checking"
- | Checked ce -> (LicDump.string_of_const_eff ce)
- | Incorrect -> "Incorrect"
- );
- match ceck with
- | Checked ce -> Hashtbl.add local_env.lenv_const (snd idref) ce
- | _ -> assert false
- ) in
- Hashtbl.iter add_local_const temp_const_eff_tab ;
+ Hashtbl.replace temp_const_eff_tab id_key (Checked ce) ;
+ ce
+ )
+ )
+ and local_id2const idrf lxm = (
+ (* is id a local const ? *)
+ try (
+ (* certainly NOT if id has a pack *)
+ let id = if (Ident.pack_of_idref idrf = None)
+ then Ident.name_of_idref idrf
+ else raise Not_found
+ in
+ let ce = treat_local_const id in
+ ce
+ ) with Not_found -> (
+ (* not a local constant -> search in global env *)
+ Verbose.printf ~level:3 " * %s not a local const, should be global ?" (Ident.string_of_idref idrf);
+ let ce = node_id_solver.id2const idrf lxm in
+ Verbose.printf ~level:3 " YES -> %s\n" (LicDump.string_of_const_eff ce);
+ ce
+ )
+ ) in
+ (* iters local_id2const n eeach declared constant *)
+ Hashtbl.iter (fun id _ -> let _ = treat_local_const id in ()) temp_const_def_tab ;
+ (* Finally, adds each local const to ICI *)
+ let add_local_const idref ceck = (
+ Verbose.printf ~level:3 " * add_local_const %s = %s\n"
+ (snd idref)
+ (match ceck with
+ | Checking -> "Checking"
+ | Checked ce -> (LicDump.string_of_const_eff ce)
+ | Incorrect -> "Incorrect"
+ );
+ match ceck with
+ | Checked ce -> Hashtbl.add local_env.lenv_const (snd idref) ce
+ | _ -> assert false
+ ) in
+ Hashtbl.iter add_local_const temp_const_eff_tab ;
- (********************************************************)
+ (********************************************************)
(* LOCAL FLOWS are added to local_env *)
- (********************************************************)
+ (********************************************************)
(* (i.e. ins,outs,locs) *)
match node_def.it.vars with
| None -> assert false (* a node with a body should have a profile *)
@@ -1132,8 +1137,8 @@ and (make_alias_node : node_exp -> node_key -> local_env -> id_solver ->
core = CallByPosEff(
Lxm.flagit (IDENT(
Ident.to_idref vi.var_name_eff)) lxm, OperEff [])}
- in
- ve
+ in
+ ve
)
vil)));
typ = tl;
@@ -1166,21 +1171,21 @@ and (make_alias_node : node_exp -> node_key -> local_env -> id_solver ->
in
alias_node
-and (gen_code : bool -> Eff.node_env -> Eff.node_exp -> unit) =
- fun provide_flag current_env nexp ->
+and gen_code (provide_flag:bool) (current_env:Eff.node_env) (nexp: Eff.node_exp) : unit =
+
let nk = nexp.node_key_eff in
let is_extern_oper =
match nexp.def_eff with
- | ExternEff | AbstractEff None -> true
- | AbstractEff (Some _) | BodyEff _ -> false
+ | ExternEff | AbstractEff None -> true
+ | AbstractEff (Some _) | BodyEff _ -> false
in
let is_main_node =
if !Global.main_node = "" then (
(* if no main node is provided, we take the first node we find,
- that has a non-empty body. *)
- match nexp.def_eff with
- | ExternEff | AbstractEff _ -> false
- | BodyEff _ ->
+ that has a non-empty body. *)
+ match nexp.def_eff with
+ | ExternEff | AbstractEff _ -> false
+ | BodyEff _ ->
Global.main_node := Ident.string_of_long (fst nk);
true
)
@@ -1197,16 +1202,16 @@ and (gen_code : bool -> Eff.node_env -> Eff.node_exp -> unit) =
node_check, because the structure and array expansion
modify (instanciate) the node profiles. *)
if
- (!Global.expand_structs && not (nexp.is_polym_eff)
+ (!Global.expand_structs && not (nexp.is_polym_eff)
&& ((not !Global.expand_nodes || is_main_node) (* it is useless otherwise *)
) || is_extern_oper)
then
(
Verbose.printf ~level:3 "-- Expand node %s \n" (Ident.long_to_string (fst nk));
- StructArrayExpand.node current_env.global current_env.local nexp
+ StructArrayExpand.node current_env.global current_env.local nexp
)
else
- nexp
+ nexp
in
if not provide_flag then
(
@@ -1215,16 +1220,15 @@ and (gen_code : bool -> Eff.node_env -> Eff.node_exp -> unit) =
Polymorphism.push_on_polymorphic_node_stack (current_env, nexp_struct)
else
let str = LicDump.node_of_node_exp_eff nexp_struct in
+(* ICI IMPRESSION DE NODE DECL *)
output_string !Global.oc str
);
-
(* Apply various source to source transformations, according to command-line options ;
+ fix-point on generated nodes
*)
-and (source_to_source : bool -> Eff.node_env -> Eff.node_exp -> Eff.node_exp) =
- fun provide_flag current_env nexp ->
+and source_to_source (provide_flag:bool) (current_env: Eff.node_env) (nexp: Eff.node_exp) : Eff.node_exp =
let rec aux nl_done nl_todo =
match nl_todo with
| [] -> assert false
@@ -1260,14 +1264,14 @@ and (source_to_source : bool -> Eff.node_env -> Eff.node_exp -> Eff.node_exp) =
let nl_done = nl_done @ [nexp] in
if nl_todo = [] then nl_done else aux nl_done nl_todo
in
- match aux [] [nexp] with
- | [] -> assert false
- | nexp::new_nodes ->
- (* The main node is printed outside
- (indeed, we do not apply UniqueOutput.check only to generated nodes)
- *)
- List.iter (gen_code provide_flag current_env) new_nodes;
- nexp
+ match aux [] [nexp] with
+ | [] -> assert false
+ | nexp::new_nodes ->
+ (* The main node is printed outside
+ (indeed, we do not apply UniqueOutput.check only to generated nodes)
+ *)
+ List.iter (gen_code provide_flag current_env) new_nodes;
+ nexp
@@ -1353,9 +1357,29 @@ let compile_all_nodes pack_name this id ni_f =
Eff.profile_of_node_exp
(fun id -> (Ident.make_long pack_name id, [])) id ni_f
+(**** to_lic : translate the (finalized) internal structure
+ into a proper LicPrg, for forthcoming manip and other prg 2 prg
+ transformations
+*)
-let (compile_all :t -> unit) =
- fun this ->
+let unflag (xflg: 'a Eff.check_flag) : 'a =
+ match xflg with
+ | Checked x -> x
+ | _ -> assert false
+
+let to_lic (this:t) : LicPrg.t =
+ (* normally, only checked and correct programs are lic'ified *)
+ let unflag = function Checked x -> x | _ -> assert false in
+ let res = LicPrg.empty in
+ let res = Hashtbl.fold (fun k vflg prg -> LicPrg.add_type k (unflag vflg) prg) this.types res in
+ let res = Hashtbl.fold (fun k vflg prg -> LicPrg.add_const k (unflag vflg) prg) this.consts res in
+ let res = Hashtbl.fold (fun k vflg prg -> LicPrg.add_node k (unflag vflg) prg) this.nodes res in
+ res
+
+(**** Entry points of the module :
+ either compile a single node or everithing ...
+*)
+let compile_all (this:t) : LicPrg.t =
let testpack pack_name = (
Verbose.printf ~level:3 " * package %s\n" (Ident.pack_name_to_string pack_name);
let prov_symbols =
@@ -1377,10 +1401,27 @@ let (compile_all :t -> unit) =
let plist = SyntaxTab.pack_list this.src_tab in
Verbose.print_string ~level:3 "*** Dump the exported items of the packages.\n";
try
- List.iter testpack plist
+ List.iter testpack plist;
+ to_lic this
with
Recursion_error (n, stack) ->
let msg = "Recursion loop detected in node " ^ (Ident.string_of_long n) in
let msg = msg ^ "\n*****" ^ (String.concat "\n*****" stack) in
raise (Compile_error (Lxm.dummy "", msg))
+let compile_node (this:t) (main_node:Ident.idref) : LicPrg.t =
+ (* la clée "absolue" du main node (pas d'args statiques) *)
+ let main_node_key =
+ Eff.make_simple_node_key (Ident.long_of_idref main_node)
+ in
+ Verbose.printf
+ "-- MAIN NODE: \"%s\"\n"
+ (LicDump.string_of_node_key_rec main_node_key);
+
+ let lxm = match Ident.pack_of_idref main_node with
+ | None -> Lxm.dummy ""
+ | Some pn -> Lxm.dummy (Ident.pack_name_to_string pn)
+ in
+ let _ = node_check this main_node_key lxm in
+ to_lic this
+
diff --git a/src/lazyCompiler.mli b/src/lazyCompiler.mli
index 43a079b8..30894ead 100644
--- a/src/lazyCompiler.mli
+++ b/src/lazyCompiler.mli
@@ -15,9 +15,9 @@ val create : SyntaxTab.t -> t
(** Compiles one node *)
-val node_check : t -> Eff.node_key -> Lxm.t -> Eff.node_exp
+val compile_node : t -> Ident.idref -> LicPrg.t
exception Recursion_error of Ident.long * string list
(* compile all items *)
-val compile_all : t -> unit
+val compile_all : t -> LicPrg.t
diff --git a/src/licDump.ml b/src/licDump.ml
index 15d3e197..59e8a03f 100644
--- a/src/licDump.ml
+++ b/src/licDump.ml
@@ -1,5 +1,6 @@
(** Time-stamp: <modified the 01/06/2011 (at 11:33) by Erwan Jahier> *)
+open Errors
open Printf
open Lxm
open Eff
@@ -63,41 +64,45 @@ let rec string_of_const_eff =
else
(dump_long s)
| Struct_const_eff (fl, t) -> (
- let string_of_field =
- function (id, veff) ->
- (Ident.to_string id)^" = "^ (string_of_const_eff veff)
- in
- let flst = List.map string_of_field fl in
- (string_of_type_eff t)^"{"^(String.concat "; " flst)^"}"
+ let string_of_field =
+ function (id, veff) ->
+ (Ident.to_string id)^" = "^ (string_of_const_eff veff)
+ in
+ let flst = List.map string_of_field fl in
+ (string_of_type_eff t)^"{"^(String.concat "; " flst)^"}"
)
| Array_const_eff (ctab, t) -> (
- let vl = List.map string_of_const_eff ctab in
- "["^(String.concat ", " vl)^"]"
+ let vl = List.map string_of_const_eff ctab in
+ "["^(String.concat ", " vl)^"]"
)
+ | Tuple_const_eff cl -> (
+ string_of_const_eff_list cl
+ )
+
and string_of_const_eff_list =
- function
- | [c] -> string_of_const_eff c
- | cl -> "(" ^ (String.concat ", " (List.map string_of_const_eff cl)) ^ ")"
+ function
+ | [c] -> string_of_const_eff c
+ | cl -> "(" ^ (String.concat ", " (List.map string_of_const_eff cl)) ^ ")"
(* modify numbers notations in such a way that they
become "valid" identifiers. Policy:
- - minus (-) becomes "m"
- - plus (+) becomes "p"
- - dot (d) becomes "d"
+ - minus (-) becomes "m"
+ - plus (+) becomes "p"
+ - dot (d) becomes "d"
*)
and correct_num_string s =
- let res = String.copy s in
- let cpt = ref 0 in
- let f c = (
- let _ = match c with
- | '-' -> (res.[!cpt] <- 'm')
- | '+' -> (res.[!cpt] <- 'p')
- | '.' -> (res.[!cpt] <- 'd')
- | _ -> ()
- in incr cpt
- ) in
- String.iter f s;
- res
+ let res = String.copy s in
+ let cpt = ref 0 in
+ let f c = (
+ let _ = match c with
+ | '-' -> (res.[!cpt] <- 'm')
+ | '+' -> (res.[!cpt] <- 'p')
+ | '.' -> (res.[!cpt] <- 'd')
+ | _ -> ()
+ in incr cpt
+ ) in
+ String.iter f s;
+ res
and string_ident_of_const_eff c =
(* that version generates a string that is a valid lic ident, in order to use it
@@ -116,11 +121,12 @@ and string_ident_of_const_eff c =
| _ -> assert false
)
| Array_const_eff (ctab, t) -> string_of_type_eff t
+ | Tuple_const_eff cl -> string_of_const_eff_list cl
and string_ident_of_const_eff_list cl =
- match cl with
- | [c] -> string_ident_of_const_eff c
- | _ -> "(" ^ (String.concat ", " (List.map string_ident_of_const_eff cl)) ^ ")"
+ match cl with
+ | [c] -> string_ident_of_const_eff c
+ | _ -> "(" ^ (String.concat ", " (List.map string_ident_of_const_eff cl)) ^ ")"
and string_of_const_eff_opt = function
| None -> ""
@@ -143,15 +149,15 @@ and string_def_of_type_eff = function
| Struct_type_eff (name, fl) ->
assert (fl <>[]);
let f sep acc (id, (type_eff, const_eff_opt)) =
- acc ^ sep ^ (Ident.to_string id) ^ " : " ^
- (string_of_type_eff type_eff) ^
- match const_eff_opt with
- None -> ""
- | Some ce -> " = " ^ (string_of_const_eff ce)
+ acc ^ sep ^ (Ident.to_string id) ^ " : " ^
+ (string_of_type_eff type_eff) ^
+ match const_eff_opt with
+ None -> ""
+ | Some ce -> " = " ^ (string_of_const_eff ce)
in
"struct " ^
- (List.fold_left (f "; ") (f "" " {" (List.hd fl)) (List.tl fl)) ^ "}"
-
+ (List.fold_left (f "; ") (f "" " {" (List.hd fl)) (List.tl fl)) ^ "}"
+
| Any -> "a"
| Overload -> "o"
@@ -252,7 +258,7 @@ and string_of_node_key_rec (nkey: node_key) =
| (ik, []) -> dump_long ik
| (ik, salst) ->
let astrings = List.map static_arg2string_bis salst in
- let name = sprintf "%s_%s" (Ident.no_pack_string_of_long ik) (String.concat "_" astrings) in
+ let name = sprintf "%s_%s" (Ident.no_pack_string_of_long ik) (String.concat "_" astrings) in
(Name.node_key nkey name)
(* for printing iterators *)
@@ -260,8 +266,8 @@ and string_of_node_key_iter (nkey: node_key) =
match nkey with
| (ik, []) -> dump_long ik
| (ik, salst) ->
- let astrings = List.map (static_arg2string) salst in
- sprintf "%s<<%s>>" (Ident.string_of_long ik) (String.concat ", " astrings)
+ let astrings = List.map (static_arg2string) salst in
+ sprintf "%s<<%s>>" (Ident.string_of_long ik) (String.concat ", " astrings)
(* for inventing a name to parametrized nodes *)
and static_arg2string_bis (sa : Eff.static_arg) =
@@ -269,7 +275,7 @@ and static_arg2string_bis (sa : Eff.static_arg) =
| ConstStaticArgEff (id, ceff) -> sprintf "%s" (string_ident_of_const_eff ceff)
| TypeStaticArgEff (id, teff) -> sprintf "%s" (string_of_type_eff teff)
| NodeStaticArgEff (id, ((long, _sargs), _, _), _) ->
- sprintf "%s" (Ident.no_pack_string_of_long long)
+ sprintf "%s" (Ident.no_pack_string_of_long long)
(* for printing recursive node and iterators *)
and static_arg2string (sa : Eff.static_arg) =
@@ -278,7 +284,7 @@ and static_arg2string (sa : Eff.static_arg) =
| TypeStaticArgEff (id, teff) -> sprintf "%s" (string_of_type_eff teff)
| NodeStaticArgEff (id, ((long,sargs), _, _), _) ->
string_of_node_key_iter (long,sargs)
-(* sprintf "%s" (dump_long long) *)
+(* sprintf "%s" (dump_long long) *)
and (string_of_var_info_eff4msg: Eff.var_info -> string) =
fun x ->
@@ -345,34 +351,34 @@ and (string_of_by_pos_op_eff: Eff.by_pos_op srcflagged -> Eff.val_exp list -> st
in
let str =
match posop.it,vel with
- | Predef (Predef.NOT_n,_), [ve1] ->
+ | Predef (Predef.NOT_n,_), [ve1] ->
((op2string Predef.NOT_n) ^ " " ^
(if is_a_tuple ve1 then (tuple_par [ve1]) else sov ve1))
- | Predef (Predef.DIESE_n,_), [ve1] ->
+ | Predef (Predef.DIESE_n,_), [ve1] ->
if !Global.lv4
then sov ve1 (* lv4 does no accept to apply # on One var only! *)
else ((op2string Predef.DIESE_n) ^ (tuple_par [ve1]))
- | Predef (Predef.IF_n,_), [ve1; ve2; ve3] ->
- let ve2str = string_of_val_exp_eff ve2 in
- let ve2str = if is_a_tuple ve2 then "("^ve2str^")" else ve2str in
- let ve3str = string_of_val_exp_eff ve3 in
- let ve3str = if is_a_tuple ve3 then "("^ve3str^")" else ve3str in
- " if " ^ (string_of_val_exp_eff ve1) ^
- " then " ^ ve2str ^ " else " ^ ve3str
-
- | Predef(op,sargs), vel ->
- if Predef.is_infix op then (
- match vel with
- | [ve1; ve2] ->
- (string_of_val_exp_eff ve1) ^ " " ^ (op2string op) ^
- " " ^ (string_of_val_exp_eff ve2)
- | _ -> assert false
- )
- else
- ((op2string op) ^
- (if sargs = [] then
+ | Predef (Predef.IF_n,_), [ve1; ve2; ve3] ->
+ let ve2str = string_of_val_exp_eff ve2 in
+ let ve2str = if is_a_tuple ve2 then "("^ve2str^")" else ve2str in
+ let ve3str = string_of_val_exp_eff ve3 in
+ let ve3str = if is_a_tuple ve3 then "("^ve3str^")" else ve3str in
+ " if " ^ (string_of_val_exp_eff ve1) ^
+ " then " ^ ve2str ^ " else " ^ ve3str
+
+ | Predef(op,sargs), vel ->
+ if Predef.is_infix op then (
+ match vel with
+ | [ve1; ve2] ->
+ (string_of_val_exp_eff ve1) ^ " " ^ (op2string op) ^
+ " " ^ (string_of_val_exp_eff ve2)
+ | _ -> assert false
+ )
+ else
+ ((op2string op) ^
+ (if sargs = [] then
match op with
| Predef.ICONST_n _ | Predef.RCONST_n _ | Predef.NOT_n
| Predef.UMINUS_n | Predef.IUMINUS_n | Predef.RUMINUS_n
@@ -382,106 +388,106 @@ and (string_of_by_pos_op_eff: Eff.by_pos_op srcflagged -> Eff.val_exp list -> st
else
"<<" ^
(String.concat ", " (List.map (static_arg2string) sargs))
- ^ ">>" ^ (tuple_par vel)))
-
- | CALL nee, _ -> (
- if nee.it.def_eff = ExternEff then
- if !Global.lv4 then
- (match nee.it.node_key_eff with
- (* predef op that are iterated are translated into node_exp ;
- hence, we need to do (again) a particular threatment to have
- a node ouput (i.e., "2>a" vs "Lustre::lt(2,a)" *)
- | ("Lustre","uminus"), [] -> " -" ^ sov (hd vel)
- | ("Lustre","iuminus"), [] -> " -" ^ sov (hd vel)
- | ("Lustre","ruminus"), [] -> " -" ^ sov (hd vel)
- | ("Lustre","not"), [] -> " not " ^ sov (hd vel)
-
- | ("Lustre","lt"), [] -> sov (hd vel) ^ " < " ^ sov (hd (tl vel))
- | ("Lustre","lte"), [] -> sov (hd vel) ^ " <= " ^ sov (hd (tl vel))
- | ("Lustre","gt"), [] -> sov (hd vel) ^ " > " ^ sov (hd (tl vel))
- | ("Lustre","gte"), [] -> sov (hd vel) ^ " >= " ^ sov (hd (tl vel))
- | ("Lustre","eq"), [] -> sov (hd vel) ^ " = " ^ sov (hd (tl vel))
- | ("Lustre","neq"), [] -> sov (hd vel) ^ " <> " ^ sov (hd (tl vel))
- | ("Lustre","diff"), [] -> sov (hd vel) ^ " <> " ^ sov (hd (tl vel))
- | ("Lustre","plus"), [] -> sov (hd vel) ^ " + " ^ sov (hd (tl vel))
- | ("Lustre","iplus"), [] -> sov (hd vel) ^ " + " ^ sov (hd (tl vel))
- | ("Lustre","rplus"), [] -> sov (hd vel) ^ " + " ^ sov (hd (tl vel))
- | ("Lustre","minus"), [] -> sov (hd vel) ^ " - " ^ sov (hd (tl vel))
- | ("Lustre","iminus"), [] -> sov (hd vel) ^ " - " ^ sov (hd (tl vel))
- | ("Lustre","rminus"), [] -> sov (hd vel) ^ " - " ^ sov (hd (tl vel))
- | ("Lustre","div"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
- | ("Lustre","idiv"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
- | ("Lustre","rdiv"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
- | ("Lustre","times"), [] -> sov (hd vel) ^ " * " ^ sov (hd (tl vel))
- | ("Lustre","rtimes"), [] -> sov (hd vel) ^ " * " ^ sov (hd (tl vel))
- | ("Lustre","itimes"), [] -> sov (hd vel) ^ " * " ^ sov (hd (tl vel))
- | ("Lustre","slash"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
- | ("Lustre","rslash"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
- | ("Lustre","islash"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
-
- | ("Lustre","impl"), [] -> sov (hd vel) ^ " => " ^ sov (hd (tl vel))
- | ("Lustre","mod"), [] -> sov (hd vel) ^ " mod " ^ sov (hd (tl vel))
-
- | ("Lustre","and"), [] -> sov (hd vel) ^ " and " ^ sov (hd (tl vel))
- | ("Lustre","or"), [] -> sov (hd vel) ^ " or " ^ sov (hd (tl vel))
- | ("Lustre","xor"), [] -> sov (hd vel) ^ " xor " ^ sov (hd (tl vel))
-
- | ("Lustre","if"), [] ->
+ ^ ">>" ^ (tuple_par vel)))
+
+ | CALL nee, _ -> (
+ if nee.it.def_eff = ExternEff then
+ if !Global.lv4 then
+ (match nee.it.node_key_eff with
+ (* predef op that are iterated are translated into node_exp ;
+ hence, we need to do (again) a particular threatment to have
+ a node ouput (i.e., "2>a" vs "Lustre::lt(2,a)" *)
+ | ("Lustre","uminus"), [] -> " -" ^ sov (hd vel)
+ | ("Lustre","iuminus"), [] -> " -" ^ sov (hd vel)
+ | ("Lustre","ruminus"), [] -> " -" ^ sov (hd vel)
+ | ("Lustre","not"), [] -> " not " ^ sov (hd vel)
+
+ | ("Lustre","lt"), [] -> sov (hd vel) ^ " < " ^ sov (hd (tl vel))
+ | ("Lustre","lte"), [] -> sov (hd vel) ^ " <= " ^ sov (hd (tl vel))
+ | ("Lustre","gt"), [] -> sov (hd vel) ^ " > " ^ sov (hd (tl vel))
+ | ("Lustre","gte"), [] -> sov (hd vel) ^ " >= " ^ sov (hd (tl vel))
+ | ("Lustre","eq"), [] -> sov (hd vel) ^ " = " ^ sov (hd (tl vel))
+ | ("Lustre","neq"), [] -> sov (hd vel) ^ " <> " ^ sov (hd (tl vel))
+ | ("Lustre","diff"), [] -> sov (hd vel) ^ " <> " ^ sov (hd (tl vel))
+ | ("Lustre","plus"), [] -> sov (hd vel) ^ " + " ^ sov (hd (tl vel))
+ | ("Lustre","iplus"), [] -> sov (hd vel) ^ " + " ^ sov (hd (tl vel))
+ | ("Lustre","rplus"), [] -> sov (hd vel) ^ " + " ^ sov (hd (tl vel))
+ | ("Lustre","minus"), [] -> sov (hd vel) ^ " - " ^ sov (hd (tl vel))
+ | ("Lustre","iminus"), [] -> sov (hd vel) ^ " - " ^ sov (hd (tl vel))
+ | ("Lustre","rminus"), [] -> sov (hd vel) ^ " - " ^ sov (hd (tl vel))
+ | ("Lustre","div"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
+ | ("Lustre","idiv"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
+ | ("Lustre","rdiv"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
+ | ("Lustre","times"), [] -> sov (hd vel) ^ " * " ^ sov (hd (tl vel))
+ | ("Lustre","rtimes"), [] -> sov (hd vel) ^ " * " ^ sov (hd (tl vel))
+ | ("Lustre","itimes"), [] -> sov (hd vel) ^ " * " ^ sov (hd (tl vel))
+ | ("Lustre","slash"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
+ | ("Lustre","rslash"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
+ | ("Lustre","islash"), [] -> sov (hd vel) ^ " / " ^ sov (hd (tl vel))
+
+ | ("Lustre","impl"), [] -> sov (hd vel) ^ " => " ^ sov (hd (tl vel))
+ | ("Lustre","mod"), [] -> sov (hd vel) ^ " mod " ^ sov (hd (tl vel))
+
+ | ("Lustre","and"), [] -> sov (hd vel) ^ " and " ^ sov (hd (tl vel))
+ | ("Lustre","or"), [] -> sov (hd vel) ^ " or " ^ sov (hd (tl vel))
+ | ("Lustre","xor"), [] -> sov (hd vel) ^ " xor " ^ sov (hd (tl vel))
+
+ | ("Lustre","if"), [] ->
" if " ^ sov (hd vel) ^ " then " ^ sov (hd (tl vel))
^ " else " ^ sov (hd (tl (tl vel)))
- | _ ->
- ((string_of_node_key_iter nee.it.node_key_eff) ^ (tuple_par vel))
- )
- else
- ((string_of_node_key_iter nee.it.node_key_eff) ^ (tuple_par vel))
- else
- (* recursive node cannot be extern *)
- ((string_of_node_key_rec nee.it.node_key_eff) ^ (tuple_par vel))
- )
- | IDENT idref, _ -> Ident.string_of_idref idref
- | PRE, _ -> "pre " ^ (tuple_par vel)
- | ARROW, [ve1; ve2] ->
- (if is_a_tuple ve1 then tuple_par [ve1] else string_of_val_exp_eff ve1) ^
+ | _ ->
+ ((string_of_node_key_iter nee.it.node_key_eff) ^ (tuple_par vel))
+ )
+ else
+ ((string_of_node_key_iter nee.it.node_key_eff) ^ (tuple_par vel))
+ else
+ (* recursive node cannot be extern *)
+ ((string_of_node_key_rec nee.it.node_key_eff) ^ (tuple_par vel))
+ )
+ | IDENT idref, _ -> Ident.string_of_idref idref
+ | PRE, _ -> "pre " ^ (tuple_par vel)
+ | ARROW, [ve1; ve2] ->
+ (if is_a_tuple ve1 then tuple_par [ve1] else string_of_val_exp_eff ve1) ^
" -> " ^
(if is_a_tuple ve1 then tuple_par [ve2] else string_of_val_exp_eff ve2)
- | FBY, [ve1; ve2] ->
+ | FBY, [ve1; ve2] ->
if !Global.lv4 then
(if is_a_tuple ve1 then tuple_par [ve1] else string_of_val_exp_eff ve1)
^ " -> pre " ^
(if is_a_tuple ve1 then tuple_par [ve2] else string_of_val_exp_eff ve2)
else
- (if is_a_tuple ve1 then tuple_par [ve1] else string_of_val_exp_eff ve1)
+ (if is_a_tuple ve1 then tuple_par [ve1] else string_of_val_exp_eff ve1)
^ " fby " ^
(if is_a_tuple ve1 then tuple_par [ve2] else string_of_val_exp_eff ve2)
- | WHEN clk, vel -> (tuple vel) ^ (string_of_clock_exp clk)
+ | WHEN clk, vel -> (tuple vel) ^ (string_of_clock_exp clk)
- | CURRENT,_ -> "current " ^ tuple_par vel
- | TUPLE,_ -> (tuple vel)
- | WITH(ve),_ -> (string_of_val_exp_eff ve)
- | CONCAT, [ve1; ve2] ->
- (string_of_val_exp_eff ve1) ^ " | " ^ (string_of_val_exp_eff ve2)
- | HAT (i, ve), _ -> (string_of_val_exp_eff ve) ^ "^" ^ (string_of_int i)
- | ARRAY vel, _ -> tuple_square vel
- | STRUCT_ACCESS(id), [ve1] ->
- (string_of_val_exp_eff ve1) ^ "." ^ (Ident.to_string id)
+ | CURRENT,_ -> "current " ^ tuple_par vel
+ | TUPLE,_ -> (tuple vel)
+ | WITH(ve),_ -> (string_of_val_exp_eff ve)
+ | CONCAT, [ve1; ve2] ->
+ (string_of_val_exp_eff ve1) ^ " | " ^ (string_of_val_exp_eff ve2)
+ | HAT (i, ve), _ -> (string_of_val_exp_eff ve) ^ "^" ^ (string_of_int i)
+ | ARRAY vel, _ -> tuple_square vel
+ | STRUCT_ACCESS(id), [ve1] ->
+ (string_of_val_exp_eff ve1) ^ "." ^ (Ident.to_string id)
- | ARRAY_ACCES(i), [ve1] ->
- (string_of_val_exp_eff ve1) ^ "[" ^ (string_of_int i) ^ "]"
+ | ARRAY_ACCES(i), [ve1] ->
+ (string_of_val_exp_eff ve1) ^ "[" ^ (string_of_int i) ^ "]"
- | ARRAY_SLICE(si_eff), [ve1] ->
- (string_of_val_exp_eff ve1) ^ (string_of_slice_info_eff si_eff)
+ | ARRAY_SLICE(si_eff), [ve1] ->
+ (string_of_val_exp_eff ve1) ^ (string_of_slice_info_eff si_eff)
- | ARRAY_SLICE(_), _ -> assert false (* todo *)
- | MERGE _, _ -> assert false (* todo *)
- (* | ITERATOR _, _ -> assert false (* todo *) *)
+ | ARRAY_SLICE(_), _ -> assert false (* todo *)
+ | MERGE _, _ -> assert false (* todo *)
+ (* | ITERATOR _, _ -> assert false (* todo *) *)
(* Cannot happen *)
- | ARROW, _ -> assert false
- | FBY, _ -> assert false
- | CONCAT, _ -> assert false
- | STRUCT_ACCESS(_), _ -> assert false
- | ARRAY_ACCES(i), _ -> assert false
+ | ARROW, _ -> assert false
+ | FBY, _ -> assert false
+ | CONCAT, _ -> assert false
+ | STRUCT_ACCESS(_), _ -> assert false
+ | ARRAY_ACCES(i), _ -> assert false
in
let do_not_parenthesize = function
| IDENT _,_
@@ -516,7 +522,7 @@ and string_of_val_exp_eff_core ve_core =
| CallByNameEff(by_name_op_eff, fl) ->
(match by_name_op_eff.it with
- | STRUCT (pn,idref) -> prefix ^ (
+ | STRUCT (pn,idref) -> prefix ^ (
match Ident.pack_of_idref idref with
| Some pn ->
Ident.string_of_idref idref
@@ -524,16 +530,16 @@ and string_of_val_exp_eff_core ve_core =
let idref = Ident.make_idref pn (Ident.of_idref idref) in
Ident.string_of_idref idref
)
- | STRUCT_anonymous -> "") ^
- "{" ^ (String.concat ";"
- (List.map
- (fun (id,veff) ->
- let str = string_of_val_exp_eff veff in
- (Ident.to_string id.it) ^ "=" ^
- (if is_a_tuple veff then ("("^ str^")") else str)
- )
- fl)) ^
- "}"
+ | STRUCT_anonymous -> "") ^
+ "{" ^ (String.concat ";"
+ (List.map
+ (fun (id,veff) ->
+ let str = string_of_val_exp_eff veff in
+ (Ident.to_string id.it) ^ "=" ^
+ (if is_a_tuple veff then ("("^ str^")") else str)
+ )
+ fl)) ^
+ "}"
and wrap_long_line str =
@@ -541,17 +547,17 @@ and wrap_long_line str =
let str_list = Str.split (Str.regexp " ") str in
let new_str, reste =
List.fold_left
- (fun (accl, acc_str) str ->
- let new_acc_str = acc_str ^ " " ^ str in
- if
- String.length new_acc_str > 75
- then
- (accl ^ acc_str ^ "\n\t" , str)
- else
- (accl, new_acc_str)
- )
- ("","")
- str_list
+ (fun (accl, acc_str) str ->
+ let new_acc_str = acc_str ^ " " ^ str in
+ if
+ String.length new_acc_str > 75
+ then
+ (accl ^ acc_str ^ "\n\t" , str)
+ else
+ (accl, new_acc_str)
+ )
+ ("","")
+ str_list
in
new_str ^ " " ^ reste
@@ -577,8 +583,8 @@ and wrap_long_profile str =
if String.length str < 75 then str else
"\n"^(
Str.global_replace (Str.regexp "returns") "\nreturns"
- (Str.global_replace (Str.regexp "(") "(\n\t"
- (Str.global_replace (Str.regexp "; ") ";\n\t" str)))
+ (Str.global_replace (Str.regexp "(") "(\n\t"
+ (Str.global_replace (Str.regexp "; ") ";\n\t" str)))
and (profile_of_node_exp_eff: Eff.node_exp -> string) =
fun neff ->
@@ -590,9 +596,9 @@ and (string_of_node_def : Eff.node_def -> string list) =
| ExternEff
| AbstractEff _ -> []
| BodyEff node_body_eff ->
- List.append
- (List.map string_of_assert node_body_eff.asserts_eff)
- (List.map string_of_eq node_body_eff.eqs_eff)
+ List.append
+ (List.map string_of_assert node_body_eff.asserts_eff)
+ (List.map string_of_eq node_body_eff.eqs_eff)
@@ -604,9 +610,9 @@ and (type_decl: Ident.long -> Eff.type_ -> string) =
| Enum_type_eff (_) ->
if !Global.expand_enums then ";\n" else
" = " ^ (string_def_of_type_eff teff) ^ ";\n"
- | External_type_eff (_)
- | Abstract_type_eff(_,External_type_eff (_)) -> ";\n"
- | _ -> " = " ^ (string_def_of_type_eff teff) ^ ";\n"
+ | External_type_eff (_)
+ | Abstract_type_eff(_,External_type_eff (_)) -> ";\n"
+ | _ -> " = " ^ (string_def_of_type_eff teff) ^ ";\n"
)
(* exported *)
@@ -631,6 +637,9 @@ and (const_decl: Ident.long -> Eff.const -> string) =
| Bool_const_eff _
| Int_const_eff _
| Real_const_eff _ -> begin_str ^ " = " ^ end_str
+ | Tuple_const_eff _ ->
+ print_internal_error "LicDump.const_decl" "should not have been called for a tuple";
+ assert false
)
@@ -652,17 +661,17 @@ and (node_of_node_exp_eff: Eff.node_exp -> string) =
(string_of_node_key_rec neff.node_key_eff) ^
(profile_of_node_exp_eff neff)) ^
(match neff.def_eff with
- | ExternEff -> ""
- | AbstractEff _ -> ""
- | BodyEff _ ->
- ((match neff.loclist_eff with None -> "" | Some [] -> ""
- | Some l ->
- "var\n " ^ (string_of_type_decl_list l ";\n ") ^ ";\n") ^
- "let\n " ^
- (String.concat "\n " (string_of_node_def neff.def_eff)) ^
- "\ntel\n-- end of node " ^
- (string_of_node_key_rec neff.node_key_eff) ^ "\n"
- )
+ | ExternEff -> ""
+ | AbstractEff _ -> ""
+ | BodyEff _ ->
+ ((match neff.loclist_eff with None -> "" | Some [] -> ""
+ | Some l ->
+ "var\n " ^ (string_of_type_decl_list l ";\n ") ^ ";\n") ^
+ "let\n " ^
+ (String.concat "\n " (string_of_node_def neff.def_eff)) ^
+ "\ntel\n-- end of node " ^
+ (string_of_node_key_rec neff.node_key_eff) ^ "\n"
+ )
)
diff --git a/src/licPrg.ml b/src/licPrg.ml
new file mode 100644
index 00000000..64faca01
--- /dev/null
+++ b/src/licPrg.ml
@@ -0,0 +1,66 @@
+
+(* Réorganisation de la compil :
+ Un LicPrg est :
+ - un programme Lustre SIMPLE, vérifié et cohérent,
+ Ã base de Eff.xx
+ - du lv6, on passe à LicPrg via LazyCompiler, qui fait
+ UNIQUEMENT le boulot de base :
+ * dé-packaging
+ * résolution de l'ordre sup statique, y compris la
+ récursion, en tirant "le fil" du main node
+ * SAUF pour les macros prédéfinies (non-programmables)
+ * résolution de la surcharge
+ - les transformations (expansions etc.) qui étaient faites
+ dans LazyCompiler sont (appelées à devenir) des phases
+ apr coup du type LicPrg -> LicPrg
+*)
+(*
+ Pas très différent des infos de LazyCompiler.t
+ Sauf que on utilise des map
+
+*)
+
+module ItemKeyMap = struct
+ include Map.Make (
+ struct
+ type t = Eff.item_key
+ let compare = compare
+ end
+ )
+ let dummy () = "dummy item: add things below to complete the module"
+end
+
+module NodeKeyMap = struct
+ include Map.Make (
+ struct
+ type t = Eff.node_key
+ let compare = compare
+ end
+ )
+ let dummy () = "dummy item: add things below to complete the module"
+end
+
+type t = {
+ types : Eff.type_ ItemKeyMap.t;
+ consts : Eff.const ItemKeyMap.t;
+ nodes : Eff.node_exp NodeKeyMap.t;
+ (* consts : (Eff.item_key, Eff.const Eff.check_flag) Hashtbl.t; *)
+ (* nodes : (Eff.node_key, Eff.node_exp Eff.check_flag) Hashtbl.t; *)
+}
+
+let empty = {
+ types = ItemKeyMap.empty;
+ consts = ItemKeyMap.empty;
+ nodes = NodeKeyMap.empty
+}
+
+let add_type (k:Eff.item_key) (v:Eff.type_) (prg:t) : t =
+ { prg with types = ItemKeyMap.add k v prg.types }
+
+let add_const (k:Eff.item_key) (v:Eff.const) (prg:t) : t =
+ { prg with consts = ItemKeyMap.add k v prg.consts }
+
+let add_node (k:Eff.node_key) (v:Eff.node_exp) (prg:t) : t =
+ { prg with nodes = NodeKeyMap.add k v prg.nodes }
+
+
diff --git a/src/main.ml b/src/main.ml
index 96bdec1f..6d31f2cf 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -147,8 +147,8 @@ let rec arg_list = [
"\n\t Generate ec (actually just an alias for '-en -lv4 --no-prefix')."
);
- ( "--no-prefix", Arg.Unit
- (fun _ -> Global.no_prefix := true),
+ ( "-np", Arg.Set Global.no_prefix, "");
+ ( "--no-prefix", Arg.Set Global.no_prefix,
"\n\t Do not prefix variable names by their module (beware: variable names may clash with this option)."
);
diff --git a/src/predefEvalClock.ml b/src/predefEvalClock.ml
index 6c91c7b8..851dec63 100644
--- a/src/predefEvalClock.ml
+++ b/src/predefEvalClock.ml
@@ -34,6 +34,14 @@ let if_clock_profile lxm sargs s =
let rec fill x n = if n > 0 then (x::(fill x (n-1))) else []
+
+(* ICI : je comprends rien à ce que ca fait ??? *)
+let condact_clock_profile lxm sargs s clks =
+ let (_, lto) = PredefEvalType.condact_profile lxm sargs in
+ let clks = List.flatten clks in
+ fill (List.hd clks) (List.length lto), s
+
+
let fillred_clock_profile lxm sargs s clks =
let (_, lto) = PredefEvalType.fillred_profile lxm sargs in
let clks = List.flatten clks in
@@ -70,6 +78,7 @@ let (f: op -> Lxm.t -> Eff.static_arg list -> clocker) =
| Red | Fill | FillRed -> fillred_clock_profile lxm sargs s
| Map -> map_clock_profile lxm sargs s
| BoolRed -> boolred_clock_profile lxm sargs s
+ | CondAct -> condact_clock_profile lxm sargs s
diff --git a/src/predefEvalConst.ml b/src/predefEvalConst.ml
index 868afad5..aa055750 100644
--- a/src/predefEvalConst.ml
+++ b/src/predefEvalConst.ml
@@ -163,6 +163,7 @@ let (f: op -> Lxm.t -> Eff.static_arg list -> const_evaluator) =
| RTIMES_n -> fff_evaluator ( *.) ll
| NOR_n -> boolred_evaluator 0 0 ll
| DIESE_n -> boolred_evaluator 1 1 ll
+ | CondAct -> assert false
| Map -> assert false
| Fill -> assert false
| Red -> assert false
diff --git a/src/predefEvalType.ml b/src/predefEvalType.ml
index 418b4fc6..9580b201 100644
--- a/src/predefEvalType.ml
+++ b/src/predefEvalType.ml
@@ -5,6 +5,7 @@ open Lxm
open Errors
open UnifyType
open Eff
+open LicDump
(* exported *)
type typer = Eff.type_ Predef.evaluator
@@ -31,11 +32,10 @@ let (type_error2 : string -> string -> string -> 'a) =
else (" whereas\n*** type '" ^expect^"' was expected")) ^
(if msg = "" then "" else ("\n*** " ^ msg)))))
-let (arity_error : 'a list -> string -> 'b) =
- fun v expect ->
+let arity_error (msg:string) (get:int) (expect:int) =
raise (EvalType_error(
- Printf.sprintf "\n*** arity error: %d argument%s, whereas %s were expected"
- (List.length v) (if List.length v>1 then "s" else "") expect))
+ Printf.sprintf "\n*** arity error%s: %d argument%s, whereas %d were expected"
+ msg get (if get>1 then "s" else "") expect))
(*********************************************************************************)
(* a few local alias to make the node profile below more readable. *)
@@ -106,6 +106,7 @@ let get_id_type vi = vi.var_name_eff, vi.var_type_eff
let condact_profile (lxm: Lxm.t) (sargs: Eff.static_arg list) : Eff.node_profile =
+try
(* Given
- a node n of type: tau_1 * ... * tau_n -> teta_1 * ... * teta_l
- a (tuple) constant dflt : teta_1 * ... * teta_l
@@ -113,11 +114,32 @@ let condact_profile (lxm: Lxm.t) (sargs: Eff.static_arg list) : Eff.node_profile
bool * tau_1 * ... * tau_n -> teta_1 * ... * teta_l
*)
let n, inlist, outlist, dflt =
- match sargs with
- [NodeStaticArgEff(_,((n,_), inlist, outlist), _);
- ConstStaticArgEff(_,dflt)] -> n, inlist, outlist, dflt in
- assert false
-
+ match sargs with
+ | [NodeStaticArgEff(_,((n,_), inlist, outlist), _);
+ ConstStaticArgEff(_,dflt)] -> n, inlist, outlist, dflt
+ | _ -> assert false
+ in
+
+ (* dflt_types doit êre compatiple avec outlist *)
+ let dflt_types = types_of_const dflt in
+ let dl = List.length dflt_types in
+ let ol = List.length outlist in
+ Verbose.printf ~level:3 " condact_profile: dflt=%s\n" (string_of_const_eff dflt);
+ let _ = if (dl <> ol) then
+ arity_error " in condact default arg" dl ol in
+ let out_types = List.map (fun x -> x.var_type_eff) outlist in
+
+ let _ = if dflt_types <> out_types then
+ type_error2
+ (LicDump.type_eff_list_to_string dflt_types)
+ (LicDump.type_eff_list_to_string out_types)
+ "in condact default arg"
+ in
+ (* ok pour les args statiques, le profil dynamique est : *)
+ (("_", Bool_type_eff)::(List.map get_id_type inlist), List.map get_id_type outlist)
+with
+| EvalType_error msg -> raise (Compile_error(lxm, "type error: "^msg))
+
let map_profile (lxm: Lxm.t) (sargs: Eff.static_arg list) : Eff.node_profile =
(* Given
@@ -215,6 +237,7 @@ let (op2profile : Predef.op -> Lxm.t -> Eff.static_arg list -> Eff.node_profile)
| Red | Fill | FillRed -> fillred_profile lxm sargs
| Map -> map_profile lxm sargs
| BoolRed -> boolred_profile lxm sargs
+ | CondAct -> condact_profile lxm sargs
| NOR_n | DIESE_n -> assert false
(* XXX The current representation of node_profile prevent us
@@ -281,7 +304,7 @@ let (f : op -> Lxm.t -> Eff.static_arg list -> typer) =
| [[Bool_type_eff]; t; e] ->
if t = e then t else
(type_error (List.flatten [[Bool_type_eff]; t; e]) "bool*any*any")
- | x -> (arity_error x "3")
+ | x -> (arity_error "" (List.length x) 3)
)
| (NOR_n | DIESE_n) ->
(* VERRUE 2 : cf XXX above: therefore i define an ad-hoc
@@ -299,7 +322,7 @@ let (f : op -> Lxm.t -> Eff.static_arg list -> typer) =
and lto = List.map (fun v -> v.var_type_eff) node_eff.outlist_eff in
let l = List.flatten ll in
if (List.length l <> List.length lti) then
- arity_error [l] (string_of_int (List.length lti))
+ arity_error "" (List.length l) (List.length lti)
else
match UnifyType.f lti l with
| Equal -> lto
diff --git a/src/predefEvalType.mli b/src/predefEvalType.mli
index b4034a45..deeaa955 100644
--- a/src/predefEvalType.mli
+++ b/src/predefEvalType.mli
@@ -4,7 +4,7 @@ type typer = Eff.type_ Predef.evaluator
exception EvalType_error of string
val type_error : Eff.type_ list -> string -> 'a
-val arity_error : 'a list -> string -> 'b
+val arity_error : string -> int -> int -> 'b
(* Provides the type profile of predef operators. More precisely, given an operator
diff --git a/src/syntaxTreeDump.ml b/src/syntaxTreeDump.ml
index de36de22..a50ced95 100644
--- a/src/syntaxTreeDump.ml
+++ b/src/syntaxTreeDump.ml
@@ -506,24 +506,45 @@ and dump_node_exp
fprintf os "%s" (Ident.string_of_idref id) ;
( match sal with
[] -> ()
- | lst -> (fprintf os "<< @,%a@, >>" dump_static_arg_list lst)
+ | lst -> (fprintf os "<< @,%a@, >>" dump_static_sarg_list lst)
)
+and dump_static_sarg_list
+ (os : Format.formatter)
+ (lst: (static_arg srcflagged) list)
+ = (
+ match lst with
+ | [] -> ()
+ | [sa] -> fprintf os "%a" dump_static_sarg sa.it
+ | sa::reste ->
+ fprintf os "%a, @,%a" dump_static_sarg sa.it dump_static_sarg_list reste
+ )
+and dump_static_sarg
+ (os : Format.formatter)
+ (sa: static_arg)
+ =
+ match sa with
+ | 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
+ | StaticArgNode op -> fprintf os "node %s" (op2string op)
+
and dump_static_arg_list
(os : Format.formatter)
(lst: (Ident.t * static_arg srcflagged) list)
= (
match lst with
| [] -> ()
- | [sa] -> fprintf os "%a" dump_static_arg sa.it
+ | [sa] -> fprintf os "%a" dump_static_arg sa
| sa::reste ->
- fprintf os "%a, @,%a" dump_static_arg sa.it dump_static_arg_list reste
+ fprintf os "%a, @,%a" dump_static_arg sa dump_static_arg_list reste
)
and dump_static_arg
(os : Format.formatter)
- ((id,sa): Ident.t * static_arg)
- = (Ident.to_string id) ^ " = " ^
- match sa with
+ ((id,sa): Ident.t * static_arg srcflagged)
+ =
+ fprintf os "%s = " (Ident.to_string id);
+ match sa.it with
| 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
@@ -637,3 +658,9 @@ let modelinfo (os: Format.formatter) (mf: SyntaxTree.model_info srcflagged) = (
Format.fprintf os "@]@."
)
+let print_val_exp oc ve =
+ let os = Format.formatter_of_out_channel oc in
+ dump_val_exp os ve;
+ pp_print_flush os ()
+
+
diff --git a/src/syntaxTreeDump.mli b/src/syntaxTreeDump.mli
index b48fe992..e8461eb1 100644
--- a/src/syntaxTreeDump.mli
+++ b/src/syntaxTreeDump.mli
@@ -11,6 +11,7 @@ val op2string : SyntaxTreeCore.by_pos_op -> string
(**/**)
+val print_val_exp : out_channel -> SyntaxTreeCore.val_exp -> unit
val dump_val_exp : Format.formatter -> SyntaxTreeCore.val_exp -> unit
val dump_type_exp : Format.formatter -> SyntaxTreeCore.type_exp -> unit
-val dump_static_arg : Format.formatter -> SyntaxTreeCore.static_arg -> unit
+val dump_static_arg : Format.formatter -> Ident.t * SyntaxTreeCore.static_arg Lxm.srcflagged -> unit
diff --git a/src/unifyClock.ml b/src/unifyClock.ml
index 57c20b98..2b7e6e85 100644
--- a/src/unifyClock.ml
+++ b/src/unifyClock.ml
@@ -331,3 +331,7 @@ let rec (const_to_val_eff: Lxm.t -> bool -> subst -> const -> subst * val_exp) =
typ = [stype] ;
clk = [BaseEff]
}
+ | Tuple_const_eff _ ->
+ print_internal_error "UnifyClock.const_to_val_eff" "should not have been called for a tuple";
+ assert false
+
diff --git a/tests/Makefile b/tests/Makefile
index d6c715fc..76846b34 100644
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -113,7 +113,7 @@ test_lv4:
for d in ${OK_LUS}; do \
/bin/echo -e "\n$(NL)====> $(LC0) --nonreg-test -lv4 $$d -o /tmp/xx.lus" >> test_lv4.res; \
$(LC0) --nonreg-test -lv4 $$d -o /tmp/xx.lus >> test_lv4.res 2>&1 ;\
- if [ ! -f /tmp/xx.lus ]; then echo "Error: no /tmp/xx.lus file" >> test_lv4.res ; fi ;\
+ if [ ! -f /tmp/xx.lus ]; then echo "Error $$d: no /tmp/xx.lus file" >> test_lv4.res 2>&1; fi ;\
for node in `lusinfo /tmp/xx.lus nodes`; do \
/bin/echo -e "lus2ec /tmp/xx.lus $$node" >> test_lv4.res; \
(lus2ec /tmp/xx.lus $$node >> \
diff --git a/tests/test.res.exp b/tests/test.res.exp
index c268067b..7ae59d23 100644
--- a/tests/test.res.exp
+++ b/tests/test.res.exp
@@ -31,6 +31,7 @@ where [options] can be:
--expanded-code
-ec
Generate ec (actually just an alias for '-en -lv4 --no-prefix').
+ -np
--no-prefix
Do not prefix variable names by their module (beware: variable names may clash with this option).
--test-lexer Internal option used to test the lexer
diff --git a/tests/test_lv4.res.exp b/tests/test_lv4.res.exp
index 52da0e28..6d7b4e66 100644
--- a/tests/test_lv4.res.exp
+++ b/tests/test_lv4.res.exp
@@ -364,7 +364,7 @@ lus2ec /tmp/xx.lus long_et_stupide_nom_de_noeud__long_et_stupide_nom_de_noeud
*** Error in file "merge.lus", line 7, col 15 to 17, token 'clk':
*** syntax error
-Error: no /tmp/xx.lus file
+Error should_work/NONREG/merge.lus: no /tmp/xx.lus file
----------------------------------------------------------------------
====> ../objlinux/lus2lic --nonreg-test -lv4 should_work/NONREG/minmax1.lus -o /tmp/xx.lus
@@ -1003,7 +1003,7 @@ lus2ec /tmp/xx.lus mainPack__preced
*** Error in file "pfs.lus", line 43, col 22 to 22, token '[':
*** syntax error
-Error: no /tmp/xx.lus file
+Error should_work/Pascal/pfs.lus: no /tmp/xx.lus file
----------------------------------------------------------------------
====> ../objlinux/lus2lic --nonreg-test -lv4 should_work/Pascal/struct.lus -o /tmp/xx.lus
@@ -1154,12 +1154,12 @@ lus2ec /tmp/xx.lus clock_ite__clock
----------------------------------------------------------------------
====> ../objlinux/lus2lic --nonreg-test -lv4 should_work/clock/when_enum.lus -o /tmp/xx.lus
Error. *** Cannot generate V4 style Lustre for programs with enumerated clocks (yet), sorry.
-Error: no /tmp/xx.lus file
+Error should_work/clock/when_enum.lus: no /tmp/xx.lus file
----------------------------------------------------------------------
====> ../objlinux/lus2lic --nonreg-test -lv4 should_work/clock/when_node.lus -o /tmp/xx.lus
Error. *** Cannot generate V4 style Lustre for programs with enumerated clocks (yet), sorry.
-Error: no /tmp/xx.lus file
+Error should_work/clock/when_node.lus: no /tmp/xx.lus file
----------------------------------------------------------------------
====> ../objlinux/lus2lic --nonreg-test -lv4 should_work/clock/when_not.lus -o /tmp/xx.lus
@@ -1170,7 +1170,7 @@ Error: no /tmp/xx.lus file
*** on clock4_u on base
-Error: no /tmp/xx.lus file
+Error should_work/clock/when_not.lus: no /tmp/xx.lus file
----------------------------------------------------------------------
====> ../objlinux/lus2lic --nonreg-test -lv4 should_work/clock/when_tuple.lus -o /tmp/xx.lus
@@ -1776,7 +1776,7 @@ lus2ec /tmp/xx.lus arrays__add_byte
*** Error in file "bug.lus", line 2, col 6 to 10, token 'pack1':
*** unknown package
-Error: no /tmp/xx.lus file
+Error should_work/lionel/bug.lus: no /tmp/xx.lus file
----------------------------------------------------------------------
====> ../objlinux/lus2lic --nonreg-test -lv4 should_work/lionel/calculs_max.lus -o /tmp/xx.lus
@@ -2192,7 +2192,7 @@ lus2ec /tmp/xx.lus noeudsIndependants__gt
----------------------------------------------------------------------
====> ../objlinux/lus2lic --nonreg-test -lv4 should_work/packEnvTest/contractForElementSelectionInArray/packageTableau.lus -o /tmp/xx.lus
Error. No package has been provided
-Error: no /tmp/xx.lus file
+Error should_work/packEnvTest/contractForElementSelectionInArray/packageTableau.lus: no /tmp/xx.lus file
----------------------------------------------------------------------
====> ../objlinux/lus2lic --nonreg-test -lv4 should_work/packEnvTest/contractForElementSelectionInArray/tri.lus -o /tmp/xx.lus
--
GitLab