Commit 0455c29d authored by Bruno Guillaume's avatar Bruno Guillaume
Browse files

the "loc" type is abstract and exported

parent 8dc5feb4
......@@ -21,15 +21,15 @@ module Int_map = Map.Make (struct type t = int let compare = Pervasives.compare
module Loc = struct
type t = string * int
let to_string (file,line) = sprintf "(file: %s, line: %d)" (Filename.basename file) line
let file_line f l = (f,l)
let file f = (f, -1)
let to_string (file,line) = sprintf "[file: %s, line: %d]" (Filename.basename file) line
let opt_set_line line = function
| None -> None
| Some (file,_) -> Some (file, line)
let opt_to_string = function
| None -> ""
| Some x -> to_string x
end (* module Loc *)
(* ================================================================================ *)
......
......@@ -39,7 +39,10 @@ end
(* ================================================================================ *)
(* [Loc] general module to describe errors location: (file name, line number in file) *)
module Loc: sig
type t = string * int
type t
val file_line: string -> int -> t
val file: string -> t
val opt_set_line: int -> t option -> t option
......
......@@ -348,7 +348,7 @@ module Conll = struct
match Str.split (Str.regexp "=") feat with
| [feat_name] -> (feat_name, "true")
| [feat_name; feat_value] -> (feat_name, feat_value)
| _ -> Error.build ~loc:(file_name,line_num) "[Conll.load] illegal morphology \n>>>>>%s<<<<<<" morph
| _ -> Error.build ~loc:(Loc.file_line file_name line_num) "[Conll.load] illegal morphology \n>>>>>%s<<<<<<" morph
) (Str.split (Str.regexp "|") morph)
let underscore s = if s = "" then "_" else s
......@@ -369,9 +369,9 @@ module Conll = struct
morph = parse_morph file_name line_num morph;
deps = deps;
}
with exc -> Error.build ~loc:(file_name,line_num) "[Conll.load] illegal line, exc=%s\n>>>>>%s<<<<<<" (Printexc.to_string exc) line
with exc -> Error.build ~loc:(Loc.file_line file_name line_num) "[Conll.load] illegal line, exc=%s\n>>>>>%s<<<<<<" (Printexc.to_string exc) line
end
| l -> Error.build ~loc:(file_name,line_num) "[Conll.load] illegal line, %d fields (10 are expected)\n>>>>>%s<<<<<<" (List.length l) line
| l -> Error.build ~loc:(Loc.file_line file_name line_num) "[Conll.load] illegal line, %d fields (10 are expected)\n>>>>>%s<<<<<<" (List.length l) line
let load file_name =
let lines = File.read_ln file_name in
......@@ -435,7 +435,7 @@ module Lex_par = struct
then Filename.concat dir file
else file in
let lines = File.read full_file in
List_.opt_mapi (fun i line -> parse_line ~loc:(full_file,i) nb_p nb_c line) lines
List_.opt_mapi (fun i line -> parse_line ~loc:(Loc.file_line full_file i) nb_p nb_c line) lines
with Sys_error _ -> Error.build ?loc "External lexical file '%s' not found" file
let sub x y = List.mem x (Str.split (Str.regexp "|") y)
......
......@@ -31,30 +31,30 @@ let empty_grs = Grs.empty
let set_timeout t = Timeout.timeout := t
type loc = Loc.t
let string_of_loc = Loc.to_string
exception File_dont_exists of string
exception Parsing_err of string
exception Build of string * (string * int) option
exception Run of string * (string * int) option
exception Bug of string * (string * int) option
exception Parsing_err of string * loc option
exception Build of string * loc option
exception Run of string * loc option
exception Bug of string * loc option
let handle ?(name="") ?(file="No file defined") fct () =
try fct () with
(* Raise again already catched exceptions *)
| Parsing_err msg -> raise (Parsing_err msg)
| Build (msg,loc) -> raise (Build (msg,loc))
| Bug (msg, loc) -> raise (Bug (msg,loc))
| Run (msg, loc) -> raise (Run (msg,loc))
| Parsing_err (msg,loc_opt) -> raise (Parsing_err (msg,loc_opt))
| Build (msg,loc_opt) -> raise (Build (msg,loc_opt))
| Bug (msg, loc_opt) -> raise (Bug (msg,loc_opt))
| Run (msg, loc_opt) -> raise (Run (msg,loc_opt))
(* Catch new exceptions *)
| Grew_parser.Parse_error (msg,Some (sub_file,l)) ->
raise (Parsing_err (sprintf "[file:%s, line:%d] %s" sub_file l msg))
| Grew_parser.Parse_error (msg,None) ->
raise (Parsing_err (sprintf "[file:%s] %s" file msg))
| Error.Build (msg,loc) -> raise (Build (msg,loc))
| Error.Bug (msg, loc) -> raise (Bug (msg,loc))
| Error.Run (msg, loc) -> raise (Run (msg,loc))
| Grew_parser.Parse_error (msg, loc_opt) -> raise (Parsing_err (msg, loc_opt))
| Error.Build (msg, loc_opt) -> raise (Build (msg, loc_opt))
| Error.Bug (msg, loc_opt) -> raise (Bug (msg,loc_opt))
| Error.Run (msg, loc_opt) -> raise (Run (msg,loc_opt))
| exc -> raise (Bug (sprintf "[Libgrew.%s] UNCATCHED EXCEPTION: %s" name (Printexc.to_string exc), None))
......@@ -118,7 +118,7 @@ let load_gr file =
let load_conll file =
handle ~name:"load_conll" ~file
(fun () ->
let graph = G_graph.of_conll ~loc:(file,-1) (Conll.load file) in
let graph = G_graph.of_conll ~loc:(Loc.file file) (Conll.load file) in
Instance.from_graph graph
) ()
......
......@@ -16,16 +16,20 @@ open Grew_grs
val css_file: string
exception Parsing_err of string
type loc = Loc.t
val string_of_loc: loc -> string
exception File_dont_exists of string
exception Parsing_err of string * loc option
(** raised when a Gr/Grs structure fails to build *)
exception Build of string * (string * int) option
exception Build of string * loc option
(** raised during rewriting when a command is undefined *)
exception Run of string * (string * int) option
(** raised during rewriting when a command is undefined *)
exception Run of string * loc option
exception Bug of string * (string * int) option
exception Bug of string * loc option
val set_timeout: float option -> unit
......@@ -35,7 +39,7 @@ val is_empty: Rewrite_history.t -> bool
val num_sol: Rewrite_history.t -> int
(** display a gr with a grs in a rew_display
(** display a gr with a grs in a rew_display
@param gr the grapth to rewrite
@param grs the graph rewriting system
@param seq the name of the sequence to apply
......@@ -46,7 +50,7 @@ val write_stat: string -> Rewrite_history.t -> unit
val empty_grs: Grs.t
(** get a graph rewriting system from a file
(** get a graph rewriting system from a file
@return a graph rewriting system
@raise Parsing_err if libgrew can't parse the file
@raise File_dont_exists if the file doesn't exists
......@@ -56,7 +60,7 @@ val load_grs: string -> Grs.t
(** [build_html_doc directory grs ] *)
val build_html_doc: ?corpus:bool -> string -> Grs.t -> unit
(** give the list of sequence names defined in a GRS
(** give the list of sequence names defined in a GRS
@return a string list
*)
val get_sequence_names: Grs.t -> string list
......@@ -102,35 +106,35 @@ val save_index: dirname:string -> base_names: string list -> unit
val write_annot: title:string -> string -> string -> (string * Rewrite_history.t) list -> unit
val write_html:
val write_html:
?no_init: bool ->
?out_gr: bool ->
?filter: string list ->
?main_feat: string ->
?main_feat: string ->
?dot: bool ->
header: string ->
?graph_file: string ->
Rewrite_history.t -> string -> unit
val error_html:
?no_init:bool ->
?main_feat:string ->
val error_html:
?no_init:bool ->
?main_feat:string ->
?dot: bool ->
header: string ->
string ->
?init:Instance.t ->
string ->
header: string ->
string ->
?init:Instance.t ->
string ->
unit
val make_index:
val make_index:
title: string ->
grs_file: string ->
html: bool ->
grs: Grs.t ->
grs_file: string ->
html: bool ->
grs: Grs.t ->
seq: string ->
input_dir: string ->
output_dir: string ->
base_names: string list ->
input_dir: string ->
output_dir: string ->
base_names: string list ->
unit
val html_sentences: title:string -> string -> (bool * string * int * string) list -> unit
......
......@@ -24,7 +24,7 @@ type graph_item =
| Graph_node of Ast.node
| Graph_edge of Ast.edge
let get_loc () = (!Parser_global.current_file,!Parser_global.current_line+1)
let get_loc () = Loc.file_line !Parser_global.current_file (!Parser_global.current_line+1)
let localize t = (t,get_loc ())
%}
......@@ -258,7 +258,7 @@ grew_module:
rules = r;
confluent = conf;
module_doc = (match doc with Some d -> d | None -> []);
mod_loc = (!Parser_global.current_file, snd id_loc);
mod_loc = Loc.file_line !Parser_global.current_file (snd id_loc);
mod_dir = "";
}
}
......@@ -285,7 +285,7 @@ rule:
param = None;
lp = None;
rule_doc = begin match doc with Some d -> d | None -> [] end;
rule_loc = (!Parser_global.current_file,snd id_loc);
rule_loc = Loc.file_line !Parser_global.current_file (snd id_loc);
}
}
| doc=option(COMMENT) LEX_RULE id_loc=simple_id_with_loc param=option(param) LACC p=pos_item n=list(neg_item) cmds=commands RACC lp=option(lp)
......@@ -297,7 +297,7 @@ rule:
param = param;
lp = lp;
rule_doc = begin match doc with Some d -> d | None -> [] end;
rule_loc = (!Parser_global.current_file,snd id_loc);
rule_loc = Loc.file_line !Parser_global.current_file (snd id_loc);
}
}
| doc=option(COMMENT) FILTER id_loc=simple_id_with_loc LACC p=pos_item n=list(neg_item) RACC
......@@ -309,7 +309,7 @@ rule:
param = None;
lp = None;
rule_doc = begin match doc with Some d -> d | None -> [] end;
rule_loc = (!Parser_global.current_file,snd id_loc);
rule_loc = Loc.file_line !Parser_global.current_file (snd id_loc);
}
}
......@@ -516,7 +516,7 @@ sequence:
{ Ast.seq_name = fst id_loc;
seq_mod = List.map (fun x -> Ast.simple_id_of_ci x) mod_names ;
seq_doc = begin match doc with Some d -> d | None -> [] end;
seq_loc = (!Parser_global.current_file,snd id_loc);
seq_loc = Loc.file_line !Parser_global.current_file (snd id_loc);
}
}
%%
......@@ -22,19 +22,19 @@ module Grew_parser = struct
try fct lexbuf with
| Lexer.Error msg ->
let cp = lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum in
raise (Parse_error ("Lexing error:"^msg, Some (file,cp)))
raise (Parse_error ("Lexing error:"^msg, Some (Loc.file_line file cp)))
| Gr_grs_parser.Error ->
let cp = lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum in
raise (Parse_error ("Syntax error:"^(Lexing.lexeme lexbuf), Some (file,cp)))
raise (Parse_error ("Syntax error:"^(Lexing.lexeme lexbuf), Some (Loc.file_line file cp)))
| Failure msg ->
let cp = lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum in
raise (Parse_error ("Failure:"^msg, Some (file,cp)))
raise (Parse_error ("Failure:"^msg, Some (Loc.file_line file cp)))
| Error.Build (msg,_) ->
let cp = lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum in
raise (Parse_error ("Syntax error:"^msg, Some (file,cp)))
raise (Parse_error ("Syntax error:"^msg, Some (Loc.file_line file cp)))
| err ->
let cp = lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum in
raise (Parse_error ("Unexpected error:"^(Printexc.to_string err), Some (file,cp)))
raise (Parse_error ("Unexpected error:"^(Printexc.to_string err), Some (Loc.file_line file cp)))
(* ------------------------------------------------------------------------------------------*)
let parse_file_to_grs_with_includes file =
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment