Move variable printer to Pprintast

- The code responsible for printing Syntaxerr errors is moved to the
  Parse module (so that it can depend on the variable printer in
  Pprintast).

- Pprintast becomes a dependency for a few tools that link some
  compiler modules in an ad hoc way (they would better be implemented
  in terms of compiler-libs).

.depend

@@ -118,12 +118,12 @@ parsing/location.cmi : utils/warnings.cmi
 parsing/longident.cmo : utils/misc.cmi parsing/longident.cmi
 parsing/longident.cmx : utils/misc.cmx parsing/longident.cmi
 parsing/longident.cmi :
-parsing/parse.cmo : parsing/syntaxerr.cmi parsing/parser.cmi \
-    parsing/location.cmi parsing/lexer.cmi parsing/docstrings.cmi \
-    parsing/parse.cmi
-parsing/parse.cmx : parsing/syntaxerr.cmx parsing/parser.cmx \
-    parsing/location.cmx parsing/lexer.cmx parsing/docstrings.cmx \
-    parsing/parse.cmi
+parsing/parse.cmo : parsing/syntaxerr.cmi parsing/pprintast.cmi \
+    parsing/parser.cmi parsing/location.cmi parsing/lexer.cmi \
+    parsing/docstrings.cmi parsing/parse.cmi
+parsing/parse.cmx : parsing/syntaxerr.cmx parsing/pprintast.cmx \
+    parsing/parser.cmx parsing/location.cmx parsing/lexer.cmx \
+    parsing/docstrings.cmx parsing/parse.cmi
 parsing/parse.cmi : parsing/parsetree.cmi
 parsing/parser.cmo : parsing/syntaxerr.cmi parsing/parsetree.cmi \
     parsing/longident.cmi parsing/location.cmi parsing/docstrings.cmi \
@@ -137,17 +137,17 @@ parsing/parser.cmi : parsing/parsetree.cmi parsing/location.cmi \
     parsing/docstrings.cmi parsing/camlinternalMenhirLib.cmi
 parsing/parsetree.cmi : parsing/longident.cmi parsing/location.cmi \
     parsing/asttypes.cmi
-parsing/pprintast.cmo : parsing/syntaxerr.cmi parsing/parsetree.cmi \
-    utils/misc.cmi parsing/longident.cmi parsing/location.cmi \
-    parsing/asttypes.cmi parsing/ast_helper.cmi parsing/pprintast.cmi
-parsing/pprintast.cmx : parsing/syntaxerr.cmx parsing/parsetree.cmi \
-    utils/misc.cmx parsing/longident.cmx parsing/location.cmx \
-    parsing/asttypes.cmi parsing/ast_helper.cmx parsing/pprintast.cmi
+parsing/pprintast.cmo : parsing/parsetree.cmi utils/misc.cmi \
+    parsing/longident.cmi parsing/location.cmi parsing/asttypes.cmi \
+    parsing/ast_helper.cmi parsing/pprintast.cmi
+parsing/pprintast.cmx : parsing/parsetree.cmi utils/misc.cmx \
+    parsing/longident.cmx parsing/location.cmx parsing/asttypes.cmi \
+    parsing/ast_helper.cmx parsing/pprintast.cmi
 parsing/pprintast.cmi : parsing/parsetree.cmi parsing/longident.cmi
-parsing/printast.cmo : parsing/syntaxerr.cmi parsing/parsetree.cmi \
+parsing/printast.cmo : parsing/pprintast.cmi parsing/parsetree.cmi \
     utils/misc.cmi parsing/longident.cmi parsing/location.cmi \
     parsing/asttypes.cmi parsing/printast.cmi
-parsing/printast.cmx : parsing/syntaxerr.cmx parsing/parsetree.cmi \
+parsing/printast.cmx : parsing/pprintast.cmx parsing/parsetree.cmi \
     utils/misc.cmx parsing/longident.cmx parsing/location.cmx \
     parsing/asttypes.cmi parsing/printast.cmi
 parsing/printast.cmi : parsing/parsetree.cmi
@@ -261,9 +261,9 @@ typing/mtype.cmx : typing/types.cmx typing/subst.cmx typing/path.cmx \
     typing/mtype.cmi
 typing/mtype.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi \
     typing/env.cmi
-typing/oprint.cmo : parsing/syntaxerr.cmi typing/outcometree.cmi \
+typing/oprint.cmo : parsing/pprintast.cmi typing/outcometree.cmi \
     parsing/asttypes.cmi typing/oprint.cmi
