diff options
| author |  herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2000-03-08 21:39:21 +0000 |
|---|---|---|
| committer | herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2000-03-08 21:39:21 +0000 |
| commit | 7048ebe10b665a973951ed6e559b0ce5d3b1d779 (patch) | |
| tree | c7a0879665de13a4e42aff49a787d12b0102ea8c /pretyping | |
| parent | 707c8a91f5e443d02f3f8d7ac318e2d7b1720d5a (diff) | |
La partie 'val' de trad_constraints devient un typed_type
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@306 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/evarutil.ml | 13 | ||||
| -rw-r--r-- | pretyping/evarutil.mli | 2 | ||||
| -rw-r--r-- | pretyping/pretyping.ml | 2 |
3 files changed, 11 insertions, 6 deletions
diff --git a/pretyping/evarutil.ml b/pretyping/evarutil.ml index 0b7388a17..38edd1e32 100644 --- a/pretyping/evarutil.ml +++ b/pretyping/evarutil.ml @@ -80,7 +80,7 @@ let split_evar_to_arrow sigma c = let dsp = num_of_evar (body_of_type dom) in let rsp = num_of_evar (body_of_type rng) in (sigma3, - mkCast (mkEvar dsp args) dummy_sort, + make_typed (mkEvar dsp args) (Type dummy_univ), mkCast (mkEvar rsp (array_cons (mkRel 1) args)) dummy_sort) @@ -376,7 +376,7 @@ let status_changed lev (pbty,t1,t2) = (* Operations on value/type constraints used in trad and progmach *) -type trad_constraint = bool * (constr option * constr option) +type trad_constraint = bool * (typed_type option * constr option) (* Basically, we have the following kind of constraints (in increasing * strength order): @@ -412,7 +412,12 @@ let prod_dom_tycon_unif env isevars = function | None -> None | Some c -> (match whd_betadeltaiota env !isevars c with - | DOP2(Prod,c1,_) -> Some c1 + | DOP2(Prod,c1,_) -> + let t = + match c1 with + | DOP2 (Cast,cc1,DOP0 (Sort s)) -> make_typed cc1 s + | _ -> make_typed c1 (Retyping.get_sort_of env !isevars c1) + in Some t | t -> if (ise_undefined isevars t) then begin let (sigma,dom,_) = split_evar_to_arrow !isevars t in @@ -425,7 +430,7 @@ let prod_dom_tycon_unif env isevars = function * first argument. *) let app_dom_tycon env isevars (_,(_,tyc)) = - (false,(None, prod_dom_tycon_unif env isevars tyc)) + (false,(None, option_app incast_type (prod_dom_tycon_unif env isevars tyc))) (* Given a constraint on a term, returns the constraint corresponding to this diff --git a/pretyping/evarutil.mli b/pretyping/evarutil.mli index fa48418b3..03982044e 100644 --- a/pretyping/evarutil.mli +++ b/pretyping/evarutil.mli @@ -50,7 +50,7 @@ val status_changed : int list -> conv_pb * constr * constr -> bool (* Value/Type constraints *) -type trad_constraint = bool * (constr option * constr option) +type trad_constraint = bool * (typed_type option * constr option) val empty_tycon : trad_constraint val def_vty_con : trad_constraint diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index b7fdfbc00..2ccb6c94b 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -295,7 +295,7 @@ match cstr with (* Où teste-t-on que le résultat doit satisfaire tycon ? *) if !compter then nbimpl:=!nbimpl+1; (match vtcon with (true,(Some v, _)) -> - let (valc,typc) = destCast v in + let (valc,typc) = (body_of_type v,mkSort (level_of_type v)) in {uj_val=valc; uj_type=typc; uj_kind=dummy_sort} | (false,(None,Some ty)) -> let (c,ty) = new_isevar isevars env ty CCI in |