bundles/sexplib/sexplib-7.0.5/lib/conv_error.ml

   1 (******************************************************************************
   2  *                             Sexplib                                        *
   3  *                                                                            *
   4  * Copyright (C) 2005- Jane Street Holding, LLC                               *
   5  *    Contact: opensource@janestreet.com                                      *
   6  *    WWW: http://www.janestreet.com/ocaml                                    *
   7  *    Author: Markus Mottl                                                    *
   8  *                                                                            *
   9  * This library is free software; you can redistribute it and/or              *
  10  * modify it under the terms of the GNU Lesser General Public                 *
  11  * License as published by the Free Software Foundation; either               *
  12  * version 2 of the License, or (at your option) any later version.           *
  13  *                                                                            *
  14  * This library is distributed in the hope that it will be useful,            *
  15  * but WITHOUT ANY WARRANTY; without even the implied warranty of             *
  16  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU          *
  17  * Lesser General Public License for more details.                            *
  18  *                                                                            *
  19  * You should have received a copy of the GNU Lesser General Public           *
  20  * License along with this library; if not, write to the Free Software        *
  21  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA  *
  22  *                                                                            *
  23  ******************************************************************************)
  24
  25 (* Conv_error: Module for Handling Errors during Automated S-expression
  26    Conversions *)
  27
  28 open Printf
  29 open Conv
  30
  31 (* Errors concerning tuples *)
  32
  33 let tuple_of_size_n_expected loc n sexp =
  34   of_sexp_error (sprintf "%s_of_sexp: tuple of size %d expected" loc n) sexp
  35
  36
  37 (* Errors concerning sum types *)
  38
  39 let stag_no_args loc sexp =
  40   of_sexp_error (loc ^ "_of_sexp: sum tag does not take arguments") sexp
  41
  42 let stag_incorrect_n_args loc tag sexp =
  43   let msg =
  44     sprintf "%s_of_sexp: sum tag %S has incorrect number of arguments" loc tag
  45   in
  46   of_sexp_error msg sexp
  47
  48 let stag_takes_args loc sexp =
  49   of_sexp_error (loc ^ "_of_sexp: sum tag must be a structured value") sexp
  50
  51 let nested_list_invalid_sum loc sexp =
  52   of_sexp_error (loc ^ "_of_sexp: a nested list is an invalid sum") sexp
  53
  54 let empty_list_invalid_sum loc sexp =
  55   of_sexp_error (loc ^ "_of_sexp: the empty list is an invalid sum") sexp
  56
  57 let unexpected_stag loc sexp =
  58   of_sexp_error (loc ^ "_of_sexp: unexpected sum tag") sexp
  59
  60
  61 (* Errors concerning records *)
  62
  63 let record_only_pairs_expected loc sexp =
  64   let msg =
  65     loc ^
  66       "_of_sexp: record conversion: only pairs expected, \
  67       their first element must be an atom" in
  68   of_sexp_error msg sexp
  69
  70 let record_superfluous_fields ~what ~loc rev_fld_names sexp =
  71   let fld_names_str = String.concat " " (List.rev rev_fld_names) in
  72   let msg = sprintf "%s_of_sexp: %s: %s" loc what fld_names_str in
  73   of_sexp_error msg sexp
  74
  75 let record_duplicate_fields loc rev_fld_names sexp =
  76   record_superfluous_fields ~what:"duplicate fields" ~loc rev_fld_names sexp
  77
  78 let record_extra_fields loc rev_fld_names sexp =
  79   record_superfluous_fields ~what:"extra fields" ~loc rev_fld_names sexp
  80
  81 let rec record_get_undefined_loop fields = function
  82   | [] -> String.concat " " (List.rev fields)
  83   | (true, field) :: rest -> record_get_undefined_loop (field :: fields) rest
  84   | _ :: rest -> record_get_undefined_loop fields rest
  85
  86 let record_undefined_elements loc sexp lst =
  87   let undefined = record_get_undefined_loop [] lst in
  88   let msg =
  89     sprintf "%s_of_sexp: the following record elements were undefined: %s"
  90       loc undefined
  91   in
  92   of_sexp_error msg sexp
  93
  94 let record_list_instead_atom loc sexp =
  95   let msg = loc ^ "_of_sexp: list instead of atom for record expected" in
  96   of_sexp_error msg sexp
  97
  98 let record_poly_field_value loc sexp =
  99   let msg =
 100     loc ^
 101     "_of_sexp: cannot convert values of types resulting from polymorphic \
 102     record fields"
 103   in
 104   of_sexp_error msg sexp
 105
 106
 107 (* Errors concerning polymorphic variants *)
 108
 109 exception No_variant_match of string * Sexp.t
 110
 111 let no_variant_match loc sexp =
 112   raise (No_variant_match (loc ^ "_of_sexp", sexp))
 113
 114 let no_matching_variant_found loc sexp =
 115   of_sexp_error (loc ^ ": no matching variant found") sexp
 116
 117 let ptag_no_args loc sexp =
 118   of_sexp_error (
 119     loc ^ "_of_sexp: polymorphic variant does not take arguments") sexp
 120
 121 let ptag_incorrect_n_args loc cnstr sexp =
 122   let msg =
 123     sprintf
 124       "%s_of_sexp: polymorphic variant tag %S has incorrect number of arguments"
 125       loc cnstr
 126   in
 127   of_sexp_error msg sexp
 128
 129 let nested_list_invalid_poly_var loc sexp =
 130   of_sexp_error (
 131     loc ^ "_of_sexp: a nested list is an invalid polymorphic variant") sexp
 132
 133 let empty_list_invalid_poly_var loc sexp =
 134   of_sexp_error (
 135     loc ^ "_of_sexp: the empty list is an invalid polymorphic variant") sexp
 136
 137 let silly_type loc sexp =
 138   of_sexp_error (loc ^ "_of_sexp: trying to convert a silly type") sexp
 139
 140 let empty_type loc sexp =
 141   of_sexp_error (loc ^ "_of_sexp: trying to convert an empty type") sexp