List.nth itl indtyp_no
with _ -> assert false in
let rec count_prod t =
- match NCicReduction.whd [] t with
+ match NCicReduction.whd ~subst:[] [] t with
NCic.Prod (_, _, t) -> 1 + (count_prod t)
| _ -> 0
in
aux
;;
- let whd ?(delta=0) ?(subst=[]) context t =
+ let whd ?(delta=0) ~subst context t =
unwind (fst (reduce ~delta ~subst context (0, [], t, [])))
;;
(* $Id$ *)
val whd :
- ?delta:int -> ?subst:NCic.substitution ->
+ ?delta:int -> subst:NCic.substitution ->
NCic.context -> NCic.term ->
NCic.term
(fun k x ->
if k = 0 then 0
else
- match R.whd context x with
+ match R.whd ~subst context x with
| C.Rel m when m = n - (indparamsno - k) -> k - 1
| _ -> raise (TypeCheckerFailure (lazy
("Argument "^string_of_int (indparamsno - k + 1) ^ " (of " ^
are skipped because we already know that are_all_occurrences_positive
of uri in te. *)
let rec aux context n nn te =
- match R.whd context te with
+ match R.whd ~subst context te with
| t when t = dummy -> true
| C.Appl (te::rargs) when te = dummy ->
List.for_all (does_not_occur ~subst context n nn) rargs
aux context n nn (subst_inductive_type_with_dummy () te)
and strictly_positive ~subst context n nn indparamsno posuri te =
- match R.whd context te with
+ match R.whd ~subst context te with
| t when does_not_occur ~subst context n nn t -> true
| C.Rel _ when indparamsno = 0 -> true
| C.Appl ((C.Rel m)::tl) as reduct when m > n && m <= nn ->
(* the inductive type indexes are s.t. n < x <= nn *)
and are_all_occurrences_positive ~subst context uri indparamsno i n nn te =
- match R.whd context te with
+ match R.whd ~subst context te with
| C.Appl ((C.Rel m)::tl) as reduct when m = i ->
check_homogeneous_call ~subst context indparamsno n uri reduct tl;
List.for_all (does_not_occur ~subst context n nn) tl
and is_non_informative ~metasenv ~subst paramsno c =
let rec aux context c =
- match R.whd context c with
+ match R.whd ~subst context c with
| C.Prod (n,so,de) ->
let s = typeof ~metasenv ~subst context so in
s = C.Sort C.Prop && aux ((n,(C.Decl so))::context) de
aux context 0 nn false t
and recursive_args ~subst ~metasenv context n nn te =
- match R.whd context te with
+ match R.whd ~subst context te with
| C.Rel _ | C.Appl _ | C.Const _ -> []
| C.Prod (name,so,de) ->
(not (does_not_occur ~subst context n nn so)) ::
let arity = match tgt with | CoercDb.Fun i -> i | _ -> 0 in
let src, tgt =
let cty = NCicTypeChecker.typeof ~subst:[] ~metasenv:[] [] c in
- match NCicMetaSubst.saturate ~delta:max_int [] [] cty (arity+1)
+ match
+ NCicMetaSubst.saturate ~delta:max_int [] [] [] cty (arity+1)
with
| NCic.Prod (_, src, tgt),_,_ ->
src, NCicSubstitution.subst (NCic.Meta (-1,(0,NCic.Irl 0))) tgt
(DB.empty,DB.empty) (CoercDb.to_list ())
;;
-(* XXX saturate takes no subst!!!! *)
-let look_for_coercion (db_src,db_tgt) metasenv _subst context infty expty =
+let look_for_coercion (db_src,db_tgt) metasenv subst context infty expty =
let set_src = DB.retrieve_unifiables db_src infty in
let set_tgt = DB.retrieve_unifiables db_tgt expty in
let candidates = CoercionSet.inter set_src set_tgt in
(fun (t,arity,arg) ->
let ty = NCicTypeChecker.typeof ~metasenv:[] ~subst:[] [] t in
let ty, metasenv, args =
- NCicMetaSubst.saturate ~delta:max_int metasenv context ty arity
+ NCicMetaSubst.saturate ~delta:max_int metasenv subst context ty arity
in
prerr_endline (
NCicPp.ppterm ~metasenv ~subst:[] ~context:[] ty ^ " --- " ^
- NCicPp.ppterm ~metasenv ~subst:_subst ~context
+ NCicPp.ppterm ~metasenv ~subst ~context
(NCicUntrusted.mk_appl t args) ^ " --- " ^
string_of_int (List.length args) ^ " == " ^ string_of_int arg);
metasenv, NCicUntrusted.mk_appl t args, ty, List.nth args arg)
mk_meta name (newmeta ()) metasenv context ty
;;
-let saturate ?(delta=0) metasenv context ty goal_arity =
+let saturate ?(delta=0) metasenv subst context ty goal_arity =
assert (goal_arity >= 0);
let rec aux metasenv = function
| NCic.Prod (name,s,t) ->
else
t, metasenv1, arg::args, pno+1
| ty ->
- match NCicReduction.whd context ty ~delta with
+ match NCicReduction.whd ~subst context ty ~delta with
| NCic.Prod _ as ty -> aux metasenv ty
| ty -> ty, metasenv, [], 0
in
(* returns the resulting type, the metasenv and the arguments *)
val saturate:
- ?delta:int -> NCic.metasenv -> NCic.context -> NCic.term -> int ->
+ ?delta:int -> NCic.metasenv -> NCic.substitution ->
+ NCic.context -> NCic.term -> int ->
NCic.term * NCic.metasenv * NCic.term list
let _, _, arity, cl = List.nth itl tyno in
let constructorsno = List.length cl in
let _, metasenv, args =
- NCicMetaSubst.saturate metasenv context arity 0 in
+ NCicMetaSubst.saturate metasenv subst context arity 0 in
let ind = if args = [] then C.Const r else C.Appl (C.Const r::args) in
let metasenv, subst, term, _ =
typeof_aux metasenv subst context (Some ind) term in