change meaning of expr_ascend to only explicitly state the top segment of the type ladder.

also add associativity of ladder types in type-equivalence
This commit is contained in:
Michael Sippel 2024-09-16 15:58:29 +02:00
parent cae0572e1b
commit 12da3e97bd
Signed by: senvas
GPG key ID: F96CF119C34B64A6
4 changed files with 41 additions and 31 deletions

View file

@ -218,6 +218,16 @@ Inductive type_eq : type_term -> type_term -> Prop :=
y === z -> y === z ->
x === z x === z
| TEq_LadderAssocLR : forall x y z,
(type_ladder (type_ladder x y) z)
===
(type_ladder x (type_ladder y z))
| TEq_LadderAssocRL : forall x y z,
(type_ladder x (type_ladder y z))
===
(type_ladder (type_ladder x y) z)
| TEq_Alpha : forall x y, | TEq_Alpha : forall x y,
x --->α y -> x --->α y ->
x === y x === y
@ -248,6 +258,9 @@ Proof.
apply IHtype_eq2. apply IHtype_eq2.
apply IHtype_eq1. apply IHtype_eq1.
apply TEq_LadderAssocRL.
apply TEq_LadderAssocLR.
apply type_alpha_symm in H. apply type_alpha_symm in H.
apply TEq_Alpha. apply TEq_Alpha.
apply H. apply H.

View file

