Warning!!!! This breaks the most part of the code of HELM.
| LetIn of name * term * term (* binder, term, target *)
| Appl of term list (* arguments *)
| Const of UriManager.uri * int (* uri, number of cookings*)
- | Abst of UriManager.uri (* uri *)
| MutInd of UriManager.uri * int * int (* uri, cookingsno, typeno*)
| MutConstruct of UriManager.uri * int * (* uri, cookingsno, *)
int * int (* typeno, consno *)
| ALetIn of id * name * annterm * annterm (* binder, term, target *)
| AAppl of id * annterm list (* arguments *)
| AConst of id * UriManager.uri * int (* uri, number of cookings*)
- | AAbst of id * UriManager.uri (* uri *)
| AMutInd of id * UriManager.uri * int * int (* uri, cookingsno, typeno*)
| AMutConstruct of id * UriManager.uri * int * (* uri, cookingsno, *)
int * int (* typeno, consno *)
end
;;
-class eltype_abst =
- object (self)
-
- inherit cic_term
-
- method to_cic_term =
- let n = self#node in
- let value = uri_of_xml_attr (n#attribute "uri")
- and id = string_of_xml_attr (n#attribute "id") in
- Cic.AAbst (id,value)
- end
-;;
-
class eltype_const =
object (self)
"LETIN", (new D.element_impl (new eltype_letin)) ;
"APPLY", (new D.element_impl (new eltype_apply)) ;
"CONST", (new D.element_impl (new eltype_const)) ;
- "ABST", (new D.element_impl (new eltype_abst)) ;
"MUTIND", (new D.element_impl (new eltype_mutind)) ;
"MUTCONSTRUCT", (new D.element_impl (new eltype_mutconstruct)) ;
"MUTCASE", (new D.element_impl (new eltype_mutcase)) ;
C.LetIn (name, deannotate_term so, deannotate_term ta)
| C.AAppl (_,l) -> C.Appl (List.map deannotate_term l)
| C.AConst (_,uri, cookingsno) -> C.Const (uri, cookingsno)
- | C.AAbst (_,uri) -> C.Abst uri
| C.AMutInd (_,uri,cookingsno,i) -> C.MutInd (uri,cookingsno,i)
| C.AMutConstruct (_,uri,cookingsno,i,j) ->
C.MutConstruct (uri,cookingsno,i,j)
List.fold_right (fun x i -> [< (aux x) ; i >]) li [<>]
>]
| C.AConst (id,_,_) -> print_ann i2a id
- | C.AAbst (id,_) -> raise NotImplemented
| C.AMutInd (id,_,_,_) -> print_ann i2a id
| C.AMutConstruct (id,_,_,_,_) -> print_ann i2a id
| C.AMutCase (id,_,_,_,ty,te,patterns) ->
set_target id (C.Term t) ;
List.iter add_target_term l
| C.AConst (id,_,_)
- | C.AAbst (id,_)
| C.AMutInd (id,_,_,_)
| C.AMutConstruct (id,_,_,_,_) ->
set_target id (C.Term t)
[C.Rel k])
else
C.Const (uri,UriManager.relative_depth curi uri cookingsno)
- | C.Abst _ as t -> t
| C.MutInd (uri,_,i) ->
if not is_letin && match CicEnvironment.get_obj uri with
C.InductiveDefinition (_,params,_) when mem var params -> true
| C.LetIn (n,s,t) -> CicSubstitution.subst (letin_nf s) t
| C.Appl l -> C.Appl (List.map letin_nf l)
| C.Const _ as t -> t
- | C.Abst _ as t -> t
| C.MutInd _ as t -> t
| C.MutConstruct _ as t -> t
| C.MutCase (sp,cookingsno,i,outt,t,pl) ->
li ""
) ^ ")"
| C.Const (uri,_) -> UriManager.name_of_uri uri
- | C.Abst uri -> UriManager.name_of_uri uri
| C.MutInd (uri,_,n) ->
(match CicEnvironment.get_obj uri with
C.InductiveDefinition (dl,_,_) ->
| C.LetIn (n,s,t) -> C.LetIn (n, unwind_aux m s, unwind_aux (m + 1) t)
| C.Appl l -> C.Appl (List.map (unwind_aux m) l)
| C.Const _ as t -> t
- | C.Abst _ as t -> t
| C.MutInd _ as t -> t
| C.MutConstruct _ as t -> t
| C.MutCase (sp,cookingsno,i,outt,t,pl) ->
| C.CurrentProof (_,_,body,_) -> reduce (0, [], body, s)
| C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
)
- | (k, e, (C.Abst _ as t), s) -> t (* s should be empty ????? *)
| (k, e, (C.MutInd (uri,_,_) as t),s) -> let t' = unwind k e t in
if s = [] then t' else C.Appl (t'::s)
| (k, e, (C.MutConstruct (uri,_,_,_) as t),s) ->
eat_first (num_to_eat,tl)
in
reduce (k, e, (List.nth pl (j-1)),(ts@s))
- | C.Abst _| C.Cast _ | C.Implicit ->
+ | C.Cast _ | C.Implicit ->
raise (Impossible 2) (* we don't trust our whd ;-) *)
| _ -> let t' = unwind k e t in
if s = [] then t' else C.Appl (t'::s)
| C.Appl [] -> raise (Impossible 1)
| C.Appl (he::tl) -> reduce (0, [], he, tl)
| C.Const _ as t -> reduce (0, [], t, [])
- | C.Abst _ as t -> t
| C.MutInd _ as t -> t
| C.MutConstruct _ as t -> t
| C.MutCase _ as t -> reduce (0, [], t, [])
| C.CurrentProof (_,_,body,_) -> whdaux l body
| C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition
)
- | C.Abst _ as t -> t (*CSC l should be empty ????? *)
| C.MutInd (uri,_,_) as t -> if l = [] then t else C.Appl (t::l)
| C.MutConstruct (uri,_,_,_) as t -> if l = [] then t else C.Appl (t::l)
| C.MutCase (mutind,cookingsno,i,_,term,pl) as t->
eat_first (num_to_eat,tl)
in
whdaux (ts@l) (List.nth pl (j-1))
- | C.Abst _| C.Cast _ | C.Implicit ->
+ | C.Cast _ | C.Implicit ->
raise (Impossible 2) (* we don't trust our whd ;-) *)
| _ -> if l = [] then t else C.Appl (t::l)
)
(fun (_,ty1,bo1) (_,ty2,bo2) b ->
b && aux context ty1 ty2 && aux (tys@context) bo1 bo2)
fl1 fl2 true
- | (C.Abst _, _) | (_, C.Abst _) | (C.Cast _, _) | (_, C.Cast _)
+ | (C.Cast _, _) | (_, C.Cast _)
| (C.Implicit, _) | (_, C.Implicit) ->
raise (Impossible 3) (* we don't trust our whd ;-) *)
| (_,_) -> false
| C.LetIn (n,s,t) -> C.LetIn (n, liftaux k s, liftaux (k+1) t)
| C.Appl l -> C.Appl (List.map (liftaux k) l)
| C.Const _ as t -> t
- | C.Abst _ as t -> t
| C.MutInd _ as t -> t
| C.MutConstruct _ as t -> t
| C.MutCase (sp,cookingsno,i,outty,t,pl) ->
end
| C.Appl _ -> assert false
| C.Const _ as t -> t
- | C.Abst _ as t -> t
| C.MutInd _ as t -> t
| C.MutConstruct _ as t -> t
| C.MutCase (sp,cookingsno,i,outt,t,pl) ->
| C.LetIn (n,s,t) -> C.LetIn (n, aux k s, aux (k + 1) t)
| C.Appl l -> C.Appl (List.map (aux k) l)
| C.Const _ as t -> t
- | C.Abst _ as t -> t
| C.MutInd _ as t -> t
| C.MutConstruct _ as t -> t
| C.MutCase (sp,cookingsno,i,outt,t,pl) ->
(* only to check that ty is well-typed *)
let _ = type_of ty in ()
| C.CurrentProof (_,conjs,te,ty) ->
+ (*CSC: bisogna controllare anche il metasenv!!! *)
let _ = type_of_aux' conjs [] ty in
if not (R.are_convertible [] (type_of_aux' conjs [] te) ty)
then
| C.Appl l ->
List.fold_right (fun x i -> i && does_not_occur context n nn x) l true
| C.Const _
- | C.Abst _
| C.MutInd _
| C.MutConstruct _ -> true
| C.MutCase (_,_,_,out,te,pl) ->
| C.Lambda _
| C.LetIn _ -> raise (Impossible 4) (* due to type-checking *)
| C.Appl _ -> []
- | C.Const _
- | C.Abst _ -> raise (Impossible 5)
+ | C.Const _ -> raise (Impossible 5)
| C.MutInd _
| C.MutConstruct _
| C.MutCase _
check_is_really_smaller_arg context n nn kl x safes he
| C.Appl [] -> raise (Impossible 11)
| C.Const _
- | C.Abst _
| C.MutInd _ -> raise (Impossible 12)
| C.MutConstruct _ -> false
| C.MutCase (uri,_,i,outtype,term,pl) ->
(fun t i -> i && guarded_by_destructors context n nn kl x safes t)
tl true
| C.Const _
- | C.Abst _
| C.MutInd _
| C.MutConstruct _ -> true
| C.MutCase (uri,_,i,outtype,term,pl) ->
guarded_by_constructors context n nn true te tl coInductiveTypeURI
| C.Appl _ ->
does_not_occur context n nn te
- | C.Const _
- | C.Abst _ -> raise (Impossible 26)
+ | C.Const _ -> raise (Impossible 26)
| C.MutInd (uri,_,_) when uri == coInductiveTypeURI ->
guarded_by_constructors context n nn true te [] coInductiveTypeURI
| C.MutInd _ ->
| C.Appl _ ->
List.fold_left
(fun i x -> i && does_not_occur context n nn x) true l
- | C.Const _
- | C.Abst _ -> raise (Impossible 31)
+ | C.Const _ -> raise (Impossible 31)
| C.MutInd _ ->
List.fold_left
(fun i x -> i && does_not_occur context n nn x) true l
| C.Appl l ->
List.fold_right (fun x i -> i && does_not_occur context n nn x) l true
| C.Const _ -> true
- | C.Abst _
| C.MutInd _ -> assert false
| C.MutConstruct _ -> true
| C.MutCase (_,_,_,out,te,pl) ->
else
C.Appl (outtype::arguments@(if need_dummy then [] else [term]))
| C.Prod (name,so,de) ->
- C.Prod (C.Anonimous,so,type_of_branch
- ((Some (name,(C.Decl so)))::context) argsno need_dummy
- (CicSubstitution.lift 1 outtype)
- (C.Appl [CicSubstitution.lift 1 term ; C.Rel 1]) de)
+ let term' =
+ match CicSubstitution.lift 1 term with
+ C.Appl l -> C.Appl (l@[C.Rel 1])
+ | t -> C.Appl [t ; C.Rel 1]
+ in
+ C.Prod (C.Anonimous,so,type_of_branch
+ ((Some (name,(C.Decl so)))::context) argsno need_dummy
+ (CicSubstitution.lift 1 outtype) term' de)
| _ -> raise (Impossible 20)
(* check_metasenv_consistency checks that the "canonical" context of a
let cty = cooked_type_of_constant uri cookingsno in
decr fdebug ;
cty
- | C.Abst _ -> raise (Impossible 22)
| C.MutInd (uri,cookingsno,i) ->
incr fdebug ;
let cty = cooked_type_of_mutual_inductive_defs uri cookingsno i in
(* only to check that ty is well-typed *)
let _ = type_of ty in ()
| C.CurrentProof (_,conjs,te,ty) ->
- (*CSC [] wrong *)
+ (*CSC: bisogna controllare anche il metasenv!!! *)
let _ = type_of_aux' conjs [] ty in
debug (type_of_aux' conjs [] te) [] ;
if not (R.are_convertible [] (type_of_aux' conjs [] te) ty) then
| C.LetIn (n,s,t) -> C.LetIn (n, deliftaux k s, deliftaux (k+1) t)
| C.Appl l -> C.Appl (List.map (deliftaux k) l)
| C.Const _ as t -> t
- | C.Abst _ as t -> t
| C.MutInd _ as t -> t
| C.MutConstruct _ as t -> t
| C.MutCase (sp,cookingsno,i,outty,t,pl) ->
fo_unif_l subst metasenv (lr1, lr2)
| (C.Const _, _)
| (_, C.Const _)
- | (C.Abst _, _)
- | (_, C.Abst _)
| (C.MutInd _, _)
| (_, C.MutInd _)
| (C.MutConstruct _, _)
List.fold_left
(function metasenv -> aux metasenv k) metasenv l
| C.Const _
- | C.Abst _
| C.MutInd _
| C.MutConstruct _ -> metasenv
| C.MutCase (_,_,_,outty,t,pl) ->
end
| C.Appl _ -> assert false
| C.Const _
- | C.Abst _
| C.MutInd _
| C.MutConstruct _ as t -> t,metasenv
| C.MutCase (sp,cookingsno,i,outty,t,pl) ->
end
| C.Appl _ -> assert false
| C.Const _ as t -> t
- | C.Abst _ as t -> t
| C.MutInd _ as t -> t
| C.MutConstruct _ as t -> t
| C.MutCase (sp,cookingsno,i,outty,t,pl) ->