diff options
| author | herbelin | 2003-11-19 14:31:51 +0000 |
|---|---|---|
| committer | herbelin | 2003-11-19 14:31:51 +0000 |
| commit | cff24d313545efba6bd14116b83bd3fa0b7f44ff (patch) | |
| tree | a1c77555098c23f0a7271c0d668bad6aee20b97b /interp/constrextern.ml | |
| parent | 26f2ff64a641f1767abb1a0d3da3e7449a5835d3 (diff) | |
Distinction entre 'as _' qui cache le terme filtre (si variable) et rien dans case_item
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@4949 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'interp/constrextern.ml')
| -rw-r--r-- | interp/constrextern.ml | 13 |
1 files changed, 10 insertions, 3 deletions
diff --git a/interp/constrextern.ml b/interp/constrextern.ml index 338f4092a2..90034e4971 100644 --- a/interp/constrextern.ml +++ b/interp/constrextern.ml @@ -1093,20 +1093,27 @@ let rec extern inctx scopes vars r = | RCases (loc,(typopt,rtntypopt),tml,eqns) -> let pred = option_app (extern_type scopes vars) typopt in - let rtntypopt = option_app (extern_type scopes vars) !rtntypopt in let vars' = List.fold_right (name_fold Idset.add) (cases_predicate_names tml) vars in + let rtntypopt' = option_app (extern_type scopes vars') !rtntypopt in let tml = List.map (fun (tm,{contents=(na,x)}) -> + let na' = match na,tm with + Anonymous, RVar (_,id) when + !rtntypopt<>None & occur_rawconstr id (out_some !rtntypopt) + -> Some Anonymous + | Anonymous, _ -> None + | Name id, RVar (_,id') when id=id' -> None + | Name _, _ -> Some na in (sub_extern false scopes vars tm, - (na,option_app (fun (loc,ind,nal) -> + (na',option_app (fun (loc,ind,nal) -> let args = List.map (function | Anonymous -> RHole (dummy_loc,InternalHole) | Name id -> RVar (dummy_loc,id)) nal in let t = RApp (dummy_loc,RRef (dummy_loc,IndRef ind),args) in (extern_type scopes vars t)) x))) tml in let eqns = List.map (extern_eqn (typopt<>None) scopes vars) eqns in - CCases (loc,(pred,rtntypopt),tml,eqns) + CCases (loc,(pred,rtntypopt'),tml,eqns) | ROrderedCase (loc,cs,typopt,tm,bv,{contents = Some x}) -> extern false scopes vars x |