ladder-calculus/coq/terms.v
2024-08-10 13:16:45 +02:00

93 lines
3.4 KiB
Coq
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

(* 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
| 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
| 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
.
(* values *)
Inductive is_value : expr_term -> Prop :=
| V_ValAbs : forall x τ e,
(is_value (expr_tm_abs x τ e))
| V_TypAbs : forall τ e,
(is_value (expr_ty_abs τ e))
| V_Ascend : forall τ e,
(is_value e) ->
(is_value (expr_ascend τ e))
.
Declare Scope ladder_type_scope.
Declare Scope ladder_expr_scope.
Declare Custom Entry ladder_type.
Declare Custom Entry ladder_expr.
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.
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).
Open Scope ladder_type_scope.
Open Scope ladder_expr_scope.
Check [ "α", (< $"Seq"$ %"α"% > ~ < $"List"$ %"α"% >) ].
Definition polymorphic_identity1 : expr_term := [[ Λ"T" λ"x"%"T"% %"x"% ]].
Definition polymorphic_identity2 : expr_term := [[ Λ"T" λ"y"%"T"% %"y"% ]].
Compute polymorphic_identity1.
Close Scope ladder_type_scope.
Close Scope ladder_expr_scope.
End Terms.