let module S = CicSubstitution in
function
C.Rel _ as t -> t
- | C.Var _ as t -> t
+ | C.Var (uri,exp_named_subst) ->
+ let exp_named_subst' =
+ List.map (fun (uri, t) -> (uri, um_aux t)) exp_named_subst
+ in
+ C.Var (uri, exp_named_subst')
| C.Meta (i, l) ->
(try
let t = List.assoc i subst in
;;
let apply_subst =
+(* CSC: old code that never performs beta reduction
let appl_fun um_aux he tl =
let tl' = List.map um_aux tl in
begin
end
in
apply_subst_gen ~appl_fun
-;;
-
-(* apply_subst_reducing subst (Some (mtr,reductions_no)) t *)
-(* performs as (apply_subst subst t) until it finds an application of *)
-(* (META [meta_to_reduce]) that, once unwinding is performed, creates *)
-(* a new beta-redex; in this case up to [reductions_no] consecutive *)
-(* beta-reductions are performed. *)
-(* Hint: this function is usually called when [reductions_no] *)
-(* eta-expansions have been performed and the head of the new *)
-(* application has been unified with (META [meta_to_reduce]): *)
-(* during the unwinding the eta-expansions are undone. *)
-
-let apply_subst_reducing meta_to_reduce =
+*)
let appl_fun um_aux he tl =
let tl' = List.map um_aux tl in
let t' =
| he' -> Cic.Appl (he'::tl')
in
begin
- match meta_to_reduce, he with
- Some (mtr,reductions_no), Cic.Meta (m,_) when m = mtr ->
+ match he with
+ Cic.Meta (m,_) ->
let rec beta_reduce =
function
- (n,(Cic.Appl (Cic.Lambda (_,_,t)::he'::tl'))) when n > 0 ->
+ (Cic.Appl (Cic.Lambda (_,_,t)::he'::tl')) ->
let he'' = CicSubstitution.subst he' t in
if tl' = [] then
he''
else
- beta_reduce (n-1,Cic.Appl(he''::tl'))
- | (_,t) -> t
+ beta_reduce (Cic.Appl(he''::tl'))
+ | t -> t
in
- beta_reduce (reductions_no,t')
- | _,_ -> t'
+ beta_reduce t'
+ | _ -> t'
end
in
apply_subst_gen ~appl_fun
+;;
let rec apply_subst_context subst context =
List.fold_right
(*CSC: deliftato la regola per il LetIn *)
(*CSC: FALSO! La regola per il LetIn non lo fa *)
else
- (match List.nth context (m-k-1) with
- Some (_,C.Def (t,_)) ->
- (*CSC: Hmmm. This bit of reduction is not in the spirit of *)
- (*CSC: first order unification. Does it help or does it harm? *)
- deliftaux k (S.lift m t)
- | Some (_,C.Decl t) ->
- C.Rel ((position (m-k) l) + k)
- | None -> raise (MetaSubstFailure "RelToHiddenHypothesis"))
+ (try
+ match List.nth context (m-k-1) with
+ Some (_,C.Def (t,_)) ->
+ (*CSC: Hmmm. This bit of reduction is not in the spirit of *)
+ (*CSC: first order unification. Does it help or does it harm? *)
+ deliftaux k (S.lift m t)
+ | Some (_,C.Decl t) ->
+ C.Rel ((position (m-k) l) + k)
+ | None -> raise (MetaSubstFailure "RelToHiddenHypothesis")
+ with
+ Failure _ ->
+ raise (MetaSubstFailure "Unbound variable found in deliftaux")
+ )
| C.Var (uri,exp_named_subst) ->
let exp_named_subst' =
List.map (function (uri,t) -> uri,deliftaux k t) exp_named_subst
(* order (in the sense of alpha-conversion). See comment above *)
(* related to the delift function. *)
debug_print "\n!!!!!!!!!!! First Order UnificationFailure, but maybe it could have been successful even in a first order setting (no conversion, only alpha convertibility)! Please, implement a better delift function !!!!!!!!!!!!!!!!" ;
-print_string "\nCicMetaSubst: UNCERTAIN" ;
raise (Uncertain (sprintf
"Error trying to abstract %s over [%s]: the algorithm only tried to abstract over bound variables"
(ppterm subst t)