(* Small step CBV semantics *)
Fixpoint is_value (t : term) : bool :=
match t with
| Const _ | Abs _ => true
| _ => false
end.
Fixpoint subst (y : var) (t1 : term) (t2 : term) : term :=
match t2 with
| Const n => Const n
| Id x =>
if eq_nat_dec x y then t1 else t2
| App t t' =>
App (subst y t1 t) (subst y t1 t')
| Abs t =>
subst (S y) t1 t
end.
Fixpoint step (t : term) : option term :=
match t with
| Const _ | Id _ => None | Abs x => None
| App t1 t2 =>
if is_value t1 then
match t1 with
| Abs t =>
if is_value t2 then ret (subst 0 t1 t)
else
t2' <- step t2;;
ret (App t1 t2')
| _ => None
end
else
t1' <- step t1;;
ret (App t1' t2)
end.
(* Generators *)
Module DoNotation.
Notation "'do!' X <- A ; B" :=
(bindGen A (fun X => B))
(at level 200, X ident, A at level 100, B at level 200).
End DoNotation.
(* Sized generator of simple types *)
Fixpoint gen_type_size (n : nat) : G type :=
match n with
| 0 => returnGen N
| S n' =>
do! m <- choose (0, n');
liftGen2 Arrow (gen_type_size (n' - m)) (gen_type_size (n' - (n' - m)))
end.
(* Generator of simple types *)
Definition gen_type : G type := bindGen arbitrary gen_type_size.
(* Returns the list of bindings that have type tau in e *)
Definition vars_with_type (e : env) (tau : type) : list term :=
map (fun p => Id (snd p))
(filter (fun p => proj1_sig (Sumbool.bool_of_sumbool (type_eq_dec tau (fst p))))
(combine e (seq 0 (List.length e)))).
Definition sigT_of_prod {A B : Type} (p : A * B) : {_ : A & B} :=
let (a, b) := p in existT (fun _ : A => B) a b.
Definition lt_pair (c1 c2 : (nat * type)) : Prop :=
lexprod nat (fun _ => type) lt (fun _ => lt_type) (sigT_of_prod c1) (sigT_of_prod c2).

Lemma wf_lt_pair : well_founded lt_pair.
Fixpoint gen_term_no_app (tau : type)  (e : env) : G term :=
match vars_with_type e tau with
| [] =>
match tau with
| N => liftGen Const arbitrary
| Arrow tau1 tau2 =>
liftGen Abs (gen_term_no_app tau2 (tau1 :: e))
end
| def :: vars =>
oneOf_ (returnGen def)
[ match tau with
| N => liftGen Const arbitrary
| Arrow tau1 tau2 =>
liftGen Abs (gen_term_no_app tau2 (tau1 :: e))
end;
elems_ def (def :: vars)]
end.