l4/pkg/ocaml/contrib/driver/errors.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the Q Public License version 1.0.               *)
  10 (*                                                                     *)
  11 (***********************************************************************)
  12
  13 (* $Id: errors.ml 8705 2007-12-04 13:38:58Z doligez $ *)
  14
  15 (* WARNING: if you change something in this file, you must look at
  16    opterrors.ml and ocamldoc/odoc_analyse.ml
  17    to see if you need to make the same changes there.
  18 *)
  19
  20 open Format
  21
  22 (* Report an error *)
  23
  24 let report_error ppf exn =
  25   let report ppf = function
  26   | Lexer.Error(err, loc) ->
  27       Location.print_error ppf loc;
  28       Lexer.report_error ppf err
  29   | Syntaxerr.Error err ->
  30       Syntaxerr.report_error ppf err
  31   | Pparse.Error ->
  32       Location.print_error_cur_file ppf;
  33       fprintf ppf "Preprocessor error"
  34   | Env.Error err ->
  35       Location.print_error_cur_file ppf;
  36       Env.report_error ppf err
  37   | Ctype.Tags(l, l') ->
  38       Location.print_error_cur_file ppf;
  39       fprintf ppf
  40       "In this program,@ variant constructors@ `%s and `%s@ \
  41        have the same hash value.@ Change one of them." l l'
  42   | Typecore.Error(loc, err) ->
  43       Location.print_error ppf loc; Typecore.report_error ppf err
  44   | Typetexp.Error(loc, err) ->
  45       Location.print_error ppf loc; Typetexp.report_error ppf err
  46   | Typedecl.Error(loc, err) ->
  47       Location.print_error ppf loc; Typedecl.report_error ppf err
  48   | Typeclass.Error(loc, err) ->
  49       Location.print_error ppf loc; Typeclass.report_error ppf err
  50   | Includemod.Error err ->
  51       Location.print_error_cur_file ppf;
  52       Includemod.report_error ppf err
  53   | Typemod.Error(loc, err) ->
  54       Location.print_error ppf loc; Typemod.report_error ppf err
  55   | Translcore.Error(loc, err) ->
  56       Location.print_error ppf loc; Translcore.report_error ppf err
  57   | Translclass.Error(loc, err) ->
  58       Location.print_error ppf loc; Translclass.report_error ppf err
  59   | Translmod.Error(loc, err) ->
  60       Location.print_error ppf loc; Translmod.report_error ppf err
  61   | Symtable.Error code ->
  62       Location.print_error_cur_file ppf;
  63       Symtable.report_error ppf code
  64   | Bytelink.Error code ->
  65       Location.print_error_cur_file ppf;
  66       Bytelink.report_error ppf code
  67   | Bytelibrarian.Error code ->
  68       Location.print_error_cur_file ppf;
  69       Bytelibrarian.report_error ppf code
  70   | Bytepackager.Error code ->
  71       Location.print_error_cur_file ppf;
  72       Bytepackager.report_error ppf code
  73   | Sys_error msg ->
  74       Location.print_error_cur_file ppf;
  75       fprintf ppf "I/O error: %s" msg
  76   | Warnings.Errors (n) ->
  77       Location.print_error_cur_file ppf;
  78       fprintf ppf "Error-enabled warnings (%d occurrences)" n
  79   | x -> fprintf ppf "@]"; raise x in
  80
  81   fprintf ppf "@[%a@]@." report exn