-typing/oprint.cmx : parsing/syntaxerr.cmx typing/outcometree.cmi \
+typing/oprint.cmx : parsing/pprintast.cmx typing/outcometree.cmi \
     parsing/asttypes.cmi typing/oprint.cmi
 typing/oprint.cmi : typing/outcometree.cmi
 typing/outcometree.cmi : parsing/asttypes.cmi
@@ -308,14 +308,14 @@ typing/printpat.cmx : typing/types.cmx typing/typedtree.cmx typing/ident.cmx \
     parsing/asttypes.cmi typing/printpat.cmi
 typing/printpat.cmi : typing/typedtree.cmi parsing/asttypes.cmi
 typing/printtyp.cmo : utils/warnings.cmi typing/types.cmi \
-    parsing/syntaxerr.cmi typing/primitive.cmi typing/predef.cmi \
+    typing/primitive.cmi typing/predef.cmi parsing/pprintast.cmi \
     typing/path.cmi parsing/parsetree.cmi typing/outcometree.cmi \
     typing/oprint.cmi utils/misc.cmi parsing/longident.cmi \
     parsing/location.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \
     utils/clflags.cmi parsing/builtin_attributes.cmi typing/btype.cmi \
     parsing/asttypes.cmi typing/printtyp.cmi
 typing/printtyp.cmx : utils/warnings.cmx typing/types.cmx \
-    parsing/syntaxerr.cmx typing/primitive.cmx typing/predef.cmx \
+    typing/primitive.cmx typing/predef.cmx parsing/pprintast.cmx \
     typing/path.cmx parsing/parsetree.cmi typing/outcometree.cmi \
     typing/oprint.cmx utils/misc.cmx parsing/longident.cmx \
     parsing/location.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \
@@ -496,14 +496,14 @@ typing/types.cmi : typing/primitive.cmi typing/path.cmi \
     parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
     typing/ident.cmi parsing/asttypes.cmi
 typing/typetexp.cmo : typing/types.cmi typing/typedtree.cmi \
-    parsing/syntaxerr.cmi typing/printtyp.cmi typing/predef.cmi \
+    typing/printtyp.cmi typing/predef.cmi parsing/pprintast.cmi \
     typing/path.cmi parsing/parsetree.cmi typing/oprint.cmi utils/misc.cmi \
     parsing/longident.cmi parsing/location.cmi typing/includemod.cmi \
     typing/env.cmi typing/ctype.cmi utils/clflags.cmi \
     parsing/builtin_attributes.cmi typing/btype.cmi parsing/asttypes.cmi \
     parsing/ast_helper.cmi typing/typetexp.cmi
 typing/typetexp.cmx : typing/types.cmx typing/typedtree.cmx \
-    parsing/syntaxerr.cmx typing/printtyp.cmx typing/predef.cmx \
+    typing/printtyp.cmx typing/predef.cmx parsing/pprintast.cmx \
     typing/path.cmx parsing/parsetree.cmi typing/oprint.cmx utils/misc.cmx \
     parsing/longident.cmx parsing/location.cmx typing/includemod.cmx \
     typing/env.cmx typing/ctype.cmx utils/clflags.cmx \

Makefile

@@ -80,9 +80,9 @@ UTILS=utils/config.cmo utils/build_path_prefix_map.cmo utils/misc.cmo \
 PARSING=parsing/location.cmo parsing/longident.cmo \
   parsing/docstrings.cmo parsing/syntaxerr.cmo \
   parsing/ast_helper.cmo \
+  parsing/pprintast.cmo \
   parsing/camlinternalMenhirLib.cmo parsing/parser.cmo \
   parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo \
-  parsing/pprintast.cmo \
   parsing/ast_mapper.cmo parsing/ast_iterator.cmo parsing/attr_helper.cmo \
   parsing/builtin_attributes.cmo parsing/ast_invariants.cmo parsing/depend.cmo
 

debugger/Makefile

