diff --git a/src/TODO b/src/TODO
index 70cfb5fcc8526854f5767838a959bd9a9db0efdc..6cae3699d045d4fcdb182f0abaf4fbd400c38acd 100644
--- a/src/TODO
+++ b/src/TODO
@@ -93,6 +93,24 @@ les operateurs aritmetiques, bof.
leve une exception au lieu d'une zoulie erreur
(le package s'appelle mainPack en fait, pas MainPack!)...
+o Lazycompiler.solve_x_idref
+
+ Comment se faisse que je n'ai pas besoin de me servir de cet
+x_info ????? En fait, je devrais le passer en argument de x_check,
+car celui ci en a besoin et je suis obligé de faire un match find_x
+with | Imported -> assert false | Local x_info -> ... pour le
+recuperer ce qui est extremement laid...
+
+-> TODO : rajouter x_info en argument de x_check (et virer symbols du
+coup eventuellement ?)
+
+log:
+lazycompiler.ml:
+ Simplify a little bit a couple of functions (avoiding code
+ duplication basically).
+
+
+
* Quand les constantes enum sont crées, ne devraient-elles pas être créées
comme étant des constantes externes ?
diff --git a/src/evalConst.ml b/src/evalConst.ml
index bf3133eea1f361c7beee6a74db53000ada5cc723..9cb24ed5abaf045b315df76d47a6450beeca5223 100644
--- a/src/evalConst.ml
+++ b/src/evalConst.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 14/04/2008 (at 17:58) by Erwan Jahier> *)
+(** Time-stamp: <modified the 16/05/2008 (at 09:34) by Erwan Jahier> *)
open Printf
@@ -6,7 +6,6 @@ open Lxm
open Errors
open SyntaxTree
open SyntaxTreeCore
-open CompiledDataDump
open CompiledData
open Predef
open PredefSemantics
@@ -59,10 +58,11 @@ let (make_array_const : const_eff list array -> const_eff) =
| None -> expected_type := Some xtyp; x
| Some t -> (
if (t = xtyp) then x else
- raise (EvalConst_error("type error in array, "^
- (string_of_type_eff xtyp)^
- " mixed with " ^string_of_type_eff t
- ))
+ raise (EvalConst_error(
+ "type error in array, "^
+ (CompiledDataDump.string_of_type_eff xtyp)^
+ " mixed with " ^ CompiledDataDump.string_of_type_eff t
+ ))
)
)
| _ -> (* tuple *)
@@ -101,8 +101,8 @@ let make_struct_const
sprintf
"type error in struct %s, %s instead of %s"
(Ident.string_of_long tnm)
- (string_of_type_eff vt)
- (string_of_type_eff ft)
+ (CompiledDataDump.string_of_type_eff vt)
+ (CompiledDataDump.string_of_type_eff ft)
))
)
) with Not_found -> (
@@ -125,7 +125,8 @@ let make_struct_const
lxm,
sprintf
"%s is not a field of struct %s"
- (Ident.to_string id) (string_of_type_eff(teff))
+ (Ident.to_string id)
+ (CompiledDataDump.string_of_type_eff(teff))
))
in
Hashtbl.iter raise_error arg_tab ;
@@ -135,7 +136,7 @@ let make_struct_const
| _ -> raise (EvalConst_error(
sprintf
"struct type expected instead of %s"
- (string_of_type_eff teff)
+ (CompiledDataDump.string_of_type_eff teff)
))
)
@@ -249,8 +250,8 @@ let rec f
raise(EvalConst_error(
sprintf
"type combination error, can't concat %s with %s"
- (string_of_type_eff(t0))
- (string_of_type_eff(t1))
+ (CompiledDataDump.string_of_type_eff(t0))
+ (CompiledDataDump.string_of_type_eff(t1))
))
)
| [_;_] ->
@@ -300,7 +301,8 @@ let rec f
with Not_found ->
raise (EvalConst_error
(Printf.sprintf "%s is not a field of struct %s"
- (Ident.to_string fid) (string_of_type_eff(typ))))
+ (Ident.to_string fid)
+ (CompiledDataDump.string_of_type_eff(typ))))
)
| [x] -> type_error_const [x] "struct type"
| x -> arity_error_const x "1"
@@ -401,7 +403,7 @@ and (eval_array_size: id_solver -> val_exp -> int) =
raise(EvalArray_error(sprintf "bad array size %d" sz))
| [x] ->
raise(EvalArray_error(sprintf "bad array size, int expected but get %s"
- (string_of_type_eff(type_of_const_eff x))))
+ (CompiledDataDump.string_of_type_eff(type_of_const_eff x))))
| _ ->
raise(EvalArray_error(sprintf "bad array size, int expected, not a tuple"))
@@ -438,8 +440,8 @@ and eval_array_index
print_string "retrieve that const!";
assert false
| [x] -> raise(EvalArray_error(sprintf
- "bad array index, int expected but get %s"
- (string_of_type_eff(type_of_const_eff x)))
+ "bad array index, int expected but get %s"
+ (CompiledDataDump.string_of_type_eff(type_of_const_eff x)))
)
| _ -> raise(EvalArray_error(sprintf
"bad array index, int expected but get a tuple")
@@ -478,8 +480,8 @@ and eval_array_slice (env : id_solver) (sl : slice_info) (sz : int) (lxm : Lxm.t
match (f env stepexp) with
| [Int_const_eff s] -> s (* ok *)
| [x] -> raise(EvalArray_error(
- sprintf "bad array step, int expected but get %s"
- (string_of_type_eff(type_of_const_eff x))))
+ sprintf "bad array step, int expected but get %s"
+ (CompiledDataDump.string_of_type_eff(type_of_const_eff x))))
| _ -> raise(EvalArray_error(
sprintf "bad array step, int expected but get a tuple"))
)
diff --git a/src/evalType.ml b/src/evalType.ml
index 852e6d094bcbd17a570449fe50b613cf5dfedcec..2d75131c8cb466f485693ebfe14ce4ab1a88c498 100644
--- a/src/evalType.ml
+++ b/src/evalType.ml
@@ -1,11 +1,10 @@
-(** Time-stamp: <modified the 03/04/2008 (at 15:32) by Erwan Jahier> *)
+(** Time-stamp: <modified the 16/05/2008 (at 09:32) by Erwan Jahier> *)
open Predef
open PredefSemantics
open SyntaxTree
open SyntaxTreeCore
-open CompiledDataDump
open CompiledData
open Printf
open Lxm
@@ -63,8 +62,8 @@ and (eval_by_pos_type :
else
raise(EvalType_error(
sprintf "type combination error, can't concat %s with %s"
- (string_of_type_eff teff0)
- (string_of_type_eff teff1)))
+ (CompiledDataDump.string_of_type_eff teff0)
+ (CompiledDataDump.string_of_type_eff teff1)))
)
| [_;_] ->
raise(EvalType_error("type combination error, array type expected"))
@@ -83,7 +82,7 @@ and (eval_by_pos_type :
raise (EvalType_error
(Printf.sprintf "%s is not a field of struct %s"
(Ident.to_string fid)
- (string_of_type_eff(List.hd type_args_eff))))
+ (CompiledDataDump.string_of_type_eff(List.hd type_args_eff))))
)
| [x] -> type_error [x] "struct type"
| x -> arity_error x "1"
diff --git a/src/getEff.ml b/src/getEff.ml
index 81c97c92586d011565189e35a45e01507d851c66..8033538e876a923127f3ac3a21021db7495deeac 100644
--- a/src/getEff.ml
+++ b/src/getEff.ml
@@ -1,11 +1,10 @@
-(** Time-stamp: <modified the 15/05/2008 (at 16:10) by Erwan Jahier> *)
+(** Time-stamp: <modified the 16/05/2008 (at 09:31) by Erwan Jahier> *)
open Lxm
open Predef
open SyntaxTree
open SyntaxTreeCore
-open CompiledDataDump
open CompiledData
open Errors
@@ -133,8 +132,9 @@ let rec (eq : id_solver -> eq_info srcflagged -> eq_info_eff srcflagged) =
(fun le re ->
if le <> re then
let msg = "type mismatch: \n***\t'"
- ^ (string_of_type_eff le) ^
- "'\n*** is not compatible with \n***\t'" ^(string_of_type_eff re) ^ "'"
+ ^ (CompiledDataDump.string_of_type_eff le) ^
+ "'\n*** is not compatible with \n***\t'"
+ ^ (CompiledDataDump.string_of_type_eff re) ^ "'"
in
raise (Compile_error(eq_info.src, msg))
)
@@ -295,7 +295,8 @@ let (assertion : CompiledData.id_solver -> SyntaxTreeCore.val_exp Lxm.srcflagge
(fun ve ->
if ve <> Bool_type_eff then
let msg = "type mismatch: \n\tthe content of the assertion is of type "
- ^ (string_of_type_eff ve) ^ " whereas it shoud be a Boolean\n"
+ ^ (CompiledDataDump.string_of_type_eff ve)
+ ^ " whereas it shoud be a Boolean\n"
in
raise (Compile_error(vef.src, msg))
)
diff --git a/src/lazyCompiler.ml b/src/lazyCompiler.ml
index 3a92cbe4dab36a13493e787b653b4c49daa32879..170cb80666d7d80d1b929e89cd98b30b1a3a0c41 100644
--- a/src/lazyCompiler.ml
+++ b/src/lazyCompiler.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 15/05/2008 (at 16:24) by Erwan Jahier> *)
+(** Time-stamp: <modified the 16/05/2008 (at 09:29) by Erwan Jahier> *)
open Lxm
@@ -6,7 +6,7 @@ open Errors
open SyntaxTree
open SyntaxTreeCore
open CompiledData
-open CompiledDataDump
+(* open CompiledDataDump *)
let finish_me msg = print_string ("\n\tXXX LazyCompiler:"^msg^" -> finish me!\n")
@@ -309,9 +309,10 @@ and (type_check_interface_do: t -> Ident.long -> Lxm.t -> SymbolTab.t ->
else
raise(Compile_error (
type_def.src,
- ("provided type \n\t" ^ (string_of_type_eff prov_type_eff) ^
+ ("provided type \n\t" ^
+ (CompiledDataDump.string_of_type_eff prov_type_eff) ^
"\n is not compatible with its implementation \n\t" ^
- (string_of_type_eff body_type_eff))))
+ (CompiledDataDump.string_of_type_eff body_type_eff))))
and (const_check_interface_do: t -> Ident.long -> Lxm.t -> SymbolTab.t ->
@@ -332,9 +333,9 @@ and (const_check_interface_do: t -> Ident.long -> Lxm.t -> SymbolTab.t ->
raise(Compile_error (
const_def.src,
("provided constant type \n\t" ^
- (string_of_type_eff teff_prov) ^
+ (CompiledDataDump.string_of_type_eff teff_prov) ^
" is not compatible with its implementation \n\t" ^
- (string_of_type_eff teff_body) ^ "")
+ (CompiledDataDump.string_of_type_eff teff_body) ^ "")
))
| Bool_const_eff _
| Int_const_eff _
@@ -389,8 +390,8 @@ and (type_check_do: t -> Ident.long -> Lxm.t -> SymbolTab.t -> bool ->
raise
(Compile_error(field_def.src, Printf.sprintf
" this field is declared as '%s' but evaluated as '%s'"
- (string_of_type_eff teff)
- (string_of_type_eff tv)))
+ (CompiledDataDump.string_of_type_eff teff)
+ (CompiledDataDump.string_of_type_eff tv)))
)
| [] -> assert false (* should not occur *)
| _::_ ->
@@ -450,8 +451,8 @@ and (const_check_do : t -> Ident.long -> Lxm.t -> SymbolTab.t -> bool ->
raise
(Compile_error (const_def.src, Printf.sprintf
" this constant is declared as '%s' but evaluated as '%s'"
- (string_of_type_eff tdecl)
- (string_of_type_eff teff)
+ (CompiledDataDump.string_of_type_eff tdecl)
+ (CompiledDataDump.string_of_type_eff teff)
)))
)
| [] -> assert false (* should not occur *)
@@ -499,7 +500,8 @@ and (node_check_interface_do: t -> CompiledData.node_key -> Lxm.t ->
raise(
Compile_error (
node_def.src,
- ("provided node \n\t" ^ (profile_of_node_exp_eff prov_node_exp_eff) ^
+ ("provided node \n\t" ^
+ (CompiledDataDump.profile_of_node_exp_eff prov_node_exp_eff) ^
"\n is not compatible with its implementation \n\t" ^
(CompiledDataDump.profile_of_node_exp_eff body_node_exp_eff))))
@@ -524,7 +526,7 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
(fun id vi_eff ->
print_string(
"\n\t" ^ (Ident.to_string id) ^ " -> " ^
- (string_of_var_info_eff vi_eff))
+ (CompiledDataDump.string_of_var_info_eff vi_eff))
)
local_env.lenv_vars;
flush stdout;
@@ -683,11 +685,11 @@ let compile_all_item this label x_check_interface string_of_x_key
let compile_all_types pack_name this =
compile_all_item this "type" type_check_interface Ident.string_of_long
- string_of_type_eff (fun id -> Ident.make_long pack_name id)
+ CompiledDataDump.string_of_type_eff (fun id -> Ident.make_long pack_name id)
let compile_all_constants pack_name this =
compile_all_item this "const" const_check_interface Ident.string_of_long
- string_of_const_eff (fun id -> Ident.make_long pack_name id)
+ CompiledDataDump.string_of_const_eff (fun id -> Ident.make_long pack_name id)
let (get_static_params : (node_info Lxm.srcflagged) SymbolTab.elt ->