diff options
| author | coqbot-app[bot] | 2021-04-23 14:48:49 +0000 |
|---|---|---|
| committer | GitHub | 2021-04-23 14:48:49 +0000 |
| commit | d332bbc3c1118631eb8c935ba61a8d071a90428e (patch) | |
| tree | b7b63655bdd186d7a9d11a0bf73268de5b186599 /pretyping | |
| parent | a0c3ebf4a6357a5140b98b4b40c71133c53d802e (diff) | |
| parent | 82910bed2fccee7d1f4814e3339fbae374980e68 (diff) | |
Merge PR #14041: Enable canonical fun _ => _ projections.
Reviewed-by: gares
Ack-by: Janno
Ack-by: CohenCyril
Ack-by: Zimmi48
Ack-by: jfehrle
Ack-by: SkySkimmer
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/evarconv.ml | 10 | ||||
| -rw-r--r-- | pretyping/structures.ml | 2 |
2 files changed, 12 insertions, 0 deletions
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml index 5eb8a88698..d6ba84d0bf 100644 --- a/pretyping/evarconv.ml +++ b/pretyping/evarconv.ml @@ -232,7 +232,17 @@ let occur_rigidly flags env evd (evk,_) t = let check_conv_record env sigma (t1,sk1) (t2,sk2) = let open ValuePattern in let (proji, u), arg = Termops.global_app_of_constr sigma t1 in + let t2, sk2' = decompose_app_vect sigma (shrink_eta env t2) in + let sk2 = Stack.append_app sk2' sk2 in let (sigma, solution), sk2_effective = + let t2 = + let rec remove_lambda t2 = + match EConstr.kind sigma t2 with + | Lambda (_,_,t2) -> remove_lambda t2 + | Cast (t2,_,_) -> remove_lambda t2 + | App (t2,_) -> t2 + | _ -> t2 in + if Stack.is_empty sk2 then remove_lambda t2 else t2 in try match EConstr.kind sigma t2 with Prod (_,a,b) -> (* assert (l2=[]); *) diff --git a/pretyping/structures.ml b/pretyping/structures.ml index 3ef6e98373..145663d3b9 100644 --- a/pretyping/structures.ml +++ b/pretyping/structures.ml @@ -161,6 +161,7 @@ let rec of_constr env t = let patt, n, args = of_constr env f in patt, n, args @ Array.to_list vargs | Rel n -> Default_cs, Some n, [] + | Lambda (_, _, b) -> let patt, _, _ = of_constr env b in patt, None, [] | Prod (_,a,b) when Vars.noccurn 1 b -> Prod_cs, None, [a; Vars.lift (-1) b] | Proj (p, c) -> Proj_cs (Names.Projection.repr p), None, [c] | Sort s -> Sort_cs (Sorts.family s), None, [] @@ -222,6 +223,7 @@ let compute_canonical_projections env ~warn (gref,ind) = let lpj = keep_true_projections lpj in let nenv = Termops.push_rels_assum sign env in List.fold_left2 (fun acc (spopt, canonical) t -> + let t = EConstr.Unsafe.to_constr (shrink_eta env (EConstr.of_constr t)) in if canonical then Option.cata (fun proji_sp -> |