fix bug when loading files (.grs ou .lp) with relative filename

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@6811 7838e531-6607-4d57-9587-6c381814729c

src/grew_ast.ml

@@ -101,6 +101,7 @@ module Ast = struct
       confluent: bool;
       module_doc:string;
       mod_loc:Loc.t;
+      mod_dir: string; (* the directory where the module is defined (for lp file localisation) *)
     }
         
   type sequence = {

src/grew_ast.mli

@@ -94,6 +94,7 @@ module Ast : sig
       confluent: bool;
       module_doc:string;
       mod_loc:Loc.t;
+      mod_dir: string; (* the directory where the module is defined (for lp file localisation) *)
     }
         
   type sequence = {

src/grew_grs.ml

@@ -171,7 +171,7 @@ module Modul = struct
        name = ast_module.Ast.module_id;
        local_labels = locals; 
        bad_labels = List.map Label.from_string ast_module.Ast.bad_labels;
-       rules = List.map (Rule.build ~locals) ast_module.Ast.rules;
+       rules = List.map (Rule.build ~locals ast_module.Ast.mod_dir) ast_module.Ast.rules;
        confluent = ast_module.Ast.confluent;
        loc = ast_module.Ast.mod_loc;
      } in

src/grew_rule.ml

@@ -164,7 +164,7 @@ module Rule = struct
       | x::t -> Error.bug ~loc "Illegal feature definition '%s' in the lexical rule" x in
     parse_pat_vars vars
     
-  let build ?(locals=[||]) rule_ast = 
+  let build ?(locals=[||]) dir rule_ast = 
 
     let (param, pat_vars, cmd_vars) = 
       match rule_ast.Ast.param with
@@ -173,7 +173,7 @@ module Rule = struct
           let (pat_vars, cmd_vars) = parse_vars rule_ast.Ast.rule_loc vars in
           let nb_pv = List.length pat_vars in
           let nb_cv = List.length cmd_vars in
-          let param = Lex_par.load ~loc:rule_ast.Ast.rule_loc nb_pv nb_cv file in
+          let param = Lex_par.load ~loc:rule_ast.Ast.rule_loc dir nb_pv nb_cv file in
           (Some param, pat_vars, cmd_vars) in
           (* try *)
           (*   let lines = File.read file in *)

src/grew_rule.mli

@@ -39,9 +39,12 @@ module Rule : sig
 
   val get_name: t -> string
 
+  (** [get_loc t] returns the file location of the rule definition *)
   val get_loc: t -> Loc.t
 
-  val build: ?locals:Label.decl array -> Ast.rule -> t
+  (** [build ?local dir ast_rule] returns the Rule.t value corresponding to [ast_rule].
+      [dir] is used for localisation of lp files *)
+  val build: ?locals:Label.decl array -> string -> Ast.rule -> t
 
   (* raise Stop if some command fails to apply *)
   val normalize: 

src/grew_utils.ml

@@ -503,9 +503,14 @@ module Lex_par = struct
     Str.global_replace (Str.regexp "\\( \\|\t\\)*$") ""
     (Str.global_replace (Str.regexp "^\\( \\|\t\\)*") "" s)
 
-  let load ?loc nb_p nb_c file =
+  let load ?loc dir nb_p nb_c file =
     try
-      let lines = File.read file in
+      let full_file = 
+        if Filename.is_relative file
+        then Filename.concat dir file
+        else file in
+      
+      let lines = File.read full_file in
       let param =
           (List.map
              (fun line ->
@@ -514,12 +519,16 @@ module Lex_par = struct
                | [args] when nb_c = 0 ->
                    (match Str.split (Str.regexp "#") args with
                    | l when List.length l = nb_p -> (l,[])
-                   | _ -> Error.bug "Illegal param line in file \"%s\", the line \"%s\" doesn't contain %d args" file line nb_p)
+                   | _ -> Error.bug 
+                         "Illegal param line in file \"%s\", the line \"%s\" doesn't contain %d args"
+                         full_file line nb_p)
                | [args; values] ->
                    (match (Str.split (Str.regexp "#") args, Str.split (Str.regexp "#") values) with
                    | (lp,lc) when List.length lp = nb_p && List.length lc = nb_c -> (lp,lc)
-                   | _ -> Error.bug "Illegal param line in file \"%s\", the line \"%s\" doesn't contain %d args and %d values" file line nb_p nb_c)
-               | _ -> Error.bug "Illegal param line in file '%s' line '%s'" file line
+                   | _ -> Error.bug 
+                         "Illegal param line in file \"%s\", the line \"%s\" doesn't contain %d args and %d values"
+                         full_file line nb_p nb_c)
+               | _ -> Error.bug "Illegal param line in file '%s' line '%s'" full_file line
              ) lines
           ) in
       param

src/grew_utils.mli

@@ -177,8 +177,8 @@ end
 module Lex_par: sig
   type t
 
-  (** [load ?loc nb_pattern_var nb_command_var file] *)
-  val load: ?loc: Loc.t -> int -> int -> string -> t
+  (** [load ?loc local_dir_name nb_pattern_var nb_command_var file] *)
+  val load: ?loc: Loc.t -> string -> int -> int -> string -> t
 
   (** [filter index atom t] returns the subset of [t] which contains only entries 
       which refers to [atom] at the [index]^th pattern_var.

src/parser/gr_grs_parser.mly

@@ -232,7 +232,8 @@ grew_module:
               rules = begin match r with None -> [] | Some r -> r; end;
               confluent = conf;
               module_doc = (match doc with Some d -> d | None -> "");
-              mod_loc = (!Parser_global.current_file, snd id); 
+              mod_loc = (!Parser_global.current_file, snd id);
+              mod_dir = "";
             }
           }
 

src/parser/grew_parser.ml

@@ -62,20 +62,22 @@ let parse_handle file fct lexbuf =
    *)
   let grs_of_file main_file =
     let grs_with_includes = parse_file_to_grs_with_includes main_file in
-    let rec flatten_modules = function
+    let rec flatten_modules current_file = function
       | [] -> []
-      | Ast.Modul m :: tail -> m :: (flatten_modules tail)
+      | Ast.Modul m :: tail -> 
+          {m with Ast.mod_dir = Filename.dirname current_file} 
+          :: (flatten_modules current_file tail)
       | Ast.Includ (inc_file,loc) :: tail -> 
           let sub_file = 
             if Filename.is_relative inc_file
-            then Filename.concat (Filename.dirname main_file) inc_file
+            then Filename.concat (Filename.dirname current_file) inc_file
             else inc_file in
-          (flatten_modules (parse_file_to_module_list loc sub_file))
-          @ (flatten_modules tail) in
+          (flatten_modules sub_file (parse_file_to_module_list loc sub_file))
+          @ (flatten_modules current_file tail) in
     {
      Ast.domain = grs_with_includes.Ast.domain_wi;
      Ast.labels = grs_with_includes.Ast.labels_wi;
-     Ast.modules = flatten_modules grs_with_includes.Ast.modules_wi;
+     Ast.modules = flatten_modules main_file grs_with_includes.Ast.modules_wi;
      Ast.sequences = grs_with_includes.Ast.sequences_wi;
    }