| e -> raise e
;;
-let exp_implicit metasenv context expty =
+let exp_implicit ~localise metasenv context expty t =
let foo x = match expty with Some t -> `WithType t | None -> x in
function
| `Closed -> NCicMetaSubst.mk_meta metasenv [] (foo `Term)
| `Type -> NCicMetaSubst.mk_meta metasenv context (foo `Type)
| `Term -> NCicMetaSubst.mk_meta metasenv context (foo `Term)
+ | `Vector ->
+ raise (RefineFailure (lazy (localise t, "A vector of implicit terms " ^
+ "can only be used in argument position")))
| _ -> assert false
;;
-
let check_allowed_sort_elimination rdb localise r orig =
let mkapp he arg =
match he with
NCicPp.ppterm ~subst ~metasenv ~context t)))
| C.Sort _ -> metasenv,subst,t,(C.Sort (C.Type NCicEnvironment.type0))
| C.Implicit infos ->
- let metasenv,_,t,ty = exp_implicit metasenv context expty infos in
- metasenv, subst, t, ty
+ let metasenv,_,t,ty =
+ exp_implicit ~localise metasenv context expty t infos
+ in
+ metasenv, subst, t, ty
| C.Meta (n,l) as t ->
let ty =
try
let bo_ty = NCicSubstitution.subst ~avoid_beta_redexes:true t bo_ty in
metasenv, subst, C.LetIn (n, ty, t, bo), bo_ty
| C.Appl ((he as orig_he)::(_::_ as args)) ->
- let upto =
- match orig_he with C.Meta _ -> List.length args | _ -> 0
- in
+ let upto = match orig_he with C.Meta _ -> List.length args | _ -> 0 in
let metasenv, subst, he, ty_he =
typeof_aux metasenv subst context None he in
let metasenv, subst, t, ty =
- eat_prods rdb ~localise
- metasenv subst context orig_he he ty_he args
- in
+ eat_prods rdb ~localise metasenv subst context orig_he he ty_he args in
let t = if upto > 0 then NCicReduction.head_beta_reduce ~upto t else t in
metasenv, subst, t, ty
| C.Appl _ -> raise (AssertFailure (lazy "Appl of length < 2"))
with NCicUtils.Subst_not_found _ -> aux 'M')
| _ -> aux 'H'
-and eat_prods rdb
- ~localise metasenv subst context orig_he he ty_he args
-=
+and eat_prods rdb ~localise metasenv subst context orig_he he ty_he args =
(*D*)inside 'E'; try let rc =
let rec aux metasenv subst args_so_far he ty_he = function
- | []->metasenv, subst, NCicUntrusted.mk_appl he (List.rev args_so_far), ty_he
+ | [] ->metasenv, subst, NCicUntrusted.mk_appl he (List.rev args_so_far), ty_he
+ | NCic.Implicit `Vector::tl -> assert false
| arg::tl ->
match NCicReduction.whd ~subst context ty_he with
| C.Prod (_,s,t) ->
match bo with
| Some bo ->
let metasenv, subst, bo, ty =
- typeof rdb ~localise metasenv subst [] bo (Some ty)
- in
+ typeof rdb ~localise metasenv subst [] bo (Some ty) in
let height = (* XXX recalculate *) height in
metasenv, subst, Some bo, ty, height
| None -> metasenv, subst, None, ty, 0
List.fold_left
(fun (types, metasenv, subst, fl) (relevance,name,k,ty,bo) ->
let metasenv, subst, ty, _ = check_type metasenv subst [] ty in
- let dbo = NCicTypeChecker.debruijn uri len [] bo in
+ let dbo = NCicTypeChecker.debruijn uri len [] ~subst bo in
let localise = relocalise localise dbo bo in
(name,C.Decl ty)::types,
metasenv, subst, (relevance,name,k,ty,dbo,localise)::fl
let k_relev =
try snd (HExtlib.split_nth leftno k_relev)
with Failure _ -> k_relev in
- let te = NCicTypeChecker.debruijn uri len [] te in
+ let te = NCicTypeChecker.debruijn uri len [] ~subst te in
let metasenv, subst, te, _ = check_type metasenv subst tys te in
let context,te = NCicReduction.split_prods ~subst tys leftno te in
let _,chopped_context_rev =
raise
(RefineFailure
(lazy (localise te,
- "Non positive occurence in " ^ NUri.string_of_uri uri)))
+ "Non positive occurence in " ^
+ NCicPp.ppterm ~metasenv ~subst ~context te)))
else
let relsno = List.length itl + leftno in
let te =
uri, height, metasenv, subst, C.Inductive (ind, leftno, itl, attr)
;;
+NCicUnification.set_refiner_typeof typeof;;
+
(* vim:set foldmethod=marker: *)