grew_loader.ml 7.32 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

14 15 16 17 18 19 20
(* ------------------------------------------------------------------------------------------*)
(** general function to handle parse errors *)
let parse_handle file fct lexbuf =
  let get_loc () = Loc.file_line file !Global.current_line in
  try fct lexbuf with
    | Grew_lexer.Error msg -> Error.parse ~loc:(get_loc ()) "Lexing error: %s" msg
    | Grew_parser.Error -> Error.parse ~loc:(get_loc ()) "Syntax error: %s" (Lexing.lexeme lexbuf)
bguillaum's avatar
bguillaum committed
21 22
    | Error.Build (msg, None) -> Error.parse ~loc:(get_loc ()) "Syntax error: %s" msg
    | Error.Build (msg, Some loc) -> Error.parse ~loc "Syntax error: %s" msg
23 24
    | Failure msg -> Error.parse ~loc:(get_loc ()) "Failure: %s" msg
    | err -> Error.bug ~loc:(get_loc ()) "Unexpected error: %s" (Printexc.to_string err)
pj2m's avatar
pj2m committed
25

26
module Loader = struct
bguillaum's avatar
bguillaum committed
27

bguillaum's avatar
bguillaum committed
28 29

  (* ------------------------------------------------------------------------------------------*)
30
  let parse_file_to_grs_wi file =
31
    try
bguillaum's avatar
bguillaum committed
32
      Global.init file;
33
      let in_ch = open_in file in
bguillaum's avatar
bguillaum committed
34
      let lexbuf = Lexing.from_channel in_ch in
35
      let grs = parse_handle file (Grew_parser.grs_wi Grew_lexer.global) lexbuf in
bguillaum's avatar
bguillaum committed
36 37
      close_in in_ch;
      grs
38
    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.parse_file_to_grs_wi] %s" msg
pj2m's avatar
pj2m committed
39

bguillaum's avatar
bguillaum committed
40
  (* ------------------------------------------------------------------------------------------*)
41
  let parse_file_to_module_list file =
42
    try
bguillaum's avatar
bguillaum committed
43
      Global.init file;
44
      let in_ch = open_in file in
bguillaum's avatar
bguillaum committed
45
      let lexbuf = Lexing.from_channel in_ch in
bguillaum's avatar
bguillaum committed
46
      let module_list = parse_handle file (Grew_parser.included Grew_lexer.global) lexbuf in
bguillaum's avatar
bguillaum committed
47 48
      close_in in_ch;
      module_list
49
    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.parse_file_to_module_list] %s" msg
pj2m's avatar
pj2m committed
50

51 52 53 54 55 56 57 58 59
  (* ------------------------------------------------------------------------------------------*)
  let domain file =
    try
      Global.init file;
      let in_ch = open_in file in
      let lexbuf = Lexing.from_channel in_ch in
      let gr = parse_handle file (Grew_parser.domain Grew_lexer.global) lexbuf in
      close_in in_ch;
      gr
60
    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.domain] %s" msg
61

bguillaum's avatar
bguillaum committed
62
  (* ------------------------------------------------------------------------------------------*)
63 64 65 66
  (**
     [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
67
  *)
bguillaum's avatar
bguillaum committed
68
  let grs main_file =
bguillaum's avatar
bguillaum committed
69 70 71 72 73 74 75 76
    let real_dir =
      match (Unix.lstat main_file).Unix.st_kind with
      | Unix.S_LNK -> Filename.dirname (Unix.readlink main_file)
      | _ -> Filename.dirname main_file in

    let unlink file = Filename.concat real_dir (Filename.basename file) in

    let grs_wi = parse_file_to_grs_wi (unlink main_file) in
77
    let domain = match grs_wi.Ast.domain_wi with
bguillaum's avatar
bguillaum committed
78 79
      | None -> None
      | Some (Ast.Dom d) -> Some d
bguillaum's avatar
bguillaum committed
80
      | Some (Ast.Dom_file file) -> Some (domain (unlink file)) in
81
    let rec flatten_modules current_file = function
82
      | [] -> []
bguillaum's avatar
bguillaum committed
83 84 85 86 87 88 89 90
      | 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
91
        (flatten_modules sub_file (parse_file_to_module_list sub_file))
bguillaum's avatar
bguillaum committed
92
        @ (flatten_modules current_file tail) in
93
    {
94 95
      Ast.domain = domain;
      Ast.modules = flatten_modules main_file grs_wi.Ast.modules_wi;
bguillaum's avatar
bguillaum committed
96
      Ast.strategies = grs_wi.Ast.strategies_wi;
bguillaum's avatar
bguillaum committed
97
    }
bguillaum's avatar
bguillaum committed
98

bguillaum's avatar
bguillaum committed
99
  (* ------------------------------------------------------------------------------------------*)
bguillaum's avatar
bguillaum committed
100
  let gr file =
101
    try
bguillaum's avatar
bguillaum committed
102
      Global.init file;
103
      let in_ch = open_in file in
bguillaum's avatar
bguillaum committed
104
      let lexbuf = Lexing.from_channel in_ch in
bguillaum's avatar
bguillaum committed
105
      let gr = parse_handle file (Grew_parser.gr Grew_lexer.global) lexbuf in
bguillaum's avatar
bguillaum committed
106 107
      close_in in_ch;
      gr
108
    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.gr] %s" msg
