diff options
| author | herbelin | 2000-04-20 15:51:40 +0000 |
|---|---|---|
| committer | herbelin | 2000-04-20 15:51:40 +0000 |
| commit | a002d6ef127b4f0103012c23fc5d272739649043 (patch) | |
| tree | 99c7ba136ce8488d2086290b3ff18fe91cdf6073 /pretyping | |
| parent | b8cd60cf1b3817a1802459310e79a8addb628ee7 (diff) | |
Abstraction du type typed_type (un pas vers les jugements 2 niveaux)
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@362 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/coercion.ml | 3 | ||||
| -rw-r--r-- | pretyping/evarconv.ml | 2 | ||||
| -rw-r--r-- | pretyping/pretyping.ml | 15 |
3 files changed, 10 insertions, 10 deletions
diff --git a/pretyping/coercion.ml b/pretyping/coercion.ml index 15945dd459..15577dd9e7 100644 --- a/pretyping/coercion.ml +++ b/pretyping/coercion.ml @@ -91,8 +91,7 @@ let inh_tosort env isevars j = let inh_ass_of_j env isevars j = let typ = whd_betadeltaiota env !isevars j.uj_type in match typ with - | DOP0(Sort s) -> - { body = j.uj_val; typ = s } + | DOP0(Sort s) -> make_typed j.uj_val s | _ -> let j1 = inh_tosort_force env isevars j in assumption_of_judgment env !isevars j1 diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml index 539a953a19..241e4ec053 100644 --- a/pretyping/evarconv.ml +++ b/pretyping/evarconv.ml @@ -22,7 +22,7 @@ let tjudge_of_cast_safe sigma env var = match under_casts (fun _ -> nf_ise1) env sigma var with | DOP2 (Cast, b, t) -> (match whd_betadeltaiota env sigma t with - | DOP0 (Sort s) -> {body=b; typ=s} + | DOP0 (Sort s) -> make_typed b s | _ -> anomaly "Not a type (tjudge_of_cast)") | c -> execute_rec_type env sigma c (* FIN TMP ***** *) diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index f7b1c51cc6..e9b74bd951 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -208,14 +208,14 @@ let evar_type_case isevars env ct pt lft p c = let pretype_var loc env id = try match lookup_id id (context env) with - | RELNAME (n,{body=typ;typ=s}) -> + | RELNAME (n,typ) -> { uj_val = Rel n; - uj_type = lift n typ; - uj_kind = DOP0 (Sort s) } - | GLOBNAME (id,{body=typ;typ=s}) -> + uj_type = lift n (body_of_type typ); + uj_kind = DOP0 (Sort (level_of_type typ)) } + | GLOBNAME (id,typ) -> { uj_val = VAR id; - uj_type = typ; - uj_kind = DOP0 (Sort s) } + uj_type = body_of_type typ; + uj_kind = DOP0 (Sort (level_of_type typ)) } with Not_found -> error_var_not_found_loc loc CCI id @@ -448,7 +448,8 @@ match cstr with (* Où teste-t-on que le résultat doit satisfaire tycon ? *) let tj = pretype def_vty_con env isevars t in let tj = inh_tosort_force env isevars tj in let cj = - pretype (mk_tycon2 vtcon (assumption_of_judgment env !isevars tj).body) + pretype + (mk_tycon2 vtcon (body_of_type (assumption_of_judgment env !isevars tj))) env isevars c in inh_cast_rel env isevars cj tj |