ladder-calculus/coq/terms.v

94 lines
3.4 KiB
Coq
Raw Normal View History

(* Define the abstract syntax of the calculus
* by inductive definition of type-terms
* and expression-terms.
*)
From Coq Require Import Strings.String.
Module Terms.
(* types *)
Inductive type_term : Type :=
| type_unit : type_term
| type_id : string -> type_term
| type_var : string -> type_term
| type_num : nat -> type_term
| type_fun : type_term -> type_term -> type_term
| type_univ : string -> type_term -> type_term
| type_spec : type_term -> type_term -> type_term
2024-07-25 12:41:44 +02:00
| type_morph : type_term -> type_term -> type_term
| type_ladder : type_term -> type_term -> type_term
.
(* expressions *)
Inductive expr_term : Type :=
| expr_var : string -> expr_term
| expr_ty_abs : string -> expr_term -> expr_term
| expr_ty_app : expr_term -> type_term -> expr_term
| expr_tm_abs : string -> type_term -> expr_term -> expr_term
2024-07-25 12:41:44 +02:00
| expr_tm_abs_morph : string -> type_term -> expr_term -> expr_term
| expr_tm_app : expr_term -> expr_term -> expr_term
| expr_let : string -> type_term -> expr_term -> expr_term -> expr_term
| expr_ascend : type_term -> expr_term -> expr_term
| expr_descend : type_term -> expr_term -> expr_term
.
2024-08-10 13:16:45 +02:00
(* values *)
Inductive is_value : expr_term -> Prop :=
| V_ValAbs : forall x τ e,
(is_value (expr_tm_abs x τ e))
2024-08-10 13:16:45 +02:00
| V_TypAbs : forall τ e,
(is_value (expr_ty_abs τ e))
| V_Ascend : forall τ e,
(is_value e) ->
(is_value (expr_ascend τ e))
.
2024-07-27 13:28:52 +02:00
Declare Scope ladder_type_scope.
Declare Scope ladder_expr_scope.
Declare Custom Entry ladder_type.
2024-08-10 13:16:45 +02:00
Declare Custom Entry ladder_expr.
2024-07-27 13:28:52 +02:00
2024-08-10 13:16:45 +02:00
Notation "[ t ]" := t
(t custom ladder_type at level 80) : ladder_type_scope.
Notation "'∀' x ',' t" := (type_univ x t)
(t custom ladder_type at level 80, in custom ladder_type at level 80, x constr).
Notation "'<' σ τ '>'" := (type_spec σ τ)
(in custom ladder_type at level 80, left associativity) : ladder_type_scope.
Notation "'(' τ ')'" := τ
(in custom ladder_type at level 70) : ladder_type_scope.
Notation "σ '->' τ" := (type_fun σ τ)
(in custom ladder_type at level 75, right associativity) : ladder_type_scope.
Notation "σ '->morph' τ" := (type_morph σ τ)
(in custom ladder_type at level 75, right associativity, τ at level 80) : ladder_type_scope.
Notation "σ '~' τ" := (type_ladder σ τ)
(in custom ladder_type at level 70, right associativity) : ladder_type_scope.
Notation "'$' x '$'" := (type_id x%string)
(in custom ladder_type at level 0, x constr) : ladder_type_scope.
Notation "'%' x '%'" := (type_var x%string)
(in custom ladder_type at level 0, x constr) : ladder_type_scope.
2024-07-27 13:28:52 +02:00
2024-08-10 13:16:45 +02:00
Notation "[[ e ]]" := e
(e custom ladder_expr at level 80) : ladder_expr_scope.
Notation "'%' x '%'" := (expr_var x%string)
(in custom ladder_expr at level 0, x constr) : ladder_expr_scope.
Notation "'λ' x τ '↦' e" := (expr_tm_abs x τ e) (in custom ladder_expr at level 0, x constr, τ custom ladder_type at level 99, e custom ladder_expr at level 99).
Notation "'Λ' t '↦' e" := (expr_ty_abs t e)
(in custom ladder_expr at level 0, t constr, e custom ladder_expr at level 80).
2024-07-27 13:28:52 +02:00
Open Scope ladder_type_scope.
2024-08-10 13:16:45 +02:00
Open Scope ladder_expr_scope.
2024-07-27 13:28:52 +02:00
2024-08-10 13:16:45 +02:00
Check [ "α", (< $"Seq"$ %"α"% > ~ < $"List"$ %"α"% >) ].
2024-07-27 13:28:52 +02:00
2024-08-10 13:16:45 +02:00
Definition polymorphic_identity1 : expr_term := [[ Λ"T" λ"x"%"T"% %"x"% ]].
Definition polymorphic_identity2 : expr_term := [[ Λ"T" λ"y"%"T"% %"y"% ]].
2024-07-27 13:28:52 +02:00
2024-08-10 13:16:45 +02:00
Compute polymorphic_identity1.
2024-07-27 13:28:52 +02:00
2024-08-10 13:16:45 +02:00
Close Scope ladder_type_scope.
Close Scope ladder_expr_scope.
2024-07-27 13:28:52 +02:00
End Terms.