diff --git a/src/TODO b/src/TODO
index 6e46de7c2b834edd8611c47d9dec4169bd81a61d..1bbf2e11357e98df8fa0c329684e1dc958a3912f 100644
--- a/src/TODO
+++ b/src/TODO
@@ -7,6 +7,8 @@ Question : dans syntaxTree.ml, comment marchent les by_name_op ?
* autoriser le fait le pouvoir donner une valeur par defaut à une constante
exportée. («provides const : n = 4; »)
+ * Here/NotHere -> à renommer.
+
* LazyCompiler.do_node
* lazyCompiler.ml:
diff --git a/src/compiledData.ml b/src/compiledData.ml
index 3266688780f35b609a1cb39f028b58b4050c8ba1..16b8899c38db0b5d7a788d83d7fc23d92c60792f 100644
--- a/src/compiledData.ml
+++ b/src/compiledData.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 12/02/2008 (at 10:18) by Erwan Jahier> *)
+(** Time-stamp: <modified the 14/02/2008 (at 17:43) by Erwan Jahier> *)
(**
@@ -115,8 +115,9 @@ N.B. On fournit les constructeurs des id_solver courants, voir :
const_and_type_id_solver
----------------------------------------------------------------------*)
type id_solver = {
- id2const : Ident.idref -> Lxm.t -> const_eff ;
- id2type : Ident.idref -> Lxm.t -> type_eff ;
+ id2const : Ident.idref -> Lxm.t -> const_eff ;
+ id2type : Ident.idref -> Lxm.t -> type_eff ;
+ id2node : Ident.idref -> static_arg_eff list -> Lxm.t -> node_eff ;
}
(*---------------------------------------------------------------------
@@ -269,6 +270,8 @@ and node_eff = {
nf_out_types : type_eff list ;
nf_in_formal_clocks : int option list ;
nf_out_formal_clocks : int option list ;
+ nf_asserts : val_eff list;
+ nf_eqs : eq_eff list;
}
(*---------------------------------------------------------------------
Type : XXX_key
@@ -373,7 +376,7 @@ Utilitaire: const_and_type_id_solver
Rôle :
comme son nom l'indique
Entrées :
- id2const, id2type
+ id2const, id2type, id2node
Sorties :
id_solver
Effets de bord :
@@ -382,10 +385,12 @@ Effets de bord :
let const_and_type_id_solver
(i2c : Ident.idref -> Lxm.t -> const_eff)
(i2t : Ident.idref -> Lxm.t -> type_eff)
+ (i2o : Ident.idref -> static_arg_eff list -> Lxm.t -> node_eff)
=
{
id2const = i2c ;
id2type = i2t ;
+ id2node = i2o ;
}
(*---------------------------------------------------------------------
diff --git a/src/lazyCompiler.ml b/src/lazyCompiler.ml
index 5881a427b25818c96f1f8e619a8cc502e4e1ae64..b9b84831fd66d3318296938d5bf19cbe6480188a 100644
--- a/src/lazyCompiler.ml
+++ b/src/lazyCompiler.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 12/02/2008 (at 16:31) by Erwan Jahier> *)
+(** Time-stamp: <modified the 14/02/2008 (at 17:49) by Erwan Jahier> *)
open Lxm
@@ -71,28 +71,45 @@ fun tbl ->
types checking
--------------
(1) [type_check env type_name lxm]: type check the type id [type_name]
- (3) [type_check_do]: untabulated version of [type_check] (do the real work).
+ (2) [type_check_do]: untabulated version of [type_check] (do the real work).
- (2) [type_check_interface]: ditto, but for the interface part
- (2) [type_check_interface_do]: untabulated version (do the real work)
+ (3) [type_check_interface]: ditto, but for the interface part
+ (4) [type_check_interface_do]: untabulated version (do the real work)
- (4) [solve_type_idref] solves constant reference (w.r.t. short/long ident)
+ (5) [solve_type_idref] solves constant reference (w.r.t. short/long ident)
constants checking
------------------
- (5) [const_check env const_name lxm]: eval/check the constant [const_name]
+ (6) [const_check env const_name lxm]: eval/check the constant [const_name]
(7) [const_check_do] : untabulated version (do the real work)
- (6) [const_check_interface]: ditto, but for the interface part
- (6) [const_check_interface_do]: untabulated version (do the real work)
+ (8) [const_check_interface]: ditto, but for the interface part
+ (9) [const_check_interface_do]: untabulated version (do the real work)
- (8) [solve_const_idref] solves constant reference (w.r.t. short/long ident)
+ (10) [solve_const_idref] solves constant reference (w.r.t. short/long ident)
+
+
+ nb: for x in {type, const, oper}, there are several functions that returns [x_eff]:
+ - [x_check]
+ o takes an x_key
+ o lookups its (syntaxic) definition (x_info) via the symbolTab.t
+ o transforms it into a [x_eff] (recursively on the syntax structure)
+
+ - [solve_x_idref]
+ o takes a idref (plus a «static_arg_eff list» for x=node!)
+ o builds an [x_key] to be able to call [x_check] (name resolution)
+ o used by evalX.f
+
+ - [evalX.f]
+ o takes a [x_exp] (i.e., an expression)
+ o used by [x_check]
+
+ nb2: the top-level call is [node_check], on a node that necessarily contains
+ no static parameters. Then:
+ - [node_check] calls [solve_x_idref] to perfrom name resolution
+ and it calls
+
- nb : the 4 functions dealing with constants duplicate 90% of the
- code of the 4 functions dealing with types. It is not easy to
- factorize them out (because of the 10%). I managed to do it for
- [type_check] and [const_check], but even there, it is not that clear
- that it was worthwhile...
*)
(* Before starting, let's define a few utilitary functions. *)
@@ -167,9 +184,10 @@ let (lookup_node_eff:
lookup_x_eff "node ref " (fun k -> fst k)
-(** solving type and constant references *)
+(** From an idref, builds a [x_key] and calls [x_check] *)
let solve_x_idref
- x_check_interface x_check find_x x_label to_x_key this symbols currpack idr lxm =
+ x_check_interface x_check find_x x_label to_x_key this symbols currpack idr
+ sargs lxm =
let s = Ident.name_of_idref idr in
match Ident.pack_of_idref idr with
| Some p -> x_check_interface this (to_x_key p s) lxm
@@ -221,15 +239,15 @@ and (solve_type_idref : t -> SymbolTab.t -> Ident.pack_name -> Ident.idref -> Lx
solve_x_idref
type_check_interface type_check SymbolTab.find_type "type"
(fun p id -> Ident.make_long p id)
- this symbols currpack idr lxm
+ this symbols currpack idr [] lxm
and (solve_const_idref : t -> SymbolTab.t -> Ident.pack_name -> Ident.idref -> Lxm.t
-> CompiledData.const_eff) =
- fun this symbols currpack idr lxm ->
- solve_x_idref
+ fun this symbols currpack idr lxm ->
+ solve_x_idref
const_check_interface const_check SymbolTab.find_const "const"
(fun p id -> Ident.make_long p id)
- this symbols currpack idr lxm
+ this symbols currpack idr [] lxm
(* now the real work! *)
@@ -304,16 +322,17 @@ and (type_check_do: t -> Ident.long -> Lxm.t -> SymbolTab.t -> Ident.pack_name -
SyntaxTreeCore.type_info srcflagged -> CompiledData.type_eff) =
fun this type_name lxm symbols pack_name type_def ->
try (
- (* Solveur d'idref pour les les appels à eval_type/eval_const *)
- let eval_env = {
- id2const = (solve_const_idref this symbols pack_name);
- id2type = (solve_type_idref this symbols pack_name);
+ (* Solveur d'idref pour les appels à eval_type/eval_const *)
+ let id_solver = {
+ id2const = solve_const_idref this symbols pack_name;
+ id2type = solve_type_idref this symbols pack_name;
+ id2node = solve_node_idref this symbols pack_name;
}
in
match type_def.it with
| ArrayType _ -> finish_me " array handling "; assert false
| ExternalType s -> External_type_eff (Ident.make_long pack_name s)
- | AliasedType (s, texp) -> EvalType.f eval_env texp
+ | AliasedType (s, texp) -> EvalType.f id_solver texp
| EnumType (s, clst) -> (
let n = Ident.make_long pack_name s in
let add_pack_name x = Ident.make_long pack_name x.it in
@@ -322,11 +341,11 @@ and (type_check_do: t -> Ident.long -> Lxm.t -> SymbolTab.t -> Ident.pack_name -
| StructType sti -> (
let make_field (fname : Ident.t) = (
let field_def = Hashtbl.find sti.st_ftable fname in
- let teff = EvalType.f eval_env field_def.it.fd_type in
+ let teff = EvalType.f id_solver field_def.it.fd_type in
match field_def.it.fd_value with
| None -> (fname, teff, None)
| Some vexp -> (
- let veff = EvalConst.f eval_env vexp in
+ let veff = EvalConst.f id_solver vexp in
match veff with
| [v] -> (
let tv = type_of_const_eff v in
@@ -371,26 +390,27 @@ and (const_check_do : t -> Ident.long -> Lxm.t -> SymbolTab.t -> Ident.pack_name
*)
try (
(* Solveur d'idref pour les les appels à eval_type/eval_const *)
- let eval_env = {
+ let id_solver = {
id2const = (solve_const_idref this symbols currpack) ;
id2type = (solve_type_idref this symbols currpack) ;
+ id2node = solve_node_idref this symbols currpack;
}
in
match const_def.it with
| ExternalConst (id, texp) ->
Extern_const_eff ((Ident.make_long currpack id),
- EvalType.f eval_env texp)
+ EvalType.f id_solver texp)
| EnumConst (id, texp) ->
- Enum_const_eff ((Ident.make_long currpack id), EvalType.f eval_env texp)
+ Enum_const_eff ((Ident.make_long currpack id), EvalType.f id_solver texp)
| DefinedConst (id, texp_opt, vexp ) -> (
- match (EvalConst.f eval_env vexp) with
+ match (EvalConst.f id_solver vexp) with
| [ceff] -> (
match texp_opt with
| None -> ceff
| Some texp -> (
- let tdecl = EvalType.f eval_env texp in
+ let tdecl = EvalType.f id_solver texp in
let teff = type_of_const_eff ceff in
if (tdecl = teff ) then ceff
else
@@ -423,7 +443,7 @@ and (const_check_do : t -> Ident.long -> Lxm.t -> SymbolTab.t -> Ident.pack_name
(******************************************************************************)
-let rec (node_check_interface_do: t -> CompiledData.node_key -> Lxm.t ->
+and (node_check_interface_do: t -> CompiledData.node_key -> Lxm.t ->
SymbolTab.t -> Ident.pack_name -> SyntaxTreeCore.node_info srcflagged ->
CompiledData.node_eff) =
fun this nk lxm symbols pack_name node_def ->
@@ -446,10 +466,14 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
fun this nk lxm symbols pack_name node_def ->
(*
- verifier les params statiques ?
+ - creer une sorte d'environnement local de compilation, qui
+ permette de gerer les espaces de noms propres aux noeuds
+ (variables, constantes, flots, types)
*)
let id_solver = {
id2const = solve_const_idref this symbols pack_name;
id2type = solve_type_idref this symbols pack_name;
+ id2node = solve_node_idref this symbols pack_name;
}
in
let make_node_eff itl otl =
@@ -459,6 +483,8 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
nf_out_types = otl;
nf_in_formal_clocks = []; (* XXX finish me! *)
nf_out_formal_clocks = []; (* XXX finish me! *)
+ nf_asserts = []; (* XXX finish me! *)
+ nf_eqs = []; (* XXX finish me! *)
}
in
match node_def.it with
@@ -468,8 +494,8 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
finish_me "" ; assert false
| NodeAlias (None, {src=_;it= CallUsrDef(idref, static_args )}) ->
- solve_node_idref
- this symbols pack_name idref id_solver static_args lxm
+ assert false
+(* id_solver.id2node idref (check_static_arg static_args) lxm *)
| NodeAlias (Some (vi_il, vi_ol), _)
| NodeExtern(vi_il, vi_ol) ->
@@ -492,24 +518,20 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
(List.map aux en.eni_outputs)
-(** solving node references *)
+(** builds and node_key and calls [node_check] *)
and (solve_node_idref : t -> SymbolTab.t -> Ident.pack_name -> Ident.idref ->
- CompiledData.id_solver -> static_arg srcflagged list -> Lxm.t ->
- CompiledData.node_eff) =
-(*
- XXX devrait retourner des oper_eff, non ?
-*)
- fun this symbols currpack idr id_solver sargs lxm ->
+ static_arg_eff list -> Lxm.t -> CompiledData.node_eff) =
+ fun this symbols currpack idr sargs lxm ->
solve_x_idref
node_check_interface node_check SymbolTab.find_node "node"
(fun p id ->
- let long = Ident.make_long p id
- and sargs_eff =
- List.map (check_static_arg this symbols currpack id_solver id) sargs
- in
- (long, sargs_eff)
+ (* builds a [node_key] from a [pack_name] and a [node] id,
+ and a static_arg_eff list *)
+ let long = Ident.make_long p id in
+ let node_key = long, sargs in
+ node_key
)
- this symbols currpack idr lxm
+ this symbols currpack idr sargs lxm
and (node_check: t -> CompiledData.node_key -> Lxm.t -> CompiledData.node_eff) =
fun this nk ->
@@ -526,44 +548,63 @@ and (node_check_interface:
(fun nk -> Ident.pack_of_long (fst nk))
(fun nk -> Ident.of_long (fst nk)) this nk
-and (check_static_arg : t -> SymbolTab.t -> Ident.pack_name ->
- CompiledData.id_solver -> Ident.t -> SyntaxTreeCore.static_arg srcflagged ->
- CompiledData.static_arg_eff) =
- fun this symbols pn id_solver id sa ->
- match sa.it with
- | StaticArgIdent idref -> ( (* migth be a const, a type, or a node *)
- try
- let sargs = [] in (* ok? *)
- let neff = solve_node_idref this symbols pn idref id_solver sargs sa.src in
- OperStaticArgEff (id, NodeOper neff)
- with Compile_error _ ->
- try
- let teff = solve_type_idref this symbols pn idref sa.src in
- TypeStaticArgEff (id, teff)
- with Compile_error _ ->
- try
- let ceff = solve_const_idref this symbols pn idref sa.src in
- ConstStaticArgEff (id, ceff)
- with Compile_error _ ->
- (raise(Compile_error(sa.src,"unbounded ident")))
- )
- | StaticArgConst ce ->
- let ceff = EvalConst.f id_solver ce in
- (match ceff with
- | [ceff] -> ConstStaticArgEff (id,ceff)
- | _ -> assert false (* should not occur *)
- )
- | StaticArgType te -> (TypeStaticArgEff (id, EvalType.f id_solver te))
-
- | StaticArgNode (CallPreDef predef_node) ->
- finish_me (" node parameter handling - predefined operator " ^
- (SyntaxTreeDump.op2string predef_node));
- assert false
-
- | StaticArgNode (CallUsrDef (idref, s_args)) ->
- let neff = solve_node_idref this symbols pn idref id_solver s_args sa.src in
- OperStaticArgEff (id, NodeOper neff)
-
+(** [check_static_arg this symbols pn id sa (symbols, acc)] compile a static arg
+ into a static_arg_eff, and adds it into an accumulator. Also returns a new
+ [symbols] table, enriched with the binding [id] -> [static_arg_eff]
+*)
+(* and (check_static_arg : t -> Ident.pack_name -> Ident.t -> *)
+(* SymbolTab.t * CompiledData.static_arg_eff list -> *)
+(* SyntaxTreeCore.static_arg srcflagged -> *)
+(* SymbolTab.t * CompiledData.static_arg_eff list) = *)
+(* fun this pn id (symbols, acc) sa -> *)
+(* (* XXX le passer en parametre plutot que de le recreer ? *) *)
+(* let id_solver = { *)
+(* id2const = solve_const_idref this symbols pn; *)
+(* id2type = solve_type_idref this symbols pn; *)
+(* id2node = solve_node_idref this symbols pn; *)
+(* } *)
+(* in *)
+(* let sa_eff = *)
+(* match sa.it with *)
+(* | StaticArgIdent idref -> ( (* migth be a const, a type, or a node *) *)
+(* try *)
+(* let sargs = [] in (* ok? *) *)
+(* let neff = id_solver.id2node idref id_solver sargs sa.src in *)
+(* OperStaticArgEff (id, NodeOper neff) *)
+(* with Compile_error _ -> *)
+(* try *)
+(* let teff = id_solver.id2type idref sa.src in *)
+(* TypeStaticArgEff (id, teff) *)
+(* with Compile_error _ -> *)
+(* try *)
+(* let ceff = id_solver.id2const idref sa.src in *)
+(* ConstStaticArgEff (id, ceff) *)
+(* with Compile_error _ -> *)
+(* (raise(Compile_error(sa.src,"unbounded ident"))) *)
+(* ) *)
+(* | StaticArgConst ce -> ( *)
+(* let ceff = EvalConst.f id_solver ce in *)
+(* match ceff with *)
+(* | [ceff] -> ConstStaticArgEff (id,ceff) *)
+(* | _ -> assert false (* should not occur *) *)
+(* ) *)
+(* | StaticArgType te -> *)
+(* let teff = (TypeStaticArgEff (id, EvalType.f id_solver te)) in *)
+(* teff *)
+(* *)
+(* | StaticArgNode (CallPreDef predef_node) -> *)
+(* finish_me (" node parameter handling - predefined operator " ^ *)
+(* (SyntaxTreeDump.op2string predef_node)); *)
+(* assert false *)
+(* *)
+(* | StaticArgNode (CallUsrDef (idref, s_args)) -> *)
+(* let neff = id_solver.id2node idref id_solver s_args sa.src in *)
+(* OperStaticArgEff (id, NodeOper neff) *)
+(* in *)
+(* *)
+(* SymbolTab.add_ *)
+(* XXX add_type this id *)
+(* (symbols, sa_eff::acc) *)
(*-------------------------------------------------------------------------
diff --git a/src/lazyCompiler.mli b/src/lazyCompiler.mli
index d24580b616bd0149ccb836d2f1ee5dd41448e39d..e3a3e370067bdfce287f51c5e8f1a0c0dbc09a61 100644
--- a/src/lazyCompiler.mli
+++ b/src/lazyCompiler.mli
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 04/02/2008 (at 15:39) by Erwan Jahier> *)
+(** Time-stamp: <modified the 14/02/2008 (at 17:08) by Erwan Jahier> *)
(** nb: compiling = type checking + constant evaluation *)
diff --git a/src/syntaxTab.ml b/src/syntaxTab.ml
index 04552e0ed02276148d0f77b171d041b18837d53c..1cd4b64023eb75c9aa50cb1555c7a1e7bea220d4 100644
--- a/src/syntaxTab.ml
+++ b/src/syntaxTab.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 07/02/2008 (at 15:22) by Erwan Jahier> *)
+(** Time-stamp: <modified the 14/02/2008 (at 17:15) by Erwan Jahier> *)
(**
Table des infos sources : une couche au dessus de SyntaxTree pour mieux
@@ -292,7 +292,7 @@ init_raw_tabs (this : t) (sl : SyntaxTree.pack_or_model list) =
une unique table qui sert pour les deux !
Comment ça marche :
- - on traite en premier les éventuels "use",
+ - on traite en premier les éventuels "use", (= open de ocaml)
- puis les déclarations locales qui peuvent éventuellement
masquer les précédentes (warning ?)
*)
diff --git a/src/syntaxTreeCore.ml b/src/syntaxTreeCore.ml
index 764b9e95c37ece85bb40fe02b363f191c731a5b0..2ee8c0f5f7472fa196e2c9c029d278f5ac2e50eb 100644
--- a/src/syntaxTreeCore.ml
+++ b/src/syntaxTreeCore.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 12/02/2008 (at 11:39) by Erwan Jahier> *)
+(** Time-stamp: <modified the 14/02/2008 (at 17:11) by Erwan Jahier> *)
(** (Raw) Abstract syntax tree of source programs. *)
@@ -82,7 +82,6 @@ and slice_info = {
si_step : val_exp option ;
}
-(* predef_node = operator *)
and predef_node =
(* zeroaire *)
NULL_exp
diff --git a/src/test/test.res.exp b/src/test/test.res.exp
index 33dd72985130813467579dccd6b6abeec650faa6..2f520306c4b29253ba83c0bdae2eb1316d6a1cfa 100644
--- a/src/test/test.res.exp
+++ b/src/test/test.res.exp
@@ -135,9 +135,10 @@ End of Syntax table dump.
* package dummy
Exported types:
Exported constants:
-*** Error in file "t0.lus", line 11, col 10 to 10, token 'n': unknown constant
-
Exported nodes:
+
+*** oops: an internal error occurred in file lazyCompiler.ml, line 499, column 5
+*** when compiling lustre program t0.lus
----------------------------------------------------------------------
====> ../lus2lic -vl 3 t2.lus
@@ -168,9 +169,7 @@ End of Syntax table dump.
Exported nodes:
### skipping fold_left
- XXX LazyCompiler: node parameter handling - predefined operator and -> finish me!
-
-*** oops: an internal error occurred in file lazyCompiler.ml, line 561, column 3
+*** oops: an internal error occurred in file lazyCompiler.ml, line 499, column 5
*** when compiling lustre program t2.lus
----------------------------------------------------------------------
@@ -284,11 +283,12 @@ End of Syntax table dump.
* package dummy
Exported types:
Exported constants:
-*** Error in file "consensus.lus", line 20, col 41 to 41, token 'n': unknown constant
-
Exported nodes:
oper dummy::main = dummy::main(bool^4) returns (bool) on clock XXX
+
+*** oops: an internal error occurred in file lazyCompiler.ml, line 499, column 5
+*** when compiling lustre program consensus.lus
----------------------------------------------------------------------
====> ../lus2lic -vl 3 left.lus