From ebb16cb1d318dc69208e346f0caab3a9eb92165d Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Thu, 8 Apr 2010 17:05:44 +0200
Subject: [PATCH] Fix a performance bug that was occuring with programs having
a lot of variables and that were using constant.
---
src/errors.ml | 4 ++-
src/evalClock.ml | 11 ++++---
src/evalType.ml | 4 +--
src/getEff.ml | 9 +++++-
src/lazyCompiler.ml | 2 +-
src/main.ml | 5 +++-
src/structArrayExpand.ml | 65 +++++++++++++++++++++-------------------
src/symbolTab.ml | 6 ++--
8 files changed, 62 insertions(+), 44 deletions(-)
diff --git a/src/errors.ml b/src/errors.ml
index ffa376fa..0fe83b49 100644
--- a/src/errors.ml
+++ b/src/errors.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 28/08/2008 (at 14:48) by Erwan Jahier> *)
+(** Time-stamp: <modified the 08/04/2010 (at 16:57) by Erwan Jahier> *)
(*----------------------------------------------------------------------
module : Errors.ml
@@ -96,6 +96,8 @@ Une erreur associ
----------------------------------------------------------------------*)
exception Compile_error of Lxm.t * string
+exception Unknown_constant of Lxm.t * string
+
(*---------------------------------------------------------------------
Une erreur plus generale
----------------------------------------------------------------------*)
diff --git a/src/evalClock.ml b/src/evalClock.ml
index c8d27dee..c6f14292 100644
--- a/src/evalClock.ml
+++ b/src/evalClock.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 26/05/2009 (at 10:14) by Erwan Jahier> *)
+(** Time-stamp: <modified the 08/04/2010 (at 16:57) by Erwan Jahier> *)
open Predef
@@ -326,10 +326,13 @@ and (eval_by_pos_clock : Eff.id_solver -> Eff.by_pos_op -> Lxm.t -> Eff.val_exp
| Eff.IDENT idref,args -> (
- try ([var_info_eff_to_clock_eff (id_solver.id2var idref lxm)], s)
- with Compile_error _ -> (* => it is a constant *)
- let s, clk = UnifyClock.new_clock_var s in
+ try
+ let _const = id_solver.id2const idref lxm in
+ let s, clk = UnifyClock.new_clock_var s in
[Ident.of_idref idref, clk], s
+ with Unknown_constant _ ->
+ ([var_info_eff_to_clock_eff (id_solver.id2var idref lxm)], s)
+
)
| Eff.CALL node_exp_eff,args ->
let (cil_arg, cil_res) = get_clock_profile node_exp_eff.it in
diff --git a/src/evalType.ml b/src/evalType.ml
index e0d12d1e..eee0a7ee 100644
--- a/src/evalType.ml
+++ b/src/evalType.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 12/03/2009 (at 14:03) by Erwan Jahier> *)
+(** Time-stamp: <modified the 08/04/2010 (at 17:12) by Erwan Jahier> *)
open Predef
@@ -80,7 +80,7 @@ and (eval_by_pos_type : Eff.id_solver -> Eff.by_pos_op -> Lxm.t ->
| Eff.IDENT id -> (
let tve = (* [id] migth be a constant, but also a variable *)
try [Eff.type_of_const (id_solver.id2const id lxm)]
- with _ -> [(id_solver.id2var id lxm).var_type_eff]
+ with Unknown_constant _ -> [(id_solver.id2var id lxm).var_type_eff]
in
None, [], tve
)
diff --git a/src/getEff.ml b/src/getEff.ml
index f128a272..ea15e4f3 100644
--- a/src/getEff.ml
+++ b/src/getEff.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 26/05/2009 (at 15:27) by Erwan Jahier> *)
+(** Time-stamp: <modified the 08/04/2010 (at 17:17) by Erwan Jahier> *)
open Lxm
@@ -305,6 +305,13 @@ and (translate_left_part : id_solver -> SyntaxTreeCore.left_part -> Eff.left) =
match lp_top with
| LeftVar id ->
let vi_eff =
+ try
+ let _const = id_solver.id2const (Ident.idref_of_string (Ident.to_string id.it)) id.src in
+ assert false
+ (* No constant should appear in left part! Is is checked somewhere?
+ Yes if this point is reached one day...
+ *)
+ with Unknown_constant _ ->
id_solver.id2var (Ident.idref_of_string (Ident.to_string id.it)) id.src
in
LeftVarEff (vi_eff, id.src)
diff --git a/src/lazyCompiler.ml b/src/lazyCompiler.ml
index a5bf2866..72c8aee1 100644
--- a/src/lazyCompiler.ml
+++ b/src/lazyCompiler.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 20/01/2010 (at 10:01) by Erwan Jahier> *)
+(** Time-stamp: <modified the 08/04/2010 (at 17:29) by Erwan Jahier> *)
open Lxm
diff --git a/src/main.ml b/src/main.ml
index 3cf81637..5d372851 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 26/01/2010 (at 18:26) by Erwan Jahier> *)
+(** Time-stamp: <modified the 08/04/2010 (at 16:57) by Erwan Jahier> *)
(** Here follows a description of the different modules used by this lus2lic compiler.
@@ -334,6 +334,9 @@ let main = (
| Parse_error ->
print_compile_error (Lxm.last_made ()) "syntax error";
my_exit 1
+ | Unknown_constant(lxm,str) ->
+ print_compile_error lxm ("unknown constant (" ^ str ^")")
+
| Compile_error(lxm,msg) ->
print_compile_error lxm msg ;
my_exit 1
diff --git a/src/structArrayExpand.ml b/src/structArrayExpand.ml
index e2e898d0..b5652f7b 100644
--- a/src/structArrayExpand.ml
+++ b/src/structArrayExpand.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 13/05/2009 (at 16:16) by Erwan Jahier> *)
+(** Time-stamp: <modified the 08/04/2010 (at 17:23) by Erwan Jahier> *)
(* Replace structures and arrays by as many variables as necessary.
Since structures can be recursive, it migth be a lot of new variables...
@@ -261,26 +261,11 @@ and (var_trees_of_val_exp : Eff.local_env -> Eff.id_solver -> acc -> Eff.val_exp
| _, (S _ | L _) -> assert false
)
| IDENT idref -> (
- try
- let vi = id_solver.id2var idref lxm in
- (acc,
- gen_var_trees (make_val_exp nenv lxm vi) "" vi.var_type_eff)
- with _ ->
- let const = try id_solver.id2const idref lxm
- with _ ->
- let msg =
- "\n*** during Array expansion: '"^
- (Ident.string_of_idref idref)^
- "': Unknown variable.\n*** Current variables are: " ^
- (Hashtbl.fold
- (fun id vi_eff acc -> acc ^ (Format.sprintf "\n\t%s"
- (LicDump.string_of_var_info_eff4msg vi_eff)))
- nenv.lenv_vars "")
- in
- raise (Errors.Compile_error(lxm, msg))
- in
+ try
+ let const =
+ id_solver.id2const idref lxm in
let s, ve_const =
- UnifyClock.const_to_val_eff lxm true UnifyClock.empty_subst const
+ UnifyClock.const_to_val_eff lxm true UnifyClock.empty_subst const
in
let ve_const,acc =
match ve_const.core with
@@ -290,6 +275,24 @@ and (var_trees_of_val_exp : Eff.local_env -> Eff.id_solver -> acc -> Eff.val_exp
| _ -> expand_val_exp nenv id_solver acc ve_const
in
(acc, L (ve_const))
+
+ with Errors.Unknown_constant _ ->
+ try
+ let vi = id_solver.id2var idref lxm in
+ (acc,
+ gen_var_trees (make_val_exp nenv lxm vi) "" vi.var_type_eff)
+ with _ ->
+ let msg =
+ "\n*** during Array expansion: '"^
+ (Ident.string_of_idref idref)^
+ "': Unknown variable.\n*** Current variables are: " ^
+ (Hashtbl.fold
+ (fun id vi_eff acc -> acc ^ (Format.sprintf "\n\t%s"
+ (LicDump.string_of_var_info_eff4msg vi_eff)))
+ nenv.lenv_vars "")
+ in
+ raise (Errors.Compile_error(lxm, msg))
+
)
| WITH(_) | HAT(_) | CONCAT | ARRAY(_)
| Predef _ | CALL _ | MERGE _
@@ -332,8 +335,8 @@ and (break_tuple : Lxm.t -> left list -> val_exp -> Eff.eq_info srcflagged list)
in
let msg =
"*** error expression " ^ (LicDump.string_of_val_exp_eff ve) ^
- "\n cannot be broken \n" ^(vel2str ve1l) ^
- " should have the same arity as\n"^(vel2str ve2l) ^ "\n"
+ "\n cannot be broken \n" ^(vel2str ve1l) ^
+ " should have the same arity as\n"^(vel2str ve2l) ^ "\n"
in
raise (Errors.Compile_error(lxm, msg))
else
@@ -352,8 +355,8 @@ and (break_tuple : Lxm.t -> left list -> val_exp -> Eff.eq_info srcflagged list)
in
let msg =
"*** error expression " ^ (LicDump.string_of_val_exp_eff ve) ^
- "\n cannot be broken \n" ^(vel2str ve1l) ^
- " should have the same arity as\n"^(vel2str ve2l) ^ "\n"
+ "\n cannot be broken \n" ^(vel2str ve1l) ^
+ " should have the same arity as\n"^(vel2str ve2l) ^ "\n"
in
raise (Errors.Compile_error(lxm, msg))
else
@@ -439,13 +442,13 @@ and (expand_val_exp: Eff.local_env -> Eff.id_solver -> acc -> val_exp ->
assert false (* just a defense against nth and assoc *)
in
TUPLE, acc, flatten_var_tree vt
-
+
in
let newve = CallByPosEff(Lxm.flagit by_pos_op lxm, OperEff vel) in
let newve = { ve with core = newve } in
-(* if newve.core <> ve.core then ( *)
-(* EvalClock.copy newve ve *)
-(* ); *)
+ (* if newve.core <> ve.core then ( *)
+ (* EvalClock.copy newve ve *)
+ (* ); *)
newve, acc
| CallByNameEff(by_name_op, fl_val) ->
@@ -486,9 +489,9 @@ and (expand_val_exp: Eff.local_env -> Eff.id_solver -> acc -> val_exp ->
core=CallByPosEff({ src=lxm ; it=TUPLE }, OperEff (List.rev vel))
}
in
-(* if newve.core <> ve.core then ( *)
-(* EvalClock.copy newve ve *)
-(* ); *)
+ (* if newve.core <> ve.core then ( *)
+ (* EvalClock.copy newve ve *)
+ (* ); *)
newve, acc
| _ -> assert false
diff --git a/src/symbolTab.ml b/src/symbolTab.ml
index 02eca2e1..cb72c297 100644
--- a/src/symbolTab.ml
+++ b/src/symbolTab.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 04/02/2009 (at 11:04) by Erwan Jahier> *)
+(** Time-stamp: <modified the 08/04/2010 (at 16:58) by Erwan Jahier> *)
(*
Sous-module pour SyntaxTab
@@ -44,12 +44,12 @@ let find_pack_of_type (this: t) (id: Ident.t) lxm =
let find_const (this: t) (id: Ident.t) lxm =
try snd (Hashtbl.find (this.st_consts) id)
with Not_found ->
- raise (Compile_error(lxm, "unknown constant (" ^ (Ident.to_string id) ^")"))
+ raise (Unknown_constant(lxm, (Ident.to_string id)))
let find_pack_of_const (this: t) (id: Ident.t) lxm =
try fst (Hashtbl.find (this.st_consts) id)
with Not_found ->
- raise (Compile_error(lxm, "unknown constant (" ^ (Ident.to_string id) ^")"))
+ raise (Unknown_constant(lxm, (Ident.to_string id)))
let find_node (this: t) (id: Ident.t) lxm =
--
GitLab