109

bguillaum's avatar
bguillaum committed
110 111

  (* ------------------------------------------------------------------------------------------*)
bguillaum's avatar
bguillaum committed
112
  let pattern file =
bguillaum's avatar
bguillaum committed
113
    try
bguillaum's avatar
bguillaum committed
114
      Global.init file;
bguillaum's avatar
bguillaum committed
115 116
      let in_ch = open_in file in
      let lexbuf = Lexing.from_channel in_ch in
117
      let pattern = parse_handle file (Grew_parser.pattern Grew_lexer.global) lexbuf in
bguillaum's avatar
bguillaum committed
118
      close_in in_ch;
119 120
      pattern
    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.pattern] %s" msg
bguillaum's avatar
bguillaum committed
121

122
  (* ------------------------------------------------------------------------------------------*)
123
  let phrase_structure_tree file =
124 125 126 127
    try
      Global.init file;
      let in_ch = open_in file in
      let lexbuf = Lexing.from_channel in_ch in
128
      let graph = parse_handle file (Grew_parser.phrase_structure_tree Grew_lexer.const) lexbuf in
129 130
      close_in in_ch;
      graph
131
    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.phrase_structure_tree] %s" msg
132

bguillaum's avatar
bguillaum committed
133
end (* module Loader *)
134 135 136 137 138 139


module Parser = struct
  (* ------------------------------------------------------------------------------------------*)
  let gr gr_string =
    try
140
      Global.init "Not a file";
141
      let lexbuf = Lexing.from_string gr_string in
142
      let gr = parse_handle "Not a file" (Grew_parser.gr Grew_lexer.global) lexbuf in
143
      gr
144
    with Sys_error msg -> Error.parse "[Grew_loader.Parser.gr] %s" msg
145 146

  (* ------------------------------------------------------------------------------------------*)
147
  let phrase_structure_tree s =
148 149 150
    try
      Global.init "Not a file";
      let lexbuf = Lexing.from_string s in
151
      let graph = parse_handle "Not a file" (Grew_parser.phrase_structure_tree Grew_lexer.const) lexbuf in
152
      graph
153 154 155 156 157 158 159 160 161 162
    with Sys_error msg -> Error.parse "[Grew_loader.Parser.phrase_structure_tree] %s" msg

  (* ------------------------------------------------------------------------------------------*)
  let pattern desc =
    try
      Global.init "Not a file";
      let lexbuf = Lexing.from_string desc in
      let pattern = parse_handle "Not a file" (Grew_parser.pattern Grew_lexer.global) lexbuf in
      pattern
    with Sys_error msg -> Error.parse "[Grew_loader.Parser.pattern] %s" msg
163

164
  (* ------------------------------------------------------------------------------------------*)
165
  let strat_def desc =
166 167 168
    try
      Global.init "Not a file";
      let lexbuf = Lexing.from_string desc in
169
      let strategy = parse_handle "Not a file" (Grew_parser.strat_def Grew_lexer.global) lexbuf in
170 171 172 173
      strategy
    with Sys_error msg -> Error.parse "[Grew_loader.Parser.strategy] %s" msg


174
end