coq typing relation: add DescendImplicit rule in addition to Descend rule for explicit type-downcasts

add one more typing example
This commit is contained in:
Michael Sippel 2024-09-08 15:33:54 +02:00
parent 4b3358372e
commit 10ca08c5a0
Signed by: senvas
GPG key ID: F96CF119C34B64A6

View file

@ -64,11 +64,16 @@ Inductive expr_type : context -> expr_term -> type_term -> Prop :=
(τ' :<= τ) -> (τ' :<= τ) ->
(Γ |- (expr_ascend τ' e) \is τ') (Γ |- (expr_ascend τ' e) \is τ')
| T_Descend : forall Γ x τ τ', | T_DescendImplicit : forall Γ x τ τ',
Γ |- x \is τ -> Γ |- x \is τ ->
(τ :<= τ') -> (τ :<= τ') ->
Γ |- x \is τ' Γ |- x \is τ'
| T_Descend : forall Γ x τ τ',
Γ |- x \is τ ->
(τ :<= τ') ->
Γ |- (expr_descend τ' x) \is τ'
where "Γ '|-' x '\is' τ" := (expr_type Γ x τ). where "Γ '|-' x '\is' τ" := (expr_type Γ x τ).
Definition is_well_typed (e:expr_term) : Prop := Definition is_well_typed (e:expr_term) : Prop :=
@ -92,7 +97,7 @@ Example typing2 :
ctx_empty |- [{ Λ"T" λ "x" %"T"% %"x"% }] \is [< "U", %"U"% -> %"U"% >]. ctx_empty |- [{ Λ"T" λ "x" %"T"% %"x"% }] \is [< "U", %"U"% -> %"U"% >].
Proof. Proof.
intros. intros.
apply T_Descend with (τ:=[< "T",(%"T"% -> %"T"%) >]). apply T_DescendImplicit with (τ:=[< "T",(%"T"% -> %"T"%) >]).
apply T_TypeAbs. apply T_TypeAbs.
apply T_Abs. apply T_Abs.
apply T_Var. apply T_Var.
@ -114,7 +119,7 @@ Example typing3 :
>]. >].
Proof. Proof.
intros. intros.
apply T_Descend with (τ:=[< "T","U",(%"T"%->%"U"%->%"U"%) >]) (τ':=[< "S","T",(%"S"%->%"T"%->%"T"%) >]). apply T_DescendImplicit with (τ:=[< "T","U",(%"T"%->%"U"%->%"U"%) >]) (τ':=[< "S","T",(%"S"%->%"T"%->%"T"%) >]).
apply T_TypeAbs, T_TypeAbs, T_Abs. apply T_TypeAbs, T_TypeAbs, T_Abs.
apply T_Abs. apply T_Abs.
apply T_Var. apply T_Var.
@ -153,9 +158,59 @@ Proof.
apply T_TypeAbs. apply T_TypeAbs.
apply T_Abs. apply T_Abs.
apply T_Abs. apply T_Abs.
apply C_shuffle. apply C_take. apply T_Var.
apply C_shuffle, C_take.
Qed.
Open Scope ladder_expr_scope.
Example typing5 : (is_well_typed
[{
let "deg2turns" :=
(λ"x" $"Angle"$~$"Degrees"$~$""$
morph (((%"/"% %"x"%) %"360"%) as $"Angle"$~$"Turns"$~$""$))
in ( %"deg2turns"% (%"60"% as $"Angle"$~$"Degrees"$~$""$) )
}]
).
Proof.
unfold is_well_typed.
exists (ctx_assign "60" [< $""$ >]
(ctx_assign "360" [< $""$ >]
(ctx_assign "/" [< $""$ -> $""$ -> $""$ >]
ctx_empty))).
exists [< $"Angle"$~$"Turns"$~$""$ >].
apply T_Let with (σ:=[< $"Angle"$~$"Degrees"$~$""$ ->morph $"Angle"$~$"Turns"$~$""$ >]).
apply T_MorphAbs.
apply T_Ascend with (τ:=[< $""$ >]).
apply T_App with (σ := [< $""$ >]) (σ' := [< $""$ >]).
apply T_App with (σ := [< $""$ >]) (σ' := [< $""$ >]).
apply T_Var.
apply C_shuffle. apply C_shuffle. apply C_shuffle. apply C_take.
apply T_DescendImplicit with (τ := [< $"Angle"$~$"Degrees"$~$""$ >]).
apply T_Var. apply T_Var.
apply C_take. apply C_take.
apply TSubRepr_Ladder. apply TSubRepr_Ladder.
apply TSubRepr_Refl. apply TEq_Refl.
apply M_Sub.
apply TSubRepr_Refl. apply TEq_Refl.
apply T_Var.
apply C_shuffle, C_shuffle, C_take.
apply M_Sub.
apply TSubRepr_Refl.
apply TEq_Refl.
apply TSubRepr_Ladder, TSubRepr_Ladder, TSubRepr_Refl.
apply TEq_Refl.
apply T_App with (σ:=[<$"Angle"$~$"Degrees"$~$""$>]) (σ':=[<$"Angle"$~$"Degrees"$~$""$>]).
apply T_MorphFun.
apply T_Var.
apply C_take.
apply T_Ascend with (τ:=[<$""$>]).
apply T_Var.
apply C_shuffle. apply C_take.
apply TSubRepr_Ladder.
apply TSubRepr_Ladder.
apply TSubRepr_Refl. apply TEq_Refl.
apply M_Sub. apply TSubRepr_Refl. apply TEq_Refl.
Qed. Qed.
End Typing. End Typing.