94 lines
2.5 KiB
Coq
94 lines
2.5 KiB
Coq
(*
|
|
sf-plf:
|
|
|
|
https://softwarefoundations.cis.upenn.edu/plf-current/Stlc.html
|
|
*)
|
|
Require Import String.
|
|
|
|
Inductive ty : Type :=
|
|
| Ty_Bool : ty
|
|
| Ty_Arrow : ty -> ty -> ty.
|
|
|
|
Inductive tm : Type :=
|
|
| tm_var : string -> tm
|
|
| tm_app : tm -> tm -> tm (* a b *)
|
|
|
|
(* Type explicitly mentioned. Not left for type inferene stage *)
|
|
| tm_abs : string -> ty -> tm -> tm (* λx.a *)
|
|
|
|
| tm_tru : tm
|
|
| tm_fls : tm
|
|
| tm_if : tm -> tm -> tm -> tm.
|
|
|
|
|
|
Declare Custom Entry stlc.
|
|
Notation "<{ e >}" := (e) (e custom stlc at level 99).
|
|
Notation "( x )" := x (in custom stlc, x at level 99).
|
|
Notation "x" := x (in custom stlc at level 0,
|
|
x constr at level 0).
|
|
Notation "S -> T" := (Ty_Arrow S T)
|
|
(in custom stlc at level 50, right associativity).
|
|
Notation "x y" := (tm_app x y)
|
|
(in custom stlc at level 1, left associativity).
|
|
Notation "\ x : T , y" := (tm_abs x T y)
|
|
(in custom stlc at level 90,
|
|
x at level 99,
|
|
T custom stlc at level 99,
|
|
y custom stlc at level 99,
|
|
left associativity).
|
|
Coercion tm_var : string >-> tm.
|
|
|
|
Notation "'Bool'" := Ty_Bool (in custom stlc at level 0).
|
|
Notation "'if' x 'then' y 'else' z" :=
|
|
(tm_if x y z)
|
|
(in custom stlc at level 89,
|
|
x custom stlc at level 99,
|
|
y custom stlc at level 99,
|
|
z custom stlc at level 99,
|
|
left associativity).
|
|
(*
|
|
Notation "'true'" := true (at level 1).
|
|
Notation "'false'" := false (at level 1).
|
|
*)
|
|
Notation "'false'" := tm_fls (in custom stlc at level 0).
|
|
Notation "'true'" := tm_tru (in custom stlc at level 0).
|
|
|
|
Inductive value : tm -> Prop :=
|
|
| v_abs : forall (x:string) (T:ty) (t:tm),
|
|
value (tm_abs x T t)
|
|
| v_tru : value tm_tru
|
|
| v_fls : value tm_fls.
|
|
|
|
(* Subst nv in t with s *)
|
|
Fixpoint subst (nv:string) (s t:tm) : tm :=
|
|
match t with
|
|
| tm_var v =>
|
|
if eqb nv v then s
|
|
else t
|
|
| tm_app e1 e2 => tm_app (subst nv s e1) (subst nv s e2)
|
|
| tm_abs v T e =>
|
|
if eqb nv v then (tm_abs nv T (subst nv v e))
|
|
else t
|
|
| tm_tru => tm_tru
|
|
| tm_fls => tm_fls
|
|
| tm_if cond e1 e2 =>
|
|
tm_if (subst nv s cond) (subst nv s e1) (subst nv s e2)
|
|
end.
|
|
Notation "'[' x ':=' s ']' t" := (subst x s t)
|
|
(in custom stlc at level 20, x constr).
|
|
|
|
Inductive substi (s:tm) (v:string) : tm -> tm -> Prop :=
|
|
(* subst a variable with s => s itself if v matches *)
|
|
| s_var1 : substi s v (tm_var v) s
|
|
| s_var2 : forall v':string,
|
|
v <> v' -> substi s v (tm_var v') (tm_var v')
|
|
| s_app : forall (e1 e2 e1' e2':tm),
|
|
substi s v e1 e1'
|
|
-> substi s v e2 e2'
|
|
-> substi s v (tm_app e1 e2) (tm_app e1' e2')
|
|
| s_abs1 :
|
|
-> substi s v (tm_abs e1 e2) (tm_abs e1' e2')
|
|
| s_abs2 :
|
|
|
|
Check True <-> True.
|