From 712306a51d8a092663dbc0b7400eb3461a7923bb Mon Sep 17 00:00:00 2001
From: Pascal Raymond <pascal.raymond@univ-grenoble-alpes.fr>
Date: Fri, 3 May 2019 15:55:34 +0200
Subject: [PATCH] fichier dbg.ml + un peu de debug + bug type_of_const sur le
tableaux immediats
---
_oasis | 2 +-
src/astV6Dump.ml | 29 +++++++++++++++++++++++++----
src/astV6Dump.mli | 1 +
src/dbg.ml | 26 ++++++++++++++++++++++++++
src/evalConst.ml | 21 +++++++++++++++++++--
src/lic.ml | 3 ++-
src/licTab.ml | 3 ++-
src/lxm.ml | 6 ++++++
src/lxm.mli | 1 +
9 files changed, 83 insertions(+), 9 deletions(-)
create mode 100755 src/dbg.ml
diff --git a/_oasis b/_oasis
index 09b36e98..a8ce1f72 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 2f755c70..4110efeb 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 1fa16ce2..70cf0e7b 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 00000000..b9247c90
--- /dev/null
+++ b/src/dbg.ml
@@ -0,0 +1,26 @@
+
+(*
+ 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
+*)
+
+(* 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 47aa2530..789d4b7f 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 89db4579..228e9f1a 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 19f3a132..40b7cace 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 d94fc38d..a9249e8b 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 e417cdc9..30aa95f6 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
--
GitLab