diff --git a/_oasis b/_oasis
index cb33d6cb56355cf15b6e2919df07fc8cf44bf888..96a91bbec78e3e31a613ba011a9846738f0f4329 100644
--- a/_oasis
+++ b/_oasis
@@ -57,5 +57,5 @@ Library "lustre-v6"
BuildDepends: str,unix,num,rdbg-plugin (>= 1.177)
Install:true
XMETAEnable: true
- InternalModules: SocExecValue,SocUtils,Lv6util,Lv6version,Lv6errors,Lxm,Lv6MainArgs,Lv6Verbose,Soc2cIdent,Soc,SocPredef,Lv6Id,SocExecDbg,SocExec,SocExecEvalPredef,Lv6Compile,AstTab,AstTabSymbol,AstInstanciateModel,Lv6parserUtils,AstV6,FilenameExtras,LicTab,LicDump,AstPredef,Lic,AstCore,FreshName,IdSolver,EvalConst,LicEvalConst,LicEvalType,UnifyType,Ast2lic,AstV6Dump,EvalClock,UnifyClock,LicEvalClock,EvalType,LicPrg,LicMetaOp,L2lCheckOutputs,Lv6Misc,L2lRmPoly,L2lExpandMetaOp,L2lSplit,L2lExpandNodes,L2lExpandArrays,L2lCheckLoops,L2lCheckMemSafe,L2lOptimIte,Lv6lexer,Lv6parser,AstRecognizePredef,Lic2soc,Action,ActionsDeps,SocVar,TopoSort,SortActions,SortActionsExpe,L2lCheckCKeyWord,L2lCheckKcgKeyWord,L2lWhenOnId,L2lNoWhenNot,L2lRemoveAlias,L2lExpandEnum
+ InternalModules: SocExecValue,SocUtils,Lv6util,Lv6version,Lv6errors,Lxm,Lv6MainArgs,Lv6Verbose,Soc2cIdent,Soc,SocPredef,Lv6Id,SocExecDbg,SocExec,SocExecEvalPredef,Lv6Compile,AstTab,AstTabSymbol,AstInstanciateModel,Lv6parserUtils,AstV6,FilenameExtras,LicTab,LicDump,AstPredef,Lic,AstCore,FreshName,IdSolver,EvalConst,LicEvalConst,LicEvalType,UnifyType,Ast2lic,AstV6Dump,EvalClock,UnifyClock,LicEvalClock,EvalType,LicPrg,LicMetaOp,L2lCheckOutputs,Lv6Misc,L2lRmPoly,L2lExpandMetaOp,L2lSplit,L2lExpandNodes,L2lExpandArrays,L2lCheckLoops,L2lCheckMemSafe,L2lOptimIte,Lv6lexer,Lv6parser,AstRecognizePredef,Lic2soc,Action,ActionsDeps,SocVar,TopoSort,SortActions,SortActionsExpe,L2lCheckCKeyWord,L2lCheckKcgKeyWord,L2lWhenOnId,L2lNoWhenNot,L2lRemoveAlias,L2lExpandEnum,Dbg
# Comment se passer de cette liste à la Prevert ?
diff --git a/src/astV6Dump.ml b/src/astV6Dump.ml
index 2f755c701563c9c9a8cae8a56cac94ade4b3723b..4110efeb0ae1bfc6c2d43d5325c54693b6bdca77 100644
--- a/src/astV6Dump.ml
+++ b/src/astV6Dump.ml
@@ -410,9 +410,9 @@ and dump_by_pos_exp (os: Format.formatter) (oper: by_pos_op) (pars: operands) =
| (GTE_n, Oper [p0;p1]) -> dump_binary_exp os ">=" p0 p1
| (DIV_n, Oper [p0;p1]) -> dump_binary_exp os "div" p0 p1
| (MOD_n, Oper [p0;p1]) -> dump_binary_exp os "mod" p0 p1
- | (MINUS_n, Oper [p0]) -> dump_unary_exp os "-" p0
- | (RMINUS_n, Oper [p0]) -> dump_unary_exp os "-" p0
- | (IMINUS_n, Oper [p0]) -> dump_unary_exp os "-" p0
+ | (MINUS_n, Oper [p0;p1]) -> dump_binary_exp os "-" p0 p1
+ | (RMINUS_n, Oper [p0;p1]) -> dump_binary_exp os "-" p0 p1
+ | (IMINUS_n, Oper [p0;p1]) -> dump_binary_exp os "-" p0 p1
| (PLUS_n, Oper [p0;p1]) -> dump_binary_exp os "+" p0 p1
| (RPLUS_n, Oper [p0;p1]) -> dump_binary_exp os "+" p0 p1
| (IPLUS_n, Oper [p0;p1]) -> dump_binary_exp os "+" p0 p1
@@ -425,7 +425,11 @@ and dump_by_pos_exp (os: Format.formatter) (oper: by_pos_op) (pars: operands) =
| (IF_n, Oper [p0;p1;p2]) -> dump_ternary_exp os "if" "then" "else" p0 p1 p2
| (NOR_n, Oper pl) -> dump_nary_exp os "nor" pl
| (DIESE_n, Oper pl) -> dump_nary_exp os "#" pl
- | (_,_) -> assert false
+ | (_,_) -> (
+ Lv6errors.print_internal_error "AstV6Dump.dump_by_pos_exp"
+ (Printf.sprintf "unexpected op '%s'" (AstPredef.op2string_long x.it));
+ assert false
+ )
)
| (HAT_n, Oper [p0;p1]) -> dump_binary_exp os "^" p0 p1
| (CONCAT_n, Oper [p0;p1]) -> dump_binary_exp os "|" p0 p1
@@ -674,3 +678,20 @@ let print_node_exp oc ne =
dump_node_exp os ne;
pp_print_flush os ()
+(* on one line for debug ... *)
+
+let print_short_val_exp oc ve =
+ let os = Format.formatter_of_out_channel oc in
+ let fof : Format.formatter_out_functions =
+ {
+ Format.out_string = (fun s p n -> output_string oc (String.sub s p n));
+ Format.out_newline = (fun () -> ());
+ Format.out_spaces = (fun _ -> ());
+ Format.out_indent = (fun _ -> ());
+ Format.out_flush = (fun () -> flush oc);
+ } in
+ Format.pp_set_formatter_out_functions os fof;
+ dump_val_exp os ve;
+ pp_print_flush os ()
+
+
diff --git a/src/astV6Dump.mli b/src/astV6Dump.mli
index 1fa16ce283dea5f9ac23ae874d6e59276abac668..70cf0e7b52c9ded71b00819bb74a8fe71a105425 100644
--- a/src/astV6Dump.mli
+++ b/src/astV6Dump.mli
@@ -16,6 +16,7 @@ val op2string : AstCore.by_pos_op -> string
(**/**)
val print_val_exp : out_channel -> AstCore.val_exp -> unit
+val print_short_val_exp : out_channel -> AstCore.val_exp -> unit
val print_node_exp : out_channel -> AstCore.node_exp -> unit
diff --git a/src/dbg.ml b/src/dbg.ml
new file mode 100755
index 0000000000000000000000000000000000000000..3a4f2b0b3e01e97028d60f3d646c15df7637f6f8
--- /dev/null
+++ b/src/dbg.ml
@@ -0,0 +1,28 @@
+
+(*
+ Idee:
+ - regrouper ici tout ce qui permet de faire du verbose/debug
+ et qui est diffus et pas toujours homogene.
+ - typiquement tous les print et to_string dont on a besoin
+ dans les Verbose
+ - autant que faire se peut, deux sortes de fonction :
+ * s_toto : toto -> string
+ * p_toto : toto -> unit
+ qui ecrit sur stderr par defaut, sur une ligne sans rc autant que possible
+
+ - a terme, mettre tout ce qu'il faut ici !
+*)
+
+(* affichage basique *)
+let cr ?(oc=stderr) () : unit = output_string oc "\n"
+let pf ?(oc=stderr) s = Printf.kprintf (fun t -> output_string oc t; flush oc) s
+
+(* lexical *)
+let s_lxm : Lxm.t -> string = Lxm.short_details
+
+(* ast *)
+let p_val_exp ?(oc=stderr) (ve:AstCore.val_exp) : unit = AstV6Dump.print_short_val_exp oc ve
+
+(* lic = ast semantique *)
+let s_const_eff : Lic.const -> string = LicDump.string_of_const_eff false
+let s_const_eff_list : Lic.const list -> string = LicDump.string_of_const_eff_list false
diff --git a/src/evalConst.ml b/src/evalConst.ml
index 47aa2530cdcd7ff8753eed1476e1e32aac81b148..789d4b7f8ce973423d77abc55ca20af91624f6d2 100644
--- a/src/evalConst.ml
+++ b/src/evalConst.ml
@@ -12,6 +12,8 @@ open AstPredef
open LicEvalConst
open LicEvalType
+let dbg = (Lv6Verbose.get_flag "eval-const")
+
(*----------------------------------------------------
EvalArray_error :
- levée par les fonctions dédiées aux tableaux
@@ -158,7 +160,8 @@ R
let rec f
(env : IdSolver.t)
(vexp : val_exp)
- = (
+ =
+(
(*-----------------------------------
fonction récursive principale
-> capte les nv
@@ -372,7 +375,21 @@ let rec f
(* Corps de la fonction principale *)
(*-------------------------------------*)
in
- rec_eval_const vexp
+
+ Lv6Verbose.exe ~flag:dbg (fun () ->
+ let lxm = lxm_of_val_exp vexp in
+ Dbg.pf "#CALL EvalConst.f '";
+ Dbg.p_val_exp vexp;
+ Dbg.pf "' %s\n" (Dbg.s_lxm lxm);
+ );
+ let res = rec_eval_const vexp in
+ Lv6Verbose.exe ~flag:dbg (fun () ->
+ let lxm = lxm_of_val_exp vexp in
+ Dbg.pf "#RET EvalConst.f '";
+ Dbg.p_val_exp vexp;
+ Dbg.pf " = %s\n" (Dbg.s_const_eff_list res)
+ );
+ res
) (* fin de f *)
(*---------------------------------------------------------------------
diff --git a/src/lic.ml b/src/lic.ml
index 89db457958bfd1417483860d653bf2606c91a9e7..228e9f1a98d4d9301cc6e8491b0f2ec1d530bca6 100644
--- a/src/lic.ml
+++ b/src/lic.ml
@@ -579,7 +579,8 @@ let (type_of_const: const -> type_) =
| Abstract_const_eff (s, teff, _v, _is_exported) -> teff
| Enum_const_eff (s, teff) -> teff
| Struct_const_eff (fl, teff) -> teff
- | Array_const_eff (ct, teff) -> teff (* Array_type_eff (teff, List.length ct) *)
+ (* | Array_const_eff (ct, teff) -> teff (* Array_type_eff (teff, List.length ct) *) *)
+ | Array_const_eff (ct, teff) -> Array_type_eff (teff, List.length ct)
| Tuple_const_eff cl ->
(* Utiliser plutot types_of_const (ci dessous) qui traite les tuples *)
print_internal_error "Lic.type_of_const" "should not have been called for a tuple";
diff --git a/src/licTab.ml b/src/licTab.ml
index 19f3a13268ee662d482e13992347f6853e45c197..40b7cace10a29a1b3a4e449d6ec148817108f306 100644
--- a/src/licTab.ml
+++ b/src/licTab.ml
@@ -966,7 +966,8 @@ and (node_check_interface_do: t -> Lic.node_key -> Lxm.t ->
let teff = Lic.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'"
+ lxmdef, Printf.sprintf
+ " this constant is declared as '%s' but evaluated as '%s'"
(Lic.string_of_type tdecl)
(Lic.string_of_type teff)
)))
diff --git a/src/lxm.ml b/src/lxm.ml
index d94fc38d3a4ae5c88e9b86d56e925a9e7d34f2ac..a9249e8be362c64c6a33a35ca53b1bb1ec2d3df0 100644
--- a/src/lxm.ml
+++ b/src/lxm.ml
@@ -40,6 +40,12 @@ let details lxm = (
Printf.sprintf "in file \"%s\", line %d, col %d to %d, token '%s'"
file lxm._line lxm._cstart lxm._cend lxm._str
)
+(* affichage compact: *)
+let short_details lxm = (
+ let file = Filename.basename lxm._file in
+ Printf.sprintf "f:%s, l:%d, c:%d-%d, t:'%s'"
+ file lxm._line lxm._cstart lxm._cend lxm._str
+)
let position lxm = (
Printf.sprintf "line:%d, col:%d to %d"
lxm._line lxm._cstart lxm._cend
diff --git a/src/lxm.mli b/src/lxm.mli
index e417cdc9e4b5133dd4d5428be4944da1d73e1785..30aa95f6da098759c39188d939c1deaf78b95d51 100644
--- a/src/lxm.mli
+++ b/src/lxm.mli
@@ -51,6 +51,7 @@ val last_made : unit -> t
(** Erreur/Warning printing *)
val details : t -> string
+val short_details : t -> string
(** prints something like: 'machin' (line:10, col:3 to 7) *)
val position : t -> string