reuse Loc.t in Global

src/grew_base.ml

@@ -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

src/grew_base.mli

@@ -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

src/grew_lexer.mll

@@ -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 }

src/grew_loader.ml

@@ -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
 

src/grew_parser.mly

@@ -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 ())
 %}