%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Simply-Typed Lambda Calculus
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Abstract Syntax for Types
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
tipe : type. %name tipe T.
nat_t : tipe.
arrow_t : tipe -> tipe -> tipe.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Abstract Syntax for Expressions
%%%
%%% Notice that for object-level lambdas, we're using
%%% a meta-level (i.e., Twelf) function. This means
%%% that we don't have a case for variables (we'll
%%% be using Twelf variables). It also means that
%%% we inherit Twelf's notion of alpha-equivalence
%%% automatically (and other features -- see below.)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
exp : type. %name exp E.
zero_e : exp.
succ_e : exp -> exp.
app_e : exp -> exp -> exp.
lam_e : (exp -> exp) -> exp.
%%% Some examples.
inc = lam_e ([x] (succ_e x)).
inc' = lam_e ([y] (succ_e y)).
compose = lam_e ([f] (lam_e ([g] (lam_e ([x] (app_e f (app_e g x))))))).
addtwo = app_e (app_e compose inc) inc.
two = app_e addtwo zero_e.
omega = app_e (lam_e ([x] app_e x x)) (lam_e ([x] app_e x x)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Values -- we can just define this as a predicate.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
value : exp -> type.
%mode value +E.
zero_v : value zero_e.
succ_v : value (succ_e E) <- value E.
lam_v : value (lam_e F).
%worlds () (value _).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Evaluation -- big step semantics.
%%%
%%% Notice on the case for applications that we use
%%% Twelf's application to apply the exp->exp function
%%% carried by the lam_e to the argument to get out
%%% a result.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
evalsto : exp -> exp -> type.
%mode evalsto +E -V.
ev_zero : evalsto zero_e zero_e.
ev_succ : evalsto (succ_e E) (succ_e V)
<- evalsto E V.
ev_lam : evalsto (lam_e F) (lam_e F).
ev_app : evalsto (app_e E1 E2) V
<- evalsto E1 (lam_e F1)
<- evalsto E2 V2
<- evalsto (F1 V2) V.
%%% We can use Twelf to run the interpreter and solve
%%% for an output.
%solve - : evalsto two X.
%%% We can also use it to check a result. Notice that
%%% even though inc' is an alpha-variant of inc, the
%%% relation holds.
%solve - : evalsto inc inc'.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Simple Claim: expressions evaluate to values
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
evalsto_value : (evalsto E1 E2) -> (value E2) -> type.
%mode evalsto_value +D -P.
value_zero : evalsto_value ev_zero zero_v.
value_succ : evalsto_value (ev_succ D) (succ_v P)
<- evalsto_value D P.
value_lam : evalsto_value ev_lam lam_v.
value_app : evalsto_value (ev_app D3 D2 D1) P3
<- evalsto_value D3 P3.
%worlds () (evalsto_value _ _).
%total D (evalsto_value D _).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Typing Rules -- Two very subtle things are going
%%% on here. First, note that we don't have any
%%% contexts. Rather, we're inheriting Twelf's
%%% context to handle variables. As a result, the
%%% rule for lambdas (arrow_I) is a bit strange. We're
%%% essentially requiring that the meta-variable only
%%% ranges over well-typed terms.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
of : exp -> tipe -> type.
zero_t : of zero_e nat_t.
succ_t : of (succ_e E) nat_t
<- of E nat_t.
lam_t : of (lam_e F) (arrow_t T1 T2)
<- ({x:exp} of x T1 -> of (F x) T2).
app_t : of (app_e E1 E2) T
<- of E1 (arrow_t T1 T)
<- of E2 T1.
%%% Note that lam_t takes a function on *derivations*.
%%% That is, of (lam_e ([x] (F x)) (lam_t ([x][z] (DF x z)) when
%%% for any expression E and derivation D : of E T1, we can
%%% construct a proof that (F E) of (DF E D). In essence,
%%% this just splices in the derivation D at the positions
%%% where we used the variable x. Thus, we're forcing
%%% someone to establish the preservation of typing under
%%% substitution as part of the hypothesis for the lam_t rule.
%%% That's why we don't end up with a substitution lemma
%%% elsewhere.
%%% We can also use Twelf to do some type-checking.
%solve - : of inc (arrow_t nat_t nat_t).
%solve - : of compose (arrow_t (arrow_t nat_t nat_t)
(arrow_t (arrow_t nat_t nat_t)
(arrow_t nat_t nat_t))).
%solve - : of addtwo (arrow_t nat_t nat_t).
%%% Or even some type-inference.
%solve - : of two T.
%%% In fact, Twelf can show that there's no solution to the
%%% following query!
%%% %solve - : of omega T.
%%% Notice the worlds declaration --- if we put in the
%%% usual %worlds () (of E T) we're going to get a worlds error.
%%% The issue is that under a lam_t, we're introducing a new
%%% kind of expression (a variable x). But we want to constrain
%%% the possible contexts that can arise to ensure that we *only*
%%% generate new expressions that also come equipped with
%%% a well-typedness proof (of x T for some tipe T). Otherwise,
%%% our substitution principle for object-level lambdas isn't
%%% satisfied. So in some sense, our worlds declaration
%%% is giving the abstract syntax for contexts -- they are
%%% of the form:
%%%
%%% G ::= . | G,x:exp,of X T
%block tp_var : some {T:tipe} block {x:exp} {u:of x T}.
%worlds (tp_var) (of E T).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Type Preservation: this is now pretty straightforward
%%% except for the application case. Notice that we're
%%% literally applying the derivation Q1' which is a
%%% function, parameterized by any term and typing
%%% proof for that term.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
pres : evalsto E V -> of E T -> of V T -> type.
%mode pres +D1 +D2 -Q.
pres_zero : pres ev_zero zero_t zero_t.
pres_succ : pres (ev_succ D1) (succ_t D2) (succ_t P)
<- pres D1 D2 P.
pres_app : pres (ev_app D3 D2 D1) (app_t P2 P1) Q3
<- pres D1 P1 (lam_t Q1')
<- pres D2 P2 Q2
<- pres D3 (Q1' _ Q2) Q3.
pres_lam : pres ev_lam (lam_t P) (lam_t P).
%worlds () (pres _ _ _).
%total D (pres D _ _).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Of course, it goes without saying that
%% this does not imply the type system is sound.
%% For this, we must set up a small-step
%% semantics.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
steps : exp -> exp -> type.
%mode (steps +E1 -E2).
steps_succ : steps (succ_e E1) (succ_e E2)
<- steps E1 E2.
steps_app1 : steps (app_e E1 E2) (app_e E1' E2)
<- steps E1 E1'.
steps_app2 : steps (app_e V E2) (app_e V E2')
<- value V
<- steps E2 E2'.
steps_beta : steps (app_e (lam_e F) V) (F V)
<- value V.
%worlds () (steps _ _).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% An expression cannot both be a value and take a step.
%%
%% See discussion on output coverage below...
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
absurd : type. %name absurd _|_.
%freeze absurd.
value_steps : (steps E1 E2) -> (value E1) -> absurd -> type.
%mode value_steps +D1 +D2 -D2.
- : value_steps (steps_succ P1) (succ_v P2) X
<- value_steps P1 P2 X.
%worlds () (value_steps _ _ _).
%covers value_steps +D1 +D2 -D2.
%total D (value_steps D _ _).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Type Preservation for small-step
%%%
%%% This is relatively straightforward. Note that once
%%% I actually stated the theorem correctly (recall I had
%%% a typo), I no longer need to put in typing constraints
%%% and can get totality.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
spres : steps E1 E2 -> of E1 T -> of E2 T -> type.
%mode spres +D1 +D2 -Q.
spres_succ : spres (steps_succ D1) (succ_t D2) (succ_t P)
<- spres D1 D2 P.
spres_app1 : spres (steps_app1 D1) (app_t P2 P1) (app_t P2 P1')
<- spres D1 P1 P1'.
spres_app2 : spres (steps_app2 D2 _) (app_t P2 P1) (app_t P2' P1)
<- spres D2 P2 P2'.
spres_beta : spres (steps_beta _) (app_t P2 (lam_t Q)) (Q V P2).
%worlds () (spres _ _ _).
%total D (spres D _ _).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Progress for small-step
%%%
%%% Progress is usually stated as "either the program
%%% is a value or else it can take a step". The problem
%%% is that coverage can't check this sort of disjunction.
%%% So I introduce an artificial predicate (ok) representing
%%% the two possible cases, and have only two constructors
%%% for it, corresponding to the value case or the step
%%% case. Then progress reduces to showing that a well-
%%% typed expression is ok. I have to split on the
%%% induction hypothesis to handle the two cases where
%%% a sub-expression might be a value or it might step.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
ok : exp -> type.
%mode ok +E.
ok_value : ok E <- value E.
ok_step : ok E <- steps E E'.
%worlds () (ok _).
prog : of E T -> ok E -> type.
%mode prog +D1 -D2.
%% Values are trivially ok
prog_zero : prog zero_t (ok_value zero_v).
prog_lam : prog (lam_t _) (ok_value lam_v).
%%% Originally, I had two rules for progress in the case that
%%% the typing proof ends with succ_t:
%%%
%%% prog_succ_v : prog (succ_t P1) (ok_value (succ_v D1))
%%% <- prog P1 (ok_value D1).
%%%
%%% prog_succ_s : prog (succ_t P1) (ok_step (steps_succ D1))
%%% <- prog P2 (ok_step D2).
%%%
%%% But then I got an output coverage error. The problem is
%%% that Twelf is too stupid to understand that an expression
%%% cannot both be a value and take a step. Consequently,
%%% I could not prove, using these two rules, that given a
%%% proof D : of E T, then there's a unique proof that ok E.
%%% Notice, however, that I don't really need this fact. As
%%% long as there's some proof, I'm happy. Nonetheless, we
%%% know that there's a unique proof, so I wanted to capture
%%% this fact. So I'm forced to introduce an auxiliary
%%% predicate (succ_ok) which "factors out" the two cases.
%%% I think this essentially turns what was an output coverage
%%% problem into an input coverage issue which Twelf handles
%%% better. See the discussion on the Twelf Wiki here:
%%% http://fp.logosphere.cs.cmu.edu/twelf/?n=Answers.Factoring
%%% A possible alternative is to use the fact established above
%%% that an expression cannot both be a value and take a step,
%%% but I didn't bother to figure out how to do this.
succ_ok : (ok E) -> (ok (succ_e E)) -> type.
%mode succ_ok +D1 -D2.
- : succ_ok (ok_value D1) (ok_value (succ_v D1)).
- : succ_ok (ok_step D1) (ok_step (steps_succ D1)).
%worlds () (succ_ok _ _).
%total D (succ_ok D _).
prog_succ : prog (succ_t P1) D
<- prog P1 D1
<- succ_ok D1 D.
%%% I did the same trick here for applications: factored
%%% out the three cases into an auxiliary predicate app_ok.
app_ok : (of E1 (arrow_t T1 T2)) -> (ok E1) -> (ok E2) -> (ok (app_e E1 E2)) -> type.
%mode app_ok +D1 +D2 +D3 -D4.
- : app_ok (lam_t F) (ok_value D1) (ok_value D2) (ok_step (steps_beta D2)).
- : app_ok _ (ok_step D1) _ (ok_step (steps_app1 D1)).
- : app_ok _ (ok_value D1) (ok_step D2) (ok_step (steps_app2 D2 D1)).
%worlds () (app_ok _ _ _ _).
%total D (app_ok _ D _ _).
prog_app1 : prog (app_t P2 P1) D
<- prog P2 D2
<- prog P1 D1
<- app_ok P1 D1 D2 D.
%worlds () (prog _ _).
%covers prog +D1 -D2.
%terminates D (prog D _).
%total D (prog D _).