Commit c99807c1 authored by Bruno Guillaume's avatar Bruno Guillaume

reuse Loc.t in Global

parent f2405941
......@@ -597,17 +597,24 @@ end (* module Timeout *)
(* ================================================================================ *)
module Global = struct
let current_file = ref None
let current_line = ref 1
let current_loc = ref Loc.empty
let label_flag = ref false
let debug = ref false
let loc_string () = match !current_file with
| None -> sprintf "[line %d]" !current_line
| Some f -> sprintf "[file %s, line %d]" f !current_line
let get_loc () = !current_loc
let loc_string () = Loc.to_string !current_loc
let new_file filename =
current_loc := (Some filename, Some 1);
label_flag := false
let init file =
current_file := Some file;
current_line := 1;
let new_string () =
current_loc := (None , Some 1);
label_flag := false
let new_line () = match !current_loc with
| (_,None) -> ()
| (fo, Some l) -> current_loc := (fo, Some (l+1))
let debug = ref false
end
......@@ -282,12 +282,13 @@ end
(* ================================================================================ *)
module Global: sig
val current_file: string option ref
val current_line: int ref
val init: string -> unit
val label_flag: bool ref
val new_file: string -> unit
val new_string: unit -> unit
val new_line: unit -> unit
val get_loc: unit -> Loc.t
val loc_string: unit -> string
val label_flag: bool ref
val debug: bool ref
end
......@@ -56,7 +56,7 @@ let color = hex hex hex hex hex hex | hex hex hex
(* ------------------------------------------------------------------------------- *)
rule comment target = parse
| '\n' { incr Global.current_line; Lexing.new_line lexbuf; target lexbuf }
| '\n' { Global.new_line (); Lexing.new_line lexbuf; target lexbuf }
| eof { EOF }
| _ { comment target lexbuf }
......@@ -65,7 +65,7 @@ and comment_multi_doc target = shortest
let start = ref 0 in
try while (Str.search_forward (Str.regexp "\n") comment !start != -1) do
start := Str.match_end ();
incr Global.current_line;
Global.new_line ();
Lexing.new_line lexbuf;
done; assert false
with Not_found ->
......@@ -74,7 +74,7 @@ and comment_multi_doc target = shortest
and comment_multi target = parse
| "*/" { target lexbuf }
| '\n' { incr Global.current_line; Lexing.new_line lexbuf; comment_multi target lexbuf }
| '\n' { Global.new_line (); Lexing.new_line lexbuf; comment_multi target lexbuf }
| _ { comment_multi target lexbuf }
and string_lex re target = parse
......@@ -83,7 +83,7 @@ and string_lex re target = parse
then (bprintf buff "\\"; escaped := false; string_lex re target lexbuf)
else (escaped := true; string_lex re target lexbuf)
}
| '\n' { incr Global.current_line; Lexing.new_line lexbuf; bprintf buff "\n"; string_lex re target lexbuf }
| '\n' { Global.new_line (); Lexing.new_line lexbuf; bprintf buff "\n"; string_lex re target lexbuf }
| '\"' {
if !escaped
then (bprintf buff "\""; escaped := false; string_lex re target lexbuf)
......@@ -98,9 +98,9 @@ and string_lex re target = parse
(* a dedicated lexer for lexical parameter: read everything until "#END" *)
and lp_lex target = parse
| '\n' { incr Global.current_line; Lexing.new_line lexbuf; bprintf buff "\n"; lp_lex target lexbuf }
| '\n' { Global.new_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 Global.current_line; LEX_PAR (Str.split (Str.regexp "\n") (Buffer.contents buff)) }
| "#END" [' ' '\t']* '\n' { Global.new_line (); LEX_PAR (Str.split (Str.regexp "\n") (Buffer.contents buff)) }
(* The lexer must be different when label_ident are parsed. The [global] lexer calls either
[label_parser] or [standard] depending on the flag [Global.label_flag].
......@@ -120,7 +120,7 @@ and label_parser target = parse
| [' ' '\t'] { global lexbuf }
| "/*" { comment_multi global lexbuf }
| '%' { comment global lexbuf }
| '\n' { incr Global.current_line; Lexing.new_line lexbuf; global lexbuf}
| '\n' { Global.new_line (); Lexing.new_line lexbuf; global lexbuf}
| '{' { LACC }
| '}' { Global.label_flag := false; RACC }
......@@ -146,9 +146,9 @@ and standard target = parse
| "/*" { comment_multi global lexbuf }
| '%' { comment global lexbuf }
| "#BEGIN" [' ' '\t']* '\n' { incr Global.current_line; Buffer.clear buff; lp_lex global lexbuf}
| "#BEGIN" [' ' '\t']* '\n' { Global.new_line (); Buffer.clear buff; lp_lex global lexbuf}
| '\n' { incr Global.current_line; Lexing.new_line lexbuf; global lexbuf}
| '\n' { Global.new_line (); Lexing.new_line lexbuf; global lexbuf}
| "include" { INCL }
| "domain" { DOMAIN }
......@@ -242,7 +242,7 @@ and standard target = parse
and const = parse
| [' ' '\t'] { const lexbuf }
| '\n' { incr Global.current_line; const lexbuf}
| '\n' { Global.new_line (); const lexbuf}
| '(' { LPAREN }
| ')' { RPAREN }
| [^'(' ')' ' ']+ as id { ID id }
......@@ -13,15 +13,14 @@ open Grew_ast
(* ------------------------------------------------------------------------------------------*)
(** general function to handle parse errors *)
let parse_handle file fct lexbuf =
let get_loc () = Loc.file_line file !Global.current_line in
let parse_handle fct lexbuf =
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)
| Error.Build (msg, None) -> Error.parse ~loc:(get_loc ()) "Syntax error: %s" msg
| Grew_lexer.Error msg -> Error.parse ~loc:(Global.get_loc ()) "Lexing error: %s" msg
| Grew_parser.Error -> Error.parse ~loc:(Global.get_loc ()) "Syntax error: %s" (Lexing.lexeme lexbuf)
| Error.Build (msg, None) -> Error.parse ~loc:(Global.get_loc ()) "Syntax error: %s" msg
| Error.Build (msg, Some loc) -> Error.parse ~loc "Syntax error: %s" msg
| Failure msg -> Error.parse ~loc:(get_loc ()) "Failure: %s" msg
| err -> Error.bug ~loc:(get_loc ()) "Unexpected error: %s" (Printexc.to_string err)
| Failure msg -> Error.parse ~loc:(Global.get_loc ()) "Failure: %s" msg
| err -> Error.bug ~loc:(Global.get_loc ()) "Unexpected error: %s" (Printexc.to_string err)
module Loader = struct
......@@ -29,10 +28,10 @@ module Loader = struct
(* ------------------------------------------------------------------------------------------*)
let parse_file_to_grs_wi file =
try
Global.init file;
Global.new_file file;
let in_ch = open_in file in
let lexbuf = Lexing.from_channel in_ch in
let grs = parse_handle file (Grew_parser.grs_wi Grew_lexer.global) lexbuf in
let grs = parse_handle (Grew_parser.grs_wi Grew_lexer.global) lexbuf in
close_in in_ch;
grs
with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.parse_file_to_grs_wi] %s" msg
......@@ -40,10 +39,10 @@ module Loader = struct
(* ------------------------------------------------------------------------------------------*)
let parse_file_to_module_list file =
try
Global.init file;
Global.new_file file;
let in_ch = open_in file in
let lexbuf = Lexing.from_channel in_ch in
let module_list = parse_handle file (Grew_parser.included Grew_lexer.global) lexbuf in
let module_list = parse_handle (Grew_parser.included Grew_lexer.global) lexbuf in
close_in in_ch;
module_list
with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.parse_file_to_module_list] %s" msg
......@@ -51,10 +50,10 @@ module Loader = struct
(* ------------------------------------------------------------------------------------------*)
let domain file =
try
Global.init file;
Global.new_file 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
let gr = parse_handle (Grew_parser.domain Grew_lexer.global) lexbuf in
close_in in_ch;
gr
with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.domain] %s" msg
......@@ -99,10 +98,10 @@ module Loader = struct
(* ------------------------------------------------------------------------------------------*)
let gr file =
try
Global.init file;
Global.new_file file;
let in_ch = open_in file in
let lexbuf = Lexing.from_channel in_ch in
let gr = parse_handle file (Grew_parser.gr Grew_lexer.global) lexbuf in
let gr = parse_handle (Grew_parser.gr Grew_lexer.global) lexbuf in
close_in in_ch;
gr
with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.gr] %s" msg
......@@ -111,10 +110,10 @@ module Loader = struct
(* ------------------------------------------------------------------------------------------*)
let pattern file =
try
Global.init file;
Global.new_file file;
let in_ch = open_in file in
let lexbuf = Lexing.from_channel in_ch in
let pattern = parse_handle file (Grew_parser.pattern Grew_lexer.global) lexbuf in
let pattern = parse_handle (Grew_parser.pattern Grew_lexer.global) lexbuf in
close_in in_ch;
pattern
with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.pattern] %s" msg
......@@ -122,10 +121,10 @@ module Loader = struct
(* ------------------------------------------------------------------------------------------*)
let phrase_structure_tree file =
try
Global.init file;
Global.new_file file;
let in_ch = open_in file in
let lexbuf = Lexing.from_channel in_ch in
let graph = parse_handle file (Grew_parser.phrase_structure_tree Grew_lexer.const) lexbuf in
let graph = parse_handle (Grew_parser.phrase_structure_tree Grew_lexer.const) lexbuf in
close_in in_ch;
graph
with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.phrase_structure_tree] %s" msg
......@@ -137,36 +136,36 @@ module Parser = struct
(* ------------------------------------------------------------------------------------------*)
let gr gr_string =
try
Global.init "Not a file";
Global.new_string ();
let lexbuf = Lexing.from_string gr_string in
let gr = parse_handle "Not a file" (Grew_parser.gr Grew_lexer.global) lexbuf in
let gr = parse_handle (Grew_parser.gr Grew_lexer.global) lexbuf in
gr
with Sys_error msg -> Error.parse "[Grew_loader.Parser.gr] %s" msg
(* ------------------------------------------------------------------------------------------*)
let phrase_structure_tree s =
try
Global.init "Not a file";
Global.new_string ();
let lexbuf = Lexing.from_string s in
let graph = parse_handle "Not a file" (Grew_parser.phrase_structure_tree Grew_lexer.const) lexbuf in
let graph = parse_handle (Grew_parser.phrase_structure_tree Grew_lexer.const) lexbuf in
graph
with Sys_error msg -> Error.parse "[Grew_loader.Parser.phrase_structure_tree] %s" msg
(* ------------------------------------------------------------------------------------------*)
let pattern desc =
try
Global.init "Not a file";
Global.new_string ();
let lexbuf = Lexing.from_string desc in
let pattern = parse_handle "Not a file" (Grew_parser.pattern Grew_lexer.global) lexbuf in
let pattern = parse_handle (Grew_parser.pattern Grew_lexer.global) lexbuf in
pattern
with Sys_error msg -> Error.parse "[Grew_loader.Parser.pattern] %s" msg
(* ------------------------------------------------------------------------------------------*)
let strat_def desc =
try
Global.init "Not a file";
Global.new_string ();
let lexbuf = Lexing.from_string desc in
let strategy = parse_handle "Not a file" (Grew_parser.strat_def Grew_lexer.global) lexbuf in
let strategy = parse_handle (Grew_parser.strat_def Grew_lexer.global) lexbuf in
strategy
with Sys_error msg -> Error.parse "[Grew_loader.Parser.strategy] %s" msg
......
......@@ -28,7 +28,7 @@ type ineq_item =
| Ineq_sofi of Ast.simple_or_feature_ident
| Ineq_float of float
let get_loc () = Loc.file_opt_line !Global.current_file !Global.current_line
let get_loc () = Global.get_loc ()
let localize t = (t,get_loc ())
%}
......
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