From e64e10318a1cbdcf9780e799d4c67341826e3e2f Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Tue, 3 Jun 2008 15:05:00 +0200
Subject: [PATCH] Wrap the parser output with a new
function, SolveIdent.recognize_predef_op that replaces node call by
Predef constructor when necessary, via a complete traversal of the
SyntaxTree (instead of doing it in the parser). The rationales for this
change are that:
- it is quite tedious to do it in parser as multiple locations are involved
- I did missed some locations
- It makes the parser more focused on parsing issues
- that traversal is a first step do deal with idref solving (hence
the name of the new module that contains that function
Note that lsrc/test/should_work/fab_test/lecteur.lus was using
"plus" as a variable ident, which raised an error, which
---
src/Makefile | 2 +
src/TODO | 56 ++++++++
src/expandPack.ml | 4 +-
src/ident.ml | 5 +-
src/lazyCompiler.ml | 27 ++--
src/main.ml | 5 +-
src/parser.mly | 17 +--
src/parserUtils.ml | 24 +---
src/predef.ml | 7 +-
src/predefSemantics.ml | 12 +-
src/solveIdent.ml | 162 ++++++++++++++++++++++
src/solveIdent.mli | 21 +++
src/syntaxTab.ml | 13 +-
src/syntaxTreeCore.ml | 4 +-
src/test/should_work/fab_test/lecteur.lus | 18 +--
src/test/test.res.exp | 24 ++--
16 files changed, 313 insertions(+), 88 deletions(-)
create mode 100644 src/solveIdent.ml
create mode 100644 src/solveIdent.mli
diff --git a/src/Makefile b/src/Makefile
index 6c1f830c..123d42f8 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -19,6 +19,8 @@ SOURCES = \
./predef.ml \
./syntaxTreeCore.ml \
./syntaxTree.ml \
+ ./solveIdent.mli \
+ ./solveIdent.ml \
./parserUtils.ml \
./parser.mly \
./lexer.mll \
diff --git a/src/TODO b/src/TODO
index a270b25f..f095bf87 100644
--- a/src/TODO
+++ b/src/TODO
@@ -103,6 +103,7 @@ lazycompiler.ml:
m'en etre completement debarassé au niveau du compiledData, et ca
n'est pas le cas pour l'instant...
+* traiter les types int, real, bool dans Predef ?
***********************************************************************************
***********************************************************************************
@@ -138,6 +139,61 @@ let
tel
+---------------------------------------------------------------------
+* Paramatrize the AS (cf SyntaxTreeCore) by the kind of ident that is
+used. Indeed, during parsing, we cannot always know what Ident.long
+should we have, given an Ident.idref, or a Ident.t. The idea is then
+to write a function resolve_name which profile is
+
+(Ident.idref) SyntaxTreeCore.t -> (long) SyntaxTreeCore.t
+
+en fait, je ne devrais pas avoir une distinction entre Ident.t et
+Ident.long. Au parsing, je ne devrais generer que des idref, puis je
+devrais les transformer en Ident.t (apres merge entre les ident.t et
+ident.long)
+
+Meme les variables locales, je pourrais leur coller le nom du package
+ou leur noeud sont définis (juste histoire d'etre homogene)...
+Mouais. Disons que le nom du package pourrait être optionnel dans le
+type Ident.t, pour qu'on ne soit pas obligé de coller le nom du pack
+aux vars locales. a voir. L'interet de ma manip, c'est que une fois
+que la gestion des idents est cantonnée à un module travaillant sur
+un type abstrait, je peux changer ca à ma guise apres.
+
+par ailleurs, ce nouveau Ident.t contiendrait également la
+facon dont il était reférencé dans le programme source
+(pour le pretty-print). Il pourrait etre defini ainsi :
+
+ type t = pack_name * string * string
+
+
+nb : il reste meme des idref dans compiledData ! Je ne sais plus
+precisement pour quelle raison d'ailleurs. Je me souviens avoir
+essayer des mettre des ident à la place, et j'ai du renoncer car je
+ne m'en sortais pas.
+
+qu : à quoi ressemblera resolve_name ?
+
+ -> a un gros parcours recursif sur SyntaxTreeCore.t !
+
+
+o inconvénients
+ - va y avoir beaucoup de loc qui ne feront rien dans cette fonction...
+ - pas mal d'effort pour obtenir grosso-merdo le même code rangé autrement
+
+o avantages
+ - ce sera mieux rangé ! (tout ce qui traite de ca dans un module à lui)
+ - cette histoire de résolution de noms est éparpillée dans plein de
+ modules, qu'elle pollue et fait grossir (cf lazycompiler)
+ - merger ident.t et long, je suis sur que ca va simplifier plein de choses
+ -
+
+par exemple, les fonctions LazyCompiler.solve_x_idref n'auraient plus
+rien à faire dans ce module ! Le truc c'est que cette fonction n'est
+pas bien compliquée ni bien longue...
+-----------------------------------------------------------------------
+
+
* evalEq.translate_left_part : faire plus de verification sur les
index de slice
diff --git a/src/expandPack.ml b/src/expandPack.ml
index 9b2c3af1..454359e9 100644
--- a/src/expandPack.ml
+++ b/src/expandPack.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 29/05/2008 (at 15:01) by Erwan Jahier> *)
+(** Time-stamp: <modified the 03/06/2008 (at 11:34) by Erwan Jahier> *)
open Lxm
open SyntaxTree
@@ -82,7 +82,7 @@ let (doit:
| StaticParamNode (s, inl, outl, has_memory) -> (
let by_pos_op = match (arg.it) with
| StaticArgIdent idr ->
- ParserUtils.call_or_predef(Lxm.flagit ((idr,[])) arg.src)
+ CALL_n(Lxm.flagit ((idr,[])) arg.src)
| StaticArgNode by_pos_op -> by_pos_op
| _ -> instance_error ()
in
diff --git a/src/ident.ml b/src/ident.ml
index 3f936616..539da0af 100644
--- a/src/ident.ml
+++ b/src/ident.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 21/05/2008 (at 14:37) by Erwan Jahier> *)
+(** Time-stamp: <modified the 03/06/2008 (at 09:50) by Erwan Jahier> *)
(* J'ai appele ca symbol (mais ca remplace le ident) :
c'est juste une couche qui garantit l'unicite en memoire
@@ -138,3 +138,6 @@ let (long_of_idref : idref -> long) =
Some p -> (p, name_of_idref idr)
| None -> (!dft_pack_name, name_of_idref idr)
+
+
+(*************************************************************************)
diff --git a/src/lazyCompiler.ml b/src/lazyCompiler.ml
index c05d68bb..e9d7c54b 100644
--- a/src/lazyCompiler.ml
+++ b/src/lazyCompiler.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 30/05/2008 (at 16:50) by Erwan Jahier> *)
+(** Time-stamp: <modified the 03/06/2008 (at 15:03) by Erwan Jahier> *)
open Lxm
@@ -530,19 +530,18 @@ and (node_check_do: t -> CompiledData.node_key -> Lxm.t -> SymbolTab.t ->
(fun id lxm ->
try lookup_var local_env (Ident.of_idref id) lxm
with Not_found ->
- print_string ((Lxm.details lxm) ^
- "\n cannot find " ^ (Ident.string_of_idref id) ^
- " into the node variable table ");
- Hashtbl.iter
- (fun id vi_eff ->
- print_string(
- "\n\t" ^ (Ident.to_string id) ^ " -> " ^
- (CompiledDataDump.string_of_var_info_eff vi_eff))
- )
- local_env.lenv_vars;
- flush stdout;
- assert false
- );
+ raise (Compile_error(
+ lxm,
+ "\n*** '"^(Ident.string_of_idref id)^
+ "': Unknown variable.\n*** Current variables are: " ^
+ (Hashtbl.fold
+ (fun id vi_eff acc ->
+ acc ^ (Format.sprintf
+ "\n\t%s" (CompiledDataDump.string_of_var_info_eff vi_eff))
+ )
+ local_env.lenv_vars
+ ""
+ ))));
id2const =
(fun id lxm ->
try lookup_const local_env id lxm
diff --git a/src/main.ml b/src/main.ml
index f34f6d0a..bf68eaf2 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 30/05/2008 (at 17:15) by Erwan Jahier> *)
+(** Time-stamp: <modified the 03/06/2008 (at 10:16) by Erwan Jahier> *)
(** Here follows a description of the different modules used by this lus2lic compiler.
@@ -126,7 +126,8 @@ let test_lex ( lexbuf ) = (
(* Retourne un parse_tree *)
let lus_load lexbuf = (
- (Parser.sxLusFile Lexer.lexer lexbuf)
+ SolveIdent.recognize_predef_op
+ (Parser.sxLusFile Lexer.lexer lexbuf)
)
(* Dump d'un packbody *)
diff --git a/src/parser.mly b/src/parser.mly
index d4988cb1..415e6dad 100644
--- a/src/parser.mly
+++ b/src/parser.mly
@@ -250,7 +250,7 @@ let (treat_node_alias : bool -> Lxm.t -> static_param srcflagged list ->
name = nstr;
static_params = statics;
vars = vars;
- def = Alias (flagit (call_or_predef value) value.src);
+ def = Alias (flagit (CALL_n value) value.src);
has_mem = has_memory;
is_safe = true;
}
@@ -1186,10 +1186,10 @@ sxPredefOp:
*/
sxCallByPosExpression:
sxEffectiveNode TK_OPEN_PAR sxExpression TK_CLOSE_PAR
- { naryexp $1.src (call_or_predef $1) [$3] }
+ { naryexp $1.src (CALL_n $1) [$3] }
/* WARNING ! il faut remettre la liste à l'endroit */
| sxEffectiveNode TK_OPEN_PAR sxExpList2 TK_CLOSE_PAR
- { naryexp $1.src (call_or_predef $1) (List.rev $3) }
+ { naryexp $1.src (CALL_n $1) (List.rev $3) }
;
/* Effective node : une constrcution qui designe un noeud */
@@ -1233,9 +1233,9 @@ sxStaticArg:
| TK_CONST sxExpression
{ {src=$1 ; it=StaticArgConst $2 } }
| TK_NODE sxEffectiveNode
- { {src=$1 ; it=StaticArgNode (call_or_predef $2) } }
+ { {src=$1 ; it=StaticArgNode (CALL_n $2) } }
| TK_FUNCTION sxEffectiveNode
- { {src=$1 ; it=StaticArgNode (call_or_predef $2) } }
+ { {src=$1 ; it=StaticArgNode (CALL_n $2) } }
| sxPredefOp
{ {src=$1.src; it=StaticArgNode $1.it } }
/* un ident OU une expression simple (à résoudre) */
@@ -1245,10 +1245,7 @@ sxStaticArg:
match $1 with
| CallByPos (op, x) -> (
match op.it with
- | IDENT_n idref ->
- (match is_a_predef idref [] with
- | None -> {src=op.src ; it = StaticArgIdent idref }
- | Some predef -> {src=op.src; it= StaticArgNode predef})
+ | IDENT_n idref -> {src=op.src ; it = StaticArgIdent idref }
| _ -> {src=op.src ; it= StaticArgConst $1}
)
| CallByName _ ->
@@ -1260,7 +1257,7 @@ sxStaticArg:
{ {src=$1.src; it=StaticArgType $1} }
/* un node sans ambiguite */
| sxSurelyNode
- { {src=$1.src; it=StaticArgNode (call_or_predef $1)} }
+ { {src=$1.src; it=StaticArgNode (CALL_n $1)} }
;
sxSurelyNode:
diff --git a/src/parserUtils.ml b/src/parserUtils.ml
index 7a03fded..6c58533c 100644
--- a/src/parserUtils.ml
+++ b/src/parserUtils.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 27/05/2008 (at 16:54) by Erwan Jahier> *)
+(** Time-stamp: <modified the 03/06/2008 (at 14:40) by Erwan Jahier> *)
@@ -142,24 +142,4 @@ let bynameexp lxm op nelst = CallByName( {src = lxm ; it = op } , nelst )
open Ident
-(* used in the parser to recognize if an idref is a predefined operator *)
-let (is_a_predef : Ident.idref -> static_arg Lxm.srcflagged list -> by_pos_op option) =
- fun idref sargs ->
- match idref.id_pack with
- | None (* We consider that the Lustre package is «use»d by default *)
- | Some "Lustre" -> (
- try Some (Predef (Predef.string_to_op idref.id_id, sargs))
- with Not_found -> None
- )
- | Some _ -> None
-
-(* used in the parser to recognize if a node is a predefined operator *)
-let (call_or_predef : node_exp Lxm.srcflagged -> by_pos_op) =
- fun nef ->
- let {it=(idref, sargs); src=lxm } = nef in
- match is_a_predef idref sargs with
- | None -> CALL_n nef
- | Some op -> op
-
-
-
+
diff --git a/src/predef.ml b/src/predef.ml
index 60425170..6da21969 100644
--- a/src/predef.ml
+++ b/src/predef.ml
@@ -1,6 +1,6 @@
-(** Time-stamp: <modified the 27/05/2008 (at 17:05) by Erwan Jahier> *)
-
+(** Time-stamp: <modified the 03/06/2008 (at 14:21) by Erwan Jahier> *)
+(* XXX shoud not type int, real, and bool be handled there ? *)
type op =
(* zero-ary *)
@@ -137,7 +137,8 @@ let (string_to_op : string -> op) =
| "if" -> IF_n
(* n-ary *)
| "nor" -> NOR_n
- | "diese" -> DIESE_n (* XXX should i put "#" instead ??? *)
+ | "#" -> DIESE_n
+ | "diese" -> DIESE_n
(* overloaded operator *)
| "uminus" -> UMINUS_n
diff --git a/src/predefSemantics.ml b/src/predefSemantics.ml
index 3a19a7c9..cac4473e 100644
--- a/src/predefSemantics.ml
+++ b/src/predefSemantics.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 30/05/2008 (at 17:47) by Erwan Jahier> *)
+(** Time-stamp: <modified the 03/06/2008 (at 14:53) by Erwan Jahier> *)
open Predef
@@ -40,8 +40,8 @@ let (type_error2 : string -> string -> string -> 'a) =
let arity_error (v : 'a list) (expect : string) =
raise (EvalType_error(
- Printf.sprintf "arity error (%d arguments, whereas %s were expected)"
- (List.length v) expect))
+ Printf.sprintf "\n*** arity error: %d argument%s, whereas %s were expected"
+ (List.length v) (if List.length v>1 then "s" else "") expect))
(* exported *)
let (type_error_const : const_eff list -> string -> 'a) =
@@ -52,8 +52,8 @@ let (type_error_const : const_eff list -> string -> 'a) =
(* exported *)
let arity_error_const (v : const_eff list) (expect : string) =
raise (EvalConst_error(
- Printf.sprintf "arity error (%d arguments, whereas %s were expected)"
- (List.length v) expect))
+ Printf.sprintf "\n*** arity error: %d argument%s, whereas %s were expected"
+ (List.length v) (if List.length v>1 then "s" else "") expect))
let not_evaluable op l =
raise (EvalConst_error(
@@ -89,7 +89,7 @@ let aab_profile = [(id "i1",Any);(id "i2",Any)], [(id "o", b)] (* 'a -> 'a -> bo
let baaa_profile = [(id "c", b);(id "b1",Any);(id "b2",Any)], [(id "o",Any)]
(* for if-then-else *)
-(** overloaded operator profiless *)
+(** overloaded operator profiles *)
let oo_profile = [(id "i",Overload)], [(id "o",Overload)]
let ooo_profile = [(id "i1",Overload);(id "i2",Overload)], [(id "o",Overload)]
diff --git a/src/solveIdent.ml b/src/solveIdent.ml
new file mode 100644
index 00000000..028d5926
--- /dev/null
+++ b/src/solveIdent.ml
@@ -0,0 +1,162 @@
+(** Time-stamp: <modified the 03/06/2008 (at 14:19) by Erwan Jahier> *)
+
+
+let (get_predef : Ident.idref -> Predef.op option) =
+ fun idref ->
+ let get_op () =
+ try Some (Predef.string_to_op (Ident.to_string (Ident.name_of_idref idref)))
+ with Not_found -> None
+ in
+ match Ident.pack_of_idref idref with
+ | None -> get_op () (* The Lustre package is «use»d by default *)
+ | Some p -> if (Ident.pack_name_to_string p) = "Lustre" then get_op () else None
+
+open SyntaxTree
+open SyntaxTreeCore
+open Lxm
+
+let flag f x_flg = Lxm.flagit (f x_flg.it) x_flg.src
+
+let fopt f = function None -> None | Some x -> Some (f x)
+
+
+(* just a tedious recursive traversal of the syntax tree, replacing idref
+ that match predef op with the Predef constructor *)
+(* exported *)
+let rec (recognize_predef_op : SyntaxTree.t -> SyntaxTree.t) = function
+ | PRPackBody(sl,pb) -> PRPackBody(sl, r_packbody pb)
+ | PRPack_or_models(sl,pml) -> PRPack_or_models(sl,List.map r_pack_or_model pml)
+
+and r_pack_or_model = function
+ | NSPack(pi) -> NSPack(flag r_pack_info pi)
+ | NSModel(mi) -> NSModel(flag r_model_info mi)
+
+and r_pack_info pi = { pi with pa_def = r_pack_def pi.pa_def }
+
+and r_model_info mi =
+ { mi with
+ mo_needs = List.map (flag r_static_param) mi.mo_needs;
+ mo_provides = r_item_info_flg_list mi.mo_provides;
+ mo_body = r_packbody mi.mo_body;
+ }
+
+and r_pack_def = function
+ | PackGiven(pg) -> PackGiven(r_pack_given pg)
+ | PackInstance(pi) -> PackInstance(r_pack_instance pi)
+
+and r_pack_given pg = {
+ pg with
+ pg_provides = r_item_info_flg_list pg.pg_provides;
+ pg_body = r_packbody pg.pg_body;
+}
+
+and r_pack_instance pi = { pi with pi_args = List.map (flag r_static_arg) pi.pi_args }
+
+and r_static_param sp = sp
+
+and r_static_arg = function
+ | StaticArgIdent(idref) -> (
+ match get_predef idref with
+ | None -> StaticArgIdent idref
+ | Some predef -> StaticArgNode (Predef (predef,[]))
+ )
+ | StaticArgConst(ve) -> StaticArgConst(r_val_exp ve)
+ | StaticArgType(te) -> StaticArgType(te)
+ | StaticArgNode(by_pos_op) -> StaticArgNode(r_by_pos_op by_pos_op)
+
+and r_by_pos_op = function
+ | Predef(op,args) -> Predef(op,args) (* assert false *)
+ | CALL_n { src=lxm;it=(idref,sargs) } -> (
+ match get_predef idref with
+ | None -> CALL_n { src=lxm;it= r_node_exp (idref,sargs) }
+ | Some op -> Predef (op, List.map (flag r_static_arg) sargs)
+ )
+ | IDENT_n(idref) -> (
+ match get_predef idref with
+ | None -> IDENT_n(idref)
+ | Some op -> Predef (op,[])
+ )
+ | ARRAY_ACCES_n(val_exp) -> ARRAY_ACCES_n(r_val_exp val_exp)
+ | ARRAY_SLICE_n(slice_info) -> ARRAY_SLICE_n(r_slice_info slice_info)
+
+ | x -> x
+
+and r_node_exp (idref, sargs) =
+ (idref, List.map (flag r_static_arg) sargs)
+
+
+and r_slice_info si = {
+ si_first = r_val_exp si.si_first;
+ si_last = r_val_exp si.si_last;
+ si_step = fopt r_val_exp si.si_step;
+}
+
+and r_val_exp = function
+ | CallByPos (by_pos_op, Oper vel) ->
+ CallByPos(flag r_by_pos_op by_pos_op, Oper (List.map r_val_exp vel))
+ | CallByName(by_name_op, args) ->
+ CallByName(by_name_op, List.map (fun (id, ve) -> id, r_val_exp ve) args)
+
+and r_item_info_flg_list = function
+ | None -> None
+ | Some iil -> Some (List.map (flag r_item_info) iil)
+
+and r_item_info = function
+ | ConstInfo ci -> ConstInfo(r_const_info ci)
+ | TypeInfo ti -> TypeInfo (r_type_info ti)
+ | NodeInfo ni -> NodeInfo (r_node_info ni)
+
+and r_const_info = function
+ | ExternalConst(id,te,ve_opt) -> ExternalConst(id,te, fopt r_val_exp ve_opt)
+ | EnumConst(id,te) -> EnumConst(id,te)
+ | DefinedConst(id,te,ve) -> DefinedConst(id,te, r_val_exp ve)
+
+and r_type_info = function
+ | ExternalType(id) -> ExternalType(id)
+ | AliasedType(id,te) -> AliasedType(id,te)
+ | EnumType(id,te) -> EnumType(id,te)
+ | StructType(sti) -> StructType(r_struct_type_info sti)
+ | ArrayType(id,te,ve) -> ArrayType(id,te, r_val_exp ve)
+
+and r_node_info ni = {
+ ni with
+ static_params = List.map (flag r_static_param) ni.static_params;
+ def = r_node_def ni.def;
+}
+and r_struct_type_info sti =
+ Hashtbl.iter
+ (fun id fi -> Hashtbl.replace sti.st_ftable id (flag r_field_info fi))
+ sti.st_ftable;
+ sti
+
+and r_field_info fi = { fi with fd_value = fopt r_val_exp fi.fd_value }
+
+and r_node_def = function
+ | Extern -> Extern
+ | Abstract -> Abstract
+ | Body(node_body) -> Body(r_node_body node_body)
+ | Alias(by_pos_op) -> Alias(flag r_by_pos_op by_pos_op)
+
+and r_packbody pb =
+ Hashtbl.iter
+ (fun id i -> Hashtbl.replace pb.pk_const_table id (flag r_const_info i))
+ pb.pk_const_table;
+ Hashtbl.iter
+ (fun id i -> Hashtbl.replace pb.pk_type_table id (flag r_type_info i))
+ pb.pk_type_table;
+ Hashtbl.iter
+ (fun id i -> Hashtbl.replace pb.pk_node_table id (flag r_node_info i))
+ pb.pk_node_table;
+ pb
+
+and r_node_body nb = {
+ asserts = List.map (flag r_val_exp) nb.asserts;
+ eqs = List.map (flag r_eq_info) nb.eqs;
+}
+and r_eq_info (lpl,ve) = (List.map r_left_part lpl, r_val_exp ve)
+
+and r_left_part = function
+ | LeftVar(id) -> LeftVar(id)
+ | LeftField(lp,id) -> LeftField(r_left_part lp,id)
+ | LeftArray(lp,ve) -> LeftArray(r_left_part lp, flag r_val_exp ve)
+ | LeftSlice(lp,si) -> LeftSlice(r_left_part lp, flag r_slice_info si)
diff --git a/src/solveIdent.mli b/src/solveIdent.mli
new file mode 100644
index 00000000..affc5df7
--- /dev/null
+++ b/src/solveIdent.mli
@@ -0,0 +1,21 @@
+(** Time-stamp: <modified the 03/06/2008 (at 14:25) by Erwan Jahier> *)
+
+(**
+ Perform a (tedious) recursive traversal of the syntax tree, and
+ replace idref that corresponds to predefined items with the
+ SyntaxTreeCore.Predef constructor.
+
+ TODO : Solves idref references
+
+ To do that, first paramatrize the AS (cf SyntaxTreeCore) by the
+ kind of ident that is used. Indeed, during parsing, we cannot
+ always know what Ident.long should we have, given an Ident.idref,
+ or a Ident.t. The idea is then to write a function resolve_name
+ which profile is
+
+ (Ident.idref) SyntaxTreeCore.t -> (long) SyntaxTreeCore.t
+
+*)
+
+
+val recognize_predef_op : SyntaxTree.t -> SyntaxTree.t
diff --git a/src/syntaxTab.ml b/src/syntaxTab.ml
index 21d2e4fc..e3ad29ad 100644
--- a/src/syntaxTab.ml
+++ b/src/syntaxTab.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 02/06/2008 (at 13:13) by Erwan Jahier> *)
+(** Time-stamp: <modified the 02/06/2008 (at 14:29) by Erwan Jahier> *)
(**
Table des infos sources : une couche au dessus de SyntaxTree pour mieux
@@ -108,10 +108,13 @@ let (pack_body_env: t -> Ident.pack_name -> SymbolTab.t) =
let (pack_prov_env: t -> Ident.pack_name -> Lxm.t -> SymbolTab.t option) =
fun this p lxm ->
try (Hashtbl.find this.st_pack_mng_tab p).pm_provide_stab
- with Not_found ->
- raise(Compile_error(
- lxm, "\n*** Could not find package " ^(Ident.pack_name_to_string p) ^
- " in the package table"))
+ with Not_found -> raise(Compile_error(lxm, ""))
+
+(** XXX This can occur is a lot of different contexts, so it is difficult to
+ give a good error message. *)
+
+(* "\n*** Could not find package " ^(Ident.pack_name_to_string p) ^
+ " in the package table" *)
diff --git a/src/syntaxTreeCore.ml b/src/syntaxTreeCore.ml
index 7f8b89de..424ab2a5 100644
--- a/src/syntaxTreeCore.ml
+++ b/src/syntaxTreeCore.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 29/05/2008 (at 09:42) by Erwan Jahier> *)
+(** Time-stamp: <modified the 02/06/2008 (at 16:27) by Erwan Jahier> *)
(** (Raw) Abstract syntax tree of source programs. *)
@@ -88,7 +88,7 @@ and by_pos_op =
(* zeroaire *)
| Predef of Predef.op * static_arg srcflagged list (* e.g., map<<toto,3>> *)
| CALL_n of node_exp srcflagged (* e.g., a_node<<xx>> *)
- | IDENT_n of Ident.idref
+ | IDENT_n of Ident.idref (* constant or variable *)
| PRE_n
| ARROW_n
diff --git a/src/test/should_work/fab_test/lecteur.lus b/src/test/should_work/fab_test/lecteur.lus
index d2c86b1b..2bb8dd3e 100644
--- a/src/test/should_work/fab_test/lecteur.lus
+++ b/src/test/should_work/fab_test/lecteur.lus
@@ -1,15 +1,15 @@
-node Environnement(diff: int; plus,moins: bool) returns (ok: bool);
+node Environnement(diff: int; Plus,Moins: bool) returns (ok: bool);
let
ok = (-4 <= diff and diff <= 4) and
- (if (true -> pre plus) then diff >= 1 else true) and
- (if (false -> pre moins) then diff <= -1 else true);
+ (if (true -> pre Plus) then diff >= 1 else true) and
+ (if (false -> pre Moins) then diff <= -1 else true);
tel
-node Controleur(diff: int) returns (vitesse: int; plus,moins: bool);
+node Controleur(diff: int) returns (vitesse: int; Plus,Moins: bool);
let
vitesse = 0 -> pre(vitesse)+diff;
- plus = vitesse <= 9;
- moins = vitesse >= 11;
+ Plus = vitesse <= 9;
+ Moins = vitesse >= 11;
tel
node Propriete(vitesse: int) returns (ok: bool);
@@ -23,10 +23,10 @@ tel
node lecteur(diff:int) returns (ok: bool);
var vitesse: int;
- plus,moins,realiste: bool;
+ Plus,Moins,realiste: bool;
let
- (vitesse,plus,moins) = Controleur(diff);
- realiste = Environnement(diff,plus,moins);
+ (vitesse,Plus,Moins) = Controleur(diff);
+ realiste = Environnement(diff,Plus,Moins);
assert(realiste);
ok = Propriete(vitesse);
tel
diff --git a/src/test/test.res.exp b/src/test/test.res.exp
index 95e7fa8b..40db3a49 100644
--- a/src/test/test.res.exp
+++ b/src/test/test.res.exp
@@ -8437,37 +8437,37 @@ node lecteur__Controleur(
diff:int)
returns (
vitesse:int;
- plus:bool;
- moins:bool);
+ Plus:bool;
+ Moins:bool);
let
vitesse = 0 -> (pre(vitesse) + diff);
- plus = (vitesse <= 9);
- moins = (vitesse >= 11);
+ Plus = (vitesse <= 9);
+ Moins = (vitesse >= 11);
tel
-- end of node lecteur__Controleur
node lecteur__Environnement(
diff:int;
- plus:bool;
- moins:bool)
+ Plus:bool;
+ Moins:bool)
returns (
ok:bool);
let
- ok = ((((-(4) <= diff) and (diff <= 4)) and if (true -> pre(plus)) then
- ((diff >= 1)) else (true)) and if (false -> pre(moins)) then ((diff <=
+ ok = ((((-(4) <= diff) and (diff <= 4)) and if (true -> pre(Plus)) then
+ ((diff >= 1)) else (true)) and if (false -> pre(Moins)) then ((diff <=
-(1))) else (true));
tel
-- end of node lecteur__Environnement
node lecteur__lecteur(diff:int) returns (ok:bool);
var
vitesse:int;
- plus:bool;
- moins:bool;
+ Plus:bool;
+ Moins:bool;
realiste:bool;
let
assert(realiste);
- (vitesse, plus, moins) = lecteur__Controleur(diff);
- realiste = lecteur__Environnement(diff, plus, moins);
+ (vitesse, Plus, Moins) = lecteur__Controleur(diff);
+ realiste = lecteur__Environnement(diff, Plus, Moins);
ok = lecteur__Propriete(vitesse);
tel
-- end of node lecteur__lecteur
--
GitLab