aboutsummaryrefslogtreecommitdiff
path: root/plugins/extraction/extract_env.ml
diff options
context:
space:
mode:
authorletouzey2012-03-26 16:03:12 +0000
committerletouzey2012-03-26 16:03:12 +0000
commitf22d5b55021fcf5fb11fa9d4fce3a7b8d9bc532f (patch)
tree24438c2eb0ca59ebe62f90c39e11bc2918e9cf4a /plugins/extraction/extract_env.ml
parent263ec91e6664a9f1f8823c791690cb5ddf43c547 (diff)
Module names and constant/inductive names are now in two separate namespaces
We now accept the following code: Definition E := 0. Module E. End E. Techically, we simply allow the same label to occur at most twice in a structure_body, which is a (label * structure_field_body) list). These two label occurences should not be at the same level of fields (e.g. a SFBmodule and a SFBmind are ok, but not two SFBmodule's or a SFBmodule and a SFBmodtype). Gain : a minimal amount of code change. Drawback : no more simple List.assoc or equivalent should be performed on a structure_body ... git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@15088 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'plugins/extraction/extract_env.ml')
-rw-r--r--plugins/extraction/extract_env.ml11
1 files changed, 7 insertions, 4 deletions
diff --git a/plugins/extraction/extract_env.ml b/plugins/extraction/extract_env.ml
index 7c517dd9bc..aa536b1dce 100644
--- a/plugins/extraction/extract_env.ml
+++ b/plugins/extraction/extract_env.ml
@@ -156,7 +156,9 @@ let factor_fix env l cb msb =
function
| (l,SFBconst cb') ->
let check' = check_fix env cb' (j+1) in
- if not (fst check = fst check' && prec_declaration_equal (snd check) (snd check')) then raise Impossible;
+ if not (fst check = fst check' &&
+ prec_declaration_equal (snd check) (snd check'))
+ then raise Impossible;
labels.(j+1) <- l;
| _ -> raise Impossible) msb';
labels, recd, msb''
@@ -197,13 +199,14 @@ let rec msid_of_seb = function
| SEBwith (seb,_) -> msid_of_seb seb
| _ -> assert false
-let env_for_mtb_with env mp seb idl =
+let env_for_mtb_with_def env mp seb idl =
let sig_b = match seb with
| SEBstruct(sig_b) -> sig_b
| _ -> assert false
in
let l = label_of_id (List.hd idl) in
- let before = fst (list_split_when (fun (l',_) -> l=l') sig_b) in
+ let spot = function (l',SFBconst _) -> l = l' | _ -> false in
+ let before = fst (list_split_when spot sig_b) in
Modops.add_signature mp before empty_delta_resolver env
(* From a [structure_body] (i.e. a list of [structure_field_body])
@@ -242,7 +245,7 @@ let rec extract_sfb_spec env mp = function
and extract_seb_spec env mp1 (seb,seb_alg) = match seb_alg with
| SEBident mp -> Visit.add_mp_all mp; MTident mp
| SEBwith(seb',With_definition_body(idl,cb))->
- let env' = env_for_mtb_with env (msid_of_seb seb') seb idl in
+ let env' = env_for_mtb_with_def env (msid_of_seb seb') seb idl in
let mt = extract_seb_spec env mp1 (seb,seb') in
(match extract_with_type env' cb with (* cb peut contenir des kn *)
| None -> mt