Commit d14601e3 authored by bguillaum's avatar bguillaum

code factoring

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@6722 7838e531-6607-4d57-9587-6c381814729c
parent 1fcba640
......@@ -33,12 +33,11 @@ let load_grs ?doc_output_dir file =
then raise (File_dont_exists file)
else
try
let ast = Grew_parser.parse_file_to_grs file in
(* Checker.check_grs ast; *)
let grs_ast = Grew_parser.grs_of_file file in
(match doc_output_dir with
| None -> ()
| Some dir -> HTMLer.proceed dir ast);
Grs.build ast
| Some dir -> HTMLer.proceed dir grs_ast);
Grs.build grs_ast
with
| Grew_parser.Parse_error msg -> raise (Parsing_err msg)
| Error.Build (msg,loc) -> raise (Build (msg,loc))
......@@ -53,9 +52,8 @@ let empty_gr = Instance.empty
let load_gr file =
if (Sys.file_exists file) then (
try
let ast = Grew_parser.parse_file_to_gr file in
(* Checker.check_gr ast;*)
Instance.build ast
let gr_ast = Grew_parser.gr_of_file file in
Instance.build gr_ast
with
| Grew_parser.Parse_error msg -> raise (Parsing_err msg)
| Error.Build (msg,loc) -> raise (Build (msg,loc))
......@@ -73,7 +71,6 @@ let rewrite ~gr ~grs ~seq =
| Error.Bug (msg, loc) -> raise (Bug (msg,loc))
| exc -> raise (Bug (sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
let display ~gr ~grs ~seq =
try Grs.build_rew_display grs seq gr
with
......@@ -81,7 +78,6 @@ let display ~gr ~grs ~seq =
| Error.Bug (msg, loc) -> raise (Bug (msg,loc))
| exc -> raise (Bug (sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
let write_stat filename rew_hist = Gr_stat.save filename (Gr_stat.from_rew_history rew_hist)
let save_index ~dirname ~base_names =
......@@ -120,11 +116,9 @@ IFDEF DEP2PICT THEN
output_base msg init
)
ELSE
Log.critical "[_html] The \"libcaml-grew\" library is compiled without Dep2pict"
Log.critical "[error_html] The \"libcaml-grew\" library is compiled without Dep2pict"
ENDIF
let make_index ~title ~grs_file ~html ~grs ~seq ~output_dir ~base_names =
let init = Corpus_stat.empty grs seq in
let corpus_stat =
......@@ -134,7 +128,5 @@ let make_index ~title ~grs_file ~html ~grs ~seq ~output_dir ~base_names =
) init base_names in
Corpus_stat.save_html title grs_file html output_dir corpus_stat
let get_css_file = Filename.concat DATA_DIR "style.css"
......@@ -17,52 +17,47 @@ exception Run of string * (string * int) option
exception Bug of string * (string * int) option
(**/**)
type grs = Grs.t
type gr = Instance.t
type rew_history
(**/**)
val rewrite: gr:gr -> grs:grs -> seq:string -> rew_history
val rewrite: gr:Instance.t -> grs:Grs.t -> seq:string -> Rewrite_history.t
val is_empty: rew_history -> bool
val is_empty: Rewrite_history.t -> bool
(** 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
@return a structure {b {i easily}} displayable *)
val display: gr:gr -> grs:grs -> seq:string -> rew_display
val display: gr:Instance.t -> grs:Grs.t -> seq:string -> rew_display
val write_stat: string -> rew_history -> unit
val write_stat: string -> Rewrite_history.t -> unit
val empty_grs : grs
val empty_grs: Grs.t
(** 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
*)
val load_grs : ?doc_output_dir:string -> string -> grs
val load_grs : ?doc_output_dir:string -> string -> Grs.t
(** give the list of sequence names defined in a GRS
@return a string list
*)
val get_sequence_names: grs -> string list
val get_sequence_names: Grs.t -> string list
val empty_gr : gr
val empty_gr : Instance.t
(** get a graph from a file
@raise Parsing_err if libgrew can't parse the file
@raise File_dont_exists if the file doesn't exists
*)
val load_gr : string -> gr
val load_gr: string -> Instance.t
val save_index: dirname:string -> base_names: string list -> unit
val write_html:
?no_init:bool -> ?main_feat:string -> header: string -> rew_history -> string -> unit
?no_init:bool -> ?main_feat:string -> header: string -> Rewrite_history.t -> string -> unit
val error_html:
?no_init:bool -> ?main_feat:string -> header: string -> string -> ?init:Instance.t -> string -> unit
......@@ -71,7 +66,7 @@ val make_index:
title: string ->
grs_file: string ->
html: bool ->
grs: grs ->
grs: Grs.t ->
seq: string ->
output_dir: string ->
base_names: string list ->
......
......@@ -5,80 +5,56 @@ module Grew_parser = struct
exception Parse_error of string
(**
(* ------------------------------------------------------------------------------------------*)
(** general fucntion to handle parse errors *)
let parse_handle fct lexbuf =
try fct lexbuf with
| Lexer.Error msg -> raise (Parse_error msg)
| Gr_grs_parser.Error ->
let cp = lexbuf.Lexing.lex_curr_p in
raise (Parse_error (Printf.sprintf "Syntax error\nLine %d : %s\n%!" cp.Lexing.pos_lnum (Lexing.lexeme lexbuf)))
| Failure msg ->
let cp = lexbuf.Lexing.lex_curr_p in
raise (Parse_error (Printf.sprintf "Syntax error\nLine %d\n%s\n%!" cp.Lexing.pos_lnum msg))
| err -> raise (Parse_error (Printexc.to_string err))
(* ------------------------------------------------------------------------------------------*)
(**
[parse_string str] where [str] is a string following the grew syntax
@param str the string to parse
@return a syntactic tree of the parsed file
*)
let parse_string_to_grs str =
let to_parse = Lexing.from_string str in
begin
try Gr_grs_parser.grs Lexer.global to_parse
with
| Lexer.Error msg -> raise (Parse_error msg)
| Gr_grs_parser.Error ->
let cp = to_parse.Lexing.lex_curr_p in
raise (Parse_error (Printf.sprintf "Syntax error\nLine %d : %s\n%!" cp.Lexing.pos_lnum (Lexing.lexeme to_parse)))
| Failure msg ->
let cp = to_parse.Lexing.lex_curr_p in
raise (Parse_error (Printf.sprintf "Syntax error\nLine %d\n%s\n%!" cp.Lexing.pos_lnum msg))
| err -> raise (Parse_error (Printexc.to_string err))
end
let parse_string_to_grs str = parse_handle (Gr_grs_parser.grs Lexer.global) (Lexing.from_string str)
(* ------------------------------------------------------------------------------------------*)
let parse_file_to_grs_with_includes file =
try
Parser_global.init file;
let in_ch = open_in file in
let to_parse = Lexing.from_channel in_ch in
begin
try
Parser_global.current_file := file;
Parser_global.current_line := 0;
let res = Gr_grs_parser.grs_with_include Lexer.global to_parse in
close_in in_ch;
res
with
| Lexer.Error msg -> raise (Parse_error msg)
| Gr_grs_parser.Error ->
let cp = to_parse.Lexing.lex_curr_p in
raise (Parse_error (Printf.sprintf "Syntax error\nFile %s\nLine %d : %s\n%!" file cp.Lexing.pos_lnum (Lexing.lexeme to_parse)))
| Failure msg ->
let cp = to_parse.Lexing.lex_curr_p in
raise (Parse_error (Printf.sprintf "Syntax error\nFile %s\nLine %d\n%s\n%!" file cp.Lexing.pos_lnum msg))
| err -> raise (Parse_error (Printexc.to_string err))
end
let lexbuf = Lexing.from_channel in_ch in
let grs = parse_handle (Gr_grs_parser.grs_with_include Lexer.global) lexbuf in
close_in in_ch;
grs
with Sys_error msg-> raise (Parse_error msg)
(* ------------------------------------------------------------------------------------------*)
let parse_file_to_module_list loc file =
try
Parser_global.init file;
let in_ch = open_in file in
let to_parse = Lexing.from_channel in_ch in
begin
try
Parser_global.current_file := file;
Parser_global.current_line := 0;
let res = Gr_grs_parser.included Lexer.global to_parse in
close_in in_ch;
res
with
| Lexer.Error msg -> raise (Parse_error msg)
| Gr_grs_parser.Error ->
let cp = to_parse.Lexing.lex_curr_p in
raise (Parse_error (Printf.sprintf "Syntax error\nFile %s\nLine %d : %s\n%!" file cp.Lexing.pos_lnum (Lexing.lexeme to_parse)))
| Failure msg ->
let cp = to_parse.Lexing.lex_curr_p in
raise (Parse_error (Printf.sprintf "Syntax error\nFile %s\nLine %d\n%s\n%!" file cp.Lexing.pos_lnum msg))
| err -> raise (Parse_error (Printexc.to_string err))
end
with Sys_error msg -> raise (Parse_error(Printf.sprintf "Sys error: %s%s%!" msg (Loc.to_string loc)))
let lexbuf = Lexing.from_channel in_ch in
let module_list = parse_handle (Gr_grs_parser.included Lexer.global) lexbuf in
close_in in_ch;
module_list
with Sys_error msg-> raise (Parse_error msg)
(* ------------------------------------------------------------------------------------------*)
(**
[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
*)
let parse_file_to_grs main_file =
let grs_of_file main_file =
let grs_with_includes = parse_file_to_grs_with_includes main_file in
let rec flatten_modules = function
| [] -> []
......@@ -97,43 +73,23 @@ module Grew_parser = struct
Ast.sequences = grs_with_includes.Ast.sequences_wi;
}
(* ------------------------------------------------------------------------------------------*)
(**
[parse_string str] where [str] is a string following the grew syntax
@param str the string to parse
@return a syntactic tree of the parsed file
*)
let parse_string_to_gr str = parse_handle (Gr_grs_parser.gr Lexer.global) (Lexing.from_string str)
let parse_string_to_gr str =
let to_parse = Lexing.from_string str in
begin
try Gr_grs_parser.gr Lexer.global to_parse
with
| Lexer.Error msg -> raise (Parse_error msg)
| Gr_grs_parser.Error ->
let cp = to_parse.Lexing.lex_curr_p in
raise (Parse_error (Printf.sprintf "Syntax error\nLine %d : %s\n%!" cp.Lexing.pos_lnum (Lexing.lexeme to_parse)))
| Failure msg ->
let cp = to_parse.Lexing.lex_curr_p in
raise (Parse_error (Printf.sprintf "Syntax error\nLine %d\n%s\n%!" cp.Lexing.pos_lnum msg))
| err -> raise (Parse_error (Printexc.to_string err))
end
let parse_file_to_gr file =
(* ------------------------------------------------------------------------------------------*)
let gr_of_file file =
try
Parser_global.init file;
let in_ch = open_in file in
let to_parse = Lexing.from_channel in_ch in
begin
try
Parser_global.current_file := file;
Parser_global.current_line := 0;
let res = Gr_grs_parser.gr Lexer.global to_parse in close_in in_ch; res
with
| Lexer.Error msg -> raise (Parse_error msg)
| Gr_grs_parser.Error ->
let cp = to_parse.Lexing.lex_curr_p in
raise (Parse_error (Printf.sprintf "Syntax error\nFile %s\nLine %d : %s\n%!" file cp.Lexing.pos_lnum (Lexing.lexeme to_parse)))
| Failure msg ->
let cp = to_parse.Lexing.lex_curr_p in
raise (Parse_error (Printf.sprintf "Syntax error\nFile %s\nLine %d\n%s\n%!" file cp.Lexing.pos_lnum msg))
| err -> raise (Parse_error (Printexc.to_string err))
end
with Sys_error msg -> raise (Parse_error msg)
let lexbuf = Lexing.from_channel in_ch in
let gr = parse_handle (Gr_grs_parser.gr Lexer.global) lexbuf in
close_in in_ch;
gr
with Sys_error msg-> raise (Parse_error msg)
end
let current_file = ref "unknown"
let current_file = ref "Not a file"
let current_line = ref 0
let init file = current_file := file; current_line := 0;
Markdown is supported
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