+
+let nmap_sequent0 status ~idref ~metasenv ~subst (i,(n,context,ty)) =
+ let module K = Content in
+ let nast_of_cic =
+ nast_of_cic1 status ~idref ~output_type:`Term ~metasenv ~subst in
+ let context',_ =
+ List.fold_right
+ (fun item (res,context) ->
+ match item with
+ | name,NCic.Decl t ->
+ Some
+ (* We should call build_decl_item, but we have not computed *)
+ (* the inner-types ==> we always produce a declaration *)
+ (`Declaration
+ { K.dec_name = (Some name);
+ K.dec_id = "-1";
+ K.dec_inductive = false;
+ K.dec_aref = "-1";
+ K.dec_type = nast_of_cic ~context t
+ })::res,item::context
+ | name,NCic.Def (t,ty) ->
+ Some
+ (* We should call build_def_item, but we have not computed *)
+ (* the inner-types ==> we always produce a declaration *)
+ (`Definition
+ { K.def_name = (Some name);
+ K.def_id = "-1";
+ K.def_aref = "-1";
+ K.def_term = nast_of_cic ~context t;
+ K.def_type = nast_of_cic ~context ty
+ })::res,item::context
+ ) context ([],[])
+ in
+ ("-1",i,context',nast_of_cic ~context ty)
+;;
+
+let nmap_sequent status ~metasenv ~subst conjecture =
+ let module K = Content in
+ let ids_to_refs = Hashtbl.create 211 in
+ let register_ref = Hashtbl.add ids_to_refs in
+ nmap_sequent0 status ~idref:(idref register_ref) ~metasenv ~subst conjecture,
+ ids_to_refs
+;;
+
+let object_prefix = "obj:";;
+let declaration_prefix = "decl:";;
+let definition_prefix = "def:";;
+let inductive_prefix = "ind:";;
+let joint_prefix = "joint:";;
+
+let get_id =
+ function
+ Ast.AttributedTerm (`IdRef id, _) -> id
+ | _ -> assert false
+;;
+
+let gen_id prefix seed =
+ let res = prefix ^ string_of_int !seed in
+ incr seed ;
+ res
+;;
+
+let build_def_item seed context metasenv id n t ty =
+ let module K = Content in
+(*
+ try
+ let sort = Hashtbl.find ids_to_inner_sorts id in
+ if sort = `Prop then
+ (let p =
+ (acic2content seed context metasenv ?name:(name_of n) ~ids_to_inner_sorts ~ids_to_inner_types t)
+ in
+ `Proof p;)
+ else
+*)
+ `Definition
+ { K.def_name = Some n;
+ K.def_id = gen_id definition_prefix seed;
+ K.def_aref = id;
+ K.def_term = t;
+ K.def_type = ty
+ }
+(*
+ with
+ Not_found -> assert false
+*)
+
+let build_decl_item seed id n s =
+ let module K = Content in
+(*
+ let sort =
+ try
+ Some (Hashtbl.find ids_to_inner_sorts (Cic2acic.source_id_of_id id))
+ with Not_found -> None
+ in
+ match sort with
+ | Some `Prop ->
+ `Hypothesis
+ { K.dec_name = name_of n;
+ K.dec_id = gen_id declaration_prefix seed;
+ K.dec_inductive = false;
+ K.dec_aref = id;
+ K.dec_type = s
+ }
+ | _ ->
+*)
+ `Declaration
+ { K.dec_name = Some n;
+ K.dec_id = gen_id declaration_prefix seed;
+ K.dec_inductive = false;
+ K.dec_aref = id;
+ K.dec_type = s
+ }
+;;
+
+let nmap_obj status (uri,_,metasenv,subst,kind) =
+ let module K = Content in
+ let ids_to_refs = Hashtbl.create 211 in
+ let register_ref = Hashtbl.add ids_to_refs in
+ let idref = idref register_ref in
+ let nast_of_cic =
+ nast_of_cic1 status ~idref ~output_type:`Term ~metasenv ~subst in
+ let seed = ref 0 in
+ let conjectures =
+ match metasenv with
+ [] -> None
+ | _ -> (*Some (List.map (map_conjectures seed) metasenv)*)
+ (*CSC: used to be the previous line, that uses seed *)
+ Some (List.map (nmap_sequent0 status ~idref ~metasenv ~subst) metasenv)
+ in
+let build_constructors seed l =
+ List.map
+ (fun (_,n,ty) ->
+ let ty = nast_of_cic ~context:[] ty in
+ { K.dec_name = Some n;
+ K.dec_id = gen_id declaration_prefix seed;
+ K.dec_inductive = false;
+ K.dec_aref = "";
+ K.dec_type = ty
+ }) l
+in
+let build_inductive b seed =
+ fun (_,n,ty,cl) ->
+ let ty = nast_of_cic ~context:[] ty in
+ `Inductive
+ { K.inductive_id = gen_id inductive_prefix seed;
+ K.inductive_name = n;
+ K.inductive_kind = b;
+ K.inductive_type = ty;
+ K.inductive_constructors = build_constructors seed cl
+ }
+in
+let build_fixpoint b seed =
+ fun (_,n,_,ty,t) ->
+ let t = nast_of_cic ~context:[] t in
+ let ty = nast_of_cic ~context:[] ty in
+ `Definition
+ { K.def_id = gen_id inductive_prefix seed;
+ K.def_name = Some n;
+ K.def_aref = "";
+ K.def_type = ty;
+ K.def_term = t;
+ }
+in
+ let res =
+ match kind with
+ | NCic.Fixpoint (is_rec, ifl, _) ->
+ (gen_id object_prefix seed, [], conjectures,
+ `Joint
+ { K.joint_id = gen_id joint_prefix seed;
+ K.joint_kind =
+ if is_rec then
+ `Recursive (List.map (fun (_,_,i,_,_) -> i) ifl)
+ else `CoRecursive;
+ K.joint_defs = List.map (build_fixpoint is_rec seed) ifl
+ })
+ | NCic.Inductive (is_ind, lno, itl, _) ->
+ (gen_id object_prefix seed, [], conjectures,
+ `Joint
+ { K.joint_id = gen_id joint_prefix seed;
+ K.joint_kind =
+ if is_ind then `Inductive lno else `CoInductive lno;
+ K.joint_defs = List.map (build_inductive is_ind seed) itl
+ })
+ | NCic.Constant (_,_,Some bo,ty,_) ->
+ let ty = nast_of_cic ~context:[] ty in
+ let bo = nast_of_cic ~context:[] bo in
+ (gen_id object_prefix seed, [], conjectures,
+ `Def (K.Const,ty,
+ build_def_item seed [] [] (get_id bo) (NUri.name_of_uri uri) bo ty))
+ | NCic.Constant (_,_,None,ty,_) ->
+ let ty = nast_of_cic ~context:[] ty in
+ (gen_id object_prefix seed, [], conjectures,
+ `Decl (K.Const,
+ (*CSC: ??? get_id ty here used to be the id of the axiom! *)
+ build_decl_item seed (get_id ty) (NUri.name_of_uri uri) ty))
+ in
+ res,ids_to_refs
+;;