diff options
Diffstat (limited to 'kernel')
| -rw-r--r-- | kernel/typeops.ml | 24 | ||||
| -rw-r--r-- | kernel/typeops.mli | 1 |
2 files changed, 25 insertions, 0 deletions
diff --git a/kernel/typeops.ml b/kernel/typeops.ml index 0d2d5cba50..0824c192cf 100644 --- a/kernel/typeops.ml +++ b/kernel/typeops.ml @@ -937,3 +937,27 @@ let type_fixpoint env sigma lna lar vdefj = (Array.map (fun j -> j.uj_type) vdefj) (Array.map body_of_type lar) with IllBranch i -> error_ill_typed_rec_body CCI env i lna vdefj lar + + +(* A function which checks that a term well typed verifies both + syntaxic conditions *) + +let control_only_guard env sigma = + let rec control_rec = function + | Rel(p) -> () + | VAR _ -> () + | DOP0(_) -> () + | DOPN(CoFix(_),cl) as cofix -> + check_cofix env sigma cofix; + Array.iter control_rec cl + | DOPN(Fix(_),cl) as fix -> + check_fix env sigma fix; + Array.iter control_rec cl + | DOPN(_,cl) -> Array.iter control_rec cl + | DOPL(_,cl) -> List.iter control_rec cl + | DOP1(_,c) -> control_rec c + | DOP2(_,c1,c2) -> control_rec c1; control_rec c2 + | DLAM(_,c) -> control_rec c + | DLAMV(_,v) -> Array.iter control_rec v + in + control_rec diff --git a/kernel/typeops.mli b/kernel/typeops.mli index 4f47bfd886..b935efd8c6 100644 --- a/kernel/typeops.mli +++ b/kernel/typeops.mli @@ -64,6 +64,7 @@ val apply_rel_list : val check_fix : env -> 'a evar_map -> constr -> unit val check_cofix : env -> 'a evar_map -> constr -> unit +val control_only_guard : env -> 'a evar_map -> constr -> unit val type_fixpoint : env -> 'a evar_map -> name list -> typed_type array -> unsafe_judgment array -> constraints |