131 lines
5.2 KiB
Coq
131 lines
5.2 KiB
Coq
(* Define the abstract syntax of the calculus
|
||
* by inductive definition of type-terms
|
||
* and expression-terms.
|
||
*)
|
||
|
||
From Coq Require Import Strings.String.
|
||
|
||
(* types *)
|
||
Inductive type_term : Type :=
|
||
| type_id : string -> type_term
|
||
| type_var : string -> 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_abs : string -> type_term -> expr_term -> expr_term
|
||
| expr_morph : string -> type_term -> expr_term -> expr_term
|
||
| expr_app : expr_term -> expr_term -> expr_term
|
||
| expr_let : string -> 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_abs_value : expr_term -> Prop :=
|
||
| VAbs_Var : forall x,
|
||
(is_abs_value (expr_var x))
|
||
|
||
| VAbs_Abs : forall x τ e,
|
||
(is_abs_value (expr_abs x τ e))
|
||
|
||
| VAbs_Morph : forall x τ e,
|
||
(is_abs_value (expr_morph x τ e))
|
||
|
||
| VAbs_TypAbs : forall τ e,
|
||
(is_abs_value (expr_ty_abs τ e))
|
||
.
|
||
|
||
Inductive is_value : expr_term -> Prop :=
|
||
| V_Abs : forall e,
|
||
(is_abs_value e) ->
|
||
(is_value e)
|
||
|
||
| V_Ascend : forall τ e,
|
||
(is_abs_value e) ->
|
||
(is_value (expr_ascend τ e))
|
||
|
||
| V_Descend : forall τ e,
|
||
(is_abs_value e) ->
|
||
(is_value (expr_descend τ 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 99) : ladder_type_scope.
|
||
Notation "t" := t
|
||
(in custom ladder_type at level 0, t ident) : 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 "'[' τ ']'" := (type_spec (type_id "Seq") τ)
|
||
(in custom ladder_type at level 70) : ladder_type_scope.
|
||
Notation "'(' τ ')'" := τ
|
||
(in custom ladder_type at level 5) : 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 20, right associativity) : ladder_type_scope.
|
||
Notation "'$' x '$'" := (type_id x%string)
|
||
(in custom ladder_type at level 10, x constr) : ladder_type_scope.
|
||
Notation "'%' x '%'" := (type_var x%string)
|
||
(in custom ladder_type at level 10, x constr) : ladder_type_scope.
|
||
|
||
Notation "[{ e }]" := e
|
||
(e custom ladder_expr at level 99) : ladder_expr_scope.
|
||
Notation "e" := e
|
||
(in custom ladder_expr at level 0, e ident) : ladder_expr_scope.
|
||
Notation "'%' x '%'" := (expr_var x%string)
|
||
(in custom ladder_expr at level 10, x constr) : ladder_expr_scope.
|
||
Notation "'Λ' t '↦' e" := (expr_ty_abs t e)
|
||
(in custom ladder_expr at level 10, t constr, e custom ladder_expr at level 80, right associativity) : ladder_expr_scope.
|
||
Notation "'λ' x ',' τ '↦' e" := (expr_abs x τ e)
|
||
(in custom ladder_expr at level 70, x constr, τ custom ladder_type at level 90, e custom ladder_expr at level 80, right associativity) :ladder_expr_scope.
|
||
Notation "'λ' x ',' τ '↦morph' e" := (expr_morph x τ e)
|
||
(in custom ladder_expr at level 70, x constr, τ custom ladder_type at level 90, e custom ladder_expr at level 80, right associativity) :ladder_expr_scope.
|
||
Notation "'let' x ':=' e 'in' t" := (expr_let x e t)
|
||
(in custom ladder_expr at level 60, x constr, e custom ladder_expr at level 80, t custom ladder_expr at level 80, right associativity) : ladder_expr_scope.
|
||
Notation "e 'as' τ" := (expr_ascend τ e)
|
||
(in custom ladder_expr at level 30, e custom ladder_expr, τ custom ladder_type at level 99) : ladder_expr_scope.
|
||
Notation "e 'des' τ" := (expr_descend τ e)
|
||
(in custom ladder_expr at level 30, e custom ladder_expr, τ custom ladder_type at level 99) : ladder_expr_scope.
|
||
Notation "e1 e2" := (expr_app e1 e2)
|
||
(in custom ladder_expr at level 90, e2 custom ladder_expr at next level) : ladder_expr_scope.
|
||
Notation "e '#' τ" := (expr_ty_app e τ)
|
||
(in custom ladder_expr at level 80, τ custom ladder_type at level 101, left associativity) : ladder_expr_scope.
|
||
Notation "'(' e ')'" := e
|
||
(in custom ladder_expr, e custom ladder_expr at next level, left associativity) : ladder_expr_scope.
|
||
|
||
|
||
Print Grammar constr.
|
||
|
||
(* EXAMPLES *)
|
||
|
||
Open Scope ladder_type_scope.
|
||
Open Scope ladder_expr_scope.
|
||
|
||
Check [< ∀"α", [%"α"%] ~ <$"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.
|