Commits

camlspotter committed 55847ad

directory fix

Comments (0)

Files changed (13)

    ocaml-3.12/utils/config
    ocaml-3.12/utils/clflags
    ocaml-3.12/utils/warnings
-   ocaml-3.12/utils/linenum
    ocaml-3.12/utils/terminfo
-   ocaml-3.12/utils/location
-   ocaml-3.12/utils/syntaxerr
 
+   ocaml-3.12/parsing/linenum
+   ocaml-3.12/parsing/location
+   ocaml-3.12/parsing/syntaxerr
    ocaml-3.12/parsing/lexer
    ocaml-3.12/parsing/longident
    ocaml-3.12/parsing/parser
    ocaml-3.12/utils/config
    ocaml-3.12/utils/clflags
    ocaml-3.12/utils/warnings
-   ocaml-3.12/utils/linenum
    ocaml-3.12/utils/terminfo
-   ocaml-3.12/utils/location
-   ocaml-3.12/utils/syntaxerr
 
+   ocaml-3.12/parsing/linenum
+   ocaml-3.12/parsing/location
+   ocaml-3.12/parsing/syntaxerr
    ocaml-3.12/parsing/lexer
    ocaml-3.12/parsing/longident
    ocaml-3.12/parsing/parser

ocaml/ocaml-3.12/parsing/linenum.mli

