API tools faq
paste
Guest User

Untitled

a guest
Feb 16th, 2019
75
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 21.78 KB | None | 0 0
raw download clone embed print report
  1. diff -r 2d6735cf3851 -r 6199973faf25 Makefile
  2. --- a/Makefile Tue Jul 05 08:41:48 2011 +0900
  3. +++ b/Makefile Fri Sep 16 00:00:00 2011 +0900
  4. @@ -19,7 +19,7 @@
  5.  
  6. CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot
  7. CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink
  8. -COMPFLAGS=-strict-sequence -warn-error A $(INCLUDES)
  9. +COMPFLAGS=-strict-sequence -warn-error A-31 $(INCLUDES)
  10. LINKFLAGS=
  11.  
  12. CAMLYACC=boot/ocamlyacc
  13. diff -r 2d6735cf3851 -r 6199973faf25 Makefile.nt
  14. --- a/Makefile.nt Tue Jul 05 08:41:48 2011 +0900
  15. +++ b/Makefile.nt Fri Sep 16 00:00:00 2011 +0900
  16. @@ -19,7 +19,7 @@
  17.  
  18. CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot
  19. CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink
  20. -COMPFLAGS=-strict-sequence -warn-error A $(INCLUDES)
  21. +COMPFLAGS=-strict-sequence -warn-error A-31 $(INCLUDES)
  22. LINKFLAGS=
  23. CAMLYACC=boot/ocamlyacc
  24. YACCFLAGS=
  25. diff -r 2d6735cf3851 -r 6199973faf25 _tags
  26. --- a/_tags Tue Jul 05 08:41:48 2011 +0900
  27. +++ b/_tags Fri Sep 16 00:00:00 2011 +0900
  28. @@ -19,7 +19,7 @@
  29. # The stdlib neither requires the stdlib nor debug information
  30. <stdlib/**>: -use_stdlib, -debug
  31.  
  32. -<**/*.ml*>: warn_error_A
  33. +<**/*.ml*>: warn_error_A-31
  34.  
  35. <{bytecomp,driver,stdlib,tools,asmcomp,toplevel,typing,utils,lex,parsing}/**>: strict_sequence
  36.  
  37. diff -r 2d6735cf3851 -r 6199973faf25 boot/ocamlc
  38. Binary file boot/ocamlc has changed
  39. diff -r 2d6735cf3851 -r 6199973faf25 boot/ocamldep
  40. Binary file boot/ocamldep has changed
  41. diff -r 2d6735cf3851 -r 6199973faf25 boot/ocamllex
  42. Binary file boot/ocamllex has changed
  43. diff -r 2d6735cf3851 -r 6199973faf25 debugger/Makefile.shared
  44. --- a/debugger/Makefile.shared Tue Jul 05 08:41:48 2011 +0900
  45. +++ b/debugger/Makefile.shared Fri Sep 16 00:00:00 2011 +0900
  46. @@ -15,7 +15,7 @@
  47. include ../config/Makefile
  48.  
  49. CAMLC=../ocamlcomp.sh
  50. -COMPFLAGS=-warn-error A $(INCLUDES)
  51. +COMPFLAGS=-warn-error A-31 $(INCLUDES)
  52. LINKFLAGS=-linkall -I $(UNIXDIR)
  53. CAMLYACC=../boot/ocamlyacc
  54. YACCFLAGS=
  55. @@ -30,8 +30,8 @@
  56. OTHEROBJS=\
  57. $(UNIXDIR)/unix.cma \
  58. ../utils/misc.cmo ../utils/config.cmo \
  59. - ../utils/tbl.cmo ../utils/clflags.cmo ../utils/consistbl.cmo \
  60. - ../parsing/longident.cmo \
  61. + ../utils/tbl.cmo ../utils/clflags.cmo ../utils/consistbl.cmo ../utils/warnings.cmo \
  62. + ../parsing/longident.cmo ../parsing/linenum.cmo ../parsing/location.cmo \
  63. ../typing/ident.cmo ../typing/path.cmo ../typing/types.cmo \
  64. ../typing/btype.cmo ../typing/primitive.cmo ../typing/typedtree.cmo \
  65. ../typing/subst.cmo ../typing/predef.cmo \
  66. diff -r 2d6735cf3851 -r 6199973faf25 debugger/envaux.ml
  67. --- a/debugger/envaux.ml Tue Jul 05 08:41:48 2011 +0900
  68. +++ b/debugger/envaux.ml Fri Sep 16 00:00:00 2011 +0900
  69. @@ -65,7 +65,7 @@
  70. with Not_found ->
  71. raise (Error (Module_not_found path'))
  72. in
  73. - Env.open_signature path' (extract_sig env mty) env
  74. + Env.open_signature Location.none path' (extract_sig env mty) env
  75. in
  76. Hashtbl.add env_cache (sum, subst) env;
  77. env
  78. diff -r 2d6735cf3851 -r 6199973faf25 driver/compile.ml
  79. --- a/driver/compile.ml Tue Jul 05 08:41:48 2011 +0900
  80. +++ b/driver/compile.ml Fri Sep 16 00:00:00 2011 +0900
  81. @@ -84,6 +84,7 @@
  82. Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in
  83. if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
  84. let sg = Typemod.transl_signature (initial_env()) ast in
  85. + Env.check_modules_opened_but_not_used_yet ();
  86. if !Clflags.print_types then
  87. fprintf std_formatter "%a@." Printtyp.signature
  88. (Typemod.simplify_signature sg);
  89. diff -r 2d6735cf3851 -r 6199973faf25 driver/optcompile.ml
  90. --- a/driver/optcompile.ml Tue Jul 05 08:41:48 2011 +0900
  91. +++ b/driver/optcompile.ml Fri Sep 16 00:00:00 2011 +0900
  92. @@ -81,6 +81,7 @@
  93. Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in
  94. if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
  95. let sg = Typemod.transl_signature (initial_env()) ast in
  96. + Env.check_modules_opened_but_not_used_yet ();
  97. if !Clflags.print_types then
  98. fprintf std_formatter "%a@." Printtyp.signature
  99. (Typemod.simplify_signature sg);
  100. diff -r 2d6735cf3851 -r 6199973faf25 lex/Makefile
  101. --- a/lex/Makefile Tue Jul 05 08:41:48 2011 +0900
  102. +++ b/lex/Makefile Fri Sep 16 00:00:00 2011 +0900
  103. @@ -15,7 +15,7 @@
  104. # The lexer generator
  105. CAMLC=../boot/ocamlrun ../boot/ocamlc -strict-sequence -nostdlib -I ../boot
  106. CAMLOPT=../boot/ocamlrun ../ocamlopt -nostdlib -I ../stdlib
  107. -COMPFLAGS=-warn-error A
  108. +COMPFLAGS=-warn-error A-31
  109. CAMLYACC=../boot/ocamlyacc
  110. YACCFLAGS=-v
  111. CAMLLEX=../boot/ocamlrun ../boot/ocamllex
  112. diff -r 2d6735cf3851 -r 6199973faf25 ocamldoc/Makefile
  113. --- a/ocamldoc/Makefile Tue Jul 05 08:41:48 2011 +0900
  114. +++ b/ocamldoc/Makefile Fri Sep 16 00:00:00 2011 +0900
  115. @@ -68,7 +68,7 @@
  116.  
  117. INCLUDES=$(INCLUDES_DEP) $(INCLUDES_NODEP)
  118.  
  119. -COMPFLAGS=$(INCLUDES) -warn-error A
  120. +COMPFLAGS=$(INCLUDES) -warn-error A-31
  121. LINKFLAGS=$(INCLUDES) -nostdlib
  122.  
  123. CMOFILES= odoc_config.cmo \
  124. diff -r 2d6735cf3851 -r 6199973faf25 otherlibs/dynlink/Makefile
  125. --- a/otherlibs/dynlink/Makefile Tue Jul 05 08:41:48 2011 +0900
  126. +++ b/otherlibs/dynlink/Makefile Fri Sep 16 00:00:00 2011 +0900
  127. @@ -20,7 +20,7 @@
  128. CAMLC=../../boot/ocamlrun ../../ocamlc
  129. CAMLOPT=../../ocamlcompopt.sh
  130. INCLUDES=-I ../../utils -I ../../typing -I ../../bytecomp -I ../../asmcomp
  131. -COMPFLAGS=-warn-error A -I ../../stdlib $(INCLUDES)
  132. +COMPFLAGS=-warn-error A-31 -I ../../stdlib $(INCLUDES)
  133.  
  134. OBJS=dynlinkaux.cmo dynlink.cmo
  135.  
  136. diff -r 2d6735cf3851 -r 6199973faf25 stdlib/Makefile.shared
  137. --- a/stdlib/Makefile.shared Tue Jul 05 08:41:48 2011 +0900
  138. +++ b/stdlib/Makefile.shared Fri Sep 16 00:00:00 2011 +0900
  139. @@ -17,10 +17,10 @@
  140. RUNTIME=../boot/ocamlrun
  141. COMPILER=../ocamlc
  142. CAMLC=$(RUNTIME) $(COMPILER)
  143. -COMPFLAGS=-strict-sequence -g -warn-error A -nostdlib
  144. +COMPFLAGS=-strict-sequence -g -warn-error A-31 -nostdlib
  145. OPTCOMPILER=../ocamlopt
  146. CAMLOPT=$(RUNTIME) $(OPTCOMPILER)
  147. -OPTCOMPFLAGS=-warn-error A -nostdlib -g
  148. +OPTCOMPFLAGS=-warn-error A-31 -nostdlib -g
  149. CAMLDEP=../boot/ocamlrun ../tools/ocamldep
  150.  
  151. OBJS=pervasives.cmo $(OTHERS)
  152. diff -r 2d6735cf3851 -r 6199973faf25 tools/Makefile.shared
  153. --- a/tools/Makefile.shared Tue Jul 05 08:41:48 2011 +0900
  154. +++ b/tools/Makefile.shared Fri Sep 16 00:00:00 2011 +0900
  155. @@ -20,7 +20,7 @@
  156. CAMLLEX=$(CAMLRUN) ../boot/ocamllex
  157. INCLUDES=-I ../utils -I ../parsing -I ../typing -I ../bytecomp -I ../asmcomp \
  158. -I ../driver
  159. -COMPFLAGS= -warn-error A $(INCLUDES)
  160. +COMPFLAGS= -warn-error A-31 $(INCLUDES)
  161. LINKFLAGS=$(INCLUDES)
  162.  
  163. all: ocamldep ocamlprof ocamlcp ocamlmktop ocamlmklib dumpobj objinfo
  164. diff -r 2d6735cf3851 -r 6199973faf25 typing/env.ml
  165. --- a/typing/env.ml Tue Jul 05 08:41:48 2011 +0900
  166. +++ b/typing/env.ml Fri Sep 16 00:00:00 2011 +0900
  167. @@ -42,17 +42,19 @@
  168. | Env_cltype of summary * Ident.t * cltype_declaration
  169. | Env_open of summary * Path.t
  170.  
  171. +type 'a with_open = 'a * Path.t option
  172. +
  173. type t = {
  174. - values: (Path.t * value_description) Ident.tbl;
  175. - annotations: (Path.t * Annot.ident) Ident.tbl;
  176. - constrs: constructor_description Ident.tbl;
  177. - labels: label_description Ident.tbl;
  178. - types: (Path.t * type_declaration) Ident.tbl;
  179. - modules: (Path.t * module_type) Ident.tbl;
  180. - modtypes: (Path.t * modtype_declaration) Ident.tbl;
  181. - components: (Path.t * module_components) Ident.tbl;
  182. - classes: (Path.t * class_declaration) Ident.tbl;
  183. - cltypes: (Path.t * cltype_declaration) Ident.tbl;
  184. + values: (Path.t * value_description) with_open Ident.tbl;
  185. + annotations: (Path.t * Annot.ident) with_open Ident.tbl;
  186. + constrs: constructor_description with_open Ident.tbl;
  187. + labels: label_description with_open Ident.tbl;
  188. + types: (Path.t * type_declaration) with_open Ident.tbl;
  189. + modules: (Path.t * module_type) with_open Ident.tbl;
  190. + modtypes: (Path.t * modtype_declaration) with_open Ident.tbl;
  191. + components: (Path.t * module_components) with_open Ident.tbl;
  192. + classes: (Path.t * class_declaration) with_open Ident.tbl;
  193. + cltypes: (Path.t * cltype_declaration) with_open Ident.tbl;
  194. summary: summary
  195. }
  196.  
  197. @@ -104,10 +106,10 @@
  198. Pident _ -> true
  199. | Pdot _ | Papply _ -> false
  200.  
  201. -let is_local (p, _) = is_ident p
  202. +let is_local ((p, _),_) = is_ident p
  203.  
  204. let is_local_exn = function
  205. - {cstr_tag = Cstr_exception p} -> is_ident p
  206. + ({cstr_tag = Cstr_exception p}, _) -> is_ident p
  207. | _ -> false
  208.  
  209. let diff env1 env2 =
  210. @@ -220,7 +222,7 @@
  211. match path with
  212. Pident id ->
  213. begin try
  214. - let (p, desc) = Ident.find_same id env.components
  215. + let (p, desc),_ = Ident.find_same id env.components
  216. in desc
  217. with Not_found ->
  218. if Ident.persistent id
  219. @@ -246,7 +248,7 @@
  220. let find proj1 proj2 path env =
  221. match path with
  222. Pident id ->
  223. - let (p, data) = Ident.find_same id (proj1 env)
  224. + let (p, data),_ = Ident.find_same id (proj1 env)
  225. in data
  226. | Pdot(p, s, pos) ->
  227. begin match Lazy.force(find_module_descr p env) with
  228. @@ -305,7 +307,7 @@
  229. match path with
  230. Pident id ->
  231. begin try
  232. - let (p, data) = Ident.find_same id env.modules
  233. + let (p, data),_ = Ident.find_same id env.modules
  234. in data
  235. with Not_found ->
  236. if Ident.persistent id then
  237. @@ -325,11 +327,38 @@
  238.  
  239. (* Lookup by name *)
  240.  
  241. +let modules_opened_but_not_used_yet = Hashtbl.create 103
  242. +
  243. +(* CR jfuruse: not sure about the place. debugger/Makefile.shared required additional modules for this *)
  244. +let check_modules_opened_but_not_used_yet () =
  245. + let loc_paths =
  246. + List.sort (fun (l1, _) (l2, _) -> compare l1 l2)
  247. + (Hashtbl.fold (fun k locs st -> List.map (fun loc -> loc, k) locs @ st) modules_opened_but_not_used_yet [])
  248. + in
  249. + Hashtbl.clear modules_opened_but_not_used_yet;
  250. + List.iter (fun (loc, path) ->
  251. + match path with
  252. + | Pident id when Ident.name id = "Pervasives" -> () (* CR jfuruse: this is not precise *)
  253. + | _ ->
  254. + Location.prerr_warning loc (Warnings.Opened_module_is_never_used (Path.name path)))
  255. + loc_paths
  256. +
  257. +let add_opened_module loc p =
  258. + let locs = loc :: try Hashtbl.find modules_opened_but_not_used_yet p with Not_found -> [] in
  259. + Hashtbl.replace modules_opened_but_not_used_yet p locs
  260. +
  261. +let mark_opened_module (v, open_info) =
  262. + begin match open_info with
  263. + | None -> ()
  264. + | Some p -> Hashtbl.remove modules_opened_but_not_used_yet p
  265. + end;
  266. + v
  267. +
  268. let rec lookup_module_descr lid env =
  269. match lid with
  270. Lident s ->
  271. begin try
  272. - Ident.find_name s env.components
  273. + mark_opened_module (Ident.find_name s env.components)
  274. with Not_found ->
  275. if s = !current_unit then raise Not_found;
  276. let ps = find_pers_struct s in
  277. @@ -359,7 +388,7 @@
  278. match lid with
  279. Lident s ->
  280. begin try
  281. - Ident.find_name s env.modules
  282. + mark_opened_module (Ident.find_name s env.modules)
  283. with Not_found ->
  284. if s = !current_unit then raise Not_found;
  285. let ps = find_pers_struct s in
  286. @@ -387,10 +416,19 @@
  287. raise Not_found
  288. end
  289.  
  290. +(* CR jfuruse: copied from Printtyp.longident *)
  291. +let format_longident ppf lid =
  292. + let open Format in
  293. + let rec longident ppf = function
  294. + | Lident s -> fprintf ppf "%s" s
  295. + | Ldot(p, s) -> fprintf ppf "%a.%s" longident p s
  296. + | Lapply(p1, p2) -> fprintf ppf "%a(%a)" longident p1 longident p2
  297. + in
  298. + longident ppf lid
  299. +
  300. let lookup proj1 proj2 lid env =
  301. match lid with
  302. - Lident s ->
  303. - Ident.find_name s (proj1 env)
  304. + Lident s -> mark_opened_module (Ident.find_name s (proj1 env))
  305. | Ldot(l, s) ->
  306. let (p, desc) = lookup_module_descr l env in
  307. begin match Lazy.force desc with
  308. @@ -406,7 +444,7 @@
  309. let lookup_simple proj1 proj2 lid env =
  310. match lid with
  311. Lident s ->
  312. - Ident.find_name s (proj1 env)
  313. + mark_opened_module (Ident.find_name s (proj1 env))
  314. | Ldot(l, s) ->
  315. let (p, desc) = lookup_module_descr l env in
  316. begin match Lazy.force desc with
  317. @@ -602,70 +640,70 @@
  318.  
  319. (* Insertion of bindings by identifier + path *)
  320.  
  321. -and store_value id path decl env =
  322. +and store_value ?opened id path decl env =
  323. { env with
  324. - values = Ident.add id (path, decl) env.values;
  325. + values = Ident.add id ((path, decl), opened) env.values;
  326. summary = Env_value(env.summary, id, decl) }
  327.  
  328. -and store_annot id path annot env =
  329. +and store_annot ?opened id path annot env =
  330. if !Clflags.annotations then
  331. { env with
  332. - annotations = Ident.add id (path, annot) env.annotations }
  333. + annotations = Ident.add id ((path, annot), opened) env.annotations }
  334. else env
  335.  
  336. -and store_type id path info env =
  337. +and store_type ?opened id path info env =
  338. { env with
  339. constrs =
  340. List.fold_right
  341. (fun (name, descr) constrs ->
  342. - Ident.add (Ident.create name) descr constrs)
  343. + Ident.add (Ident.create name) (descr, opened) constrs)
  344. (constructors_of_type path info)
  345. env.constrs;
  346. labels =
  347. List.fold_right
  348. (fun (name, descr) labels ->
  349. - Ident.add (Ident.create name) descr labels)
  350. + Ident.add (Ident.create name) (descr, opened) labels)
  351. (labels_of_type path info)
  352. env.labels;
  353. - types = Ident.add id (path, info) env.types;
  354. + types = Ident.add id ((path, info), opened) env.types;
  355. summary = Env_type(env.summary, id, info) }
  356.  
  357. -and store_type_infos id path info env =
  358. +and store_type_infos ?opened id path info env =
  359. (* Simplified version of store_type that doesn't compute and store
  360. constructor and label infos, but simply record the arity and
  361. manifest-ness of the type. Used in components_of_module to
  362. keep track of type abbreviations (e.g. type t = float) in the
  363. computation of label representations. *)
  364. { env with
  365. - types = Ident.add id (path, info) env.types;
  366. + types = Ident.add id ((path, info), opened) env.types;
  367. summary = Env_type(env.summary, id, info) }
  368.  
  369. -and store_exception id path decl env =
  370. +and store_exception ?opened id path decl env =
  371. { env with
  372. - constrs = Ident.add id (Datarepr.exception_descr path decl) env.constrs;
  373. + constrs = Ident.add id (Datarepr.exception_descr path decl, opened) env.constrs;
  374. summary = Env_exception(env.summary, id, decl) }
  375.  
  376. -and store_module id path mty env =
  377. +and store_module ?opened id path mty env =
  378. { env with
  379. - modules = Ident.add id (path, mty) env.modules;
  380. + modules = Ident.add id ((path, mty), opened) env.modules;
  381. components =
  382. - Ident.add id (path, components_of_module env Subst.identity path mty)
  383. + Ident.add id ((path, components_of_module env Subst.identity path mty), opened)
  384. env.components;
  385. summary = Env_module(env.summary, id, mty) }
  386.  
  387. -and store_modtype id path info env =
  388. +and store_modtype ?opened id path info env =
  389. { env with
  390. - modtypes = Ident.add id (path, info) env.modtypes;
  391. + modtypes = Ident.add id ((path, info), opened) env.modtypes;
  392. summary = Env_modtype(env.summary, id, info) }
  393.  
  394. -and store_class id path desc env =
  395. +and store_class ?opened id path desc env =
  396. { env with
  397. - classes = Ident.add id (path, desc) env.classes;
  398. + classes = Ident.add id ((path, desc), opened) env.classes;
  399. summary = Env_class(env.summary, id, desc) }
  400.  
  401. -and store_cltype id path desc env =
  402. +and store_cltype ?opened id path desc env =
  403. { env with
  404. - cltypes = Ident.add id (path, desc) env.cltypes;
  405. + cltypes = Ident.add id ((path, desc), opened) env.cltypes;
  406. summary = Env_cltype(env.summary, id, desc) }
  407.  
  408. (* Compute the components of a functor application in a path. *)
  409. @@ -746,7 +784,11 @@
  410.  
  411. (* Open a signature path *)
  412.  
  413. -let open_signature root sg env =
  414. +let open_signature loc root sg env =
  415. + (* Format.eprintf "%a %s@." format_longident lid (Path.unique_name p); *)
  416. + (* jfuruse Format.eprintf "open %s@." (Path.unique_name root); *)
  417. + add_opened_module loc root;
  418. +
  419. (* First build the paths and substitution *)
  420. let (pl, sub) = prefix_idents root 0 Subst.identity sg in
  421. (* Then enter the components in the environment after substitution *)
  422. @@ -755,25 +797,25 @@
  423. (fun env item p ->
  424. match item with
  425. Tsig_value(id, decl) ->
  426. - let e1 = store_value (Ident.hide id) p
  427. + let e1 = store_value ~opened:root (Ident.hide id) p
  428. (Subst.value_description sub decl) env
  429. in store_annot (Ident.hide id) p (Annot.Iref_external) e1
  430. | Tsig_type(id, decl, _) ->
  431. - store_type (Ident.hide id) p
  432. + store_type ~opened:root (Ident.hide id) p
  433. (Subst.type_declaration sub decl) env
  434. | Tsig_exception(id, decl) ->
  435. - store_exception (Ident.hide id) p
  436. + store_exception ~opened:root (Ident.hide id) p
  437. (Subst.exception_declaration sub decl) env
  438. | Tsig_module(id, mty, _) ->
  439. - store_module (Ident.hide id) p (Subst.modtype sub mty) env
  440. + store_module ~opened:root (Ident.hide id) p (Subst.modtype sub mty) env
  441. | Tsig_modtype(id, decl) ->
  442. - store_modtype (Ident.hide id) p
  443. + store_modtype ~opened:root (Ident.hide id) p
  444. (Subst.modtype_declaration sub decl) env
  445. | Tsig_class(id, decl, _) ->
  446. - store_class (Ident.hide id) p
  447. + store_class ~opened:root (Ident.hide id) p
  448. (Subst.class_declaration sub decl) env
  449. | Tsig_cltype(id, decl, _) ->
  450. - store_cltype (Ident.hide id) p
  451. + store_cltype ~opened:root (Ident.hide id) p
  452. (Subst.cltype_declaration sub decl) env)
  453. env sg pl in
  454. { newenv with summary = Env_open(env.summary, root) }
  455. @@ -782,7 +824,7 @@
  456.  
  457. let open_pers_signature name env =
  458. let ps = find_pers_struct name in
  459. - open_signature (Pident(Ident.create_persistent name)) ps.ps_sig env
  460. + open_signature Location.none (Pident(Ident.create_persistent name)) ps.ps_sig env
  461.  
  462. (* Read a signature from a file *)
  463.  
  464. diff -r 2d6735cf3851 -r 6199973faf25 typing/env.mli
  465. --- a/typing/env.mli Tue Jul 05 08:41:48 2011 +0900
  466. +++ b/typing/env.mli Fri Sep 16 00:00:00 2011 +0900
  467. @@ -37,6 +37,8 @@
  468. of the compiler's type-based optimisations. *)
  469. val find_modtype_expansion: Path.t -> t -> Types.module_type
  470.  
  471. +val check_modules_opened_but_not_used_yet : unit -> unit
  472. +
  473. (* Lookup by long identifiers *)
  474.  
  475. val lookup_value: Longident.t -> t -> Path.t * value_description
  476. @@ -68,7 +70,7 @@
  477. (* Insertion of all fields of a signature, relative to the given path.
  478. Used to implement open. *)
  479.  
  480. -val open_signature: Path.t -> signature -> t -> t
  481. +val open_signature: Location.t -> Path.t -> signature -> t -> t
  482. val open_pers_signature: string -> t -> t
  483.  
  484. (* Insertion by name *)
  485. diff -r 2d6735cf3851 -r 6199973faf25 typing/path.ml
  486. --- a/typing/path.ml Tue Jul 05 08:41:48 2011 +0900
  487. +++ b/typing/path.ml Fri Sep 16 00:00:00 2011 +0900
  488. @@ -46,3 +46,9 @@
  489. Pident id -> id
  490. | Pdot(p, s, pos) -> head p
  491. | Papply(p1, p2) -> assert false
  492. +
  493. +let rec unique_name = function
  494. + Pident id -> Ident.unique_name id
  495. + | Pdot(p, s, pos) -> unique_name p ^ "." ^ s ^ "/" ^ string_of_int pos
  496. + | Papply(p1, p2) -> unique_name p1 ^ "(" ^ unique_name p2 ^ ")"
  497. +
  498. diff -r 2d6735cf3851 -r 6199973faf25 typing/path.mli
  499. --- a/typing/path.mli Tue Jul 05 08:41:48 2011 +0900
  500. +++ b/typing/path.mli Fri Sep 16 00:00:00 2011 +0900
  501. @@ -26,4 +26,5 @@
  502. val nopos: int
  503.  
  504. val name: t -> string
  505. +val unique_name : t -> string
  506. val head: t -> Ident.t
  507. diff -r 2d6735cf3851 -r 6199973faf25 typing/typemod.ml
  508. --- a/typing/typemod.ml Tue Jul 05 08:41:48 2011 +0900
  509. +++ b/typing/typemod.ml Fri Sep 16 00:00:00 2011 +0900
  510. @@ -59,7 +59,7 @@
  511. let type_open env loc lid =
  512. let (path, mty) = Typetexp.find_module env loc lid in
  513. let sg = extract_sig_open env loc mty in
  514. - Env.open_signature path sg env
  515. + Env.open_signature loc path sg env
  516.  
  517. (* Record a module type *)
  518. let rm node =
  519. @@ -979,6 +979,7 @@
  520. let (str, sg, finalenv) = type_structure initial_env ast Location.none in
  521. let simple_sg = simplify_signature sg in
  522. Typecore.force_delayed_checks ();
  523. + Env.check_modules_opened_but_not_used_yet ();
  524. if !Clflags.print_types then begin
  525. fprintf std_formatter "%a@." Printtyp.signature simple_sg;
  526. (str, Tcoerce_none) (* result is ignored by Compile.implementation *)
  527. diff -r 2d6735cf3851 -r 6199973faf25 utils/warnings.ml
  528. --- a/utils/warnings.ml Tue Jul 05 08:41:48 2011 +0900
  529. +++ b/utils/warnings.ml Fri Sep 16 00:00:00 2011 +0900
  530. @@ -50,6 +50,7 @@
  531. | Wildcard_arg_to_constant_constr (* 28 *)
  532. | Eol_in_string (* 29 *)
  533. | Duplicate_definitions of string * string * string * string (*30 *)
  534. + | Opened_module_is_never_used of string (* 31 *)
  535. ;;
  536.  
  537. (* If you remove a warning, leave a hole in the numbering. NEVER change
  538. @@ -89,9 +90,10 @@
  539. | Wildcard_arg_to_constant_constr -> 28
  540. | Eol_in_string -> 29
  541. | Duplicate_definitions _ -> 30
  542. + | Opened_module_is_never_used _ -> 31
  543. ;;
  544.  
  545. -let last_warning_number = 30;;
  546. +let last_warning_number = 31;;
  547. (* Must be the max number returned by the [number] function. *)
  548.  
  549. let letter = function
  550. @@ -260,6 +262,9 @@
  551. | Duplicate_definitions (kind, cname, tc1, tc2) ->
  552. Printf.sprintf "the %s %s is defined in both types %s and %s."
  553. kind cname tc1 tc2
  554. + | Opened_module_is_never_used mname ->
  555. + Printf.sprintf "open %s is redundant."
  556. + mname
  557. ;;
  558.  
  559. let nerrors = ref 0;;
  560. @@ -335,6 +340,7 @@
  561. 29, "Unescaped end-of-line in a string constant (non-portable code).";
  562. 30, "Two labels or constructors of the same name are defined in two\n\
  563. \ mutually recursive types.";
  564. + 31, "a module is opened, but not required.";
  565. ]
  566.  
  567. let help_warnings () =
  568. diff -r 2d6735cf3851 -r 6199973faf25 utils/warnings.mli
  569. --- a/utils/warnings.mli Tue Jul 05 08:41:48 2011 +0900
  570. +++ b/utils/warnings.mli Fri Sep 16 00:00:00 2011 +0900
  571. @@ -45,6 +45,7 @@
  572. | Wildcard_arg_to_constant_constr (* 28 *)
  573. | Eol_in_string (* 29 *)
  574. | Duplicate_definitions of string * string * string * string (*30 *)
  575. + | Opened_module_is_never_used of string (* 31 *)
  576. ;;
  577.  
  578. val parse_options : bool -> string -> unit;;
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!