diff options
| author | herbelin | 2007-06-30 11:01:05 +0000 |
|---|---|---|
| committer | herbelin | 2007-06-30 11:01:05 +0000 |
| commit | 908223f97c27ed33ddd867dfb12a63b294b399ad (patch) | |
| tree | f3c08215aeeb7052af67d9a93d533e35698ba3a3 /pretyping | |
| parent | 5e31b6b1e7678ba6b56c379dbc306db89b57b70f (diff) | |
Factorisation des types dans l'affichage des paramètres des (Co)Inductif/Record
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@9918 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/detyping.ml | 16 | ||||
| -rw-r--r-- | pretyping/detyping.mli | 4 |
2 files changed, 19 insertions, 1 deletions
diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml index a67de715a8..d859c79800 100644 --- a/pretyping/detyping.ml +++ b/pretyping/detyping.ml @@ -533,6 +533,22 @@ and detype_binder isgoal bk avoid env na ty c = | BLambda -> RLambda (dl, na',detype isgoal avoid env ty, r) | BLetIn -> RLetIn (dl, na',detype isgoal avoid env ty, r) +let rec detype_rel_context where avoid env = + let rec aux avoid env sign = function + | [] -> sign + | (na,b,t)::rest -> + let na',avoid' = + match where with + | None -> na,avoid + | Some c -> + let c = it_mkLambda_or_LetIn c rest in + if b<>None then concrete_let_name None avoid env na c + else concrete_name None avoid env na c in + let b = option_map (detype false avoid env) b in + let t = detype false avoid env t in + aux avoid' (add_name na' env) ((na',b,t)::sign) rest + in aux avoid env [] + (**********************************************************************) (* Module substitution: relies on detyping *) diff --git a/pretyping/detyping.mli b/pretyping/detyping.mli index 0e9166ac4c..445c2183df 100644 --- a/pretyping/detyping.mli +++ b/pretyping/detyping.mli @@ -40,6 +40,9 @@ val detype_case : val detype_sort : sorts -> rawsort +val detype_rel_context : constr option -> identifier list -> names_context -> + rel_context -> (name * rawconstr option * rawconstr) list + (* look for the index of a named var or a nondep var as it is renamed *) val lookup_name_as_renamed : env -> constr -> identifier -> int option val lookup_index_as_renamed : env -> constr -> int -> int option @@ -57,4 +60,3 @@ val simple_cases_matrix_of_branches : inductive -> int list -> rawconstr list -> cases_clauses val return_type_of_predicate : inductive -> int -> int -> rawconstr -> predicate_pattern * rawconstr option - |