Fix: array contant issue

Merge branch 'pascal01'

_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 ?

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 ()
+
+

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
 
 

src/dbg.ml

+
+(*
+   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

src/evalConst.ml

@@ -12,6 +12,8 @@ open AstPredef
 open LicEvalConst
 open LicEvalType
 
+let dbg = (Lv6Verbose.get_flag "eval-const")
+
 (*----------------------------------------------------
 EvalArray_error :
         - leve par les fonctions ddies aux tableaux
@@ -158,7 +160,8 @@ R
 let rec f
     (env : IdSolver.t) 
     (vexp : val_exp)
-    = (
+    =
+(
   (*-----------------------------------
     fonction rcursive 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 *)
 
 (*---------------------------------------------------------------------

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";

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)
                     )))

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

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