Commit f0fbd3f7 by Raphaël Cauderlier

### Decide subtyping for generated coq terms.

parent 93984d51
 ... ... @@ -20,6 +20,20 @@ Defined. Inductive Istrue : bool -> Prop := | Istrue_true : Istrue true. Lemma Istrue_eq b : b = true -> Istrue b. Proof. intro e. rewrite e. exact Istrue_true. Defined. Lemma Istrue_eq_inv b : Istrue b -> b = true. Proof. intro e. inversion e. reflexivity. Defined. Definition isProp A := forall x y : A, x = y. Module String_dec. ... ... @@ -214,7 +228,7 @@ Section subtyping. Proof. decide equality. apply string_dec. Qed. Defined. (* Definition of the subtyping relation: A <: B if B is a subset of A. *) Fixpoint Subtype A B {struct B} : Type := ... ... @@ -253,6 +267,25 @@ Section subtyping. assumption. Defined. Fixpoint subtype_dec (A B : type) : bool. Proof. destruct B as [ | l B1 B2 ]. - exact true. - case_eq (mem l (domain A)). + intro H. apply Istrue_eq in H. apply mem_pos in H. case (type_dec (assoc A l H) B1); intro. * exact (subtype_dec A B2). * exact false. + intro; exact false. Defined. Definition subtype_dec_correct A B : Istrue (subtype_dec A B) -> A <: B. Proof. admit. Qed. Fixpoint domain_subtype {A} {B} : A <: B -> domain B ⊂ domain A. Proof. ... ... @@ -593,12 +626,10 @@ Definition lmeth_meth A (lm : Lmethod A) : Method A ((A ⊙ (lmeth_label A lm)) assumption. Defined. Definition pocons_3 A (lm : Lmethod A) (a : Expr A) : Expr A := Definition pocons_3 {A} (lm : Lmethod A) (a : Expr A) : Expr A := update (lmeth_label A lm) a (lmeth_H A lm) (lmeth_meth A lm). Notation "[ m1 ; .. ; mn ]" := (pocons_3 _ m1%meth (.. (pocons_3 _ mn%meth (init _ Istrue_true)) .. )) : object_scope. Notation "[ m1 ; .. ; mn ]" := (pocons_3 m1%meth (.. (pocons_3 mn%meth (init _ Istrue_true)) .. )) : object_scope. Notation "[[ l = 'ς' ( x ) m ; p ]]" := (pocons l (Make_meth (fun x => m)) p) (at level 50) : object_scope. ... ... @@ -613,10 +644,10 @@ Section examples. Definition init_bool A : Expr (BoolT A) := init (BoolT A) Istrue_true. Definition trueT A : Expr (BoolT A) := pocons_3 _ ("if" = ς(x !: BoolT A) (x # "then"))%meth (init_bool A). pocons_3 ("if" = ς(x !: BoolT A) (x # "then"))%meth (init_bool A). Definition falseT A : Expr (BoolT A) := pocons_3 _ ("if" = ς(x !: BoolT A) (x # "else"))%meth (init_bool A). pocons_3 ("if" = ς(x !: BoolT A) (x # "else"))%meth (init_bool A). Definition Ifthenelse A b (t e : Expr A) : Expr A := (((b##"then" ⇐ ς(x !: BoolT A) t)##"else" ⇐ ς(x !: BoolT A) e)#"if")%obj. ... ... @@ -629,7 +660,7 @@ Section examples. Definition init_arr A B := init (Arrow A B) Istrue_true. Definition Lambda A B (f : Expr A -> Expr B) : Expr (Arrow A B) := pocons_3 _ ("val" = ς(x !: Arrow A B) (f (x#"arg")))%meth (init_arr A B). pocons_3 ("val" = ς(x !: Arrow A B) (f (x#"arg")))%meth (init_arr A B). Definition App A B (f : Expr (Arrow A B)) (a : Expr A) : Expr B := ((f##"arg" ⇐ ς(x !: Arrow A B) a)#"val")%obj. ... ...
 ... ... @@ -22,7 +22,7 @@ let rec print_ty out_fmter = function and print_ty_elem out_fmter (l, ty) = Format.fprintf out_fmter "@[%a :@ %a@]" print_label l print_ty ty print_par_ty ty and print_ty_elems out_fmter = function | [] -> () | [ el ] -> print_ty_elem out_fmter el ... ... @@ -62,9 +62,9 @@ let rec print_term out_fmter : tterm -> unit = function print_term b print_term t print_par_term e | Tobj (ll, _) -> Format.fprintf out_fmter "[@[%a@]]" print_obj_elems ll | Tobj (ll, ty) -> Format.fprintf out_fmter "@[%a@]" (print_obj_elems ty) ll | Tsel (t, l, _) -> Format.fprintf out_fmter "@[%a#%a@]" print_par_term t ... ... @@ -75,26 +75,29 @@ let rec print_term out_fmter : tterm -> unit = function print_label l print_meth m | Tcast (t, ty1, ty2) -> Format.fprintf out_fmter "@[coerce@ %a@ %a@ eq_refl@ %a@]" print_par_ty ty1 Format.fprintf out_fmter "@[Ecoerce@ %a@ %a@ %a@ (subtype_dec_correct@ %a@ %a@ Istrue_true)@]" print_par_ty ty2 print_par_ty ty1 print_par_term t print_par_ty ty1 print_par_ty ty2 and print_par_term out_fmter = function | Tvar _ | Tconst _ | Tpar _ | Tobj _ as t -> print_term out_fmter t | t -> Format.fprintf out_fmter "(%a)" print_term t and print_obj_elem out_fmter (l, m) = Format.fprintf out_fmter "@[%a =@ %a@]" Format.fprintf out_fmter "(@[%a =@ %a@])%%meth" print_label l print_meth m and print_obj_elems out_fmter = function | [] -> () | [el] -> print_obj_elem out_fmter el and print_obj_elems ty out_fmter = function | [] -> Format.fprintf out_fmter "(init@ %a@ Istrue_true)" print_par_ty ty | el :: els -> Format.fprintf out_fmter "%a;@ %a" Format.fprintf out_fmter "(pocons_3@ %a@ %a)" print_obj_elem el print_obj_elems els (print_obj_elems ty) els and print_meth out_fmter (Tmeth (x, ty, body, _)) = Format.fprintf out_fmter "@[ς(%a !: %a)%a@]" print_id x ... ... @@ -107,15 +110,16 @@ let rec print_line out_fmter = function print_cid cid print_par_ty ty | Tvardef (id, ty, def) -> Format.fprintf out_fmter "@[Definition %a :@ Obj %a :=@ %a%%obj.@]@\n" Format.fprintf out_fmter "@[Definition %a :@ Expr %a :=@ %a%%obj.@]@\n" print_id id print_par_ty ty print_par_term def | Tcheck (t, ty) -> Format.fprintf out_fmter "@[Goal Obj %a@]. Format.fprintf out_fmter "@[Goal Expr %a@]. Proof. exact %a%%obj. Qed." Qed. " print_par_ty ty print_par_term t | Tconv (t1, t2, ty) -> ... ...
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!