+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1997 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(* An auxiliary lexer for determining the line number corresponding to
+   a file position, honoring the directives # linenum "filename" *)
+
+val for_position: string -> int -> string * int * int
+        (* [Linenum.for_position file loc] returns a triple describing
+           the location [loc] in the file named [file].
+           First result is name of actual source file.
+           Second result is line number in that source file.
+           Third result is position of beginning of that line in [file]. *)

ocaml/ocaml-3.12/parsing/linenum.mll

+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1997 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(* An auxiliary lexer for determining the line number corresponding to
+   a file position, honoring the directives # linenum "filename" *)
+
+{
+let filename = ref ""
+let linenum = ref 0
+let linebeg = ref 0
+
+let parse_sharp_line s =
+  try
+    (* Update the line number and file name *)
+    let l1 = ref 0 in
+    while let c = s.[!l1] in c < '0' || c > '9' do incr l1 done;
+    let l2 = ref (!l1 + 1) in
+    while let c = s.[!l2] in c >= '0' && c <= '9' do incr l2 done;
+    linenum := int_of_string(String.sub s !l1 (!l2 - !l1));
+    let f1 = ref (!l2 + 1) in
+    while !f1 < String.length s && s.[!f1] <> '"' do incr f1 done;
+    let f2 = ref (!f1 + 1) in
+    while !f2 < String.length s && s.[!f2] <> '"' do incr f2 done;
+    if !f1 < String.length s then
+      filename := String.sub s (!f1 + 1) (!f2 - !f1 - 1)
+  with Failure _ | Invalid_argument _ ->
+    Misc.fatal_error "Linenum.parse_sharp_line"
+}
+
+rule skip_line = parse
+    "#" [' ' '\t']* ['0'-'9']+ [' ' '\t']*
+    ("\"" [^ '\n' '\r' '"' (* '"' *) ] * "\"")?
+    [^ '\n' '\r'] *
+    ('\n' | '\r' | "\r\n")
+      { parse_sharp_line(Lexing.lexeme lexbuf);
+        linebeg := Lexing.lexeme_start lexbuf;
+        Lexing.lexeme_end lexbuf }
+  | [^ '\n' '\r'] *
+    ('\n' | '\r' | "\r\n")
+      { incr linenum;
+        linebeg := Lexing.lexeme_start lexbuf;
+        Lexing.lexeme_end lexbuf }
+  | [^ '\n' '\r'] * eof
+      { incr linenum;
+        linebeg := Lexing.lexeme_start lexbuf;
+        raise End_of_file }
+
+{
+
+let for_position file loc =
+  let ic = open_in_bin file in
+  let lb = Lexing.from_channel ic in
+  filename := file;
+  linenum := 1;
+  linebeg := 0;
+  begin try
+    while skip_line lb <= loc do () done
+  with End_of_file -> ()
+  end;
+  close_in ic;
+  (!filename, !linenum - 1, !linebeg)
+
+}

ocaml/ocaml-3.12/parsing/location.ml

+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+open Lexing
+
+type t = { loc_start: position; loc_end: position; loc_ghost: bool };;
+
+let none = { loc_start = dummy_pos; loc_end = dummy_pos; loc_ghost = true };;
+
+let in_file name =
+  let loc = {
+    pos_fname = name;
+    pos_lnum = 1;
+    pos_bol = 0;
+    pos_cnum = -1;
+  } in
+  { loc_start = loc; loc_end = loc; loc_ghost = true }
+;;
+
+let curr lexbuf = {
+  loc_start = lexbuf.lex_start_p;
+  loc_end = lexbuf.lex_curr_p;
+  loc_ghost = false
+};;
+
+let init lexbuf fname =
+  lexbuf.lex_curr_p <- {
+    pos_fname = fname;
+    pos_lnum = 1;
+    pos_bol = 0;
+    pos_cnum = 0;
+  }
+;;
+
+let symbol_rloc () = {
+  loc_start = Parsing.symbol_start_pos ();
+  loc_end = Parsing.symbol_end_pos ();
+  loc_ghost = false;
+};;
+
+let symbol_gloc () = {
+  loc_start = Parsing.symbol_start_pos ();
+  loc_end = Parsing.symbol_end_pos ();
+  loc_ghost = true;
+};;
+
+let rhs_loc n = {
+  loc_start = Parsing.rhs_start_pos n;
+  loc_end = Parsing.rhs_end_pos n;
+  loc_ghost = false;
+};;
+
+let input_name = ref "_none_"
+let input_lexbuf = ref (None : lexbuf option)
+
+(* Terminal info *)
+
+let status = ref Terminfo.Uninitialised
+
+let num_loc_lines = ref 0 (* number of lines already printed after input *)
+
+(* Highlight the locations using standout mode. *)
+
+let highlight_terminfo ppf num_lines lb loc1 loc2 =
+  Format.pp_print_flush ppf ();  (* avoid mixing Format and normal output *)
+  (* Char 0 is at offset -lb.lex_abs_pos in lb.lex_buffer. *)
+  let pos0 = -lb.lex_abs_pos in
+  (* Do nothing if the buffer does not contain the whole phrase. *)
+  if pos0 < 0 then raise Exit;
+  (* Count number of lines in phrase *)
+  let lines = ref !num_loc_lines in
+  for i = pos0 to lb.lex_buffer_len - 1 do
+    if lb.lex_buffer.[i] = '\n' then incr lines
+  done;
+  (* If too many lines, give up *)
+  if !lines >= num_lines - 2 then raise Exit;
+  (* Move cursor up that number of lines *)
+  flush stdout; Terminfo.backup !lines;
+  (* Print the input, switching to standout for the location *)
+  let bol = ref false in
+  print_string "# ";
+  for pos = 0 to lb.lex_buffer_len - pos0 - 1 do
+    if !bol then (print_string "  "; bol := false);
+    if pos = loc1.loc_start.pos_cnum || pos = loc2.loc_start.pos_cnum then
+      Terminfo.standout true;
+    if pos = loc1.loc_end.pos_cnum || pos = loc2.loc_end.pos_cnum then
+      Terminfo.standout false;
+    let c = lb.lex_buffer.[pos + pos0] in
+    print_char c;
+    bol := (c = '\n')
+  done;
+  (* Make sure standout mode is over *)
+  Terminfo.standout false;
+  (* Position cursor back to original location *)
+  Terminfo.resume !num_loc_lines;
+  flush stdout
+
+(* Highlight the location by printing it again. *)
+
+let highlight_dumb ppf lb loc =
+  (* Char 0 is at offset -lb.lex_abs_pos in lb.lex_buffer. *)
+  let pos0 = -lb.lex_abs_pos in
+  (* Do nothing if the buffer does not contain the whole phrase. *)
+  if pos0 < 0 then raise Exit;
+  let end_pos = lb.lex_buffer_len - pos0 - 1 in
+  (* Determine line numbers for the start and end points *)
+  let line_start = ref 0 and line_end = ref 0 in
+  for pos = 0 to end_pos do
+    if lb.lex_buffer.[pos + pos0] = '\n' then begin
+      if loc.loc_start.pos_cnum > pos then incr line_start;
+      if loc.loc_end.pos_cnum   > pos then incr line_end;
+    end
+  done;
+  (* Print character location (useful for Emacs) *)
+  Format.fprintf ppf "Characters %i-%i:@."
+                 loc.loc_start.pos_cnum loc.loc_end.pos_cnum;
+  (* Print the input, underlining the location *)
+  Format.pp_print_string ppf "  ";
+  let line = ref 0 in
+  let pos_at_bol = ref 0 in
+  for pos = 0 to end_pos do
+    let c = lb.lex_buffer.[pos + pos0] in
+    if c <> '\n' then begin
+      if !line = !line_start && !line = !line_end then
+        (* loc is on one line: print whole line *)
+        Format.pp_print_char ppf c
+      else if !line = !line_start then
+        (* first line of multiline loc: print ... before loc_start *)
+        if pos < loc.loc_start.pos_cnum
+        then Format.pp_print_char ppf '.'
+        else Format.pp_print_char ppf c
+      else if !line = !line_end then
+        (* last line of multiline loc: print ... after loc_end *)
+        if pos < loc.loc_end.pos_cnum
+        then Format.pp_print_char ppf c
+        else Format.pp_print_char ppf '.'
+      else if !line > !line_start && !line < !line_end then
+        (* intermediate line of multiline loc: print whole line *)
+        Format.pp_print_char ppf c
+    end else begin
+      if !line = !line_start && !line = !line_end then begin
+        (* loc is on one line: underline location *)
+        Format.fprintf ppf "@.  ";
+        for i = !pos_at_bol to loc.loc_start.pos_cnum - 1 do
+          Format.pp_print_char ppf ' '
+        done;
+        for i = loc.loc_start.pos_cnum to loc.loc_end.pos_cnum - 1 do
+          Format.pp_print_char ppf '^'
+        done
+      end;
+      if !line >= !line_start && !line <= !line_end then begin
+        Format.fprintf ppf "@.";
+        if pos < loc.loc_end.pos_cnum then Format.pp_print_string ppf "  "
+      end;
+      incr line;
+      pos_at_bol := pos + 1;
+    end
+  done
+
+(* Highlight the location using one of the supported modes. *)
+
+let rec highlight_locations ppf loc1 loc2 =
+  match !status with
+    Terminfo.Uninitialised ->
+      status := Terminfo.setup stdout; highlight_locations ppf loc1 loc2
+  | Terminfo.Bad_term ->
+      begin match !input_lexbuf with
+        None -> false
+      | Some lb ->
+          let norepeat =
+            try Sys.getenv "TERM" = "norepeat" with Not_found -> false in
+          if norepeat then false else
+            try highlight_dumb ppf lb loc1; true
+            with Exit -> false
+      end
+  | Terminfo.Good_term num_lines ->
+      begin match !input_lexbuf with
+        None -> false
+      | Some lb ->
+          try highlight_terminfo ppf num_lines lb loc1 loc2; true
+          with Exit -> false
+      end
+
+(* Print the location in some way or another *)
+
+open Format
+
+let reset () =
+  num_loc_lines := 0
+
+let (msg_file, msg_line, msg_chars, msg_to, msg_colon, msg_head) =
+  ("File \"", "\", line ", ", characters ", "-", ":", "")
+
+(* return file, line, char from the given position *)
+let get_pos_info pos =
+  let (filename, linenum, linebeg) =
+    if pos.pos_fname = "" && !input_name = "" then
+      ("", -1, 0)
+    else if pos.pos_fname = "" then
+      Linenum.for_position !input_name pos.pos_cnum
+    else
+      (pos.pos_fname, pos.pos_lnum, pos.pos_bol)
+  in
+  (filename, linenum, pos.pos_cnum - linebeg)
+;;
+
+let print ppf loc =
+  let (file, line, startchar) = get_pos_info loc.loc_start in
+  let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in
+  let (startchar, endchar) =
+    if startchar < 0 then (0, 1) else (startchar, endchar)
+  in
+  if file = "" then begin
+    if highlight_locations ppf loc none then () else
+      fprintf ppf "Characters %i-%i:@."
+              loc.loc_start.pos_cnum loc.loc_end.pos_cnum
+  end else begin
+    fprintf ppf "%s%s%s%i" msg_file file msg_line line;
+    fprintf ppf "%s%i" msg_chars startchar;
+    fprintf ppf "%s%i%s@.%s" msg_to endchar msg_colon msg_head;
+  end
+;;
+
+let print_error ppf loc =
+  print ppf loc;
+  fprintf ppf "Error: ";
+;;
+
+let print_error_cur_file ppf = print_error ppf (in_file !input_name);;
+
+let print_warning loc ppf w =
+  if Warnings.is_active w then begin
+    let printw ppf w =
+      let n = Warnings.print ppf w in
+      num_loc_lines := !num_loc_lines + n
+    in
+    fprintf ppf "%a" print loc;
+    fprintf ppf "Warning %a@." printw w;
+    pp_print_flush ppf ();
+    incr num_loc_lines;
+  end
+;;
+
+let prerr_warning loc w = print_warning loc err_formatter w;;
+
+let echo_eof () =
+  print_newline ();
+  incr num_loc_lines

ocaml/ocaml-3.12/parsing/location.mli

+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(* Source code locations (ranges of positions), used in parsetree. *)
+
+open Format
+
+type t = {
+  loc_start: Lexing.position;
+  loc_end: Lexing.position;
+  loc_ghost: bool;
+}
+
+(* Note on the use of Lexing.position in this module.
+   If [pos_fname = ""], then use [!input_name] instead.
+   If [pos_lnum = -1], then [pos_bol = 0]. Use [pos_cnum] and
+     re-parse the file to get the line and character numbers.
+   Else all fields are correct.
+*)
+
+val none : t
+(** An arbitrary value of type [t]; describes an empty ghost range. *)
+val in_file : string -> t;;
+(** Return an empty ghost range located in a given file. *)
+val init : Lexing.lexbuf -> string -> unit
+(** Set the file name and line number of the [lexbuf] to be the start
+    of the named file. *)
+val curr : Lexing.lexbuf -> t
+(** Get the location of the current token from the [lexbuf]. *)
+
+val symbol_rloc: unit -> t
+val symbol_gloc: unit -> t
+val rhs_loc: int -> t
+
+val input_name: string ref
+val input_lexbuf: Lexing.lexbuf option ref
+
+val get_pos_info : Lexing.position -> string * int * int (* file, line, char *)
+val print: formatter -> t -> unit
+val print_error: formatter -> t -> unit
+val print_error_cur_file: formatter -> unit
+val print_warning: t -> formatter -> Warnings.t -> unit
+val prerr_warning: t -> Warnings.t -> unit
+val echo_eof: unit -> unit
+val reset: unit -> unit
+
+val highlight_locations: formatter -> t -> t -> bool

ocaml/ocaml-3.12/parsing/syntaxerr.ml

+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1997 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(* Auxiliary type for reporting syntax errors *)
+
+open Format
+
+type error =
+    Unclosed of Location.t * string * Location.t * string
+  | Applicative_path of Location.t
+  | Other of Location.t
+
+exception Error of error
+exception Escape_error
+
+let report_error ppf = function
+  | Unclosed(opening_loc, opening, closing_loc, closing) ->
+      if String.length !Location.input_name = 0
+      && Location.highlight_locations ppf opening_loc closing_loc
+      then fprintf ppf "Syntax error: '%s' expected, \
+                   the highlighted '%s' might be unmatched" closing opening
+      else begin
+        fprintf ppf "%aSyntax error: '%s' expected@."
+          Location.print_error closing_loc closing;
+        fprintf ppf "%aThis '%s' might be unmatched"
+          Location.print_error opening_loc opening
+      end
+  | Applicative_path loc ->
+      fprintf ppf "%aSyntax error: applicative paths of the form F(X).t are not supported when the option -no-app-func is set."
+        Location.print_error loc
+  | Other loc ->
+      fprintf ppf "%aSyntax error" Location.print_error loc

ocaml/ocaml-3.12/parsing/syntaxerr.mli

+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1997 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(* Auxiliary type for reporting syntax errors *)
+
+open Format
+
+type error =
+    Unclosed of Location.t * string * Location.t * string
+  | Applicative_path of Location.t
+  | Other of Location.t
+
+exception Error of error
+exception Escape_error
+
+val report_error: formatter -> error -> unit

ocaml/ocaml-3.12/utils/linenum.mli

-(***********************************************************************)
-(*                                                                     *)
-(*                           Objective Caml                            *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1997 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id$ *)
-
-(* An auxiliary lexer for determining the line number corresponding to
-   a file position, honoring the directives # linenum "filename" *)
-
-val for_position: string -> int -> string * int * int
-        (* [Linenum.for_position file loc] returns a triple describing
-           the location [loc] in the file named [file].
-           First result is name of actual source file.
-           Second result is line number in that source file.
-           Third result is position of beginning of that line in [file]. *)

ocaml/ocaml-3.12/utils/linenum.mll

-(***********************************************************************)
-(*                                                                     *)
-(*                           Objective Caml                            *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1997 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id$ *)
-
-(* An auxiliary lexer for determining the line number corresponding to
-   a file position, honoring the directives # linenum "filename" *)
-
-{
-let filename = ref ""
-let linenum = ref 0
-let linebeg = ref 0
-
-let parse_sharp_line s =
-  try
-    (* Update the line number and file name *)
-    let l1 = ref 0 in
-    while let c = s.[!l1] in c < '0' || c > '9' do incr l1 done;
-    let l2 = ref (!l1 + 1) in
-    while let c = s.[!l2] in c >= '0' && c <= '9' do incr l2 done;
-    linenum := int_of_string(String.sub s !l1 (!l2 - !l1));
-    let f1 = ref (!l2 + 1) in
-    while !f1 < String.length s && s.[!f1] <> '"' do incr f1 done;
-    let f2 = ref (!f1 + 1) in
-    while !f2 < String.length s && s.[!f2] <> '"' do incr f2 done;
-    if !f1 < String.length s then
-      filename := String.sub s (!f1 + 1) (!f2 - !f1 - 1)
-  with Failure _ | Invalid_argument _ ->
-    Misc.fatal_error "Linenum.parse_sharp_line"
-}
-
-rule skip_line = parse
-    "#" [' ' '\t']* ['0'-'9']+ [' ' '\t']*
-    ("\"" [^ '\n' '\r' '"' (* '"' *) ] * "\"")?
-    [^ '\n' '\r'] *
-    ('\n' | '\r' | "\r\n")
-      { parse_sharp_line(Lexing.lexeme lexbuf);
-        linebeg := Lexing.lexeme_start lexbuf;
-        Lexing.lexeme_end lexbuf }
-  | [^ '\n' '\r'] *
-    ('\n' | '\r' | "\r\n")
-      { incr linenum;
-        linebeg := Lexing.lexeme_start lexbuf;
-        Lexing.lexeme_end lexbuf }
-  | [^ '\n' '\r'] * eof
-      { incr linenum;
-        linebeg := Lexing.lexeme_start lexbuf;
-        raise End_of_file }
-
-{
-
-let for_position file loc =
-  let ic = open_in_bin file in
-  let lb = Lexing.from_channel ic in
-  filename := file;
-  linenum := 1;
-  linebeg := 0;
-  begin try
-    while skip_line lb <= loc do () done
-  with End_of_file -> ()
-  end;
-  close_in ic;
-  (!filename, !linenum - 1, !linebeg)
-
-}

ocaml/ocaml-3.12/utils/location.ml

-(***********************************************************************)
-(*                                                                     *)
-(*                           Objective Caml                            *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id$ *)
-
-open Lexing
-
-type t = { loc_start: position; loc_end: position; loc_ghost: bool };;
-
-let none = { loc_start = dummy_pos; loc_end = dummy_pos; loc_ghost = true };;
-
-let in_file name =
-  let loc = {
-    pos_fname = name;
-    pos_lnum = 1;
-    pos_bol = 0;
-    pos_cnum = -1;
-  } in
-  { loc_start = loc; loc_end = loc; loc_ghost = true }
-;;
-
-let curr lexbuf = {
-  loc_start = lexbuf.lex_start_p;
-  loc_end = lexbuf.lex_curr_p;
-  loc_ghost = false
-};;
-
-let init lexbuf fname =
-  lexbuf.lex_curr_p <- {
-    pos_fname = fname;
-    pos_lnum = 1;
-    pos_bol = 0;
-    pos_cnum = 0;
-  }
-;;
-
-let symbol_rloc () = {
-  loc_start = Parsing.symbol_start_pos ();
-  loc_end = Parsing.symbol_end_pos ();
-  loc_ghost = false;
-};;
-
-let symbol_gloc () = {
-  loc_start = Parsing.symbol_start_pos ();
-  loc_end = Parsing.symbol_end_pos ();
-  loc_ghost = true;
-};;
-
-let rhs_loc n = {
-  loc_start = Parsing.rhs_start_pos n;
-  loc_end = Parsing.rhs_end_pos n;
-  loc_ghost = false;
-};;
-
-let input_name = ref "_none_"
-let input_lexbuf = ref (None : lexbuf option)
-
-(* Terminal info *)
-
-let status = ref Terminfo.Uninitialised
-
-let num_loc_lines = ref 0 (* number of lines already printed after input *)
-
-(* Highlight the locations using standout mode. *)
-
-let highlight_terminfo ppf num_lines lb loc1 loc2 =
-  Format.pp_print_flush ppf ();  (* avoid mixing Format and normal output *)
-  (* Char 0 is at offset -lb.lex_abs_pos in lb.lex_buffer. *)
-  let pos0 = -lb.lex_abs_pos in
-  (* Do nothing if the buffer does not contain the whole phrase. *)
-  if pos0 < 0 then raise Exit;
-  (* Count number of lines in phrase *)
-  let lines = ref !num_loc_lines in
-  for i = pos0 to lb.lex_buffer_len - 1 do
-    if lb.lex_buffer.[i] = '\n' then incr lines
-  done;
-  (* If too many lines, give up *)
-  if !lines >= num_lines - 2 then raise Exit;
-  (* Move cursor up that number of lines *)
-  flush stdout; Terminfo.backup !lines;
-  (* Print the input, switching to standout for the location *)
-  let bol = ref false in
-  print_string "# ";
-  for pos = 0 to lb.lex_buffer_len - pos0 - 1 do
-    if !bol then (print_string "  "; bol := false);
-    if pos = loc1.loc_start.pos_cnum || pos = loc2.loc_start.pos_cnum then
-      Terminfo.standout true;
-    if pos = loc1.loc_end.pos_cnum || pos = loc2.loc_end.pos_cnum then
-      Terminfo.standout false;
-    let c = lb.lex_buffer.[pos + pos0] in
-    print_char c;
-    bol := (c = '\n')
-  done;
-  (* Make sure standout mode is over *)
-  Terminfo.standout false;
-  (* Position cursor back to original location *)
-  Terminfo.resume !num_loc_lines;
-  flush stdout
-
-(* Highlight the location by printing it again. *)
-
-let highlight_dumb ppf lb loc =
-  (* Char 0 is at offset -lb.lex_abs_pos in lb.lex_buffer. *)
-  let pos0 = -lb.lex_abs_pos in
-  (* Do nothing if the buffer does not contain the whole phrase. *)
-  if pos0 < 0 then raise Exit;
-  let end_pos = lb.lex_buffer_len - pos0 - 1 in
-  (* Determine line numbers for the start and end points *)
-  let line_start = ref 0 and line_end = ref 0 in
-  for pos = 0 to end_pos do
-    if lb.lex_buffer.[pos + pos0] = '\n' then begin
-      if loc.loc_start.pos_cnum > pos then incr line_start;
-      if loc.loc_end.pos_cnum   > pos then incr line_end;
-    end
-  done;
-  (* Print character location (useful for Emacs) *)
-  Format.fprintf ppf "Characters %i-%i:@."
-                 loc.loc_start.pos_cnum loc.loc_end.pos_cnum;
-  (* Print the input, underlining the location *)
-  Format.pp_print_string ppf "  ";
-  let line = ref 0 in
-  let pos_at_bol = ref 0 in
-  for pos = 0 to end_pos do
-    let c = lb.lex_buffer.[pos + pos0] in
-    if c <> '\n' then begin
-      if !line = !line_start && !line = !line_end then
-        (* loc is on one line: print whole line *)
-        Format.pp_print_char ppf c
-      else if !line = !line_start then
-        (* first line of multiline loc: print ... before loc_start *)
-        if pos < loc.loc_start.pos_cnum
-        then Format.pp_print_char ppf '.'
-        else Format.pp_print_char ppf c
-      else if !line = !line_end then
-        (* last line of multiline loc: print ... after loc_end *)
-        if pos < loc.loc_end.pos_cnum
-        then Format.pp_print_char ppf c
-        else Format.pp_print_char ppf '.'
-      else if !line > !line_start && !line < !line_end then
-        (* intermediate line of multiline loc: print whole line *)
-        Format.pp_print_char ppf c
-    end else begin
-      if !line = !line_start && !line = !line_end then begin
-        (* loc is on one line: underline location *)
-        Format.fprintf ppf "@.  ";
-        for i = !pos_at_bol to loc.loc_start.pos_cnum - 1 do
-          Format.pp_print_char ppf ' '
-        done;
-        for i = loc.loc_start.pos_cnum to loc.loc_end.pos_cnum - 1 do
-          Format.pp_print_char ppf '^'
-        done
-      end;
-      if !line >= !line_start && !line <= !line_end then begin
-        Format.fprintf ppf "@.";
-        if pos < loc.loc_end.pos_cnum then Format.pp_print_string ppf "  "
-      end;
-      incr line;
-      pos_at_bol := pos + 1;
-    end
-  done
-
-(* Highlight the location using one of the supported modes. *)
-
-let rec highlight_locations ppf loc1 loc2 =
-  match !status with
-    Terminfo.Uninitialised ->
-      status := Terminfo.setup stdout; highlight_locations ppf loc1 loc2
-  | Terminfo.Bad_term ->
-      begin match !input_lexbuf with
-        None -> false
-      | Some lb ->
-          let norepeat =
-            try Sys.getenv "TERM" = "norepeat" with Not_found -> false in
-          if norepeat then false else
-            try highlight_dumb ppf lb loc1; true
-            with Exit -> false
-      end
-  | Terminfo.Good_term num_lines ->
-      begin match !input_lexbuf with
-        None -> false
-      | Some lb ->
-          try highlight_terminfo ppf num_lines lb loc1 loc2; true
-          with Exit -> false
-      end
-
-(* Print the location in some way or another *)
-
-open Format
-
-let reset () =
-  num_loc_lines := 0
-
-let (msg_file, msg_line, msg_chars, msg_to, msg_colon, msg_head) =
-  ("File \"", "\", line ", ", characters ", "-", ":", "")
-
-(* return file, line, char from the given position *)
-let get_pos_info pos =
-  let (filename, linenum, linebeg) =
-    if pos.pos_fname = "" && !input_name = "" then
-      ("", -1, 0)
-    else if pos.pos_fname = "" then
-      Linenum.for_position !input_name pos.pos_cnum
-    else
-      (pos.pos_fname, pos.pos_lnum, pos.pos_bol)
-  in
-  (filename, linenum, pos.pos_cnum - linebeg)
-;;
-
-let print ppf loc =
-  let (file, line, startchar) = get_pos_info loc.loc_start in
-  let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in
-  let (startchar, endchar) =
-    if startchar < 0 then (0, 1) else (startchar, endchar)
-  in
-  if file = "" then begin
-    if highlight_locations ppf loc none then () else
-      fprintf ppf "Characters %i-%i:@."
-              loc.loc_start.pos_cnum loc.loc_end.pos_cnum
-  end else begin
-    fprintf ppf "%s%s%s%i" msg_file file msg_line line;
-    fprintf ppf "%s%i" msg_chars startchar;
-    fprintf ppf "%s%i%s@.%s" msg_to endchar msg_colon msg_head;
-  end
-;;
-
-let print_error ppf loc =
-  print ppf loc;
-  fprintf ppf "Error: ";
-;;
-
-let print_error_cur_file ppf = print_error ppf (in_file !input_name);;
-
-let print_warning loc ppf w =
-  if Warnings.is_active w then begin
-    let printw ppf w =
-      let n = Warnings.print ppf w in
-      num_loc_lines := !num_loc_lines + n
-    in
-    fprintf ppf "%a" print loc;
-    fprintf ppf "Warning %a@." printw w;
-    pp_print_flush ppf ();
-    incr num_loc_lines;
-  end
-;;
-
-let prerr_warning loc w = print_warning loc err_formatter w;;
-
-let echo_eof () =
-  print_newline ();
-  incr num_loc_lines

ocaml/ocaml-3.12/utils/location.mli

-(***********************************************************************)
-(*                                                                     *)
-(*                           Objective Caml                            *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id$ *)
-
-(* Source code locations (ranges of positions), used in parsetree. *)
-
-open Format
-
-type t = {
-  loc_start: Lexing.position;
-  loc_end: Lexing.position;
-  loc_ghost: bool;
-}
-
-(* Note on the use of Lexing.position in this module.
-   If [pos_fname = ""], then use [!input_name] instead.
-   If [pos_lnum = -1], then [pos_bol = 0]. Use [pos_cnum] and
-     re-parse the file to get the line and character numbers.
-   Else all fields are correct.
-*)
-
-val none : t
-(** An arbitrary value of type [t]; describes an empty ghost range. *)
-val in_file : string -> t;;
-(** Return an empty ghost range located in a given file. *)
-val init : Lexing.lexbuf -> string -> unit
-(** Set the file name and line number of the [lexbuf] to be the start
-    of the named file. *)
-val curr : Lexing.lexbuf -> t
-(** Get the location of the current token from the [lexbuf]. *)
-
-val symbol_rloc: unit -> t
-val symbol_gloc: unit -> t
-val rhs_loc: int -> t
-
-val input_name: string ref
-val input_lexbuf: Lexing.lexbuf option ref
-
-val get_pos_info : Lexing.position -> string * int * int (* file, line, char *)
-val print: formatter -> t -> unit
-val print_error: formatter -> t -> unit
-val print_error_cur_file: formatter -> unit
-val print_warning: t -> formatter -> Warnings.t -> unit
-val prerr_warning: t -> Warnings.t -> unit
-val echo_eof: unit -> unit
-val reset: unit -> unit
-
-val highlight_locations: formatter -> t -> t -> bool

ocaml/ocaml-3.12/utils/syntaxerr.ml

-(***********************************************************************)
-(*                                                                     *)
-(*                           Objective Caml                            *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1997 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id$ *)
-
-(* Auxiliary type for reporting syntax errors *)
-
-open Format
-
-type error =
-    Unclosed of Location.t * string * Location.t * string
-  | Applicative_path of Location.t
-  | Other of Location.t
-
-exception Error of error
-exception Escape_error
-
-let report_error ppf = function
-  | Unclosed(opening_loc, opening, closing_loc, closing) ->
-      if String.length !Location.input_name = 0
-      && Location.highlight_locations ppf opening_loc closing_loc
-      then fprintf ppf "Syntax error: '%s' expected, \
-                   the highlighted '%s' might be unmatched" closing opening
-      else begin
-        fprintf ppf "%aSyntax error: '%s' expected@."
-          Location.print_error closing_loc closing;
-        fprintf ppf "%aThis '%s' might be unmatched"
-          Location.print_error opening_loc opening
-      end
-  | Applicative_path loc ->
-      fprintf ppf "%aSyntax error: applicative paths of the form F(X).t are not supported when the option -no-app-func is set."
-        Location.print_error loc
-  | Other loc ->
-      fprintf ppf "%aSyntax error" Location.print_error loc

ocaml/ocaml-3.12/utils/syntaxerr.mli

-(***********************************************************************)
-(*                                                                     *)
-(*                           Objective Caml                            *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1997 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id$ *)
-
-(* Auxiliary type for reporting syntax errors *)
-
-open Format
-
-type error =
-    Unclosed of Location.t * string * Location.t * string
-  | Applicative_path of Location.t
-  | Other of Location.t
-
-exception Error of error
-exception Escape_error
-
-val report_error: formatter -> error -> unit