Commit ecaa016e authored by bguillaum's avatar bguillaum

Merge branch 'master' into grep

Conflicts:
	src/grew_rule.ml
	src/libgrew_.mli

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8459 7838e531-6607-4d57-9587-6c381814729c
parent 928ac485
Version 0.24 (11/24/14)
* Changes in the interface:
- the "loc" type is abstract and exported (changes the libgrew interface)
* New features:
- use a float in a command "node.feat = 123.456"
- improve checking for consistency between rules and feature domain at GRS loading time
- add the possibility to use parameters in the without part
* Bug fixes:
- take the feature "position" into account when the user chose features to display
- accept colors like "#abc"
* Misc
- add files for Geshi
- code reorganization
- add activate mechanism (untested)
Version 0.23 (2014-06-05)
Please refer to SVN logs
\ No newline at end of file
VERSION = 0.23.1
VERSION = 0.24.0
INSTALL_DIR_LIB = @OCAMLLIB@
INSTALL_DIR = @prefix@/bin/
......
......@@ -93,7 +93,7 @@ module Ast = struct
type feature_kind =
| Equality of feature_value list
| Disequality of feature_value list
| Param of string (* $ident *)
| Equal_param of string (* $ident *)
| Absent
type u_feature = {
......@@ -186,7 +186,7 @@ module Ast = struct
neg_basics: basic list;
commands: command list;
param: (string list * string list) option;
lp: string list option;
lex_par: string list option;
rule_doc:string list;
rule_loc: Loc.t;
}
......
......@@ -45,7 +45,7 @@ module Ast : sig
type feature_kind =
| Equality of feature_value list
| Disequality of feature_value list
| Param of string (* $ident *)
| Equal_param of string (* $ident *)
| Absent
type u_feature = {
......@@ -123,7 +123,7 @@ module Ast : sig
neg_basics: basic list;
commands: command list;
param: (string list * string list) option; (* (files, vars) *)
lp: string list option; (* lexical parameters in the file *)
lex_par: string list option; (* lexical parameters in the file *)
rule_doc:string list;
rule_loc: Loc.t;
}
......
......@@ -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 *)
(* ================================================================================ *)
......@@ -61,6 +61,12 @@ module String_ = struct
let of_float float = Str.global_replace (Str.regexp ",") "." (sprintf "%g" float)
let rm_first_char = function "" -> "" | s -> String.sub s 1 ((String.length s) - 1)
let rm_peripheral_white s =
s
|> (Str.global_replace (Str.regexp "\\( \\|\t\\)*$") "")
|> (Str.global_replace (Str.regexp "^\\( \\|\t\\)*") "")
end (* module String_ *)
(* ================================================================================ *)
......
......@@ -26,6 +26,10 @@ module String_: sig
(* [rm_first_char s] returns the string [s] without the first charater if s is not empty.
If s in empty, the empty string is returned *)
val rm_first_char: string -> string
(* [rm_peripheral_white s] returns the string [s] without any white space ot tab
at the beginning or at the end of the string. *)
val rm_peripheral_white: string -> string
end
......@@ -39,7 +43,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
......@@ -88,7 +95,8 @@ module List_: sig
val set: int -> 'a -> 'a list -> 'a list
(** [pos elt list] return [Some index] if [index] is the smallest position in the [list] equals to [elt]. None is returned if [elt] is not in the [list] *)
(** [pos elt list] return [Some index] if [index] is the smallest position in the [list] equals to [elt].
None is returned if [elt] is not in the [list] *)
val pos: 'a -> 'a list -> int option
val opt_map: ('a -> 'b option) -> 'a list -> 'b list
......
This diff is collapsed.
......@@ -74,7 +74,7 @@ module P_fs: sig
exception Fail
(** [match_ ?param t gfs] tries to match the pattern fs [pfs] with the graph fs [gfs]
(** [match_ ?param p_fs g_fs] tries to match the pattern fs [p_fs] with the graph fs [g_fs].
If [param] is [None], it returns [None] if matching succeeds and else raise [Fail].
If [param] is [Some p], it returns [Some p'] if matching succeeds and else raise [Fail].
*)
......@@ -84,7 +84,8 @@ module P_fs: sig
It returns [true] iff [pfs] has no requirement about position ok if the requirement is satisfied. *)
val check_position: ?param:Lex_par.t -> float -> t -> bool
val filter: t -> G_fs.t -> bool
(** [unif fs1 fs2] returns the unification of the two feature structures.
It raises (Error.Build msg) exception in case of Failure.
*)
val unif: t -> t -> t
end (* module P_fs *)
......@@ -60,7 +60,10 @@ module P_graph = struct
let rec insert (ast_node, loc) = function
| [] -> [P_node.build ?pat_vars (ast_node, loc)]
| (node_id,fs)::tail when ast_node.Ast.node_id = node_id ->
(node_id, P_node.unif_fs (P_fs.build ?pat_vars ast_node.Ast.fs) fs) :: tail
begin
try (node_id, P_node.unif_fs (P_fs.build ?pat_vars ast_node.Ast.fs) fs) :: tail
with Error.Build (msg,_) -> raise (Error.Build (msg,Some loc))
end
| head :: tail -> head :: (insert (ast_node, loc) tail) in
let (named_nodes : (Id.name * P_node.t) list) =
......@@ -104,9 +107,9 @@ module P_graph = struct
}
(* -------------------------------------------------------------------------------- *)
let build_extension ?(locals=[||]) pos_table full_node_list full_edge_list =
let build_extension ?pat_vars ?(locals=[||]) pos_table full_node_list full_edge_list =
let built_nodes = List.map P_node.build full_node_list in
let built_nodes = List.map (P_node.build ?pat_vars) full_node_list in
let (old_nodes, new_nodes) =
List.partition
......
......@@ -60,6 +60,7 @@ module P_graph: sig
(t * Id.table)
val build_extension:
?pat_vars: string list ->
?locals: Label.decl array ->
Id.table ->
Ast.node list ->
......
......@@ -80,7 +80,7 @@ module Html_doc = struct
sprintf "!%s" u_feature.Ast.name
| Ast.Disequality values ->
sprintf "%s<>%s" u_feature.Ast.name (List_.to_string (fun x->x) "|" values)
| Ast.Param index ->
| Ast.Equal_param index ->
sprintf "%s=%s" u_feature.Ast.name index
let buff_html_node buff (u_node,_) =
......@@ -275,7 +275,7 @@ module Html_doc = struct
wnl "<h6>Lexical parameters</h6>";
(* output local lexical parameters (if any) *)
(match rule_.Ast.lp with
(match rule_.Ast.lex_par with
| None -> ()
| Some lines ->
wnl "<b>Local parameters</b><br/>";
......
......@@ -70,7 +70,10 @@ module P_node: sig
val get_fs: t -> P_fs.t
val get_next: t -> P_edge.t Massoc_pid.t
(** [unif_fs fs t] replaces the feature structure of the node by node.fs unif fs *)
(** [unif_fs fs t] replaces the feature structure of the node
by the unification of [node.fs] ] and [fs].
It raises (Error.Build msg) exception in case of Failure.
*)
val unif_fs: P_fs.t -> t -> t
val build: ?pat_vars: string list -> Ast.node -> (Id.name * t)
......
......@@ -169,9 +169,9 @@ module Rule = struct
and (node_name2, feat_name2) = qfn2 in
Feature_ineq (ineq, pid_of_name loc node_name1, feat_name1, pid_of_name loc node_name2, feat_name2)
let build_neg_basic ?(locals=[||]) pos_table basic_ast =
let build_neg_basic ?pat_vars ?(locals=[||]) pos_table basic_ast =
let (extension, neg_table) =
P_graph.build_extension ~locals pos_table basic_ast.Ast.pat_nodes basic_ast.Ast.pat_edges in
P_graph.build_extension ?pat_vars ~locals pos_table basic_ast.Ast.pat_nodes basic_ast.Ast.pat_edges in
let filters = Pid_map.fold (fun id node acc -> Filter (id, P_node.get_fs node) :: acc) extension.P_graph.old_map [] in
{
graph = extension.P_graph.ext_map;
......@@ -305,21 +305,22 @@ 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 = List.fold_left
let local_param = match rule_ast.Ast.lex_par with
| None -> None
| Some lines -> Some (Lex_par.from_lines ~loc:rule_ast.Ast.rule_loc nb_pv nb_cv lines) in
let full_param = List.fold_left
(fun acc file ->
Lex_par.append
(Lex_par.load ~loc:rule_ast.Ast.rule_loc dir nb_pv nb_cv file)
acc
)
(match rule_ast.Ast.lp with
| None -> Lex_par.empty
| Some lines -> Lex_par.from_lines ~loc:rule_ast.Ast.rule_loc nb_pv nb_cv lines
)
files in
(Some param, pat_vars, cmd_vars) in
match acc with
| None -> Some (Lex_par.load ~loc:rule_ast.Ast.rule_loc dir nb_pv nb_cv file)
| Some lp -> Some (Lex_par.append (Lex_par.load ~loc:rule_ast.Ast.rule_loc dir nb_pv nb_cv file) lp)
) local_param files in
(full_param, pat_vars, cmd_vars) in
let (pos, pos_table) = build_pos_basic ~pat_vars ~locals rule_ast.Ast.pos_basic in
let negs = List.map (fun basic_ast -> build_neg_basic ~locals pos_table basic_ast) rule_ast.Ast.neg_basics in
let negs = List.map (fun basic_ast -> build_neg_basic ~pat_vars ~locals pos_table basic_ast) rule_ast.Ast.neg_basics in
{
name = rule_ast.Ast.rule_id;
pattern = (pos, negs);
......@@ -433,7 +434,7 @@ module Rule = struct
}
(* ---------------------------------------------------------------------- *)
let fullfill graph matching cst =
let apply_cst graph matching cst =
let get_node pid = G_graph.find (Pid_map.find pid matching.n_match) graph in
let get_string_feat pid = function
| "position" -> Some (sprintf "%g" (G_node.get_position (get_node pid)))
......@@ -445,45 +446,61 @@ module Rule = struct
match cst with
| Cst_out (pid,edge) ->
let gid = Pid_map.find pid matching.n_match in
G_graph.edge_out graph gid edge
if G_graph.edge_out graph gid edge
then matching
else raise Fail
| Cst_in (pid,edge) ->
let gid = Pid_map.find pid matching.n_match in
G_graph.node_exists
if G_graph.node_exists
(fun node ->
List.exists (fun e -> P_edge.compatible edge e) (Massoc_gid.assoc gid (G_node.get_next node))
) graph
then matching
else raise Fail
| Filter (pid, fs) ->
let gid = Pid_map.find pid matching.n_match in
let gnode = G_graph.find gid graph in
P_fs.filter fs (G_node.get_fs gnode)
begin
try
let gid = Pid_map.find pid matching.n_match in
let gnode = G_graph.find gid graph in
let new_param = P_fs.match_ ?param:matching.m_param fs (G_node.get_fs gnode) in
{matching with m_param = new_param }
with P_fs.Fail -> raise Fail
end
| Feature_eq (pid1, feat_name1, pid2, feat_name2) ->
begin
match (get_string_feat pid1 feat_name1, get_string_feat pid2 feat_name2) with
| Some fv1, Some fv2 when fv1 = fv2 -> true
| _ -> false
| Some fv1, Some fv2 when fv1 = fv2 -> matching
| _ -> raise Fail
end
| Feature_diseq (pid1, feat_name1, pid2, feat_name2) ->
begin
match (get_string_feat pid1 feat_name1, get_string_feat pid2 feat_name2) with
| Some fv1, Some fv2 when fv1 <> fv2 -> true
| _ -> false
| Some fv1, Some fv2 when fv1 <> fv2 -> matching
| _ -> raise Fail
end
| Feature_ineq (ineq, pid1, feat_name1, pid2, feat_name2) ->
match (ineq, get_float_feat pid1 feat_name1, get_float_feat pid2 feat_name2) with
| (Ast.Lt, Some fv1, Some fv2) when fv1 < fv2 -> true
| (Ast.Gt, Some fv1, Some fv2) when fv1 > fv2 -> true
| (Ast.Le, Some fv1, Some fv2) when fv1 <= fv2 -> true
| (Ast.Ge, Some fv1, Some fv2) when fv1 >= fv2 -> true
| _ -> false
| (Ast.Lt, Some fv1, Some fv2) when fv1 < fv2 -> matching
| (Ast.Gt, Some fv1, Some fv2) when fv1 > fv2 -> matching
| (Ast.Le, Some fv1, Some fv2) when fv1 <= fv2 -> matching
| (Ast.Ge, Some fv1, Some fv2) when fv1 >= fv2 -> matching
| _ -> raise Fail
(* ---------------------------------------------------------------------- *)
(* returns all extension of the partial input matching *)
let rec extend_matching (positive,neg) (graph:G_graph.t) (partial:partial) =
match (partial.unmatched_edges, partial.unmatched_nodes) with
| [], [] ->
if List.for_all (fun const -> fullfill graph partial.sub const) partial.check
then [partial.sub, partial.already_matched_gids]
else []
begin
try
let new_matching =
List.fold_left
(fun acc const ->
apply_cst graph acc const
) partial.sub partial.check in
[new_matching, partial.already_matched_gids]
with Fail -> []
end
| (src_pid, p_edge, tar_pid)::tail_ue, _ ->
begin
try (* is the tar already found in the matching ? *)
......@@ -550,7 +567,6 @@ module Rule = struct
try
let new_param = P_node.match_ ?param: partial.sub.m_param p_node g_node in
(* add all out-edges from pid in pattern *)
let new_unmatched_edges =
Massoc_pid.fold
......@@ -804,11 +820,10 @@ module Rule = struct
(* ---------------------------------------------------------------------- *)
let fulfill (pos_graph,neg_graph) graph new_partial_matching =
let fulfill (pos_graph,neg_graph) graph new_partial_matching =
match extend_matching (pos_graph, neg_graph) graph new_partial_matching with
| [] -> true (* the without basic in not found -> OK *)
| x -> false
| [] -> true (* the without pattern in not found -> OK *)
| _ -> false
(* ================================================================================ *)
(* ================================================================================ *)
......
......@@ -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
......@@ -391,9 +391,13 @@ module Lex_par = struct
type t = item list
let empty=[]
let size = List.length
let append = List.append
let signature = function
| [] -> Error.bug "[Lex_par.signature] empty data"
| (pp,cp)::_ -> (List.length pp,List.length cp)
let dump t =
printf "[Lex_par.dump] --> size = %d\n" (List.length t);
List.iter (fun (pp,cp) ->
......@@ -402,12 +406,8 @@ module Lex_par = struct
(String.concat "#" cp)
) t
let rm_peripheral_white s =
Str.global_replace (Str.regexp "\\( \\|\t\\)*$") ""
(Str.global_replace (Str.regexp "^\\( \\|\t\\)*") "" s)
let parse_line ?loc nb_p nb_c line =
let line = rm_peripheral_white line in
let line = String_.rm_peripheral_white line in
if line = "" || line.[0] = '%'
then None
else
......@@ -415,18 +415,21 @@ module Lex_par = struct
| [args] when nb_c = 0 ->
(match Str.split (Str.regexp "#") args with
| l when List.length l = nb_p -> Some (l,[])
| _ -> Error.bug ?loc
| _ -> Error.build ?loc
"Illegal lexical parameter line: \"%s\" doesn't contain %d args"
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 -> Some (lp,lc)
| _ -> Error.bug ?loc
| _ -> Error.build ?loc
"Illegal lexical parameter line: \"%s\" doesn't contain %d args and %d values"
line nb_p nb_c)
| _ -> Error.bug ?loc "Illegal param line: '%s'" line
| _ -> Error.build ?loc "Illegal param line: '%s'" line
let from_lines ?loc nb_p nb_c lines = List_.opt_map (parse_line ?loc nb_p nb_c) lines
let from_lines ?loc nb_p nb_c lines =
match List_.opt_map (parse_line ?loc nb_p nb_c) lines with
| [] -> Error.build ?loc "Empty lexical parameter list"
| l -> l
let load ?loc dir nb_p nb_c file =
try
......@@ -435,22 +438,19 @@ 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
match List_.opt_mapi (fun i line -> parse_line ~loc:(Loc.file_line full_file i) nb_p nb_c line) lines with
| [] -> Error.build ?loc "Empty lexical parameter file '%s'" file
| l -> l
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)
let filter index atom t =
let select index atom t =
match
List_.opt_map
(fun (p_par, c_par) ->
let par = List.nth p_par index in
if atom=par
if atom = par
then Some (p_par, c_par)
else
if sub atom par (* atom is one of the values of the disjunction par *)
then Some (List_.set index atom p_par, c_par)
else None
else None
) t
with
| [] -> None
......
......@@ -149,22 +149,26 @@ end (* module Conll *)
module Lex_par: sig
type t
val empty:t
val append: t -> t -> t
val dump: t -> unit
val size: t -> int
(** [signature t] returns (number of pattern parameters, number of lexical parameters) *)
val signature: t -> (int * int)
(** [from_lines filename nb_pattern_var nb_command_var strings] *)
val from_lines: ?loc: Loc.t -> int -> int -> string list -> 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
(** [select index atom t] returns the subset of [t] which contains only entries
which refers to [atom] at the [index]^th pattern_var.
[None] is returnes if no such entry s founded.
[None] is returned if no such entry s founded.
*)
val filter: int -> string -> t -> t option
val select: int -> string -> t -> t option
(** [get_param_value index t] returns the [index]^th param_var. *)
val get_param_value: int -> t -> string
......
......@@ -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
) ()
......@@ -277,4 +277,4 @@ let load_pattern file =
let match_in_graph pattern graph = Rule.match_in_graph pattern graph
let match_deco pattern matching = Rule.match_deco pattern matching
\ No newline at end of file
let match_deco pattern matching = Rule.match_deco pattern matching
......@@ -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
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
......@@ -149,4 +153,4 @@ type pattern
type matching
val load_pattern: string -> pattern
val match_in_graph: pattern -> graph -> matching list
val match_deco: pattern -> matching -> deco
\ No newline at end of file
val match_deco: pattern -> matching -> deco
This diff is collapsed.
......@@ -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 =
......
......@@ -86,7 +86,7 @@ and string_lex target = parse
and lp_lex target = parse
| '\n' { incr Parser_global.current_line; Lexing.new_line lexbuf; bprintf buff "\n"; lp_lex target lexbuf }
| _ as c { bprintf buff "%c" c; lp_lex target lexbuf }
| "#END" [' ' '\t']* '\n' { incr Parser_global.current_line; LP (Str.split (Str.regexp "\n") (Buffer.contents buff)) }
| "#END" [' ' '\t']* '\n' { incr Parser_global.current_line; LEX_PAR (Str.split (Str.regexp "\n") (Buffer.contents buff)) }
and global = parse
| [' ' '\t'] { global lexbuf }
......
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