summaryrefslogtreecommitdiff
path: root/plugins/extraction/modutil.ml
diff options
context:
space:
mode:
Diffstat (limited to 'plugins/extraction/modutil.ml')
-rw-r--r--plugins/extraction/modutil.ml24
1 files changed, 16 insertions, 8 deletions
diff --git a/plugins/extraction/modutil.ml b/plugins/extraction/modutil.ml
index 60fe8e76..f33a59ed 100644
--- a/plugins/extraction/modutil.ml
+++ b/plugins/extraction/modutil.ml
@@ -1,12 +1,15 @@
(************************************************************************)
-(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
+(* * The Coq Proof Assistant / The Coq Development Team *)
+(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *)
+(* <O___,, * (see CREDITS file for the list of authors) *)
(* \VV/ **************************************************************)
-(* // * This file is distributed under the terms of the *)
-(* * GNU Lesser General Public License Version 2.1 *)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(* * (see LICENSE file for the text of the license) *)
(************************************************************************)
open Names
+open ModPath
open Globnames
open CErrors
open Util
@@ -16,10 +19,15 @@ open Mlutil
(*S Functions upon ML modules. *)
+(** Note: a syntax like [(F M) with ...] is actually legal, see for instance
+ bug #4720. Hence the code below tries to handle [MTsig], maybe not in
+ a perfect way, but that should be enough for the use of [se_iter] below. *)
+
let rec msid_of_mt = function
| MTident mp -> mp
+ | MTsig(mp,_) -> mp
| MTwith(mt,_)-> msid_of_mt mt
- | _ -> anomaly ~label:"extraction" (Pp.str "the With operator isn't applied to a name")
+ | MTfunsig _ -> assert false (* A functor cannot be inside a MTwith *)
(*s Apply some functions upon all [ml_decl] and [ml_spec] found in a
[ml_structure]. *)
@@ -35,7 +43,7 @@ let se_iter do_decl do_spec do_mp =
List.fold_left (fun mp l -> MPdot(mp,Label.of_id l)) mp_mt idl'
in
let r = ConstRef (Constant.make2 mp_w (Label.of_id l')) in
- mt_iter mt; do_decl (Dtype(r,l,t))
+ mt_iter mt; do_spec (Stype(r,l,Some t))
| MTwith (mt,ML_With_module(idl,mp))->
let mp_mt = msid_of_mt mt in
let mp_w =
@@ -110,7 +118,7 @@ let ind_iter_references do_term do_cons do_type kn ind =
do_type (IndRef ip);
if lang () == Ocaml then
(match ind.ind_equiv with
- | Miniml.Equiv kne -> do_type (IndRef (mind_of_kn kne, snd ip));
+ | Miniml.Equiv kne -> do_type (IndRef (MutInd.make1 kne, snd ip));
| _ -> ());
Array.iteri (fun j -> cons_iter (ip,j+1)) p.ip_types
in
@@ -231,7 +239,7 @@ let get_decl_in_structure r struc =
| _ -> error_not_visible r
in go ll sel
with Not_found ->
- anomaly (Pp.str "reference not found in extracted structure")
+ anomaly (Pp.str "reference not found in extracted structure.")
(*s Optimization of a [ml_structure]. *)