From 433485b8b54158c69a506f89d79d9d07c36cd462 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= Date: Tue, 9 Jun 2020 12:30:44 +0200 Subject: [PATCH] ocamldoc: remove debugging facility --- ocamldoc/Makefile | 24 ++++--------------- ocamldoc/odoc.ml | 6 ----- ocamldoc/odoc_analyse.ml | 2 -- ocamldoc/odoc_ast.ml | 35 --------------------------- ocamldoc/odoc_comments.ml | 18 ++------------ ocamldoc/odoc_env.ml | 27 ++++----------------- ocamldoc/odoc_html.ml | 10 -------- ocamldoc/odoc_latex.ml | 2 -- ocamldoc/odoc_lexer.mll | 8 ------- ocamldoc/odoc_module.ml | 13 ++-------- ocamldoc/odoc_parameter.ml | 8 +------ ocamldoc/odoc_parser.mly | 8 ------- ocamldoc/odoc_see_lexer.mll | 9 ------- ocamldoc/odoc_sig.ml | 45 +---------------------------------- ocamldoc/odoc_text_lexer.mll | 8 ------- ocamldoc/odoc_text_parser.mly | 2 -- ocamldoc/remove_DEBUG | 23 ------------------ 17 files changed, 15 insertions(+), 233 deletions(-) delete mode 100755 ocamldoc/remove_DEBUG diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile index 8addaadb2..06aaa2230 100644 --- a/ocamldoc/Makefile +++ b/ocamldoc/Makefile @@ -28,17 +28,6 @@ OCAMLDEP = $(BEST_OCAMLDEP) DEPFLAGS = -slash OCAMLLEX = $(BEST_OCAMLLEX) -# TODO: figure out whether the DEBUG lines the following preprocessor removes -# are actually useful. -# If they are not, then the preprocessor logic (including the -# remove_DEBUG script and the debug target) could be removed. -# If they are, it may be better to be able to enable them at run-time -# rather than compile-time, e.g. through a -debug command-line option. -# In the following line, "sh" is useful under Windows. Without it, -# the ./remove_DEBUG command would be executed by cmd.exe which would not -# know how to handle it. -OCAMLPP=-pp 'sh ./remove_DEBUG' - # For installation ############## @@ -208,11 +197,6 @@ libopt: $(OCAMLDOC_LIBCMXA) $(OCAMLDOC_LIBCMI) .PHONY: generatorsopt generatorsopt: $(GENERATORS_CMXS) -# TODO: the following debug target could be replaced by a DEBUG variable -.PHONY: debug -debug: - $(MAKE) OCAMLPP="" - OCAMLDOC_LIBRARIES = ocamlcommon unix str dynlink OCAMLDOC_BCLIBRARIES = $(OCAMLDOC_LIBRARIES:%=%.cma) @@ -271,16 +255,16 @@ odoc_see_lexer.ml: odoc_see_lexer.mll .SUFFIXES: .mll .mly .ml .mli .cmo .cmi .cmx .cmxs .ml.cmo: - $(OCAMLC) $(OCAMLPP) $(COMPFLAGS) -c $< + $(OCAMLC) $(COMPFLAGS) -c $< .mli.cmi: - $(OCAMLC) $(OCAMLPP) $(COMPFLAGS) -c $< + $(OCAMLC) $(COMPFLAGS) -c $< .ml.cmx: - $(OCAMLOPT) $(OCAMLPP) $(COMPFLAGS) -c $< + $(OCAMLOPT) $(COMPFLAGS) -c $< .ml.cmxs: - $(OCAMLOPT_CMD) -shared -o $@ $(OCAMLPP) $(COMPFLAGS) $< + $(OCAMLOPT_CMD) -shared -o $@ $(COMPFLAGS) $< .mll.ml: $(OCAMLLEX) $(OCAMLLEX_FLAGS) $< diff --git a/ocamldoc/odoc.ml b/ocamldoc/odoc.ml index b49aa1b11..1d0332ddb 100644 --- a/ocamldoc/odoc.ml +++ b/ocamldoc/odoc.ml @@ -18,8 +18,6 @@ module M = Odoc_messages -let print_DEBUG s = print_string s ; print_newline () - (* we check if we must load a module given on the command line *) let arg_list = Array.to_list Sys.argv let (plugins, paths) = @@ -37,8 +35,6 @@ let (plugins, paths) = in iter ([], []) arg_list -let _ = print_DEBUG "Fin analyse des arguments pour le dynamic load" - (** Return the real name of the file to load, searching it in the paths if it is a simple name and not in the current directory. *) @@ -79,8 +75,6 @@ let load_plugin file = ;; List.iter load_plugin plugins;; -let () = print_DEBUG "Fin du chargement dynamique eventuel" - let () = Odoc_args.parse () diff --git a/ocamldoc/odoc_analyse.ml b/ocamldoc/odoc_analyse.ml index ab29fe7b2..79eda876f 100644 --- a/ocamldoc/odoc_analyse.ml +++ b/ocamldoc/odoc_analyse.ml @@ -16,8 +16,6 @@ (** Analysis of source files. This module is strongly inspired from driver/main.ml :-) *) -let print_DEBUG s = print_string s ; print_newline () - open Format open Typedtree diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml index 0203752de..c7cc62b8a 100644 --- a/ocamldoc/odoc_ast.ml +++ b/ocamldoc/odoc_ast.ml @@ -18,9 +18,6 @@ open Asttypes open Types open Typedtree -let print_DEBUG3 s = print_string s ; print_newline ();; -let print_DEBUG s = print_string s ; print_newline ();; - type typedtree = (Typedtree.structure * Typedtree.module_coercion) open Odoc_parameter @@ -324,7 +321,6 @@ module Analyser = in (new_param, func_body2) | _ -> - print_DEBUG3 "Pas le bon filtre pour le parametre optionnel avec valeur par defaut."; (parameter, func_body) ) ) @@ -484,7 +480,6 @@ module Analyser = in (new_param, body2) | _ -> - print_DEBUG3 "Pas le bon filtre pour le parametre optionnel avec valeur par defaut."; (parameter, body) ) ) @@ -1023,7 +1018,6 @@ module Analyser = (** Analysis of a parse tree structure with a typed tree, to return module elements.*) let rec analyse_structure env current_module_name last_pos pos_limit parsetree typedtree = - print_DEBUG "Odoc_ast:analyse_struture"; let (table, table_values) = Typedtree_search.tables typedtree.str_items in let rec iter env last_pos = function [] -> @@ -1065,7 +1059,6 @@ module Analyser = (** Analysis of a parse tree structure item to obtain a new environment and a list of elements.*) and analyse_structure_item env current_module_name loc pos_limit comment_opt parsetree_item_desc _typedtree table table_values = - print_DEBUG "Odoc_ast:analyse_struture_item"; match parsetree_item_desc with Parsetree.Pstr_eval _ -> (* don't care *) @@ -1138,7 +1131,6 @@ module Analyser = | Parsetree.Pstr_primitive val_desc -> let name_pre = val_desc.Parsetree.pval_name.txt in (* of string * value_description *) - print_DEBUG ("Parsetree.Pstr_primitive ("^name_pre^", ["^(String.concat ", " val_desc.Parsetree.pval_prim)^"]"); let typ = Typedtree_search.search_primitive table name_pre in let name = Name.parens_if_infix name_pre in let complete_name = Name.concat current_module_name name in @@ -1749,7 +1741,6 @@ module Analyser = let loc_start = loc.Location.loc_start.Lexing.pos_cnum in let loc_end = loc.Location.loc_end.Lexing.pos_cnum in let mp_type_code = get_string_of_file loc_start loc_end in - print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code); let param = { mp_name ; @@ -1799,7 +1790,6 @@ module Analyser = | (Parsetree.Pmod_constraint (p_module_expr2, p_modtype), Typedtree.Tmod_constraint (tt_module_expr2, tt_modtype, _, _)) -> - print_DEBUG ("Odoc_ast: case Parsetree.Pmod_constraint + Typedtree.Tmod_constraint "^module_name); let m_base2 = analyse_module env current_module_name @@ -1827,8 +1817,6 @@ module Analyser = tt_modtype, _, _) ) -> (* needed for recursive modules *) - - print_DEBUG ("Odoc_ast: case Parsetree.Pmod_structure + Typedtree.Tmod_constraint "^module_name); let elements = analyse_structure env complete_name pos_start pos_end p_structure tt_structure in (* we must complete the included modules *) let included_modules_from_tt = tt_get_included_module_list tt_structure in @@ -1840,7 +1828,6 @@ module Analyser = | (Parsetree.Pmod_unpack p_exp, Typedtree.Tmod_unpack (_t_exp, tt_modtype)) -> - print_DEBUG ("Odoc_ast: case Parsetree.Pmod_unpack + Typedtree.Tmod_unpack "^module_name); let code = let loc = p_module_expr.Parsetree.pmod_loc in let loc_end = loc.Location.loc_end.Lexing.pos_cnum in @@ -1863,28 +1850,6 @@ module Analyser = } | (_parsetree, _typedtree) -> - (*DEBUG*)let s_parse = - (*DEBUG*) match _parsetree with - (*DEBUG*) Parsetree.Pmod_ident _ -> "Pmod_ident" - (*DEBUG*) | Parsetree.Pmod_structure _ -> "Pmod_structure" - (*DEBUG*) | Parsetree.Pmod_functor _ -> "Pmod_functor" - (*DEBUG*) | Parsetree.Pmod_apply _ -> "Pmod_apply" - (*DEBUG*) | Parsetree.Pmod_constraint _ -> "Pmod_constraint" - (*DEBUG*) | Parsetree.Pmod_unpack _ -> "Pmod_unpack" - (*DEBUG*) | Parsetree.Pmod_extension _ -> "Pmod_extension" - (*DEBUG*)in - (*DEBUG*)let s_typed = - (*DEBUG*) match _typedtree with - (*DEBUG*) Typedtree.Tmod_ident _ -> "Tmod_ident" - (*DEBUG*) | Typedtree.Tmod_structure _ -> "Tmod_structure" - (*DEBUG*) | Typedtree.Tmod_functor _ -> "Tmod_functor" - (*DEBUG*) | Typedtree.Tmod_apply _ -> "Tmod_apply" - (*DEBUG*) | Typedtree.Tmod_constraint _ -> "Tmod_constraint" - (*DEBUG*) | Typedtree.Tmod_unpack _ -> "Tmod_unpack" - (*DEBUG*)in - (*DEBUG*)let code = get_string_of_file pos_start pos_end in - print_DEBUG (Printf.sprintf "code=%s\ns_parse=%s\ns_typed=%s\n" code s_parse s_typed); - raise (Failure "analyse_module: parsetree and typedtree don't match.") let analyse_typed_tree source_file input_file diff --git a/ocamldoc/odoc_comments.ml b/ocamldoc/odoc_comments.ml index e408829b9..40322e280 100644 --- a/ocamldoc/odoc_comments.ml +++ b/ocamldoc/odoc_comments.ml @@ -17,8 +17,6 @@ open Odoc_types -let print_DEBUG s = print_string s ; print_newline ();; - (** This variable contains the regular expression representing a blank but not a '\n'.*) let simple_blank = "[ \013\009\012]" @@ -56,7 +54,6 @@ module Info_retriever = None -> () | Some s -> - (*DEBUG*)print_string ("remain: "^s); print_newline(); let lexbuf2 = Lexing.from_string s in Odoc_parser.info_part2 Odoc_lexer.elements lexbuf2 end; @@ -144,26 +141,18 @@ module Info_retriever = iter s let all_special file s = - print_DEBUG ("all_special: "^s); let rec iter acc n s2 = match retrieve_info_special file s2 with (_, None) -> (n, acc) | (n2, Some i) -> - print_DEBUG ("all_special: avant String.sub new_s="^s2); - print_DEBUG ("n2="^(Int.to_string n2)) ; - print_DEBUG ("len(s2)="^(Int.to_string (String.length s2))) ; let new_s = String.sub s2 n2 ((String.length s2) - n2) in - print_DEBUG ("all_special: apres String.sub new_s="^new_s); iter (acc @ [i]) (n + n2) new_s in - let res = iter [] 0 s in - print_DEBUG ("all_special: end"); - res + iter [] 0 s let just_after_special file s = - print_DEBUG ("just_after_special: "^s); - let res = match retrieve_info_special file s with + match retrieve_info_special file s with (_, None) -> (0, None) | (len, Some d) -> @@ -188,9 +177,6 @@ module Info_retriever = ) | (_, Some _) -> (0, None) - in - print_DEBUG ("just_after_special:end"); - res let first_special file s = retrieve_info_special file s diff --git a/ocamldoc/odoc_env.ml b/ocamldoc/odoc_env.ml index 79928f26c..c1aaeea4d 100644 --- a/ocamldoc/odoc_env.ml +++ b/ocamldoc/odoc_env.ml @@ -15,8 +15,6 @@ (** Environment for finding complete names from relative names. *) -let print_DEBUG s = print_string s ; print_newline ();; - module Name = Odoc_name (** relative name * complete name *) @@ -118,17 +116,11 @@ let add_class_type env full_name = let full_module_name env n = try List.assoc n env.env_modules - with Not_found -> - print_DEBUG ("Module "^n^" not found with env="); - List.iter (fun (sn, fn) -> print_DEBUG ("("^sn^", "^fn^")")) env.env_modules; - n + with Not_found -> n let full_module_type_name env n = try List.assoc n env.env_module_types - with Not_found -> - print_DEBUG ("Module "^n^" not found with env="); - List.iter (fun (sn, fn) -> print_DEBUG ("("^sn^", "^fn^")")) env.env_modules; - n + with Not_found -> n let full_module_or_module_type_name env n = try List.assoc n env.env_modules @@ -151,24 +143,15 @@ let full_value_name env n = let full_extension_constructor_name env n = try List.assoc n env.env_extensions - with Not_found -> - print_DEBUG ("Extension "^n^" not found with env="); - List.iter (fun (sn, fn) -> print_DEBUG ("("^sn^", "^fn^")")) env.env_extensions; - n + with Not_found -> n let full_class_name env n = try List.assoc n env.env_classes - with Not_found -> - print_DEBUG ("Class "^n^" not found with env="); - List.iter (fun (sn, fn) -> print_DEBUG ("("^sn^", "^fn^")")) env.env_classes; - n + with Not_found -> n let full_class_type_name env n = try List.assoc n env.env_class_types - with Not_found -> - print_DEBUG ("Class type "^n^" not found with env="); - List.iter (fun (sn, fn) -> print_DEBUG ("("^sn^", "^fn^")")) env.env_class_types; - n + with Not_found -> n let full_class_or_class_type_name env n = try List.assoc n env.env_classes diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml index a035f7852..5a071be6c 100644 --- a/ocamldoc/odoc_html.ml +++ b/ocamldoc/odoc_html.ml @@ -15,8 +15,6 @@ (** Generation of html documentation.*) -let print_DEBUG s = print_string s ; print_newline () - open Odoc_info open Value open Type @@ -319,7 +317,6 @@ class virtual text = (** Print the html code for the [text_element] in parameter. *) method html_of_text_element b txt = - print_DEBUG "text::html_of_text_element"; match txt with | Odoc_info.Raw s -> self#html_of_Raw b s | Odoc_info.Code s -> self#html_of_Code b s @@ -1314,18 +1311,14 @@ class html = (** Print html code to display a [Types.type_expr list]. *) method html_of_cstr_args ?par b m_name c_name sep l = - print_DEBUG "html#html_of_cstr_args"; match l with | Cstr_tuple l -> - print_DEBUG "html#html_of_cstr_args: 1"; let s = Odoc_info.string_of_type_list ?par sep l in let s2 = newline_to_indented_br s in - print_DEBUG "html#html_of_cstr_args: 2"; bs b ""; bs b (self#create_fully_qualified_idents_links m_name s2); bs b "" | Cstr_record l -> - print_DEBUG "html#html_of_cstr_args: 1 bis"; bs b ""; self#html_of_record ~father:m_name ~close_env: "" (Naming.inline_recfield_target m_name c_name) @@ -2227,7 +2220,6 @@ class html = } ); bs b ((self#keyword "class")^" "); - print_DEBUG "html#html_of_class : virtual or not" ; if c.cl_virtual then bs b ((self#keyword "virtual")^" "); ( match c.cl_type_parameters with @@ -2236,7 +2228,6 @@ class html = self#html_of_class_type_param_expr_list b father l; bs b " " ); - print_DEBUG "html#html_of_class : with link or not" ; ( if with_link then bp b "%s" html_file (Name.simple c.cl_name) @@ -2248,7 +2239,6 @@ class html = self#html_of_class_parameter_list b father c ; self#html_of_class_kind b father ~cl: c c.cl_kind; bs b "" ; - print_DEBUG "html#html_of_class : info" ; ( if complete then self#html_of_info ~cls: "class top" ~indent: true diff --git a/ocamldoc/odoc_latex.ml b/ocamldoc/odoc_latex.ml index 621ceec8f..ca669d76e 100644 --- a/ocamldoc/odoc_latex.ml +++ b/ocamldoc/odoc_latex.ml @@ -15,8 +15,6 @@ (** Generation of LaTeX documentation. *) -let print_DEBUG s = print_string s ; print_newline () - open Odoc_info open Value open Type diff --git a/ocamldoc/odoc_lexer.mll b/ocamldoc/odoc_lexer.mll index 8749d1235..bb41cb928 100644 --- a/ocamldoc/odoc_lexer.mll +++ b/ocamldoc/odoc_lexer.mll @@ -44,11 +44,8 @@ let blank = "[ \013\009\012]" (** The nested comments level. *) let comments_level = ref 0 -let print_DEBUG2 s = print_string s; print_newline () - (** This function returns the given string without the leading and trailing blanks.*) let remove_blanks s = - print_DEBUG2 ("remove_blanks "^s); let l = Str.split_delim (Str.regexp "\n") s in let l2 = let rec iter liste = @@ -57,7 +54,6 @@ let remove_blanks s = let h2 = Str.global_replace (Str.regexp ("^"^blank^"+")) "" h in if h2 = "" then ( - print_DEBUG2 (h^" n'a que des blancs"); (* we remove this line and must remove leading blanks of the next one *) iter q ) @@ -75,7 +71,6 @@ let remove_blanks s = let h2 = Str.global_replace (Str.regexp (blank^"+$")) "" h in if h2 = "" then ( - print_DEBUG2 (h^" n'a que des blancs"); (* we remove this line and must remove trailing blanks of the next one *) iter q ) @@ -294,7 +289,6 @@ and elements = parse | [ '\010' ] { incr line_number; incr Odoc_comments_global.nb_chars; - print_DEBUG2 "newline"; elements lexbuf } | "@" { @@ -306,7 +300,6 @@ and elements = parse let s = Lexing.lexeme lexbuf in Odoc_comments_global.nb_chars := !Odoc_comments_global.nb_chars + (String.length s); let s2 = String.sub s 1 ((String.length s) - 1) in - print_DEBUG2 s2; match s2 with "param" -> T_PARAM @@ -339,7 +332,6 @@ and elements = parse let s = Lexing.lexeme lexbuf in let s = Str.global_replace (Str.regexp_string "\\@") "@" s in let s = remove_blanks s in - print_DEBUG2 ("Desc "^s); Desc s } | eof diff --git a/ocamldoc/odoc_module.ml b/ocamldoc/odoc_module.ml index 1b9cb180d..c61c8f713 100644 --- a/ocamldoc/odoc_module.ml +++ b/ocamldoc/odoc_module.ml @@ -17,8 +17,6 @@ module String = Misc.Stdlib.String (** Representation and manipulation of modules and module types. *) -let print_DEBUG s = print_string s ; print_newline () - module Name = Odoc_name (** To keep the order of elements in a module. *) @@ -253,11 +251,8 @@ let module_elements ?(trans=true) m = *) let rec module_elements visited ?(trans=true) m = let rec iter_kind = function - Module_struct l -> - print_DEBUG "Odoc_module.module_elements: Module_struct"; - l + Module_struct l -> l | Module_alias ma -> - print_DEBUG "Odoc_module.module_elements: Module_alias"; if trans then match ma.ma_module with None -> [] @@ -270,18 +265,14 @@ let module_elements ?(trans=true) m = else [] | Module_functor (_, k) - | Module_apply (k, _) -> - print_DEBUG "Odoc_module.module_elements: Module_functor ou Module_apply"; - iter_kind k + | Module_apply (k, _) -> iter_kind k | Module_with (tk,_) -> - print_DEBUG "Odoc_module.module_elements: Module_with"; module_type_elements ~trans: trans { mt_name = "" ; mt_info = None ; mt_type = None ; mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ; mt_loc = Odoc_types.dummy_loc ; } | Module_constraint (k, _tk) -> - print_DEBUG "Odoc_module.module_elements: Module_constraint"; (* FIXME : use k or tk ? *) module_elements visited ~trans: trans { m_name = "" ; diff --git a/ocamldoc/odoc_parameter.ml b/ocamldoc/odoc_parameter.ml index 32aa0dece..489183583 100644 --- a/ocamldoc/odoc_parameter.ml +++ b/ocamldoc/odoc_parameter.ml @@ -15,8 +15,6 @@ (** Representation and manipulation of method / function / class parameters. *) -let print_DEBUG s = print_string s ; print_newline () - (** Types *) (** Representation of a simple parameter name *) @@ -109,7 +107,6 @@ let type_by_name pi name = (** access to the optional description of a parameter name from an optional info structure.*) let desc_from_info_opt info_opt s = - print_DEBUG "desc_from_info_opt"; match info_opt with None -> None | Some i -> @@ -119,7 +116,4 @@ let desc_from_info_opt info_opt s = try Some (List.assoc s i.Odoc_types.i_params) with - Not_found -> - print_DEBUG ("desc_from_info_opt "^s^" not found in\n"); - List.iter (fun (s, _) -> print_DEBUG s) i.Odoc_types.i_params; - None + Not_found -> None diff --git a/ocamldoc/odoc_parser.mly b/ocamldoc/odoc_parser.mly index f27a9982f..da3280bad 100644 --- a/ocamldoc/odoc_parser.mly +++ b/ocamldoc/odoc_parser.mly @@ -20,8 +20,6 @@ let uppercase = "[A-Z\192-\214\216-\222]" let identchar = "[A-Za-z_\192-\214\216-\246\248-\255'0-9]" let blank = "[ \010\013\009\012]" - -let print_DEBUG s = print_string s; print_newline () %} %token Description @@ -101,12 +99,9 @@ param: | _ :: [] -> raise (Failure "usage: @param id description") | id :: _ -> - print_DEBUG ("Identificator "^id); let reg = identchar^"+" in - print_DEBUG ("reg="^reg); if Str.string_match (Str.regexp reg) id 0 then let remain = String.sub s (String.length id) ((String.length s) - (String.length id)) in - print_DEBUG ("T_PARAM Desc remain="^remain); let remain2 = Str.replace_first (Str.regexp ("^"^blank^"+")) "" remain in params := !params @ [(id, remain2)] else @@ -135,7 +130,6 @@ before: | _ :: [] -> raise (Failure "usage: @before version description") | id :: _ -> - print_DEBUG ("version "^id); let remain = String.sub s (String.length id) ((String.length s) - (String.length id)) in let remain2 = Str.replace_first (Str.regexp ("^"^blank^"+")) "" remain in before := !before @ [(id, remain2)] @@ -154,9 +148,7 @@ raise_exc: | _ :: [] -> raise (Failure "usage: @raise Exception description") | id :: _ -> - print_DEBUG ("exception "^id); let reg = uppercase^identchar^"*"^"\\(\\."^uppercase^identchar^"*\\)*" in - print_DEBUG ("reg="^reg); if Str.string_match (Str.regexp reg) id 0 then let remain = String.sub s (String.length id) ((String.length s) - (String.length id)) in let remain2 = Str.replace_first (Str.regexp ("^"^blank^"+")) "" remain in diff --git a/ocamldoc/odoc_see_lexer.mll b/ocamldoc/odoc_see_lexer.mll index 1962d50dc..5b68a733f 100644 --- a/ocamldoc/odoc_see_lexer.mll +++ b/ocamldoc/odoc_see_lexer.mll @@ -14,8 +14,6 @@ (* *) (**************************************************************************) -let print_DEBUG2 s = print_string s ; print_newline () - (** the lexer for special comments. *) open Odoc_parser @@ -27,38 +25,32 @@ let buf = Buffer.create 32 rule main = parse [' ' '\013' '\009' '\012'] + { - print_DEBUG2 "[' ' '\013' '\009' '\012'] +"; main lexbuf } | [ '\010' ] { - print_DEBUG2 " [ '\010' ] "; main lexbuf } | "<" { - print_DEBUG2 "call url lexbuf" ; url lexbuf } | "\"" { - print_DEBUG2 "call doc lexbuf" ; doc lexbuf } | '\'' { - print_DEBUG2 "call file lexbuf" ; file lexbuf } | eof { - print_DEBUG2 "EOF"; EOF } @@ -73,7 +65,6 @@ and url = parse | ([^'>'] | '\n')+">" { let s = Lexing.lexeme lexbuf in - print_DEBUG2 ("([^'>'] | '\n')+ \">\" with "^s) ; See_url (String.sub s 0 ((String.length s) -1)) } diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml index e7cb90ab2..9e4d1e445 100644 --- a/ocamldoc/odoc_sig.ml +++ b/ocamldoc/odoc_sig.ml @@ -17,9 +17,6 @@ open Asttypes open Types - -let print_DEBUG s = print_string s ; print_newline ();; - open Odoc_parameter open Odoc_value open Odoc_type @@ -954,23 +951,6 @@ module Analyser = pos_limit2 type_decl in -(* DEBUG *) begin -(* DEBUG *) let comm = -(* DEBUG *) match assoc_com with -(* DEBUG *) | None -> "sans commentaire" -(* DEBUG *) | Some c -> Odoc_misc.string_of_info c -(* DEBUG *) in -(* DEBUG *) print_DEBUG ("Type "^name.txt^" : "^comm); -(* DEBUG *) let f_DEBUG (name, c_opt) = -(* DEBUG *) let comm = -(* DEBUG *) match c_opt with -(* DEBUG *) | None -> "sans commentaire" -(* DEBUG *) | Some c -> Odoc_misc.string_of_info c -(* DEBUG *) in -(* DEBUG *) print_DEBUG ("constructor/field "^name^": "^comm) -(* DEBUG *) in -(* DEBUG *) List.iter f_DEBUG name_comment_list; -(* DEBUG *) end; (* get the information for the type in the signature *) let sig_type_decl = try Signature_search.search_type table name.txt @@ -1062,23 +1042,6 @@ module Analyser = pos_limit2 type_decl in -(* DEBUG *) begin -(* DEBUG *) let comm = -(* DEBUG *) match assoc_com with -(* DEBUG *) | None -> "sans commentaire" -(* DEBUG *) | Some c -> Odoc_misc.string_of_info c -(* DEBUG *) in -(* DEBUG *) print_DEBUG ("Type "^name.txt^" : "^comm); -(* DEBUG *) let f_DEBUG (name, c_opt) = -(* DEBUG *) let comm = -(* DEBUG *) match c_opt with -(* DEBUG *) | None -> "sans commentaire" -(* DEBUG *) | Some c -> Odoc_misc.string_of_info c -(* DEBUG *) in -(* DEBUG *) print_DEBUG ("constructor/field "^name^": "^comm) -(* DEBUG *) in -(* DEBUG *) List.iter f_DEBUG name_comment_list; -(* DEBUG *) end; (* get the information for the type in the signature *) let sig_type_decl = try Signature_search.search_type table name.txt @@ -1218,9 +1181,7 @@ module Analyser = (* FIXME : can this be a Tmty_ident? in this case, we wouldn't have the signature *) Types.Mty_signature s -> Odoc_env.add_signature e complete_name ~rel: name s - | _ -> - print_DEBUG "not a Tmty_signature"; - e + | _ -> e ) env decls @@ -1589,7 +1550,6 @@ module Analyser = let loc_start = Loc.start loc in let loc_end = Loc.end_ loc in let mp_type_code = get_string_of_file loc_start loc_end in - print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code); match sig_module_type with Types.Mty_functor (param, body_module_type) -> let mp_name, mp_kind = @@ -1689,7 +1649,6 @@ module Analyser = let loc_start = Loc.start loc in let loc_end = Loc.end_ loc in let mp_type_code = get_string_of_file loc_start loc_end in - print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code); let mp_name, mp_kind = match param2, param with Parsetree.Named (_, pmty), Types.Named (Some ident, mty) -> @@ -1744,7 +1703,6 @@ module Analyser = match parse_class_type.Parsetree.pcty_desc, sig_class_type with (Parsetree.Pcty_constr (_, _) (*of Longident.t * core_type list *), Types.Cty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) -> - print_DEBUG "Cty_constr _"; let path_name = Name.from_path p in let name = Odoc_env.full_class_or_class_type_name env path_name in let k = @@ -1795,7 +1753,6 @@ module Analyser = match parse_class_type.Parsetree.pcty_desc, sig_class_type with (Parsetree.Pcty_constr (_, _) (*of Longident.t * core_type list *), Types.Cty_constr (p, typ_list, _) (*of Path.t * type_expr list * class_type*)) -> - print_DEBUG "Cty_constr _"; Class_type { cta_name = Odoc_env.full_class_or_class_type_name env (Name.from_path p) ; diff --git a/ocamldoc/odoc_text_lexer.mll b/ocamldoc/odoc_text_lexer.mll index f503b5271..b13d72cb7 100644 --- a/ocamldoc/odoc_text_lexer.mll +++ b/ocamldoc/odoc_text_lexer.mll @@ -43,9 +43,6 @@ let description = ref "" let blank = "[ \013\009\012]" - -let print_DEBUG s = print_string s; print_newline () - (** this flag indicates whether we're in a string between begin_code and end_code tokens, to remember the number of open '[' and handle ']' correctly. *) let open_brackets = ref 0 @@ -189,7 +186,6 @@ rule main = parse | end { - print_DEBUG "end"; incr_cpts lexbuf ; if !verb_mode || !target_mode || !code_pre_mode || (!open_brackets >= 1) then @@ -202,7 +198,6 @@ rule main = parse } | begin_title { - print_DEBUG "begin_title"; incr_cpts lexbuf ; if !verb_mode || !target_mode || !code_pre_mode || (!open_brackets >= 1) || !ele_ref_mode then @@ -313,7 +308,6 @@ rule main = parse } | begin_list { - print_DEBUG "LIST"; incr_cpts lexbuf ; if !verb_mode || !target_mode || !code_pre_mode || (!open_brackets >= 1) || !ele_ref_mode then @@ -332,7 +326,6 @@ rule main = parse } | begin_item { - print_DEBUG "ITEM"; incr_cpts lexbuf ; if !verb_mode || !target_mode || !code_pre_mode || (!open_brackets >= 1) || !ele_ref_mode then @@ -828,7 +821,6 @@ rule main = parse | begin_custom { - print_DEBUG "begin_custom"; incr_cpts lexbuf ; if !verb_mode || !target_mode || !code_pre_mode || (!open_brackets >= 1) || !ele_ref_mode then diff --git a/ocamldoc/odoc_text_parser.mly b/ocamldoc/odoc_text_parser.mly index 3d590d45c..2b7b2a6b4 100644 --- a/ocamldoc/odoc_text_parser.mly +++ b/ocamldoc/odoc_text_parser.mly @@ -23,8 +23,6 @@ let remove_beginning_blanks s = let remove_trailing_blanks s = Str.global_replace (Str.regexp (blank^"+$")) "" s - -let print_DEBUG s = print_string s; print_newline () %} %token END diff --git a/ocamldoc/remove_DEBUG b/ocamldoc/remove_DEBUG deleted file mode 100755 index 0eee2df9f..000000000 --- a/ocamldoc/remove_DEBUG +++ /dev/null @@ -1,23 +0,0 @@ -#!/bin/sh - -#************************************************************************** -#* * -#* OCaml * -#* * -#* Damien Doligez, projet Moscova, INRIA Rocquencourt * -#* * -#* Copyright 2003 Institut National de Recherche en Informatique et * -#* en Automatique. * -#* * -#* All rights reserved. This file is distributed under the terms of * -#* the GNU Lesser General Public License version 2.1, with the * -#* special exception on linking described in the file LICENSE. * -#* * -#************************************************************************** - -# usage: remove_DEBUG -# remove from every line that contains the string "DEBUG", -# respecting the cpp # line annotation conventions - -echo "# 1 \"$1\"" -LC_ALL=C sed -e '/DEBUG/s/^.*$/(* DEBUG statement removed *)/' "$1"