grew_loader.ml 4.68 KB
Newer Older
bguillaum's avatar
bguillaum committed
1 2 3 4 5 6 7 8 9 10
(**********************************************************************************)
(*    Libcaml-grew - a Graph Rewriting library dedicated to NLP applications      *)
(*                                                                                *)
(*    Copyright 2011-2013 Inria, Université de Lorraine                           *)
(*                                                                                *)
(*    Webpage: http://grew.loria.fr                                               *)
(*    License: CeCILL (see LICENSE folder or "http://www.cecill.info")            *)
(*    Authors: see AUTHORS file                                                   *)
(**********************************************************************************)

bguillaum's avatar
bguillaum committed
11
open Grew_base
bguillaum's avatar
bguillaum committed
12
open Grew_ast
pj2m's avatar
pj2m committed
13

bguillaum's avatar
bguillaum committed
14
module Loader = struct
pj2m's avatar
pj2m committed
15

bguillaum's avatar
bguillaum committed
16
  (* message and location *)
bguillaum's avatar
bguillaum committed
17
  exception Error of (string * Loc.t option)
bguillaum's avatar
bguillaum committed
18

bguillaum's avatar
bguillaum committed
19
  (* ------------------------------------------------------------------------------------------*)
20
  (** general function to handle parse errors *)
bguillaum's avatar
bguillaum committed
21 22
  let parse_handle file fct lexbuf =
    try fct lexbuf with
bguillaum's avatar
bguillaum committed
23
      | Grew_lexer.Error msg ->
bguillaum's avatar
bguillaum committed
24
        let cp = lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum in
bguillaum's avatar
bguillaum committed
25 26
        raise (Error ("Lexing error:"^msg, Some (Loc.file_line file cp)))
      | Grew_parser.Error ->
bguillaum's avatar
bguillaum committed
27
        let cp = lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum in
bguillaum's avatar
bguillaum committed
28
        raise (Error ("Syntax error:"^(Lexing.lexeme lexbuf), Some (Loc.file_line file cp)))
bguillaum's avatar
bguillaum committed
29 30
      | Failure msg ->
        let cp = lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum in
bguillaum's avatar
bguillaum committed
31
        raise (Error ("Failure:"^msg, Some (Loc.file_line file cp)))
bguillaum's avatar
bguillaum committed
32 33
      | Error.Build (msg,_) ->
        let cp = lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum in
bguillaum's avatar
bguillaum committed
34
        raise (Error ("Syntax error:"^msg, Some (Loc.file_line file cp)))
bguillaum's avatar
bguillaum committed
35 36
      | err ->
        let cp = lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum in
bguillaum's avatar
bguillaum committed
37
        raise (Error ("Unexpected error:"^(Printexc.to_string err), Some (Loc.file_line file cp)))
bguillaum's avatar
bguillaum committed
38 39 40

  (* ------------------------------------------------------------------------------------------*)
  let parse_file_to_grs_with_includes file =
41
    try
bguillaum's avatar
bguillaum committed
42
      Global.init file;
43
      let in_ch = open_in file in
bguillaum's avatar
bguillaum committed
44
      let lexbuf = Lexing.from_channel in_ch in
bguillaum's avatar
bguillaum committed
45
      let grs = parse_handle file (Grew_parser.grs_with_include Grew_lexer.global) lexbuf in
bguillaum's avatar
bguillaum committed
46 47
      close_in in_ch;
      grs
bguillaum's avatar
bguillaum committed
48
    with Sys_error msg -> raise (Error (msg, None))
pj2m's avatar
pj2m committed
49

bguillaum's avatar
bguillaum committed
50
  (* ------------------------------------------------------------------------------------------*)
51
  let parse_file_to_module_list loc file =
52
    try
bguillaum's avatar
bguillaum committed
53
      Global.init file;
54
      let in_ch = open_in file in
bguillaum's avatar
bguillaum committed
55
      let lexbuf = Lexing.from_channel in_ch in
bguillaum's avatar
bguillaum committed
56
      let module_list = parse_handle file (Grew_parser.included Grew_lexer.global) lexbuf in
bguillaum's avatar
bguillaum committed
57 58
      close_in in_ch;
      module_list
bguillaum's avatar
bguillaum committed
59
    with Sys_error msg-> raise (Error (msg, None))
pj2m's avatar
pj2m committed
60

bguillaum's avatar
bguillaum committed
61
  (* ------------------------------------------------------------------------------------------*)
62 63 64 65
  (**
     [parse_string file] where [file] is a file following the grew syntax
     @param file the file to parse
     @return a syntactic tree of the parsed file
bguillaum's avatar
bguillaum committed
66
  *)
bguillaum's avatar
bguillaum committed
67
  let grs main_file =
68
    let grs_with_includes = parse_file_to_grs_with_includes main_file in
69
    let rec flatten_modules current_file = function
70
      | [] -> []
bguillaum's avatar
bguillaum committed
71 72 73 74 75 76 77 78 79 80
      | 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 current_file) inc_file
          else inc_file in
        (flatten_modules sub_file (parse_file_to_module_list loc sub_file))
        @ (flatten_modules current_file tail) in
81
    {
bguillaum's avatar
bguillaum committed
82 83 84 85 86
      Ast.domain = grs_with_includes.Ast.domain_wi;
      Ast.labels = grs_with_includes.Ast.labels_wi;
      Ast.modules = flatten_modules main_file grs_with_includes.Ast.modules_wi;
      Ast.sequences = grs_with_includes.Ast.sequences_wi;
    }
bguillaum's avatar
bguillaum committed
87

bguillaum's avatar
bguillaum committed
88
  (* ------------------------------------------------------------------------------------------*)
bguillaum's avatar
bguillaum committed
89
  let gr file =
90
    try
bguillaum's avatar
bguillaum committed
91
      Global.init file;
92
      let in_ch = open_in file in
bguillaum's avatar
bguillaum committed
93
      let lexbuf = Lexing.from_channel in_ch in
bguillaum's avatar
bguillaum committed
94
      let gr = parse_handle file (Grew_parser.gr Grew_lexer.global) lexbuf in
bguillaum's avatar
bguillaum committed
95 96
      close_in in_ch;
      gr
bguillaum's avatar
bguillaum committed
97
    with Sys_error msg-> raise (Error (msg, None))
bguillaum's avatar
bguillaum committed
98 99

  (* ------------------------------------------------------------------------------------------*)
bguillaum's avatar
bguillaum committed
100
  let pattern file =
bguillaum's avatar
bguillaum committed
101
    try
bguillaum's avatar
bguillaum committed
102
      Global.init file;
bguillaum's avatar
bguillaum committed
103 104
      let in_ch = open_in file in
      let lexbuf = Lexing.from_channel in_ch in
bguillaum's avatar
bguillaum committed
105
      let gr = parse_handle file (Grew_parser.pattern Grew_lexer.global) lexbuf in
bguillaum's avatar
bguillaum committed
106 107
      close_in in_ch;
      gr
bguillaum's avatar
bguillaum committed
108
    with Sys_error msg-> raise (Error (msg, None))
bguillaum's avatar
bguillaum committed
109

bguillaum's avatar
bguillaum committed
110
end (* module Loader *)