@ -52,7 +52,7 @@ Inductive translate_morphism_path : context -> type_term -> type_term -> expr_te
(translate_morphism_path Γ τ τ' m) -> (translate_morphism_path Γ τ τ' m) ->
(translate_morphism_path Γ (type_ladder σ τ) (type_ladder σ τ') (translate_morphism_path Γ (type_ladder σ τ) (type_ladder σ τ')
(expr_morph "x" (type_ladder σ τ) (expr_morph "x" (type_ladder σ τ)
(expr_ascend (type_ladder σ τ') (expr_app m (expr_descend τ (expr_var "x")))))) (expr_ascend σ (expr_app m (expr_descend τ (expr_var "x"))))))
| Translate_Single : forall Γ h τ τ', | Translate_Single : forall Γ h τ τ',
(context_contains Γ h (type_morph τ τ')) -> (context_contains Γ h (type_morph τ τ')) ->

View file

@ -53,7 +53,7 @@ Proof.
(* Lift *) (* Lift *)
apply T_MorphAbs. apply T_MorphAbs.
apply T_Ascend with (τ:=τ'). apply T_Ascend.
apply T_App with (σ':=τ) (σ:=τ). apply T_App with (σ':=τ) (σ:=τ).
apply T_MorphFun. apply T_MorphFun.
apply typing_weakening. apply typing_weakening.
@ -63,7 +63,6 @@ Proof.
apply C_take. apply C_take.
apply TSubRepr_Ladder, TSubRepr_Refl, TEq_Refl. apply TSubRepr_Ladder, TSubRepr_Refl, TEq_Refl.
apply M_Sub, TSubRepr_Refl, TEq_Refl. apply M_Sub, TSubRepr_Refl, TEq_Refl.
apply TSubRepr_Ladder, TSubRepr_Refl, TEq_Refl.
(* Single *) (* Single *)
apply T_Var. apply T_Var.
@ -223,7 +222,6 @@ Proof.
apply TSubRepr_Ladder, TSubRepr_Refl, TEq_Refl. apply TSubRepr_Ladder, TSubRepr_Refl, TEq_Refl.
apply M_Sub, TSubRepr_Refl, TEq_Refl. apply M_Sub, TSubRepr_Refl, TEq_Refl.
apply TSubRepr_Ladder, TSubRepr_Refl, TEq_Refl.
apply IHtranslate_typing2. apply IHtranslate_typing2.
apply H1. apply H1.
@ -309,10 +307,9 @@ Proof.
apply H0. apply H0.
(* e is Ascension *) (* e is Ascension *)
apply T_Ascend with (τ:=τ). apply T_Ascend.
apply IHtranslate_typing. apply IHtranslate_typing.
apply H0. apply H0.
apply H1.
(* e is Desecension *) (* e is Desecension *)
apply T_DescendImplicit with (τ:=τ). apply T_DescendImplicit with (τ:=τ).

View file

@ -61,8 +61,7 @@ Inductive expr_type : context -> expr_term -> type_term -> Prop :=
| T_Ascend : forall Γ e τ τ', | T_Ascend : forall Γ e τ τ',
(Γ |- e \is τ) -> (Γ |- e \is τ) ->
(τ' :<= τ) -> (Γ |- (expr_ascend τ' e) \is (type_ladder τ' τ))
(Γ |- (expr_ascend τ' e) \is τ')
| T_DescendImplicit : forall Γ x τ τ', | T_DescendImplicit : forall Γ x τ τ',
Γ |- x \is τ -> Γ |- x \is τ ->
@ -77,7 +76,8 @@ Inductive expr_type : context -> expr_term -> type_term -> Prop :=
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 :=
exists Γ τ, forall Γ,
exists τ,
Γ |- e \is τ Γ |- e \is τ
. .
@ -135,10 +135,9 @@ Inductive translate_typing : context -> expr_term -> type_term -> expr_term -> P
| Expand_Ascend : forall Γ e e' τ τ', | Expand_Ascend : forall Γ e e' τ τ',
(Γ |- e \is τ) -> (Γ |- e \is τ) ->
(τ' :<= τ) -> (Γ |- (expr_ascend τ' e) \is (type_ladder τ' τ)) ->
(Γ |- (expr_ascend τ' e) \is τ') ->
(translate_typing Γ e τ e') -> (translate_typing Γ e τ e') ->
(translate_typing Γ (expr_ascend τ' e) τ' (expr_ascend τ' e')) (translate_typing Γ (expr_ascend τ' e) (type_ladder τ' τ) (expr_ascend τ' e'))
| Expand_Descend : forall Γ e e' τ τ', | Expand_Descend : forall Γ e e' τ τ',
(Γ |- e \is τ) -> (Γ |- e \is τ) ->
@ -219,7 +218,6 @@ Example typing4 : (is_well_typed
). ).
Proof. Proof.
unfold is_well_typed. unfold is_well_typed.
exists ctx_empty.
exists [< "T","U",%"T"%->%"U"%->%"T"% >]. exists [< "T","U",%"T"%->%"U"%->%"T"% >].
apply T_TypeAbs. apply T_TypeAbs.
apply T_TypeAbs. apply T_TypeAbs.
@ -231,24 +229,29 @@ Qed.
Open Scope ladder_expr_scope. Open Scope ladder_expr_scope.
Example typing5 : (is_well_typed Example typing5 :
(ctx_assign "60" [< $""$ >]
(ctx_assign "360" [< $""$ >]
(ctx_assign "/" [< $""$ -> $""$ -> $""$ >]
ctx_empty)))
|-
[{ [{
let "deg2turns" := let "deg2turns" :=
(λ"x" $"Angle"$~$"Degrees"$~$""$ (λ"x" $"Angle"$~$"Degrees"$~$""$
morph (((%"/"% %"x"%) %"360"%) as $"Angle"$~$"Turns"$~$""$)) morph (((%"/"% %"x"%) %"360"%) as $"Angle"$~$"Turns"$))
in ( %"deg2turns"% (%"60"% as $"Angle"$~$"Degrees"$~$""$) ) in ( %"deg2turns"% (%"60"% as $"Angle"$~$"Degrees"$) )
}] }]
). \is
[<
$"Angle"$~$"Turns"$~$""$
>]
.
Proof. 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_Let with (σ:=[< $"Angle"$~$"Degrees"$~$""$ ->morph $"Angle"$~$"Turns"$~$""$ >]).
apply T_MorphAbs. apply T_MorphAbs.
apply T_Ascend with (τ:=[< $""$ >]). apply T_DescendImplicit with (τ:=(type_ladder [<$"Angle"$~$"Turns"$>] [<$""$>])).
2: apply TSubRepr_Refl, TEq_LadderAssocLR.
apply T_Ascend with (τ:=[<$""$>]) (τ':=[<$"Angle"$~$"Turns"$>]).
apply T_App with (σ := [< $""$ >]) (σ' := [< $""$ >]). apply T_App with (σ := [< $""$ >]) (σ' := [< $""$ >]).
apply T_App with (σ := [< $""$ >]) (σ' := [< $""$ >]). apply T_App with (σ := [< $""$ >]) (σ' := [< $""$ >]).
apply T_Var. apply T_Var.
@ -265,18 +268,15 @@ Proof.
apply M_Sub. apply M_Sub.
apply TSubRepr_Refl. apply TSubRepr_Refl.
apply TEq_Refl. apply TEq_Refl.
apply TSubRepr_Ladder, TSubRepr_Ladder, TSubRepr_Refl.
apply TEq_Refl.
apply T_App with (σ:=[<$"Angle"$~$"Degrees"$~$""$>]) (σ':=[<$"Angle"$~$"Degrees"$~$""$>]). apply T_App with (σ:=[<$"Angle"$~$"Degrees"$~$""$>]) (σ':=[<$"Angle"$~$"Degrees"$~$""$>]).
apply T_MorphFun. apply T_MorphFun.
apply T_Var. apply T_Var.
apply C_take. apply C_take.
apply T_Ascend with (τ:=[<$""$>]). apply T_DescendImplicit with (τ:=(type_ladder [<$"Angle"$~$"Degrees"$>] [<$""$>])).
2: apply TSubRepr_Refl, TEq_LadderAssocLR.
apply T_Ascend.
apply T_Var. apply T_Var.
apply C_shuffle. apply C_take. 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. apply M_Sub. apply TSubRepr_Refl. apply TEq_Refl.
Qed. Qed.