summaryrefslogtreecommitdiff
path: root/library/lib.ml
diff options
context:
space:
mode:
authorGravatar Stephane Glondu <steph@glondu.net>2010-07-01 17:21:14 +0200
committerGravatar Stephane Glondu <steph@glondu.net>2010-07-01 17:21:14 +0200
commitda178a880e3ace820b41d38b191d3785b82991f5 (patch)
tree6356ab3164a5ad629f4161dc6c44ead74edc2937 /library/lib.ml
parente4282ea99c664d8d58067bee199cbbcf881b60d5 (diff)
Imported Upstream version 8.2pl2+dfsgupstream/8.2.pl2+dfsg
Diffstat (limited to 'library/lib.ml')
-rw-r--r--library/lib.ml28
1 files changed, 17 insertions, 11 deletions
diff --git a/library/lib.ml b/library/lib.ml
index 4a124cec..f0ec488b 100644
--- a/library/lib.ml
+++ b/library/lib.ml
@@ -6,7 +6,7 @@
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(* $Id: lib.ml 12187 2009-06-13 19:36:59Z msozeau $ *)
+(* $Id: lib.ml 12496 2009-11-11 13:37:57Z herbelin $ *)
open Pp
open Util
@@ -171,9 +171,8 @@ let find_split_p p =
let split_lib_gen test =
let rec collect after equal = function
- | hd::strict_before as before ->
- if test hd then collect after (hd::equal) strict_before else after,equal,before
- | [] as before -> after,equal,before
+ | hd::before when test hd -> collect after (hd::equal) before
+ | before -> after,equal,before
in
let rec findeq after = function
| hd :: before ->
@@ -194,7 +193,14 @@ let split_lib_gen test =
| None -> error "no such entry"
| Some r -> r
-let split_lib sp = split_lib_gen (fun x -> (fst x) = sp)
+let split_lib sp = split_lib_gen (fun x -> fst x = sp)
+
+let split_lib_at_opening sp =
+ split_lib_gen (function
+ | x,(OpenedSection _|OpenedModule _|OpenedModtype _|CompilingLibrary _) ->
+ x = sp
+ | _ ->
+ false)
(* Adding operations. *)
@@ -299,7 +305,7 @@ let end_module id =
with Not_found ->
error "no opened modules"
in
- let (after,modopening,before) = split_lib oname in
+ let (after,modopening,before) = split_lib_at_opening oname in
lib_stk := before;
add_entry (make_oname id) (ClosedModule (List.rev_append after (List.rev modopening)));
let prefix = !path_prefix in
@@ -344,7 +350,7 @@ let end_modtype id =
with Not_found ->
error "no opened module types"
in
- let (after,modtypeopening,before) = split_lib sp in
+ let (after,modtypeopening,before) = split_lib_at_opening sp in
lib_stk := before;
add_entry (make_oname id) (ClosedModtype (List.rev_append after (List.rev modtypeopening)));
let dir = !path_prefix in
@@ -407,7 +413,7 @@ let end_compilation dir =
("The current open module has name "^ (Names.string_of_dirpath m) ^
" and not " ^ (Names.string_of_dirpath m));
in
- let (after,_,before) = split_lib oname in
+ let (after,_,before) = split_lib_at_opening oname in
comp_name := None;
!path_prefix,after
@@ -587,7 +593,7 @@ let close_section id =
with Not_found ->
error "No opened section."
in
- let (secdecls,secopening,before) = split_lib oname in
+ let (secdecls,secopening,before) = split_lib_at_opening oname in
lib_stk := before;
let full_olddir = fst !path_prefix in
pop_path_prefix ();
@@ -640,7 +646,7 @@ let reset_to_gen test =
let (_,_,before) = split_lib_gen test in
set_lib_stk before
-let reset_to sp = reset_to_gen (fun x -> (fst x) = sp)
+let reset_to sp = reset_to_gen (fun x -> fst x = sp)
let reset_to_state sp =
let (_,eq,before) = split_lib sp in
@@ -667,7 +673,7 @@ let delete_gen test =
in
set_lib_stk (List.rev_append (chop_at_dot after) (chop_before_dot before))
-let delete sp = delete_gen (fun x -> (fst x) = sp)
+let delete sp = delete_gen (fun x -> fst x = sp)
let reset_name (loc,id) =
let (sp,_) =