let rec debug_aux t i =
let module C = Cic in
let module U = UriManager in
- CicPp.ppobj (C.Variable ("DEBUG", None, t, [])) ^ "\n" ^ i
+ CicPp.ppobj (C.Variable ("DEBUG", None, t, [], [])) ^ "\n" ^ i
in
if !fdebug = 0 then
prerr_endline (s ^ "\n" ^ List.fold_right debug_aux (t::env) "")
in
(match o with
C.Constant _ -> raise ReferenceToConstant
- | C.Variable (_,_,_,params) -> params
+ | C.Variable (_,_,_,params,_) -> params
| C.CurrentProof _ -> raise ReferenceToCurrentProof
| C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
)
CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri
in
(match o with
- C.Constant (_,_,_,params) -> params
+ C.Constant (_,_,_,params,_) -> params
| C.Variable _ -> raise ReferenceToVariable
- | C.CurrentProof (_,_,_,_,params) -> params
+ | C.CurrentProof (_,_,_,_,params,_) -> params
| C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
)
in
C.Constant _ -> raise ReferenceToConstant
| C.Variable _ -> raise ReferenceToVariable
| C.CurrentProof _ -> raise ReferenceToCurrentProof
- | C.InductiveDefinition (_,params,_) -> params
+ | C.InductiveDefinition (_,params,_,_) -> params
)
in
let exp_named_subst' =
C.Constant _ -> raise ReferenceToConstant
| C.Variable _ -> raise ReferenceToVariable
| C.CurrentProof _ -> raise ReferenceToCurrentProof
- | C.InductiveDefinition (_,params,_) -> params
+ | C.InductiveDefinition (_,params,_,_) -> params
)
in
let exp_named_subst' =
C.Constant _ -> raise ReferenceToConstant
| C.CurrentProof _ -> raise ReferenceToCurrentProof
| C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
- | C.Variable (_,None,_,_) ->
+ | C.Variable (_,None,_,_,_) ->
let t' = unwind k e ens t in
if s = [] then t' else
C.Appl (t'::(RS.from_stack_list ~unwind s))
- | C.Variable (_,Some body,_,_) ->
+ | C.Variable (_,Some body,_,_,_) ->
let ens' = push_exp_named_subst k e ens exp_named_subst in
reduce (0, [], ens', body, s)
)
CicEnvironment.get_cooked_obj CicUniv.empty_ugraph uri
in
match o with
- C.Constant (_,Some body,_,_) ->
+ C.Constant (_,Some body,_,_,_) ->
let ens' = push_exp_named_subst k e ens exp_named_subst in
(* constants are closed *)
reduce (0, [], ens', body, s)
- | C.Constant (_,None,_,_) ->
+ | C.Constant (_,None,_,_,_) ->
let t' = unwind k e ens t in
if s = [] then t' else C.Appl (t'::(RS.from_stack_list ~unwind s))
| C.Variable _ -> raise ReferenceToVariable
- | C.CurrentProof (_,_,body,_,_) ->
+ | C.CurrentProof (_,_,body,_,_,_) ->
let ens' = push_exp_named_subst k e ens exp_named_subst in
(* constants are closed *)
reduce (0, [], ens', body, s)
CicEnvironment.get_cooked_obj CicUniv.empty_ugraph mutind
in
match o with
- C.InductiveDefinition (tl,ingredients,r) ->
+ C.InductiveDefinition (tl,ingredients,r,_) ->
let (_,_,arity,_) = List.nth tl i in
(arity,r)
| _ -> raise WrongUriToInductiveDefinition
let rec debug_aux t i =
let module C = Cic in
let module U = UriManager in
- CicPp.ppobj (C.Variable ("DEBUG", None, t, [])) ^ "\n" ^ i
+ CicPp.ppobj (C.Variable ("DEBUG", None, t, [], [])) ^ "\n" ^ i
in
if !fdebug = 0 then
prerr_endline (s ^ "\n" ^ List.fold_right debug_aux (t::env) "")
C.Constant _ -> raise ReferenceToConstant
| C.CurrentProof _ -> raise ReferenceToCurrentProof
| C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
- | C.Variable (_,None,_,_) -> if l = [] then t else C.Appl (t::l)
- | C.Variable (_,Some body,_,_) ->
+ | C.Variable (_,None,_,_,_) -> if l = [] then t else C.Appl (t::l)
+ | C.Variable (_,Some body,_,_,_) ->
whdaux l (CicSubstitution.subst_vars exp_named_subst body)
)
| C.Meta _ as t -> if l = [] then t else C.Appl (t::l)
CicEnvironment.get_cooked_obj ~trust:false CicUniv.empty_ugraph uri
in
(match o with
- C.Constant (_,Some body,_,_) ->
+ C.Constant (_,Some body,_,_,_) ->
whdaux l (CicSubstitution.subst_vars exp_named_subst body)
| C.Constant _ -> if l = [] then t else C.Appl (t::l)
| C.Variable _ -> raise ReferenceToVariable
- | C.CurrentProof (_,_,body,_,_) ->
+ | C.CurrentProof (_,_,body,_,_,_) ->
whdaux l (CicSubstitution.subst_vars exp_named_subst body)
| C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
)
let (arity, r) =
let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph mutind in
match o with
- C.InductiveDefinition (tl,ingredients,r) ->
+ C.InductiveDefinition (tl,ingredients,r,_) ->
let (_,_,arity,_) = List.nth tl i in
(arity,r)
| _ -> raise WrongUriToInductiveDefinition
let obj,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
(match obj with
C.Constant _ -> raise ReferenceToConstant
- | C.Variable (_,_,_,params) -> params
+ | C.Variable (_,_,_,params,_) -> params
| C.CurrentProof _ -> raise ReferenceToCurrentProof
| C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
)
let params =
let obj,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
(match obj with
- C.Constant (_,_,_,params) -> params
+ C.Constant (_,_,_,params,_) -> params
| C.Variable _ -> raise ReferenceToVariable
- | C.CurrentProof (_,_,_,_,params) -> params
+ | C.CurrentProof (_,_,_,_,params,_) -> params
| C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
)
in
C.Constant _ -> raise ReferenceToConstant
| C.Variable _ -> raise ReferenceToVariable
| C.CurrentProof _ -> raise ReferenceToCurrentProof
- | C.InductiveDefinition (_,params,_) -> params
+ | C.InductiveDefinition (_,params,_,_) -> params
)
in
let exp_named_subst'' =
C.Constant _ -> raise ReferenceToConstant
| C.Variable _ -> raise ReferenceToVariable
| C.CurrentProof _ -> raise ReferenceToCurrentProof
- | C.InductiveDefinition (_,params,_) -> params
+ | C.InductiveDefinition (_,params,_,_) -> params
)
in
let exp_named_subst'' =
let rec debug_aux t i =
let module C = Cic in
let module U = UriManager in
- CicPp.ppobj (C.Variable ("DEBUG", None, t, [])) ^ "\n" ^ i
+ CicPp.ppobj (C.Variable ("DEBUG", None, t, [], [])) ^ "\n" ^ i
in
if !fdebug = 0 then
raise (TypeCheckerFailure (List.fold_right debug_aux (t::context) ""))
let ugraph_dust =
(match uobj with
- C.Constant (_,Some te,ty,_) ->
+ C.Constant (_,Some te,ty,_,_) ->
let _,ugraph = type_of ~logger ty ugraph in
let type_of_te,ugraph' = type_of ~logger te ugraph in
let b',ugraph'' = (R.are_convertible [] type_of_te ty ugraph') in
(CicPp.ppterm ty)))
else
ugraph'
- | C.Constant (_,None,ty,_) ->
+ | C.Constant (_,None,ty,_,_) ->
(* only to check that ty is well-typed *)
let _,ugraph' = type_of ~logger ty ugraph in
ugraph'
- | C.CurrentProof (_,conjs,te,ty,_) ->
+ | C.CurrentProof (_,conjs,te,ty,_,_) ->
let _,ugraph1 =
List.fold_left
(fun (metasenv,ugraph) ((_,context,ty) as conj) ->
uobj,ugraph_dust
in
match cobj,ugraph with
- (C.Constant (_,_,ty,_)),g -> ty,g
- | (C.CurrentProof (_,_,_,ty,_)),g -> ty,g
+ (C.Constant (_,_,ty,_,_)),g -> ty,g
+ | (C.CurrentProof (_,_,_,ty,_,_)),g -> ty,g
| _ ->
raise (TypeCheckerFailure ("Unknown constant:" ^ U.string_of_uri uri))
let module U = UriManager in
(* 0 because a variable is never cooked => no partial cooking at one level *)
match CicEnvironment.is_type_checked ~trust:true ugraph uri with
- CicEnvironment.CheckedObj ((C.Variable (_,_,ty,_)),ugraph') -> ty,ugraph'
- | CicEnvironment.UncheckedObj (C.Variable (_,bo,ty,_)) ->
+ CicEnvironment.CheckedObj ((C.Variable (_,_,ty,_,_)),ugraph') -> ty,ugraph'
+ | CicEnvironment.UncheckedObj (C.Variable (_,bo,ty,_,_)) ->
logger#log (`Start_type_checking uri) ;
(* only to check that ty is well-typed *)
let _,ugraph1 = type_of ~logger ty ugraph in
CicEnvironment.set_type_checking_info uri ;
logger#log (`Type_checking_completed uri) ;
match CicEnvironment.is_type_checked ~trust:false ugraph uri with
- CicEnvironment.CheckedObj ((C.Variable (_,_,ty,_)),ugraph') ->
+ CicEnvironment.CheckedObj ((C.Variable (_,_,ty,_,_)),ugraph') ->
ty,ugraph'
| CicEnvironment.CheckedObj _
| CicEnvironment.UncheckedObj _ -> raise CicEnvironmentError
let (ok,paramsno,ity,cl,name) =
let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
match o with
- C.InductiveDefinition (tl,_,paramsno) ->
+ C.InductiveDefinition (tl,_,paramsno,_) ->
let (name,_,ity,cl) = List.nth tl i in
(List.length tl = 1, paramsno, ity, cl, name)
| _ ->
(* inductive block definition. *)
and check_mutual_inductive_defs uri obj ugraph =
match obj with
- Cic.InductiveDefinition (itl, params, indparamsno) ->
+ Cic.InductiveDefinition (itl, params, indparamsno, _) ->
typecheck_mutual_inductive_defs uri (itl,params,indparamsno) ugraph
| _ ->
raise (TypeCheckerFailure (
uobj,ugraph1_dust
in
match cobj with
- C.InductiveDefinition (dl,_,_) ->
+ C.InductiveDefinition (dl,_,_,_) ->
let (_,_,arity,_) = List.nth dl i in
arity,ugraph1
| _ ->
uobj,ugraph1_dust
in
match cobj with
- C.InductiveDefinition (dl,_,_) ->
+ C.InductiveDefinition (dl,_,_,_) ->
let (_,_,_,cl) = List.nth dl i in
let (_,ty) = List.nth cl (j-1) in
ty,ugraph1
let (tys,len,isinductive,paramsno,cl) =
let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
match o with
- C.InductiveDefinition (tl,_,paramsno) ->
+ C.InductiveDefinition (tl,_,paramsno,_) ->
let tys =
List.map
(fun (n,_,ty,_) -> Some (Cic.Name n,(Cic.Decl ty))) tl
let (tys,len,isinductive,paramsno,cl) =
let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
match o with
- C.InductiveDefinition (tl,_,paramsno) ->
+ C.InductiveDefinition (tl,_,paramsno,_) ->
let (_,isinductive,_,cl) = List.nth tl i in
let tys =
List.map (fun (n,_,ty,_) ->
let (tys,len,isinductive,paramsno,cl) =
let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
match o with
- C.InductiveDefinition (tl,_,paramsno) ->
+ C.InductiveDefinition (tl,_,paramsno,_) ->
let len = List.length tl in
let (_,isinductive,_,cl) = List.nth tl i in
let tys =
let (tys,len,isinductive,paramsno,cl) =
let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
match o with
- C.InductiveDefinition (tl,_,paramsno) ->
+ C.InductiveDefinition (tl,_,paramsno,_) ->
let (_,isinductive,_,cl) = List.nth tl i in
let tys =
List.map
with Not_found -> assert false
in
match obj with
- C.InductiveDefinition (itl,_,_) ->
+ C.InductiveDefinition (itl,_,_,_) ->
let (_,_,_,cl) = List.nth itl i in
let (_,cons) = List.nth cl (j - 1) in
CicSubstitution.subst_vars exp_named_subst cons
(*CSC: WRONG. MISSING CONDITIONS ON THE ARGUMENTS OF THE CONSTRUTOR *)
(let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
match o with
- C.InductiveDefinition (itl,_,_) ->
+ C.InductiveDefinition (itl,_,_,_) ->
let (_,_,_,cl) = List.nth itl i in
(* is a singleton definition or the empty proposition? *)
(List.length cl = 1 || List.length cl = 0) , ugraph
when need_dummy ->
(let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
match o with
- C.InductiveDefinition (itl,_,paramsno) ->
+ C.InductiveDefinition (itl,_,paramsno,_) ->
let tys =
List.map (fun (n,_,ty,_) -> Some (Cic.Name n,(Cic.Decl ty))) itl
in
| (C.Sort C.Set | C.Sort C.CProp) ->
(let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
match o with
- C.InductiveDefinition (itl,_,_) ->
+ C.InductiveDefinition (itl,_,_,_) ->
let (_,_,_,cl) = List.nth itl i in
(* is a singleton definition? *)
List.length cl = 1,ugraph1
(* TASSI: da verificare *)
(let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
match o with
- C.InductiveDefinition (itl,_,paramsno) ->
+ C.InductiveDefinition (itl,_,paramsno,_) ->
let (_,_,_,cl) = List.nth itl i in
let tys =
List.map
with Not_found -> assert false
in
match obj with
- C.InductiveDefinition (_,_,parsno) -> parsno
+ C.InductiveDefinition (_,_,parsno,_) -> parsno
| _ ->
raise (TypeCheckerFailure
("Unknown mutual inductive definition:" ^
with Not_found -> assert false
in
(match obj with
- C.InductiveDefinition (itl,_,_) ->
+ C.InductiveDefinition (itl,_,_,_) ->
let (_,is_inductive,_,_) = List.nth itl i in
if is_inductive then None else (Some uri)
| _ ->
| C.Appl ((C.MutInd (uri,i,_))::_) ->
(let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in
match o with
- C.InductiveDefinition (itl,_,_) ->
+ C.InductiveDefinition (itl,_,_,_) ->
let (_,is_inductive,_,_) = List.nth itl i in
if is_inductive then None else (Some uri)
| _ ->
(* prerr_endline ("INIZIO A TYPECHECKARE " ^ U.string_of_uri uri); *)
let ugraph1 =
(match uobj with
- C.Constant (_,Some te,ty,_) ->
+ C.Constant (_,Some te,ty,_,_) ->
let _,ugraph1 = type_of ~logger ty ugraph in
let ty_te,ugraph2 = type_of ~logger te ugraph1 in
let b,ugraph3 = (R.are_convertible [] ty_te ty ugraph2) in
("Unknown constant:" ^ U.string_of_uri uri))
else
ugraph3
- | C.Constant (_,None,ty,_) ->
+ | C.Constant (_,None,ty,_,_) ->
(* only to check that ty is well-typed *)
let _,ugraph1 = type_of ~logger ty ugraph in
ugraph1
- | C.CurrentProof (_,conjs,te,ty,_) ->
+ | C.CurrentProof (_,conjs,te,ty,_,_) ->
let _,ugraph1 =
List.fold_left
(fun (metasenv,ugraph) ((_,context,ty) as conj) ->
(CicPp.ppterm ty)))
else
ugraph4
- | C.Variable (_,bo,ty,_) ->
+ | C.Variable (_,bo,ty,_,_) ->
(* only to check that ty is well-typed *)
let _,ugraph1 = type_of ~logger ty ugraph in
(match bo with
don := u::!don;
(match fst(CicEnvironment.get_obj CicUniv.empty_ugraph u)
with
- | C.InductiveDefinition (l,_,_) ->
+ | C.InductiveDefinition (l,_,_,_) ->
List.fold_left (
fun y (_,_,t,l') ->
y @ (aux t) @
begin
don := u::!don;
(match fst(CicEnvironment.get_obj CicUniv.empty_ugraph u) with
- | C.InductiveDefinition (l,_,_) ->
+ | C.InductiveDefinition (l,_,_,_) ->
List.fold_left (
fun x (_,_,_t,l') ->
x @ aux t @
List.fold_left (fun x (_,b,c) -> x @ (aux b) @ (aux c)) [] funs
and aux_obj ?(boo=false) (t,_) =
(match t with
- C.Constant (_,Some te,ty,v) -> aux te @ aux ty @
+ C.Constant (_,Some te,ty,v,_) -> aux te @ aux ty @
List.fold_left (
fun l u ->
l @ if eq u uri then [] else
(aux_obj (CicEnvironment.get_obj CicUniv.empty_ugraph u)))
[] v
- | C.Constant (_,None,ty,v) -> aux ty @
+ | C.Constant (_,None,ty,v,_) -> aux ty @
List.fold_left (
fun l u ->
l @ if eq u uri then [] else
(aux_obj (CicEnvironment.get_obj CicUniv.empty_ugraph u)))
[] v
- | C.CurrentProof (_,conjs,te,ty,v) -> aux te @ aux ty @
+ | C.CurrentProof (_,conjs,te,ty,v,_) -> aux te @ aux ty @
List.fold_left (
fun l u ->
l @ if eq u uri then [] else
(aux_obj (CicEnvironment.get_obj CicUniv.empty_ugraph u)))
[] v
- | C.Variable (_,Some bo,ty,v) -> aux bo @ aux ty @
+ | C.Variable (_,Some bo,ty,v,_) -> aux bo @ aux ty @
List.fold_left (
fun l u ->
l @ if eq u uri then [] else
(aux_obj (CicEnvironment.get_obj CicUniv.empty_ugraph u)))
[] v
- | C.Variable (_,None ,ty,v) -> aux ty @
+ | C.Variable (_,None ,ty,v,_) -> aux ty @
List.fold_left (
fun l u ->
l @ if eq u uri then [] else
(aux_obj (CicEnvironment.get_obj CicUniv.empty_ugraph u)))
[] v
- | C.InductiveDefinition (l,v,_) ->
+ | C.InductiveDefinition (l,v,_,_) ->
(List.fold_left (
fun x (_,_,t,l') ->
x @ aux t @ List.fold_left (
*)
let obj,u= CicEnvironment.get_obj ugraph uri in
match obj with
- C.Constant (_,_,ty,_) -> ty,u
- | C.CurrentProof (_,_,_,ty,_) -> ty,u
+ C.Constant (_,_,ty,_,_) -> ty,u
+ | C.CurrentProof (_,_,_,ty,_,_) -> ty,u
| _ ->
raise
(RefineFailure ("Unknown constant definition " ^ U.string_of_uri uri))
*)
let obj,u = CicEnvironment.get_obj ugraph uri in
match obj with
- C.Variable (_,_,ty,_) -> ty,u
+ C.Variable (_,_,ty,_,_) -> ty,u
| _ ->
raise
(RefineFailure
*)
let obj,u = CicEnvironment.get_obj ugraph uri in
match obj with
- C.InductiveDefinition (dl,_,_) ->
+ C.InductiveDefinition (dl,_,_,_) ->
let (_,_,arity,_) = List.nth dl i in
arity,u
| _ ->
*)
let obj,u = CicEnvironment.get_obj ugraph uri in
match obj with
- C.InductiveDefinition (dl,_,_) ->
+ C.InductiveDefinition (dl,_,_,_) ->
let (_,_,_,cl) = List.nth dl i in
let (_,ty) = List.nth cl (j-1) in
ty,u
*)
let obj,u = CicEnvironment.get_obj ugraph uri in
match obj with
- C.InductiveDefinition (l,expl_params,parsno) ->
+ C.InductiveDefinition (l,expl_params,parsno,_) ->
List.nth l i , expl_params, parsno, u
| _ ->
raise
[] c_to_src)
;;
-
+let obj_attrs = [`Class `Coercion; `Generated]
(* generate_composite_closure (c2 (c1 s)) in the universe graph univ *)
let generate_composite_closure c1 c2 univ =
let cleaned_ty =
FreshNamesGenerator.clean_dummy_dependent_types c_ty
in
- let obj = Cic.Constant ("xxxx",Some c,cleaned_ty,[]) in
+ let obj = Cic.Constant ("xxxx",Some c,cleaned_ty,[],obj_attrs) in
obj,univ
;;
CicUtil.term_of_uri (UriManager.string_of_uri uri)
in
let first_step =
- (Cic.Constant ("",Some (term_of_uri' he),Cic.Sort Cic.Prop,[]))
+ Cic.Constant ("", Some (term_of_uri' he), Cic.Sort Cic.Prop, [],
+ obj_attrs)
in
let o,u =
List.fold_left (fun (o,u) coer ->
match o with
- | Cic.Constant (_,Some c,_,[]) ->
- generate_composite_closure c (term_of_uri' coer) u
+ | Cic.Constant (_,Some c,_,[],_) ->
+ generate_composite_closure c (term_of_uri' coer) u
| _ -> assert false
) (first_step, CicUniv.empty_ugraph) tl
in
in
let named_obj =
match o with
- | Cic.Constant (_,bo,ty,vl) -> Cic.Constant (name,bo,ty,vl)
+ | Cic.Constant (_,bo,ty,vl,attrs) ->
+ Cic.Constant (name,bo,ty,vl,attrs)
| _ -> assert false
in
((src,tgt,c_uri),(c_uri,named_obj,u))