diff options
| author |  Pierre Letouzey <pierre.letouzey@inria.fr> | 2017-07-21 12:02:36 +0200 |
|---|---|---|
| committer | Pierre Letouzey <pierre.letouzey@inria.fr> | 2017-07-26 19:23:47 +0200 |
| commit | b0e52bbbc52691343b3fab927b20c1f512f59976 (patch) | |
| tree | bb6685c2394ad333cbc1d87d893125d70063c9a7 | |
| parent | bd1a0abf49fe67e7f02dc562d4b81d27ed6f606c (diff) | |
Extraction: reduce primitive projections in types (fix bug 4709)
| -rw-r--r-- | API/API.mli | 2 | ||||
| -rw-r--r-- | plugins/extraction/extraction.ml | 6 |
2 files changed, 7 insertions, 1 deletions
diff --git a/API/API.mli b/API/API.mli index bb24d5768..d136deb70 100644 --- a/API/API.mli +++ b/API/API.mli @@ -169,6 +169,8 @@ sig val map : (Constant.t -> Constant.t) -> t -> t val constant : t -> Constant.t val equal : t -> t -> bool + val unfolded : t -> bool + val unfold : t -> t end type evaluable_global_reference = diff --git a/plugins/extraction/extraction.ml b/plugins/extraction/extraction.ml index 3661faada..996df1a47 100644 --- a/plugins/extraction/extraction.ml +++ b/plugins/extraction/extraction.ml @@ -295,7 +295,11 @@ let rec extract_type env db j c args = | Ind ((kn,i),u) -> let s = (extract_ind env kn).ind_packets.(i).ip_sign in extract_type_app env db (IndRef (kn,i),s) args - | Case _ | Fix _ | CoFix _ | Proj _ -> Tunknown + | Proj (p,t) -> + (* Let's try to reduce, if it hasn't already been done. *) + if Projection.unfolded p then Tunknown + else extract_type env db j (Term.mkProj (Projection.unfold p, t)) args + | Case _ | Fix _ | CoFix _ -> Tunknown | _ -> assert false (*s Auxiliary function dealing with type application. |