(function t -> RS.compute_to_stack ~reduce ~unwind (k,e,ens,t,[])) tl
in
reduce (k, e, ens, he, (List.append tl') s)
- (* CSC: Old Dead Code
- | (k, e, ens, C.Appl ((C.Lambda _ as he)::tl), s)
- | (k, e, ens, C.Appl ((C.Const _ as he)::tl), s)
- | (k, e, ens, C.Appl ((C.MutCase _ as he)::tl), s)
- | (k, e, ens, C.Appl ((C.Fix _ as he)::tl), s) ->
- (* strict evaluation, but constants are NOT unfolded *)
- let red =
- function
- C.Const _ as t -> unwind k e ens t
- | t -> reduce (k,e,ens,t,[])
- in
- let tl' = List.map red tl in
- reduce (k, e, ens, he , List.append tl' s)
- | (k, e, ens, C.Appl l, s) ->
- C.Appl (List.append (List.map (unwind k e ens) l) s)
- *)
| (_, _, _, C.Const _, _) as config when delta=false-> config
| (k, e, ens, C.Const (uri,exp_named_subst), s) as config ->
(let o,_ =
(match recparam with
Some recparam ->
(match reduce recparam with
- (* match recparam with *)
(_,_,_,C.MutConstruct _,_) as config ->
- (* OLD
- let body' =
- let counter = ref (List.length fl) in
- List.fold_right
- (fun _ -> decr counter ; S.subst (C.Fix (!counter,fl)))
- fl
- body
- in
- reduce (k, e, ens, body', s) *)
- (* NEW *)
let leng = List.length fl in
let new_env =
let counter = ref 0 in
in
reduce
;;
- (*
- let rec whd context t =
- try
- reduce context (0, [], [], t, [])
- with Not_found ->
- debug_print (lazy (CicPp.ppterm t)) ;
- raise Not_found
- ;;
- *)
let whd ?(delta=true) ?(subst=[]) context t =
unwind (reduce ~delta ~subst context (0, [], [], t, []))
;;
-
end
;;
| (_,_) -> false,ugraph
end
in
- begin
- debug t1 [t2] "PREWHD";
- let t1' = whd ?delta:(Some true) ?subst:(Some subst) context t1 in
- let t2' = whd ?delta:(Some true) ?subst:(Some subst) context t2 in
- debug t1' [t2'] "POSTWHD";
- aux2 test_equality_only t1' t2' ugraph
- end
+ debug t1 [t2] "PREWHD";
+ let t1' = whd ?delta:(Some true) ?subst:(Some subst) context t1 in
+ let t2' = whd ?delta:(Some true) ?subst:(Some subst) context t2 in
+ debug t1' [t2'] "POSTWHD";
+ aux2 test_equality_only t1' t2' ugraph
in
aux false (*c t1 t2 ugraph *)
;;