From 3c17c53d6628c1863a33ab071266a0f5614bbce1 Mon Sep 17 00:00:00 2001 From: Claudio Sacerdoti Coen Date: Fri, 31 Jul 2009 09:03:22 +0000 Subject: [PATCH] Record projections are now defined as fixpoints in order to block delta-expansion when the argument is not a constructor. --- .../components/ng_tactics/nCicElim.ml | 14 +++++++------ helm/software/matita/nlibrary/sets/setoids.ma | 21 +++++-------------- 2 files changed, 13 insertions(+), 22 deletions(-) diff --git a/helm/software/components/ng_tactics/nCicElim.ml b/helm/software/components/ng_tactics/nCicElim.ml index 0abff3a6c..79a22b077 100644 --- a/helm/software/components/ng_tactics/nCicElim.ml +++ b/helm/software/components/ng_tactics/nCicElim.ml @@ -265,16 +265,18 @@ let mk_projection leftno tyname consname consty (projname,_,_) i = @ names in let outtype = pp rels outtype in let outtype= CicNotationPt.Binder (`Lambda, (arg, Some arg_ty), outtype) in - CicNotationPt.Binder - (`Lambda, (arg,Some arg_ty), - CicNotationPt.Case (arg,None,Some outtype,[branch])) + [arg, Some arg_ty], CicNotationPt.Case (arg,None,Some outtype,[branch]) | _,NCic.Prod (name,_,t) -> let name = mk_id name in - CicNotationPt.Binder - (`Lambda, (name,None), aux (name::names) t (leftno - 1)) + let params,body = aux (name::names) t (leftno - 1) in + (name,None)::params, body | _,_ -> assert false in - let res = aux [] consty leftno in + let params,bo = aux [] consty leftno in + let pprojname = mk_id projname in + let res = + CicNotationPt.LetRec (`Inductive, + [params, (pprojname,None), bo, leftno], pprojname) in (* prerr_endline (BoxPp.render_to_string ~map_unicode_to_tex:false diff --git a/helm/software/matita/nlibrary/sets/setoids.ma b/helm/software/matita/nlibrary/sets/setoids.ma index 0f192e5f8..1a2ff0978 100644 --- a/helm/software/matita/nlibrary/sets/setoids.ma +++ b/helm/software/matita/nlibrary/sets/setoids.ma @@ -42,22 +42,11 @@ ndefinition function_space_setoid: setoid → setoid → setoid. #A; #B; napply mk_setoid; ##[ napply (function_space A B); ##| #f; #f1; napply (∀a:A. proofs (eq … (f a) (f1 a))); -##| nwhd; #x; #a; - napply (f_ok … x); (* QUI!! *) -(* unfold carr; unfold proofs; simplify; - apply (refl A) - | simplify; - intros; - unfold carr; unfold proofs; simplify; - apply (sym B); - apply (f a) - | simplify; - intros; - unfold carr; unfold proofs; simplify; - apply (trans B ? (y a)); - [ apply (f a) - | apply (f1 a)]] -qed. +##| nnormalize; #x; #a; napply (f_ok … x); napply refl + | nnormalize; #x; #y; #H; #a; napply sym; napply H + | nnormalize; #z; #x; #y; #H1; #H2; #a; + napply trans; ##[##2: napply H1 | ##skip | napply H2]##] +nqed. nrecord isomorphism (A,B: setoid): Type ≝ { map1:> function_space_setoid A B; -- 2.39.2