@@ -42,7 +42,7 @@ utils_modules := $(addprefix utils/,\
 
 parsing_modules := $(addprefix parsing/,\
   location longident docstrings syntaxerr ast_helper ast_mapper ast_iterator \
-  attr_helper builtin_attributes)
+  attr_helper builtin_attributes pprintast)
 
 typing_modules := $(addprefix typing/,\
   ident path types btype primitive typedtree subst predef datarepr \

ocamldoc/odoc_analyse.ml

@@ -87,18 +87,19 @@ let process_implementation_file sourcefile =
     in
     (Some (parsetree, typedtree), inputfile)
   with
-    e ->
-      match e with
-        Syntaxerr.Error err ->
+  | Syntaxerr.Error _ as exn ->
+      begin match Location.error_of_exn exn with
+      | Some (`Ok err) ->
           fprintf Format.err_formatter "@[%a@]@."
-            Syntaxerr.report_error err;
-          None, inputfile
-      | Failure s ->
-          prerr_endline s;
-          incr Odoc_global.errors ;
-          None, inputfile
-      | e ->
-          raise e
+            Location.print_report err
+      | _ ->
+          assert false
+      end;
+      None, inputfile
+  | Failure s ->
+      prerr_endline s;
+      incr Odoc_global.errors ;
+      None, inputfile
 
 (** Analysis of an interface file. Returns (Some signature) if
    no error occurred, else None and an error message is printed.*)

parsing/parse.ml

@@ -120,3 +120,48 @@ and use_file = wrap_menhir Parser.Incremental.use_file
 and core_type = wrap_menhir Parser.Incremental.parse_core_type
 and expression = wrap_menhir Parser.Incremental.parse_expression
 and pattern = wrap_menhir Parser.Incremental.parse_pattern
+
+
+
+(* Error reporting for Syntaxerr *)
+(* The code has been moved here so that one can reuse Pprintast.tyvar *)
+
+let prepare_error err =
+  let open Syntaxerr in
+  match err with
+  | Unclosed(opening_loc, opening, closing_loc, closing) ->
+      Location.errorf
+        ~loc:closing_loc
+        ~sub:[
+          Location.msg ~loc:opening_loc
+            "This '%s' might be unmatched" opening
+        ]
+        "Syntax error: '%s' expected" closing
+
+  | Expecting (loc, nonterm) ->
+      Location.errorf ~loc "Syntax error: %s expected." nonterm
+  | Not_expecting (loc, nonterm) ->
+      Location.errorf ~loc "Syntax error: %s not expected." nonterm
+  | Applicative_path loc ->
+      Location.errorf ~loc
+        "Syntax error: applicative paths of the form F(X).t \
+         are not supported when the option -no-app-func is set."
+  | Variable_in_scope (loc, var) ->
+      Location.errorf ~loc
+        "In this scoped type, variable %a \
+         is reserved for the local type %s."
+        Pprintast.tyvar var var
+  | Other loc ->
+      Location.errorf ~loc "Syntax error"
+  | Ill_formed_ast (loc, s) ->
+      Location.errorf ~loc
+        "broken invariant in parsetree: %s" s
+  | Invalid_package_type (loc, s) ->
+      Location.errorf ~loc "invalid package type: %s" s
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Syntaxerr.Error err -> Some (prepare_error err)
+      | _ -> None
+    )

parsing/pprintast.ml

@@ -244,7 +244,14 @@ let iter_loc f ctxt {txt; loc = _} = f ctxt txt
 
 let constant_string f s = pp f "%S" s
 
-let tyvar = Syntaxerr.print_tyvar
+let tyvar ppf s =
+  if String.length s >= 2 && s.[1] = '\'' then
+    (* without the space, this would be parsed as
+       a character literal *)
+    Format.fprintf ppf "' %s" s
+  else
+    Format.fprintf ppf "'%s" s
+
 let tyvar_loc f str = tyvar f str.txt
 let string_quot f x = pp f "`%s" x
 

parsing/pprintast.mli

@@ -37,3 +37,8 @@ val string_of_structure: Parsetree.structure -> string
 
 val toplevel_phrase : Format.formatter -> Parsetree.toplevel_phrase -> unit
 val top_phrase: Format.formatter -> Parsetree.toplevel_phrase -> unit
+
+
+val tyvar: Format.formatter -> string -> unit
+  (** Print a type variable name, taking care of the special treatment
+      required for the single quote character in second position. *)

parsing/printast.ml

@@ -182,7 +182,7 @@ let rec core_type i ppf x =
   | Ptyp_poly (sl, ct) ->
       line i ppf "Ptyp_poly%a\n"
         (fun ppf ->
-           List.iter (fun x -> fprintf ppf " %a" Syntaxerr.print_tyvar x.txt)
+           List.iter (fun x -> fprintf ppf " %a" Pprintast.tyvar x.txt)
         )
         sl;
       core_type i ppf ct;

parsing/syntaxerr.ml

@@ -28,57 +28,6 @@ type error =
 exception Error of error
 exception Escape_error
 
-let print_tyvar ppf s =
-  if String.length s >= 2 && s.[1] = '\'' then
-    (* without the space, this would be parsed as
-       a character literal *)
-    Format.fprintf ppf "' %s" s
-  else
-    Format.fprintf ppf "'%s" s
-
-let prepare_error err =
-  match err with
-  | Unclosed(opening_loc, opening, closing_loc, closing) ->
-      Location.errorf
-        ~loc:closing_loc
-        ~sub:[
-          Location.msg ~loc:opening_loc
-            "This '%s' might be unmatched" opening
-        ]
-        "Syntax error: '%s' expected" closing
-
-  | Expecting (loc, nonterm) ->
-      Location.errorf ~loc "Syntax error: %s expected." nonterm
-  | Not_expecting (loc, nonterm) ->
-      Location.errorf ~loc "Syntax error: %s not expected." nonterm
-  | Applicative_path loc ->
-      Location.errorf ~loc
-        "Syntax error: applicative paths of the form F(X).t \
-         are not supported when the option -no-app-func is set."
-  | Variable_in_scope (loc, var) ->
-      Location.errorf ~loc
-        "In this scoped type, variable %a \
-         is reserved for the local type %s."
-        print_tyvar var var
-  | Other loc ->
-      Location.errorf ~loc "Syntax error"
-  | Ill_formed_ast (loc, s) ->
-      Location.errorf ~loc
-        "broken invariant in parsetree: %s" s
-  | Invalid_package_type (loc, s) ->
-      Location.errorf ~loc "invalid package type: %s" s
-
-let () =
-  Location.register_error_of_exn
-    (function
-      | Error err -> Some (prepare_error err)
-      | _ -> None
-    )
-
-
-let report_error ppf err =
-  Location.print_report ppf (prepare_error err)
-
 let location_of_error = function
   | Unclosed(l,_,_,_)
   | Applicative_path l

parsing/syntaxerr.mli

@@ -20,8 +20,6 @@
 
 *)
 
-open Format
-
 type error =
     Unclosed of Location.t * string * Location.t * string
   | Expecting of Location.t * string
@@ -35,11 +33,5 @@ type error =
 exception Error of error
 exception Escape_error
 
-val report_error: formatter -> error -> unit
- (** @deprecated Use {!Location.error_of_exn}, {!Location.print_report}. *)
-
 val location_of_error: error -> Location.t
 val ill_formed_ast: Location.t -> string -> 'a
-
-
-val print_tyvar: Format.formatter -> string -> unit

tools/Makefile

@@ -115,6 +115,7 @@ CSLPROF_IMPORTS=config.cmo build_path_prefix_map.cmo misc.cmo identifiable.cmo \
   warnings.cmo location.cmo longident.cmo docstrings.cmo \
   syntaxerr.cmo ast_helper.cmo \
   camlinternalMenhirLib.cmo parser.cmo \
+  pprintast.cmo \
   lexer.cmo parse.cmo
 
 $(call byte_and_opt,ocamlprof,$(CSLPROF_IMPORTS) profiling.cmo $(CSLPROF),)

typing/oprint.ml

@@ -238,7 +238,7 @@ let rec print_list pr sep ppf =
 let pr_present =
   print_list (fun ppf s -> fprintf ppf "`%s" s) (fun ppf -> fprintf ppf "@ ")
 
-let pr_var = Syntaxerr.print_tyvar
+let pr_var = Pprintast.tyvar
 
 let pr_vars =
   print_list pr_var (fun ppf -> fprintf ppf "@ ")
@@ -381,7 +381,7 @@ let out_type = ref print_out_type
 (* Class types *)
 
 let print_type_parameter ppf s =
-  if s = "_" then fprintf ppf "_" else Syntaxerr.print_tyvar ppf s
+  if s = "_" then fprintf ppf "_" else pr_var ppf s
 
 let type_parameter ppf (ty, (co, cn)) =
   fprintf ppf "%s%a"

typing/typetexp.ml

@@ -914,7 +914,7 @@ let report_error env ppf = function
         but is here applied to %i argument(s)@]"
       longident lid expected provided
   | Bound_type_variable name ->
-    fprintf ppf "Already bound type parameter %a" Syntaxerr.print_tyvar name
+    fprintf ppf "Already bound type parameter %a" Pprintast.tyvar name
   | Recursive_type ->
     fprintf ppf "This type is recursive"
   | Unbound_row_variable lid ->
@@ -971,7 +971,7 @@ let report_error env ppf = function
   | Cannot_quantify (name, v) ->
       fprintf ppf
         "@[<hov>The universal type variable %a cannot be generalized:@ "
-        Syntaxerr.print_tyvar name;
+        Pprintast.tyvar name;
       if Btype.is_Tvar v then
         fprintf ppf "it escapes its scope"
       else if Btype.is_Tunivar v then