From a1fe45ddbd37d3c447a23cde0ee21f105ef42ac0 Mon Sep 17 00:00:00 2001
From: msozeau <msozeau@85f007b7-540e-0410-9357-904b9bb8a0f7>
Date: Fri, 6 Jun 2008 22:39:43 +0000
Subject: Enhancements to coqdoc, better globalization of sections and modules.
 Minor fix in Morphisms which prevented working with higher-order morphisms
 and PER relations.

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@11065 85f007b7-540e-0410-9357-904b9bb8a0f7
---
 interp/modintern.ml | 36 ++++++++++++++++++++++++++++++++++--
 1 file changed, 34 insertions(+), 2 deletions(-)

(limited to 'interp/modintern.ml')

diff --git a/interp/modintern.ml b/interp/modintern.ml
index 68978080b..cd55ec74d 100644
--- a/interp/modintern.ml
+++ b/interp/modintern.ml
@@ -60,19 +60,51 @@ let lookup_qualid (modtype:bool) qid =
 
 *)
 
+
+let split_modpath mp =
+  let rec aux = function
+    | MPfile dp -> dp, []
+    | MPbound mbid -> 
+	Lib.library_dp (), [id_of_mbid mbid]
+    | MPself msid -> Lib.library_dp (), [id_of_msid msid]
+    | MPdot (mp,l) -> let (mp', lab) = aux mp in
+			(mp', id_of_label l :: lab)
+  in 
+  let (mp, l) = aux mp in
+    mp, l
+			
+let dump_moddef loc mp ty =
+  if !Flags.dump then
+    let (dp, l) = split_modpath mp in
+    let fp = string_of_dirpath dp in
+    let mp = string_of_dirpath (make_dirpath l) in
+      Flags.dump_string (Printf.sprintf "%s %d %s %s\n" ty (fst (unloc loc)) "<>" mp)
+
+let rec drop_last = function [] -> assert false | hd :: [] -> [] | hd :: tl -> hd :: drop_last tl
+
+let dump_modref loc mp ty =
+  if !Flags.dump then
+    let (dp, l) = split_modpath mp in
+    let fp = string_of_dirpath dp in
+    let mp = string_of_dirpath (make_dirpath (drop_last l)) in
+      Flags.dump_string (Printf.sprintf "R%d %s %s %s %s\n" 
+			    (fst (unloc loc)) fp mp "<>" ty)
+
 (* Search for the head of [qid] in [binders]. 
    If found, returns the module_path/kernel_name created from the dirpath
    and the basename. Searches Nametab otherwise.
 *)
 let lookup_module (loc,qid) =
   try
-    Nametab.locate_module qid
+    let mp = Nametab.locate_module qid in
+      dump_modref loc mp "modtype"; mp
   with
     | Not_found -> Modops.error_not_a_module_loc loc (string_of_qualid qid)
 	
 let lookup_modtype (loc,qid) =
   try
-    Nametab.locate_modtype qid
+    let mp = Nametab.locate_modtype qid in
+      dump_modref loc mp "mod"; mp
   with
     | Not_found -> 
 	Modops.error_not_a_modtype_loc loc (string_of_qualid qid)
-- 
cgit v1.2.3