diff --git a/src/lxm.ml b/src/lxm.ml
index 285e525b8c7cb5d89d0b99ed1724bd29aa8f0a06..e6df9487f14436c6c8887508b685d5e07692683c 100644
--- a/src/lxm.ml
+++ b/src/lxm.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 28/05/2008 (at 14:09) by Erwan Jahier> *)
+(** Time-stamp: <modified the 30/05/2008 (at 15:42) by Erwan Jahier> *)
(** Common to lus2lic and lic2loc *)
@@ -78,4 +78,10 @@ let make ( lexbuf ) = (
)
+let make_string ( lexbuf ) =
+ let lxm = make lexbuf in
+ { lxm with _str = String.sub lxm._str 1 ((String.length lxm._str)-2) }
+
+
+
let last_made () = !last_lexeme
diff --git a/src/lxm.mli b/src/lxm.mli
index b2184e223ec0d329a91987e795c823960cc03c8a..0a40d8e2c4948c012b99a92af9574015553d4084 100644
--- a/src/lxm.mli
+++ b/src/lxm.mli
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 14/04/2008 (at 17:53) by Erwan Jahier> *)
+(** Time-stamp: <modified the 30/05/2008 (at 15:42) by Erwan Jahier> *)
(** Common to lus2lic and lic2loc *)
@@ -28,6 +28,8 @@ val cend : t -> int
val make : Lexing.lexbuf -> t
val new_line : Lexing.lexbuf -> unit
+(* remove the quotes from the string *)
+val make_string: Lexing.lexbuf -> t
(** compiler interface *)
diff --git a/src/main.ml b/src/main.ml
index fd1cfac03e7e41083140c950102d8f9bd1dc546a..f71ec7a4a2fcef52120e904f0f3bc1baa3121b78 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 28/05/2008 (at 14:30) by Erwan Jahier> *)
+(** Time-stamp: <modified the 30/05/2008 (at 15:37) by Erwan Jahier> *)
(** Here follows a description of the different modules used by this lus2lic compiler.
@@ -159,15 +159,16 @@ type maybe_packed =
let (get_source_list : string list -> SyntaxTree.pack_or_model list) =
fun infile_list ->
- let (get_one_source : string -> maybe_packed) =
+ let (get_one_source : string -> string list * maybe_packed) =
fun infile ->
- let inchannel = open_in infile in
+ let inchannel =
+ Verbose.print_string ~level:3
+ ("Opening file " ^ (Sys.getcwd ()) ^ infile ^ "\n");
+ open_in infile in
let lexbuf = Lexing.from_channel inchannel in
- Verbose.print_string ~level:3 ("Opening file " ^ infile ^ "\n");
Global.vars.current_file <- infile;
-
match (lus_load lexbuf) with
- | PRPackBody pbdy ->
+ | PRPackBody(incl_files, pbdy) ->
let nme =
try Filename.chop_extension (Filename.basename infile)
with _ -> print_string ("*** '"^infile^"': Bad file name\n"); exit 1
@@ -175,27 +176,38 @@ let (get_source_list : string list -> SyntaxTree.pack_or_model list) =
let pi =
SyntaxTree.give_pack_this_name (Ident.pack_name_of_string nme) pbdy
in
- Unpacked (NSPack (Lxm.flagit pi (Lxm.dummy nme)))
- | PRPack_or_models nsl -> Packed nsl
+ incl_files, Unpacked (NSPack (Lxm.flagit pi (Lxm.dummy nme)))
+ | PRPack_or_models(incl_files, nsl) -> incl_files, Packed nsl
in
- let (get_remaining_source_list : maybe_packed -> string -> maybe_packed) =
- fun acc infile ->
- match acc, get_one_source infile with
- | Unpacked _, _
- | _, Unpacked _ ->
- print_string ("old-style (un-packaged) lustre files can " ^
- " not be mixed with packages, nor be " ^
- " defined in more than 1 file.");
- exit 1
- | Packed l1, Packed l2 -> Packed (l1@l2)
-
+ let rec (get_remaining_source_list : maybe_packed * string list * string list ->
+ maybe_packed * string list * string list) =
+ fun (maybe_pack, compiled, to_be_compiled) ->
+ match to_be_compiled with
+ | [] -> (maybe_pack, compiled, [])
+ | infile::tail ->
+ if List.mem infile compiled then
+ get_remaining_source_list (maybe_pack, compiled, tail)
+ else
+ let included_files, pack = get_one_source infile in
+ let new_maybe_pack =
+ match maybe_pack, pack with
+ | Unpacked _, _
+ | _, Unpacked _ ->
+ print_string ("old-style (un-packaged) lustre files can " ^
+ " not be mixed with packages, nor be " ^
+ " defined in more than 1 file.");
+ exit 1
+ | Packed l1, Packed l2 -> Packed (l1@l2)
+ in
+ get_remaining_source_list(
+ new_maybe_pack,
+ infile::compiled,
+ tail@included_files)
in
- let pack_list =
- assert (infile_list <> []);
- List.fold_left
- get_remaining_source_list
- (get_one_source (List.hd infile_list))
- (List.tl infile_list)
+ let first_file = assert (infile_list <> []); List.hd infile_list in
+ let included_files, first_pack = get_one_source first_file in
+ let (pack_list,_,_) = get_remaining_source_list
+ (first_pack, [first_file], (List.tl infile_list) @ included_files)
in
match pack_list with
| Packed l -> l
diff --git a/src/parser.mly b/src/parser.mly
index 18a14fbbfdfeca948bc3881bcb566fe74be39f3c..a18480d2b86e17d3b88c984238ce89a303a01a23 100644
--- a/src/parser.mly
+++ b/src/parser.mly
@@ -306,7 +306,6 @@ let (treat_external_node : bool -> Lxm.t ->
add_info node_table "(extern) node" ext_nodelxm ninfo ;
def_list := (NodeItem (Lxm.id (ext_nodelxm),statics)) :: !def_list
-
(**********************************************************************************)
(**********************************************************************************)
(**********************************************************************************)
@@ -395,6 +394,9 @@ let (treat_external_node : bool -> Lxm.t ->
%token <Lxm.t> TK_IS
%token <Lxm.t> TK_BODY
%token <Lxm.t> TK_END
+%token <Lxm.t> TK_INCLUDE
+%token <Lxm.t> TK_STRING
+/* %token <Lxm.t> TK_QUOTE */
/* Priorities */
@@ -448,13 +450,13 @@ or a list of pack/model declaration
sxLusFile:
/* WARNING ! il faut remettre la liste à l'endroit */
- sxPackBody TK_EOF
+ sxIncludeList sxPackBody TK_EOF
{
- SyntaxTree.PRPackBody $1
+ SyntaxTree.PRPackBody($1, $2)
}
-| sxPackList TK_EOF
+| sxIncludeList sxPackList TK_EOF
{
- SyntaxTree.PRPack_or_models (List.rev $1)
+ SyntaxTree.PRPack_or_models ($1, List.rev $2)
}
;
@@ -474,9 +476,20 @@ sxOnePack:
{ SyntaxTree.NSPack $1 }
;
+sxInclude:
+ TK_INCLUDE TK_STRING
+ { (Lxm.str $2) }
+;
+
+sxIncludeList:
+ { [] }
+| sxInclude sxIncludeList
+ { $1::$2 }
+;
+
/*
Pour les provides, on rend des decls, bien
-que synataxiquement, on n'autorise pas n'importe quoi ...
+que syntaxiquement, on n'autorise pas n'importe quoi ...
*/
sxProvides:
diff --git a/src/syntaxTree.ml b/src/syntaxTree.ml
index f2bb24a9cf3d8b51ef11b71127dde6aad8b9bec1..5f3b7a8f018d211bf17f1e4840058c35e5bd35b2 100644
--- a/src/syntaxTree.ml
+++ b/src/syntaxTree.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 10/03/2008 (at 11:07) by Erwan Jahier> *)
+(** Time-stamp: <modified the 30/05/2008 (at 10:26) by Erwan Jahier> *)
(** (Raw) Abstract syntax tree of source programs.
@@ -23,8 +23,8 @@ type 'a error =
(**********************************************************************************)
type t =
- PRPackBody of packbody
- | PRPack_or_models of pack_or_model list
+ PRPackBody of string list * packbody
+ | PRPack_or_models of string list * pack_or_model list
and
pack_or_model =
NSPack of pack_info srcflagged