From 85c9833081d0101bb8054b1fc2b03c5fa59a255d Mon Sep 17 00:00:00 2001
From: Alhadis <gardnerjohng@gmail.com>
Date: Thu, 3 Nov 2016 02:15:36 +1100
Subject: [PATCH 1/2] Delete GPL2.1-licensed Coq samples

These files are modified variants of the ones included in Coq's standard
distribution. The original materials feature the GPL 2.1 license in each
file's header, which was suspiciously removed from Linguist's samples.

    https://github.com/coq/coq/tree/trunk/theories

Basics.v is a different file to that found in Coq's distro, but is vague
in origin and being removed to err on the side of caution. The remaining
samples are from a MIT-licensed online course by Software Foundations:

    https://www.cis.upenn.edu/~bcpierce/sf/current/

References: github/linguist#3313
---
 samples/Coq/Basics.v         | 707 -----------------------------------
 samples/Coq/Heap.v           | 290 --------------
 samples/Coq/PermutSetoid.v   | 539 --------------------------
 samples/Coq/Permutation.v    | 632 -------------------------------
 samples/Coq/Sorting.v        |   2 -
 samples/Coq/interval_discr.v | 419 ---------------------
 6 files changed, 2589 deletions(-)
 delete mode 100755 samples/Coq/Basics.v
 delete mode 100755 samples/Coq/Heap.v
 delete mode 100755 samples/Coq/PermutSetoid.v
 delete mode 100755 samples/Coq/Permutation.v
 delete mode 100755 samples/Coq/Sorting.v
 delete mode 100644 samples/Coq/interval_discr.v

diff --git a/samples/Coq/Basics.v b/samples/Coq/Basics.v
deleted file mode 100755
index 054fcbd8..00000000
--- a/samples/Coq/Basics.v
+++ /dev/null
@@ -1,707 +0,0 @@
-Inductive day : Type :=
-| monday : day
-| tuesday : day
-| wednesday : day
-| thursday : day
-| friday : day
-| saturday : day
-| sunday : day.
-
-Definition next_weekday (d:day) : day :=
-  match d with
-  | monday => tuesday
-  | tuesday => wednesday
-  | wednesday => thursday
-  | thursday => friday
-  | friday => monday
-  | saturday => monday
-  | sunday => monday
-  end.
-
-Example test_next_weekday:
-(next_weekday (next_weekday saturday)) = tuesday.
-
-Proof. simpl. reflexivity. Qed.
-
-Inductive bool : Type :=
-	| true : bool
-	| false : bool.
-
-Definition negb (b:bool) : bool :=
-													 match b with
-																			 | true => false
-																			 | false => true
-													 end.
-
-Definition andb (b1:bool) (b2:bool) : bool :=
-		match b1 with
-		 | true => b2
-		 | false => false
-	  end.
-
-Definition orb (b1:bool) (b2:bool) : bool :=
-		match b1 with
-		  | true => true
-		  | false => b2
-		end.
-
-Example test_orb1: (orb true false) = true.
-Proof. simpl. reflexivity. Qed.
-
-Example test_orb2: (orb false false) = false.
-Proof. simpl. reflexivity. Qed.
-
-Example test_orb3: (orb false true) = true.
-Proof. simpl. reflexivity. Qed.
-
-Example test_orb4: (orb true true) = true.
-Proof. simpl. reflexivity. Qed.
-
-Definition nandb (b1: bool) (b2:bool) : bool :=
-	match b1 with
-		| true => match b2 with
-										| false => true
-										| true => false
-							end
-		| false => true
-	end.
-
-Example test_nandb1: (nandb true false) = true.
-Proof. simpl. reflexivity. Qed.
-Example test_nandb2: (nandb false false) = true.
-Proof. simpl. reflexivity. Qed.
-Example test_nandb3: (nandb false true) = true.
-Proof. simpl. reflexivity. Qed.
-Example test_nandb4: (nandb true true) = false.
-Proof. simpl. reflexivity. Qed.
-
-Definition andb3 (b1: bool) (b2:bool) (b3:bool) : bool :=
-	match b1 with
-    | false => false
-		| true => match b2 with
-								| false => false
-								| true => b3
-							end
-	end.
-
-Example test_andb31: (andb3 true true true) = true.
-Proof. simpl. reflexivity. Qed.
-Example test_andb32: (andb3 false true true) = false.
-Proof. simpl. reflexivity. Qed.
-Example test_andb33: (andb3 true false true) = false.
-Proof. simpl. reflexivity. Qed.
-Example test_andb34: (andb3 true true false) = false.
-Proof. simpl. reflexivity. Qed.
-
-Module Playground1.
-
-Inductive nat : Type :=
-	| O : nat
-	| S : nat -> nat.
-
-Definition pred (n : nat) : nat :=
-	match n with
-		| O => O
-		| S n' => n'
-	end.
-
-Definition minustwo (n : nat) : nat :=
-	match n with
-		| O => O
-		| S O => O
-		| S (S n') => n'
-	end.
-
-Fixpoint evenb (n : nat) : bool :=
-	match n with
-		| O => true
-		| S O => false
-		| S (S n') => evenb n'
-	end.
-
-Definition oddb (n : nat) : bool := negb (evenb n).
-
-Example test_oddb1: (oddb (S O)) = true.
-Proof. reflexivity. Qed.
-Example test_oddb2: (oddb (S (S (S (S O))))) = false.
-Proof. reflexivity. Qed.
-
-Fixpoint plus (n : nat) (m : nat) : nat :=
-	match n with
-		| O => m
-		| S n' => S (plus n' m)
-	end.
-
-Fixpoint mult (n m : nat) : nat :=
-	match n with
-		| O => O
-		| S n' => plus m (mult n' m)
-	end.
-
-Fixpoint minus (n m : nat) : nat :=
-	match n, m with
-		| O, _ => n
-		| S n', O => S n'
-		| S n', S m' => minus n' m'
-	end.
-
-Fixpoint exp (base power : nat) : nat :=
-	match power with
-		| O => S O
-		| S p => mult base (exp base p)
-	end.
-
-Fixpoint factorial (n : nat) : nat :=
-	match n with
-		| O => S O
-		| S n' => mult n (factorial n')
-	end.
-
-Example test_factorial1: (factorial (S (S (S O)))) = (S (S (S (S (S (S O)))))).
-Proof. simpl. reflexivity. Qed.
-
-Notation "x + y" := (plus x y) (at level 50, left associativity) : nat_scope.
-Notation "x - y" := (minus x y) (at level 50, left associativity) : nat_scope.
-Notation "x * y" := (mult x y) (at level 40, left associativity) : nat_scope.
-
-Fixpoint beq_nat (n m : nat) : bool :=
-	match n with
-		| O => match m with
-						| O => true
-						| S m' => false
-					 end
-		| S n' => match m with
-							| O => false
-							| S m' => beq_nat n' m'
-							end
-	end.
-
-Fixpoint ble_nat (n m : nat) : bool :=
-	match n with
-		| O => true
-		| S n' => 
-				match m with
-					| O => false
-					| S m' => ble_nat n' m'
-				end
-	end.
-
-Example test_ble_nat1: (ble_nat (S (S O)) (S (S O))) = true.
-Proof. simpl. reflexivity. Qed.
-Example test_ble_nat2: (ble_nat (S (S O)) (S (S (S (S O))))) = true.
-Proof. simpl. reflexivity. Qed.
-Example test_ble_nat3: (ble_nat (S (S (S (S O)))) (S (S O))) = false.
-Proof. simpl. reflexivity. Qed.
-
-Definition blt_nat (n m : nat) : bool :=
-		(andb (negb (beq_nat n m)) (ble_nat n m)).
-
-Example test_blt_nat1: (blt_nat (S (S O)) (S (S O))) = false.
-Proof. simpl. reflexivity. Qed.
-Example test_blt_nat3: (blt_nat (S (S (S (S O)))) (S (S O))) = false.
-Proof. simpl. reflexivity. Qed.
-Example test_blt_nat2 : (blt_nat (S (S O)) (S (S (S (S O))))) = true.
-Proof. simpl. reflexivity. Qed.
-
-Theorem plus_O_n : forall n : nat, O + n = n.
-Proof.
-	simpl. reflexivity. Qed.
-
-Theorem plus_O_n' : forall n : nat, O + n = n.
-Proof.
-	reflexivity. Qed.
-
-Theorem plus_O_n'' : forall n : nat, O + n = n.
-Proof.
-	intros n. reflexivity. Qed.
-
-Theorem plus_1_1 : forall n : nat, (S O) + n = S n.
-Proof.
-	intros n. reflexivity. Qed.
-
-Theorem mult_0_1: forall n : nat, O * n = O.
-Proof.
-	intros n. reflexivity. Qed.
-
-Theorem plus_id_example : forall n m:nat,
-	n = m -> n + n = m + m.
-Proof.
-	intros n m.
-	intros H.
-	rewrite -> H.
-	reflexivity. Qed.
-
-Theorem plus_id_exercise : forall n m o: nat,
-	n = m -> m = o -> n + m = m + o.
-Proof.
-	intros n m o.
-	intros H.
-	intros H'.
-	rewrite -> H.
-	rewrite <- H'.
-	reflexivity.
-	Qed.
-
-Theorem mult_0_plus : forall n m : nat,
-				(O + n) * m = n * m.
-Proof.
-	intros n m.
-	rewrite -> plus_O_n.
-	reflexivity. Qed.
-
-Theorem mult_1_plus : forall n m: nat,
-	((S O) + n) * m = m + (n * m).
-Proof.
-	intros n m.
-	rewrite -> plus_1_1.
-	reflexivity.
-	Qed.
-
-Theorem mult_1 : forall n : nat,
-				n * (S O) = n.
-Proof.
-	intros n.
-	induction n as [| n'].
-	reflexivity.
-	simpl.
-	rewrite -> IHn'.
-	reflexivity.
-	Qed.
-
-Theorem plus_1_neq_0 : forall n : nat,
-				beq_nat (n + (S O)) O = false.
-Proof.
-	intros n.
-	destruct n as [| n'].
-	reflexivity.
-	reflexivity.
-	Qed.
-
-Theorem zero_nbeq_plus_1 : forall n : nat,
-				beq_nat O (n + (S O)) = false.
-Proof.
-	intros n.
-	destruct n.
-	reflexivity.
-	reflexivity.
-Qed.
-
-Require String. Open Scope string_scope.
-
-Ltac move_to_top x :=
-match reverse goal with
-| H : _ |- _ => try move x after H
-end.
-
-Tactic Notation "assert_eq" ident(x) constr(v) :=
-	let H := fresh in
-	assert (x = v) as H by reflexivity;
-	clear H.
-
-	Tactic Notation "Case_aux" ident(x) constr(name) :=
-		first [
-		set (x := name); move_to_top x
-		| assert_eq x name; move_to_top x
-		| fail 1 "because we are working on a different case" ].
-
-		Ltac Case name := Case_aux Case name.
-		Ltac SCase name := Case_aux SCase name.
-		Ltac SSCase name := Case_aux SSCase name.
-		Ltac SSSCase name := Case_aux SSSCase name.
-		Ltac SSSSCase name := Case_aux SSSSCase name.
-		Ltac SSSSSCase name := Case_aux SSSSSCase name.
-		Ltac SSSSSSCase name := Case_aux SSSSSSCase name.
-		Ltac SSSSSSSCase name := Case_aux SSSSSSSCase name.
-
-Theorem andb_true_elim1 : forall b c : bool,
-				andb b c = true -> b = true.
-Proof.
-	intros b c H.
-	destruct b.
-	Case "b = true".
-		reflexivity.
-	Case "b = false".
-		rewrite <- H. reflexivity. Qed.
-
-Theorem plus_0_r : forall n : nat, n + O = n.
-Proof.
-	intros n. induction n as [| n'].
-	Case "n = 0". reflexivity.
-	Case "n = S n'". simpl. rewrite -> IHn'. reflexivity. Qed.
-
-Theorem minus_diag : forall n,
-				minus n n = O.
-Proof.
-	intros n. induction n as [| n'].
-	Case "n = 0".
-		simpl. reflexivity.
-	Case "n = S n'".
-		simpl. rewrite -> IHn'. reflexivity. Qed.
-
-
-Theorem mult_0_r : forall n:nat,
-				n * O = O.
-Proof.
-	intros n. induction n as [| n'].
-	Case "n = 0".
-		reflexivity.
-	Case "n = S n'".
-		simpl. rewrite -> IHn'. reflexivity. Qed.
-
-Theorem plus_n_Sm : forall n m : nat,
-				S (n + m) = n + (S m).
-Proof.
-	intros n m. induction n as [| n'].
-	Case "n = 0".
-		reflexivity.
-	Case "n = S n'".
-		simpl. rewrite -> IHn'. reflexivity. Qed.
-
-Theorem plus_assoc : forall n m p : nat,
-					n + (m + p) = (n + m) + p.
-Proof.
-	intros n m p.
-	induction n as [| n'].
-	reflexivity.
-	simpl.
-	rewrite -> IHn'.
-	reflexivity. Qed.
-
-Theorem plus_distr : forall n m: nat, S (n + m) = n + (S m).
-Proof.
-	intros n m.  induction n as [| n'].
-	Case "n = 0".
-		reflexivity.
-	Case "n = S n'".
-		simpl. rewrite -> IHn'. reflexivity. Qed.
-
-Theorem mult_distr : forall n m: nat, n * ((S O) + m) = n * (S m).
-Proof.
-	intros n m.
-	induction n as [| n'].
-	reflexivity.
-	reflexivity.
-	Qed.
-
-Theorem plus_comm : forall n m : nat,
-	n + m = m + n.
-Proof.
-	intros n m.
-	induction n as [| n'].
-	Case "n = 0".
-		simpl.
-		rewrite -> plus_0_r.
-		reflexivity.
-	Case "n = S n'".
-		simpl.
-		rewrite -> IHn'.
-		rewrite -> plus_distr.
-		reflexivity. Qed.
-
-Fixpoint double (n:nat) :=
-	match n with
-		| O => O
-		| S n' => S (S (double n'))
-	end.
-
-Lemma double_plus : forall n, double n = n + n.
-Proof.
-	intros n. induction n as [| n'].
-	Case "n = 0".
-		reflexivity.
-	Case "n = S n'".
-		simpl. rewrite -> IHn'.
-		rewrite -> plus_distr. reflexivity.
-		Qed.
-
-Theorem beq_nat_refl : forall n : nat,
-	true = beq_nat n n.
-Proof.
-	intros n. induction n as [| n'].
-	Case "n = 0".
-		reflexivity.
-	Case "n = S n".
-		simpl. rewrite <- IHn'.
-		reflexivity. Qed.
-
-Theorem plus_rearrange: forall n m p q : nat,
-				(n + m) + (p + q) = (m + n) + (p + q).
-Proof.
-	intros n m p q.
-	assert(H: n + m = m + n).
-		Case "Proof by assertion".
-		rewrite -> plus_comm. reflexivity.
-	rewrite -> H. reflexivity. Qed.
-
-Theorem plus_swap : forall n m p: nat,
-				n + (m + p) = m + (n + p).
-Proof.
-	intros n m p.
-	rewrite -> plus_assoc.
-	assert(H: m + (n + p) = (m + n) + p).
-	rewrite -> plus_assoc.
-	reflexivity.
-	rewrite -> H.
-	assert(H2: m + n = n + m).
-	rewrite -> plus_comm.
-	reflexivity.
-	rewrite -> H2.
-	reflexivity.
-	Qed.
-
-Theorem plus_swap' : forall n m p: nat,
-				n + (m + p) = m + (n + p).
-Proof.
-	intros n m p.
-	rewrite -> plus_assoc.
-	assert(H: m + (n + p) = (m + n) + p).
-	rewrite -> plus_assoc.
-	reflexivity.
-	rewrite -> H.
-	replace (m + n) with (n + m).
-	rewrite -> plus_comm.
-	reflexivity.
-	rewrite -> plus_comm.
-	reflexivity.
-	Qed.
-
-Theorem mult_1_distr: forall m n: nat,
-				n * ((S O) + m) = n * (S O) + n * m.
-Proof.
-	intros n m.
-	rewrite -> mult_1.
-	rewrite -> plus_1_1.
-	simpl.
-	induction m as [|m'].
-	simpl.
-	reflexivity.
-	simpl.
-	rewrite -> plus_swap.
-	rewrite <- IHm'.
-	reflexivity.
-	Qed.
-
-Theorem mult_comm: forall m n : nat,
-				m * n = n * m.
-Proof.
-	intros m n.
-	induction n as [| n'].
-	Case "n = 0".
-		simpl.
-		rewrite -> mult_0_r.
-		reflexivity.
-	Case "n = S n'".
-		simpl.
-		rewrite <- mult_distr.
-		rewrite -> mult_1_distr.
-		rewrite -> mult_1.
-		rewrite -> IHn'.
-		reflexivity.
-		Qed.
-
-Theorem evenb_next : forall n : nat,
-				evenb n = evenb (S (S n)).
-Proof.
-	intros n.
-Admitted.
-
-Theorem negb_negb : forall n : bool,
-				n = negb (negb n).
-Proof.
-	intros n.
-	destruct n.
-	reflexivity.
-	reflexivity.
-	Qed.
-
-Theorem evenb_n_oddb_Sn : forall n : nat,
-				evenb n = negb (evenb (S n)).
-Proof.
-	intros n.
-	induction n as [|n'].
-	reflexivity.
-	assert(H: evenb n' = evenb (S (S n'))).
-	reflexivity.
-	rewrite <- H.
-	rewrite -> IHn'.
-	rewrite <- negb_negb.
-	reflexivity.
-	Qed.
-
-(*Fixpoint bad (n : nat) : bool :=
-	match n with
-		| O => true
-		| S O => bad (S n)
-		| S (S n') => bad n'
-	end.*)
-
-Theorem ble_nat_refl : forall n:nat,
-				true = ble_nat n n.
-Proof.
-	intros n.
-	induction n as [|n'].
-	Case "n = 0".
-		reflexivity.
-	Case "n = S n".
-		simpl.
-		rewrite <- IHn'.
-		reflexivity.
-	Qed.
-
-Theorem zero_nbeq_S : forall n: nat,
-				beq_nat O (S n) = false.
-Proof.
-	intros n.
-	reflexivity.
-	Qed.
-
-Theorem andb_false_r : forall b : bool,
-				andb b false = false.
-Proof.
-	intros b.
-	destruct b.
-	reflexivity.
-	reflexivity.
-	Qed.
-
-Theorem plus_ble_compat_1 : forall n m p : nat,
-				ble_nat n m = true -> ble_nat (p + n) (p + m) = true.
-Proof.
-	intros n m p.
-	intros H.
-	induction p.
-	Case "p = 0".
-		simpl.
-		rewrite -> H.
-		reflexivity.
-	Case "p = S p'".
-		simpl.
-		rewrite -> IHp.
-		reflexivity.
-		Qed.
-
-Theorem S_nbeq_0 : forall n:nat,
-				beq_nat (S n) O = false.
-Proof.
-	intros n.
-	reflexivity.
-	Qed.
-
-Theorem mult_1_1 : forall n:nat, (S O) * n = n.
-Proof.
-	intros n.
-	simpl.
-	rewrite -> plus_0_r.
-	reflexivity. Qed.
-
-Theorem all3_spec : forall b c : bool,
-	orb (andb b c)
-			(orb (negb b)
-			 		 (negb c))
-	= true.
-Proof.
-	intros b c.
-	destruct b.
-	destruct c.
-	reflexivity.
-	reflexivity.
-	reflexivity.
-	Qed.
-
-Lemma mult_plus_1 : forall n m : nat,
-			S(m + n) = m + (S n).
-Proof.
-	intros n m.
-	induction m.
-	reflexivity.
-	simpl.
-	rewrite -> IHm.
-	reflexivity.
-	Qed.
-
-Theorem mult_mult : forall n m : nat,
-	n * (S m) = n * m + n.
-Proof.
-	intros n m.
-	induction n.
-	reflexivity.
-	simpl.
-	rewrite -> IHn.
-	rewrite -> plus_assoc.
-	rewrite -> mult_plus_1.
-	reflexivity.
-	Qed.
-
-Theorem mult_plus_distr_r : forall n m p:nat,
-				(n + m) * p = (n * p) + (m * p).
-Proof.
-	intros n m p.
-	induction p.
-	rewrite -> mult_0_r.
-	rewrite -> mult_0_r.
-	rewrite -> mult_0_r.
-	reflexivity.
-	rewrite -> mult_mult.
-	rewrite -> mult_mult.
-	rewrite -> mult_mult.
-	rewrite -> IHp.
-	assert(H1: ((n * p) + n) + (m * p + m) = (n * p) + (n + (m * p + m))).
-	rewrite <- plus_assoc.
-	reflexivity.
-	rewrite -> H1.
-	assert(H2: (n + (m * p + m)) = (m * p + (n + m))).
-	rewrite -> plus_swap.
-	reflexivity.
-	rewrite -> H2.
-	assert(H3: (n * p) + (m * p + (n + m)) = ((n * p ) + (m * p)) + (n + m)).
-	rewrite -> plus_assoc.
-	reflexivity.
-	rewrite -> H3.
-	reflexivity.
-	Qed.
-
-Theorem mult_assoc : forall n m p : nat,
-				n * (m * p) = (n * m) * p.
-Proof.
-	intros n m p.
-	induction n.
-	simpl.
-	reflexivity.
-	simpl.
-	rewrite -> mult_plus_distr_r.
-	rewrite -> IHn.
-	reflexivity.
-	Qed.
-
-Inductive bin : Type :=
-	| BO : bin
-	| D : bin -> bin
-	| M : bin -> bin.
-
-Fixpoint incbin (n : bin) : bin :=
-	match n with
-		| BO => M (BO)
-		| D n' => M n'
-		| M n' => D (incbin n')
-	end.
-
-Fixpoint bin2un (n : bin) : nat :=
-	match n with
-		| BO => O
-		| D n' => double (bin2un n')
-		| M n' => S (double (bin2un n'))
-	end.
-
-Theorem bin_comm : forall n : bin,
-				bin2un(incbin n) = S (bin2un n).
-Proof.
-	intros n.
-	induction n.
-		reflexivity.
-		reflexivity.
-		simpl.
-		rewrite -> IHn.
-		reflexivity.
-	Qed.
-
-End Playground1.
diff --git a/samples/Coq/Heap.v b/samples/Coq/Heap.v
deleted file mode 100755
index 4881c99e..00000000
--- a/samples/Coq/Heap.v
+++ /dev/null
@@ -1,290 +0,0 @@
-(** A development of Treesort on Heap trees. It has an average
-    complexity of O(n.log n) but of O(n²) in the worst case (e.g. if
-    the list is already sorted) *)
-
-(* G. Huet 1-9-95 uses Multiset *)
-
-Require Import List Multiset PermutSetoid Relations Sorting.
-
-Section defs.
-
-  (** * Trees and heap trees *)
-
-  (** ** Definition of trees over an ordered set *)
-
-  Variable A : Type.
-  Variable leA : relation A.
-  Variable eqA : relation A.
-
-  Let gtA (x y:A) := ~ leA x y.
-
-  Hypothesis leA_dec : forall x y:A, {leA x y} + {leA y x}.
-  Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
-  Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y.
-  Hypothesis leA_trans : forall x y z:A, leA x y -> leA y z -> leA x z.
-  Hypothesis leA_antisym : forall x y:A, leA x y -> leA y x -> eqA x y.
-
-  Hint Resolve leA_refl.
-  Hint Immediate eqA_dec leA_dec leA_antisym.
-
-  Let emptyBag := EmptyBag A.
-  Let singletonBag := SingletonBag _ eqA_dec.
-
-  Inductive Tree :=
-    | Tree_Leaf : Tree
-    | Tree_Node : A -> Tree -> Tree -> Tree.
-
-  (** [a] is lower than a Tree [T] if [T] is a Leaf
-      or [T] is a Node holding [b>a] *)
-
-  Definition leA_Tree (a:A) (t:Tree) :=
-    match t with
-      | Tree_Leaf => True
-      | Tree_Node b T1 T2 => leA a b
-    end.
-
-  Lemma leA_Tree_Leaf : forall a:A, leA_Tree a Tree_Leaf.
-  Proof.
-    simpl; auto with datatypes.
-  Qed.
-
-  Lemma leA_Tree_Node :
-    forall (a b:A) (G D:Tree), leA a b -> leA_Tree a (Tree_Node b G D).
-  Proof.
-    simpl; auto with datatypes.
-  Qed.
-
-
-  (** ** The heap property *)
-
-  Inductive is_heap : Tree -> Prop :=
-    | nil_is_heap : is_heap Tree_Leaf
-    | node_is_heap :
-      forall (a:A) (T1 T2:Tree),
-        leA_Tree a T1 ->
-        leA_Tree a T2 ->
-        is_heap T1 -> is_heap T2 -> is_heap (Tree_Node a T1 T2).
-
-  Lemma invert_heap :
-    forall (a:A) (T1 T2:Tree),
-      is_heap (Tree_Node a T1 T2) ->
-      leA_Tree a T1 /\ leA_Tree a T2 /\ is_heap T1 /\ is_heap T2.
-  Proof.
-    intros; inversion H; auto with datatypes.
-  Qed.
-
-  (* This lemma ought to be generated automatically by the Inversion tools *)
-  Lemma is_heap_rect :
-    forall P:Tree -> Type,
-      P Tree_Leaf ->
-      (forall (a:A) (T1 T2:Tree),
-        leA_Tree a T1 ->
-        leA_Tree a T2 ->
-        is_heap T1 -> P T1 -> is_heap T2 -> P T2 -> P (Tree_Node a T1 T2)) ->
-      forall T:Tree, is_heap T -> P T.
-  Proof.
-    simple induction T; auto with datatypes.
-    intros a G PG D PD PN.
-    elim (invert_heap a G D); auto with datatypes.
-    intros H1 H2; elim H2; intros H3 H4; elim H4; intros.
-    apply X0; auto with datatypes.
-  Qed.
-
-  (* This lemma ought to be generated automatically by the Inversion tools *)
-  Lemma is_heap_rec :
-    forall P:Tree -> Set,
-      P Tree_Leaf ->
-      (forall (a:A) (T1 T2:Tree),
-        leA_Tree a T1 ->
-        leA_Tree a T2 ->
-        is_heap T1 -> P T1 -> is_heap T2 -> P T2 -> P (Tree_Node a T1 T2)) ->
-      forall T:Tree, is_heap T -> P T.
-  Proof.
-    simple induction T; auto with datatypes.
-    intros a G PG D PD PN.
-    elim (invert_heap a G D); auto with datatypes.
-    intros H1 H2; elim H2; intros H3 H4; elim H4; intros.
-    apply X; auto with datatypes.
-  Qed.
-
-  Lemma low_trans :
-    forall (T:Tree) (a b:A), leA a b -> leA_Tree b T -> leA_Tree a T.
-  Proof.
-    simple induction T; auto with datatypes.
-    intros; simpl; apply leA_trans with b; auto with datatypes.
-  Qed.
-
-  (** ** Merging two sorted lists *)
-
-  Inductive merge_lem (l1 l2:list A) : Type :=
-    merge_exist :
-    forall l:list A,
-      Sorted leA l ->
-      meq (list_contents _ eqA_dec l)
-      (munion (list_contents _ eqA_dec l1) (list_contents _ eqA_dec l2)) ->
-      (forall a, HdRel leA a l1 -> HdRel leA a l2 -> HdRel leA a l) ->
-      merge_lem l1 l2.
-  Require Import Morphisms.
-
-  Instance: Equivalence (@meq A).
-  Proof. constructor; auto with datatypes. red. apply meq_trans. Defined.
-
-  Instance: Proper (@meq A ++> @meq _ ++> @meq _) (@munion A).
-  Proof. intros x y H x' y' H'. now apply meq_congr. Qed.
-
-  Lemma merge :
-    forall l1:list A, Sorted leA l1 ->
-    forall l2:list A, Sorted leA l2 -> merge_lem l1 l2.
-  Proof.
-    fix 1; intros; destruct l1.
-    apply merge_exist with l2; auto with datatypes.
-    rename l1 into l.
-    revert l2 H0. fix 1. intros.
-    destruct l2 as [|a0 l0].
-    apply merge_exist with (a :: l); simpl; auto with datatypes.
-    elim (leA_dec a a0); intros.
-
-    (* 1 (leA a a0) *)
-    apply Sorted_inv in H. destruct H.
-    destruct (merge l H (a0 :: l0) H0).
-    apply merge_exist with (a :: l1). clear merge merge0.
-      auto using cons_sort, cons_leA with datatypes.
-    simpl. rewrite m. now rewrite munion_ass.
-    intros. apply cons_leA.
-    apply (@HdRel_inv _ leA) with l; trivial with datatypes.
-
-    (* 2 (leA a0 a) *)
-    apply Sorted_inv in H0. destruct H0.
-    destruct (merge0 l0 H0). clear merge merge0.
-    apply merge_exist with (a0 :: l1);
-      auto using cons_sort, cons_leA with datatypes.
-    simpl; rewrite m. simpl. setoid_rewrite munion_ass at 1. rewrite munion_comm.
-    repeat rewrite munion_ass. setoid_rewrite munion_comm at 3. reflexivity.
-    intros. apply cons_leA.
-    apply (@HdRel_inv _ leA) with l0; trivial with datatypes.
-  Qed.
-
-  (** ** From trees to multisets *)
-
-  (** contents of a tree as a multiset *)
-
-  (** Nota Bene : In what follows the definition of SingletonBag
-      in not used. Actually, we could just take as postulate:
-      [Parameter SingletonBag : A->multiset].  *)
-
-  Fixpoint contents (t:Tree) : multiset A :=
-    match t with
-      | Tree_Leaf => emptyBag
-      | Tree_Node a t1 t2 =>
-        munion (contents t1) (munion (contents t2) (singletonBag a))
-    end.
-
-
-  (** equivalence of two trees is equality of corresponding multisets *)
-  Definition equiv_Tree (t1 t2:Tree) := meq (contents t1) (contents t2).
-
-
-
-  (** * From lists to sorted lists *)
-
-  (** ** Specification of heap insertion *)
-
-  Inductive insert_spec (a:A) (T:Tree) : Type :=
-    insert_exist :
-    forall T1:Tree,
-      is_heap T1 ->
-      meq (contents T1) (munion (contents T) (singletonBag a)) ->
-      (forall b:A, leA b a -> leA_Tree b T -> leA_Tree b T1) ->
-      insert_spec a T.
-
-
-  Lemma insert : forall T:Tree, is_heap T -> forall a:A, insert_spec a T.
-  Proof.
-    simple induction 1; intros.
-    apply insert_exist with (Tree_Node a Tree_Leaf Tree_Leaf);
-      auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes.
-    simpl; unfold meq, munion; auto using node_is_heap with datatypes.
-    elim (leA_dec a a0); intros.
-    elim (X a0); intros.
-    apply insert_exist with (Tree_Node a T2 T0);
-      auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes.
-    simpl; apply treesort_twist1; trivial with datatypes.
-    elim (X a); intros T3 HeapT3 ConT3 LeA.
-    apply insert_exist with (Tree_Node a0 T2 T3);
-      auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes.
-    apply node_is_heap; auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes.
-    apply low_trans with a; auto with datatypes.
-    apply LeA; auto with datatypes.
-    apply low_trans with a; auto with datatypes.
-    simpl; apply treesort_twist2; trivial with datatypes.
-  Qed.
-
-
-  (** ** Building a heap from a list *)
-
-  Inductive build_heap (l:list A) : Type :=
-    heap_exist :
-    forall T:Tree,
-      is_heap T ->
-      meq (list_contents _ eqA_dec l) (contents T) -> build_heap l.
-
-  Lemma list_to_heap : forall l:list A, build_heap l.
-  Proof.
-    simple induction l.
-    apply (heap_exist nil Tree_Leaf); auto with datatypes.
-    simpl; unfold meq; exact nil_is_heap.
-    simple induction 1.
-    intros T i m; elim (insert T i a).
-    intros; apply heap_exist with T1; simpl; auto with datatypes.
-    apply meq_trans with (munion (contents T) (singletonBag a)).
-    apply meq_trans with (munion (singletonBag a) (contents T)).
-    apply meq_right; trivial with datatypes.
-    apply munion_comm.
-    apply meq_sym; trivial with datatypes.
-  Qed.
-
-
-  (** ** Building the sorted list *)
-
-  Inductive flat_spec (T:Tree) : Type :=
-    flat_exist :
-    forall l:list A,
-      Sorted leA l ->
-      (forall a:A, leA_Tree a T -> HdRel leA a l) ->
-      meq (contents T) (list_contents _ eqA_dec l) -> flat_spec T.
-
-  Lemma heap_to_list : forall T:Tree, is_heap T -> flat_spec T.
-  Proof.
-    intros T h; elim h; intros.
-    apply flat_exist with (nil (A:=A)); auto with datatypes.
-    elim X; intros l1 s1 i1 m1; elim X0; intros l2 s2 i2 m2.
-    elim (merge _ s1 _ s2); intros.
-    apply flat_exist with (a :: l); simpl; auto with datatypes.
-    apply meq_trans with
-      (munion (list_contents _ eqA_dec l1)
-        (munion (list_contents _ eqA_dec l2) (singletonBag a))).
-    apply meq_congr; auto with datatypes.
-    apply meq_trans with
-      (munion (singletonBag a)
-        (munion (list_contents _ eqA_dec l1) (list_contents _ eqA_dec l2))).
-    apply munion_rotate.
-    apply meq_right; apply meq_sym; trivial with datatypes.
-  Qed.
-
-
-  (** * Specification of treesort *)
-
-  Theorem treesort :
-    forall l:list A,
-    {m : list A | Sorted leA m & permutation _ eqA_dec l m}.
-  Proof.
-    intro l; unfold permutation.
-    elim (list_to_heap l).
-    intros.
-    elim (heap_to_list T); auto with datatypes.
-    intros.
-    exists l0; auto with datatypes.
-    apply meq_trans with (contents T); trivial with datatypes.
-  Qed.
-
-End defs.
diff --git a/samples/Coq/PermutSetoid.v b/samples/Coq/PermutSetoid.v
deleted file mode 100755
index 2e0dd17f..00000000
--- a/samples/Coq/PermutSetoid.v
+++ /dev/null
@@ -1,539 +0,0 @@
-Require Import Omega Relations Multiset SetoidList.
-
-(** This file is deprecated, use [Permutation.v] instead.
-
-    Indeed, this file defines a notion of permutation based on
-    multisets (there exists a permutation between two lists iff every
-    elements have the same multiplicity in the two lists) which
-    requires a more complex apparatus (the equipment of the domain
-    with a decidable equality) than [Permutation] in [Permutation.v].
-
-    The relation between the two relations are in lemma
-    [permutation_Permutation].
-
-    File [Permutation] concerns Leibniz equality : it shows in particular
-    that [List.Permutation] and [permutation] are equivalent in this context.
-*)
-
-Set Implicit Arguments.
-
-Local Notation "[ ]" := nil.
-Local Notation "[ a ; .. ; b ]" := (a :: .. (b :: []) ..).
-
-Section Permut.
-
-(** * From lists to multisets *)
-
-Variable A : Type.
-Variable eqA : relation A.
-Hypothesis eqA_equiv : Equivalence eqA.
-Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
-
-Let emptyBag := EmptyBag A.
-Let singletonBag := SingletonBag _ eqA_dec.
-
-(** contents of a list *)
-
-Fixpoint list_contents (l:list A) : multiset A :=
-  match l with
-  | [] => emptyBag
-  | a :: l => munion (singletonBag a) (list_contents l)
-  end.
-
-Lemma list_contents_app :
-  forall l m:list A,
-    meq (list_contents (l ++ m)) (munion (list_contents l) (list_contents m)).
-Proof.
-  simple induction l; simpl; auto with datatypes.
-  intros.
-  apply meq_trans with
-    (munion (singletonBag a) (munion (list_contents l0) (list_contents m)));
-    auto with datatypes.
-Qed.
-
-(** * [permutation]: definition and basic properties *)
-
-Definition permutation (l m:list A) := meq (list_contents l) (list_contents m).
-
-Lemma permut_refl : forall l:list A, permutation l l.
-Proof.
-  unfold permutation; auto with datatypes.
-Qed.
-
-Lemma permut_sym :
-  forall l1 l2 : list A, permutation l1 l2 -> permutation l2 l1.
-Proof.
-  unfold permutation, meq; intros; symmetry; trivial.
-Qed.
-
-Lemma permut_trans :
-  forall l m n:list A, permutation l m -> permutation m n -> permutation l n.
-Proof.
-  unfold permutation; intros.
-  apply meq_trans with (list_contents m); auto with datatypes.
-Qed.
-
-Lemma permut_cons_eq :
-  forall l m:list A,
-    permutation l m -> forall a a', eqA a a' -> permutation (a :: l) (a' :: m).
-Proof.
-  unfold permutation; simpl; intros.
-  apply meq_trans with (munion (singletonBag a') (list_contents l)).
-  apply meq_left, meq_singleton; auto.
-  auto with datatypes.
-Qed.
-
-Lemma permut_cons :
-  forall l m:list A,
-    permutation l m -> forall a:A, permutation (a :: l) (a :: m).
-Proof.
-  unfold permutation; simpl; auto with datatypes.
-Qed.
-
-Lemma permut_app :
-  forall l l' m m':list A,
-    permutation l l' -> permutation m m' -> permutation (l ++ m) (l' ++ m').
-Proof.
-  unfold permutation; intros.
-  apply meq_trans with (munion (list_contents l) (list_contents m));
-    auto using permut_cons, list_contents_app with datatypes.
-  apply meq_trans with (munion (list_contents l') (list_contents m'));
-    auto using permut_cons, list_contents_app with datatypes.
-  apply meq_trans with (munion (list_contents l') (list_contents m));
-    auto using permut_cons, list_contents_app with datatypes.
-Qed.
-
-Lemma permut_add_inside_eq :
-  forall a a' l1 l2 l3 l4, eqA a a' ->
-    permutation (l1 ++ l2) (l3 ++ l4) ->
-    permutation (l1 ++ a :: l2) (l3 ++ a' :: l4).
-Proof.
-  unfold permutation, meq in *; intros.
-  specialize H0 with a0.
-  repeat rewrite list_contents_app in *; simpl in *.
-  destruct (eqA_dec a a0) as [Ha|Ha]; rewrite H in Ha;
-    decide (eqA_dec a' a0) with Ha; simpl; auto with arith.
-  do 2 rewrite <- plus_n_Sm; f_equal; auto.
-Qed.
-
-Lemma permut_add_inside :
-  forall a l1 l2 l3 l4,
-    permutation (l1 ++ l2) (l3 ++ l4) ->
-    permutation (l1 ++ a :: l2) (l3 ++ a :: l4).
-Proof.
-  unfold permutation, meq in *; intros.
-  generalize (H a0); clear H.
-  do 4 rewrite list_contents_app.
-  simpl.
-  destruct (eqA_dec a a0); simpl; auto with arith.
-  do 2 rewrite <- plus_n_Sm; f_equal; auto.
-Qed.
-
-Lemma permut_add_cons_inside_eq :
-  forall a a' l l1 l2, eqA a a' ->
-    permutation l (l1 ++ l2) ->
-    permutation (a :: l) (l1 ++ a' :: l2).
-Proof.
-  intros;
-  replace (a :: l) with ([] ++ a :: l); trivial;
-    apply permut_add_inside_eq; trivial.
-Qed.
-
-Lemma permut_add_cons_inside :
-  forall a l l1 l2,
-    permutation l (l1 ++ l2) ->
-    permutation (a :: l) (l1 ++ a :: l2).
-Proof.
-  intros;
-    replace (a :: l) with ([] ++ a :: l); trivial;
-        apply permut_add_inside; trivial.
-Qed.
-
-Lemma permut_middle :
-  forall (l m:list A) (a:A), permutation (a :: l ++ m) (l ++ a :: m).
-Proof.
-  intros; apply permut_add_cons_inside; auto using permut_sym, permut_refl.
-Qed.
-
-Lemma permut_sym_app :
-  forall l1 l2, permutation (l1 ++ l2) (l2 ++ l1).
-Proof.
-  intros l1 l2;
-    unfold permutation, meq;
-        intro a; do 2 rewrite list_contents_app; simpl;
-          auto with arith.
-Qed.
-
-Lemma permut_rev :
-  forall l, permutation l (rev l).
-Proof.
-  induction l.
-  simpl; trivial using permut_refl.
-  simpl.
-  apply permut_add_cons_inside.
-  rewrite <- app_nil_end. trivial.
-Qed.
-
-(** * Some inversion results. *)
-Lemma permut_conv_inv :
-  forall e l1 l2, permutation (e :: l1) (e :: l2) -> permutation l1 l2.
-Proof.
-  intros e l1 l2; unfold permutation, meq; simpl; intros H a;
-    generalize (H a); apply plus_reg_l.
-Qed.
-
-Lemma permut_app_inv1 :
-  forall l l1 l2, permutation (l1 ++ l) (l2 ++ l) -> permutation l1 l2.
-Proof.
-  intros l l1 l2; unfold permutation, meq; simpl;
-    intros H a; generalize (H a); clear H.
-  do 2 rewrite list_contents_app.
-  simpl.
-  intros; apply plus_reg_l with (multiplicity (list_contents l) a).
-  rewrite plus_comm; rewrite H; rewrite plus_comm.
-  trivial.
-Qed.
-
-(** we can use [multiplicity] to define [InA] and [NoDupA]. *)
-
-Fact if_eqA_then : forall a a' (B:Type)(b b':B),
- eqA a a' -> (if eqA_dec a a' then b else b') = b.
-Proof.
-  intros. destruct eqA_dec as [_|NEQ]; auto.
-  contradict NEQ; auto.
-Qed.
-
-Lemma permut_app_inv2 :
-  forall l l1 l2, permutation (l ++ l1) (l ++ l2) -> permutation l1 l2.
-Proof.
-  intros l l1 l2; unfold permutation, meq; simpl;
-    intros H a; generalize (H a); clear H.
-  do 2 rewrite list_contents_app.
-  simpl.
-  intros; apply plus_reg_l with (multiplicity (list_contents l) a).
-  trivial.
-Qed.
-
-Lemma permut_remove_hd_eq :
-  forall l l1 l2 a b, eqA a b ->
-    permutation (a :: l) (l1 ++ b :: l2) -> permutation l (l1 ++ l2).
-Proof.
-  unfold permutation, meq; simpl; intros l l1 l2 a b Heq H a0.
-  specialize H with a0.
-  rewrite list_contents_app in *; simpl in *.
-  apply plus_reg_l with (if eqA_dec a a0 then 1 else 0).
-  rewrite H; clear H.
-  symmetry; rewrite plus_comm, <- ! plus_assoc; f_equal.
-  rewrite plus_comm.
-  destruct (eqA_dec a a0) as [Ha|Ha]; rewrite Heq in Ha;
-    decide (eqA_dec b a0) with Ha; reflexivity.
-Qed.
-
-Lemma permut_remove_hd :
-  forall l l1 l2 a,
-    permutation (a :: l) (l1 ++ a :: l2) -> permutation l (l1 ++ l2).
-Proof.
-  eauto using permut_remove_hd_eq, Equivalence_Reflexive.
-Qed.
-
-Fact if_eqA_else : forall a a' (B:Type)(b b':B),
- ~eqA a a' -> (if eqA_dec a a' then b else b') = b'.
-Proof.
-  intros. decide (eqA_dec a a') with H; auto.
-Qed.
-
-Fact if_eqA_refl : forall a (B:Type)(b b':B),
- (if eqA_dec a a then b else b') = b.
-Proof.
-  intros; apply (decide_left (eqA_dec a a)); auto with *.
-Qed.
-
-(** PL: Inutilisable dans un rewrite sans un change prealable. *)
-
-Global Instance if_eqA (B:Type)(b b':B) :
- Proper (eqA==>eqA==>@eq _) (fun x y => if eqA_dec x y then b else b').
-Proof.
- intros x x' Hxx' y y' Hyy'.
- intros; destruct (eqA_dec x y) as [H|H];
-  destruct (eqA_dec x' y') as [H'|H']; auto.
- contradict H'; transitivity x; auto with *; transitivity y; auto with *.
- contradict H; transitivity x'; auto with *; transitivity y'; auto with *.
-Qed.
-
-Fact if_eqA_rewrite_l : forall a1 a1' a2 (B:Type)(b b':B),
- eqA a1 a1' -> (if eqA_dec a1 a2 then b else b') =
-               (if eqA_dec a1' a2 then b else b').
-Proof.
- intros; destruct (eqA_dec a1 a2) as [A1|A1];
-  destruct (eqA_dec a1' a2) as [A1'|A1']; auto.
- contradict A1'; transitivity a1; eauto with *.
- contradict A1; transitivity a1'; eauto with *.
-Qed.
-
-Fact if_eqA_rewrite_r : forall a1 a2 a2' (B:Type)(b b':B),
- eqA a2 a2' -> (if eqA_dec a1 a2 then b else b') =
-               (if eqA_dec a1 a2' then b else b').
-Proof.
- intros; destruct (eqA_dec a1 a2) as [A2|A2];
-  destruct (eqA_dec a1 a2') as [A2'|A2']; auto.
- contradict A2'; transitivity a2; eauto with *.
- contradict A2; transitivity a2'; eauto with *.
-Qed.
-
-
-Global Instance multiplicity_eqA (l:list A) :
- Proper (eqA==>@eq _) (multiplicity (list_contents l)).
-Proof.
-  intros x x' Hxx'.
-  induction l as [|y l Hl]; simpl; auto.
-  rewrite (@if_eqA_rewrite_r y x x'); auto.
-Qed.
-
-Lemma multiplicity_InA :
-  forall l a, InA eqA a l <-> 0 < multiplicity (list_contents l) a.
-Proof.
-  induction l.
-  simpl.
-  split; inversion 1.
-  simpl.
-  intros a'; split; intros H. inversion_clear H.
-  apply (decide_left (eqA_dec a a')); auto with *.
-  destruct (eqA_dec a a'); auto with *. simpl; rewrite <- IHl; auto.
-  destruct (eqA_dec a a'); auto with *. right. rewrite IHl; auto.
-Qed.
-
-Lemma multiplicity_InA_O :
-  forall l a, ~ InA eqA a l -> multiplicity (list_contents l) a = 0.
-Proof.
-  intros l a; rewrite multiplicity_InA;
-    destruct (multiplicity (list_contents l) a); auto with arith.
-  destruct 1; auto with arith.
-Qed.
-
-Lemma multiplicity_InA_S :
-  forall l a, InA eqA a l -> multiplicity (list_contents l) a >= 1.
-Proof.
-  intros l a; rewrite multiplicity_InA; auto with arith.
-Qed.
-
-Lemma multiplicity_NoDupA : forall l,
-  NoDupA eqA l <-> (forall a, multiplicity (list_contents l) a <= 1).
-Proof.
-  induction l.
-  simpl.
-  split; auto with arith.
-  split; simpl.
-  inversion_clear 1.
-  rewrite IHl in H1.
-  intros; destruct (eqA_dec a a0) as [EQ|NEQ]; simpl; auto with *.
-  rewrite <- EQ.
-  rewrite multiplicity_InA_O; auto.
-  intros; constructor.
-  rewrite multiplicity_InA.
-  specialize (H a).
-  rewrite if_eqA_refl in H.
-  clear IHl; omega.
-  rewrite IHl; intros.
-  specialize (H a0). omega.
-Qed.
-
-(** Permutation is compatible with InA. *)
-Lemma permut_InA_InA :
-  forall l1 l2 e, permutation l1 l2 -> InA eqA e l1 -> InA eqA e l2.
-Proof.
-  intros l1 l2 e.
-  do 2 rewrite multiplicity_InA.
-  unfold permutation, meq.
-  intros H;rewrite H; auto.
-Qed.
-
-Lemma permut_cons_InA :
-  forall l1 l2 e, permutation (e :: l1) l2 -> InA eqA e l2.
-Proof.
-  intros; apply (permut_InA_InA (e:=e) H); auto with *.
-Qed.
-
-(** Permutation of an empty list. *)
-Lemma permut_nil :
-  forall l, permutation l [] -> l = [].
-Proof.
-  intro l; destruct l as [ | e l ]; trivial.
-  assert (InA eqA e (e::l)) by (auto with *).
-  intro Abs; generalize (permut_InA_InA Abs H).
-  inversion 1.
-Qed.
-
-(** Permutation for short lists. *)
-
-Lemma permut_length_1:
-  forall a b, permutation [a] [b] -> eqA a b.
-Proof.
-  intros a b; unfold permutation, meq.
-  intro P; specialize (P b); simpl in *.
-  rewrite if_eqA_refl in *.
-  destruct (eqA_dec a b); simpl; auto; discriminate.
-Qed.
-
-Lemma permut_length_2 :
-  forall a1 b1 a2 b2, permutation [a1; b1] [a2; b2] ->
-    (eqA a1 a2) /\ (eqA b1 b2) \/ (eqA a1 b2) /\ (eqA a2 b1).
-Proof.
-  intros a1 b1 a2 b2 P.
-  assert (H:=permut_cons_InA P).
-  inversion_clear H.
-  left; split; auto.
-  apply permut_length_1.
-  red; red; intros.
-  specialize (P a). simpl in *.
-  rewrite (@if_eqA_rewrite_l a1 a2 a) in P by auto. omega.
-  right.
-  inversion_clear H0; [|inversion H].
-  split; auto.
-  apply permut_length_1.
-  red; red; intros.
-  specialize (P a); simpl in *.
-  rewrite (@if_eqA_rewrite_l a1 b2 a) in P by auto. omega.
-Qed.
-
-(** Permutation is compatible with length. *)
-Lemma permut_length :
-  forall l1 l2, permutation l1 l2 -> length l1 = length l2.
-Proof.
-  induction l1; intros l2 H.
-  rewrite (permut_nil (permut_sym H)); auto.
-  assert (H0:=permut_cons_InA H).
-  destruct (InA_split H0) as (h2,(b,(t2,(H1,H2)))).
-  subst l2.
-  rewrite app_length.
-  simpl; rewrite <- plus_n_Sm; f_equal.
-  rewrite <- app_length.
-  apply IHl1.
-  apply permut_remove_hd with b.
-  apply permut_trans with (a::l1); auto.
-  revert H1; unfold permutation, meq; simpl.
-  intros; f_equal; auto.
-  rewrite (@if_eqA_rewrite_l a b a0); auto.
-Qed.
-
-Lemma NoDupA_equivlistA_permut :
-  forall l l', NoDupA eqA l -> NoDupA eqA l' ->
-    equivlistA eqA l l' -> permutation l l'.
-Proof.
-  intros.
-  red; unfold meq; intros.
-  rewrite multiplicity_NoDupA in H, H0.
-  generalize (H a) (H0 a) (H1 a); clear H H0 H1.
-  do 2 rewrite multiplicity_InA.
-  destruct 3; omega.
-Qed.
-
-End Permut.
-
-Section Permut_map.
-
-Variables A B : Type.
-
-Variable eqA : relation A.
-Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
-Hypothesis eqA_equiv : Equivalence eqA.
-
-Variable eqB : B->B->Prop.
-Hypothesis eqB_dec : forall x y:B, { eqB x y }+{ ~eqB x y }.
-Hypothesis eqB_trans : Transitive eqB.
-
-(** Permutation is compatible with map. *)
-
-Lemma permut_map :
-  forall f,
-    (Proper (eqA==>eqB) f) ->
-    forall l1 l2, permutation _ eqA_dec l1 l2 ->
-      permutation _ eqB_dec (map f l1) (map f l2).
-Proof.
-  intros f; induction l1.
-  intros l2 P; rewrite (permut_nil eqA_equiv (permut_sym P)); apply permut_refl.
-  intros l2 P.
-  simpl.
-  assert (H0:=permut_cons_InA eqA_equiv P).
-  destruct (InA_split H0) as (h2,(b,(t2,(H1,H2)))).
-  subst l2.
-  rewrite map_app.
-  simpl.
-  apply permut_trans with (f b :: map f l1).
-  revert H1; unfold permutation, meq; simpl.
-  intros; f_equal; auto.
-  destruct (eqB_dec (f b) a0) as [H2|H2];
-    destruct (eqB_dec (f a) a0) as [H3|H3]; auto.
-  destruct H3; transitivity (f b); auto with *.
-  destruct H2; transitivity (f a); auto with *.
-  apply permut_add_cons_inside.
-  rewrite <- map_app.
-  apply IHl1; auto.
-  apply permut_remove_hd with b; trivial.
-  apply permut_trans with (a::l1); auto.
-  revert H1; unfold permutation, meq; simpl.
-  intros; f_equal; auto.
-  rewrite (@if_eqA_rewrite_l _ _ eqA_equiv eqA_dec a b a0); auto.
-Qed.
-
-End Permut_map.
-
-Require Import Permutation.
-
-Section Permut_permut.
-
-Variable A : Type.
-
-Variable eqA : relation A.
-Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
-Hypothesis eqA_equiv : Equivalence eqA.
-
-Lemma Permutation_impl_permutation : forall l l',
-  Permutation l l' -> permutation _ eqA_dec l l'.
-Proof.
-  induction 1.
-    apply permut_refl.
-    apply permut_cons; auto using Equivalence_Reflexive.
-    change (x :: y :: l) with ([x] ++ y :: l);
-      apply permut_add_cons_inside; simpl;
-      apply permut_cons_eq; auto using Equivalence_Reflexive, permut_refl.
-    apply permut_trans with l'; trivial.
-Qed.
-
-Lemma permut_eqA : forall l l', Forall2 eqA l l' -> permutation _ eqA_dec l l'.
-Proof.
-  induction 1.
-    apply permut_refl.
-    apply permut_cons_eq; trivial.
-Qed.
-
-Lemma permutation_Permutation : forall l l',
-  permutation _ eqA_dec l l' <->
-  exists l'', Permutation l l'' /\ Forall2 eqA l'' l'.
-Proof.
-  split; intro H.
-  (* -> *)
-  induction l in l', H |- *.
-    exists []; apply permut_sym, permut_nil in H as ->; auto using Forall2.
-    pose proof H as H'.
-    apply permut_cons_InA, InA_split in H
-      as (l1 & y & l2 & Heq & ->); trivial.
-    apply permut_remove_hd_eq, IHl in H'
-      as (l'' & IHP & IHA); clear IHl; trivial.
-    apply Forall2_app_inv_r in IHA as (l1'' & l2'' & Hl1 & Hl2 & ->).
-    exists (l1'' ++ a :: l2''); split.
-      apply Permutation_cons_app; trivial.
-      apply Forall2_app, Forall2_cons; trivial.
-  (* <- *)
-  destruct H as (l'' & H & Heq).
-  apply permut_trans with l''.
-    apply Permutation_impl_permutation; trivial.
-    apply permut_eqA; trivial.
-Qed.
-
-End Permut_permut.
-
-(* begin hide *)
-(** For compatibilty *)
-Notation permut_right := permut_cons (only parsing).
-Notation permut_tran := permut_trans (only parsing).
-(* end hide *)
diff --git a/samples/Coq/Permutation.v b/samples/Coq/Permutation.v
deleted file mode 100755
index 4761fb6d..00000000
--- a/samples/Coq/Permutation.v
+++ /dev/null
@@ -1,632 +0,0 @@
-(* Adapted in May 2006 by Jean-Marc Notin from initial contents by
-   Laurent Thery (Huffmann contribution, October 2003) *)
-
-Require Import List Setoid Compare_dec Morphisms.
-Import ListNotations. (* For notations [] and [a;b;c] *)
-Set Implicit Arguments.
-
-Section Permutation.
-
-Variable A:Type.
-
-Inductive Permutation : list A -> list A -> Prop :=
-| perm_nil: Permutation [] []
-| perm_skip x l l' : Permutation l l' -> Permutation (x::l) (x::l')
-| perm_swap x y l : Permutation (y::x::l) (x::y::l)
-| perm_trans l l' l'' :
-    Permutation l l' -> Permutation l' l'' -> Permutation l l''.
-
-Local Hint Constructors Permutation.
-
-(** Some facts about [Permutation] *)
-
-Theorem Permutation_nil : forall (l : list A), Permutation [] l -> l = [].
-Proof.
-  intros l HF.
-  remember (@nil A) as m in HF.
-  induction HF; discriminate || auto.
-Qed.
-
-Theorem Permutation_nil_cons : forall (l : list A) (x : A),
- ~ Permutation nil (x::l).
-Proof.
-  intros l x HF.
-  apply Permutation_nil in HF; discriminate.
-Qed.
-
-(** Permutation over lists is a equivalence relation *)
-
-Theorem Permutation_refl : forall l : list A, Permutation l l.
-Proof.
-  induction l; constructor. exact IHl.
-Qed.
-
-Theorem Permutation_sym : forall l l' : list A,
- Permutation l l' -> Permutation l' l.
-Proof.
-  intros l l' Hperm; induction Hperm; auto.
-  apply perm_trans with (l':=l'); assumption.
-Qed.
-
-Theorem Permutation_trans : forall l l' l'' : list A,
- Permutation l l' -> Permutation l' l'' -> Permutation l l''.
-Proof.
-  exact perm_trans.
-Qed.
-
-End Permutation.
-
-Hint Resolve Permutation_refl perm_nil perm_skip.
-
-(* These hints do not reduce the size of the problem to solve and they
-   must be used with care to avoid combinatoric explosions *)
-
-Local Hint Resolve perm_swap perm_trans.
-Local Hint Resolve Permutation_sym Permutation_trans.
-
-(* This provides reflexivity, symmetry and transitivity and rewriting
-   on morphims to come *)
-
-Instance Permutation_Equivalence A : Equivalence (@Permutation A) | 10 := {
-  Equivalence_Reflexive := @Permutation_refl A ;
-  Equivalence_Symmetric := @Permutation_sym A ;
-  Equivalence_Transitive := @Permutation_trans A }.
-
-Instance Permutation_cons A :
- Proper (Logic.eq ==> @Permutation A ==> @Permutation A) (@cons A) | 10.
-Proof.
-  repeat intro; subst; auto using perm_skip.
-Qed.
-
-Section Permutation_properties.
-
-Variable A:Type.
-
-Implicit Types a b : A.
-Implicit Types l m : list A.
-
-(** Compatibility with others operations on lists *)
-
-Theorem Permutation_in : forall (l l' : list A) (x : A),
- Permutation l l' -> In x l -> In x l'.
-Proof.
-  intros l l' x Hperm; induction Hperm; simpl; tauto.
-Qed.
-
-Global Instance Permutation_in' :
- Proper (Logic.eq ==> @Permutation A ==> iff) (@In A) | 10.
-Proof.
-  repeat red; intros; subst; eauto using Permutation_in.
-Qed.
-
-Lemma Permutation_app_tail : forall (l l' tl : list A),
- Permutation l l' -> Permutation (l++tl) (l'++tl).
-Proof.
-  intros l l' tl Hperm; induction Hperm as [|x l l'|x y l|l l' l'']; simpl; auto.
-  eapply Permutation_trans with (l':=l'++tl); trivial.
-Qed.
-
-Lemma Permutation_app_head : forall (l tl tl' : list A),
- Permutation tl tl' -> Permutation (l++tl) (l++tl').
-Proof.
-  intros l tl tl' Hperm; induction l;
-   [trivial | repeat rewrite <- app_comm_cons; constructor; assumption].
-Qed.
-
-Theorem Permutation_app : forall (l m l' m' : list A),
- Permutation l l' -> Permutation m m' -> Permutation (l++m) (l'++m').
-Proof.
-  intros l m l' m' Hpermll' Hpermmm';
-   induction Hpermll' as [|x l l'|x y l|l l' l''];
-    repeat rewrite <- app_comm_cons; auto.
-  apply Permutation_trans with (l' := (x :: y :: l ++ m));
-   [idtac | repeat rewrite app_comm_cons; apply Permutation_app_head]; trivial.
-  apply Permutation_trans with (l' := (l' ++ m')); try assumption.
-  apply Permutation_app_tail; assumption.
-Qed.
-
-Global Instance Permutation_app' :
- Proper (@Permutation A ==> @Permutation A ==> @Permutation A) (@app A) | 10.
-Proof.
-  repeat intro; now apply Permutation_app.
-Qed.
-
-Lemma Permutation_add_inside : forall a (l l' tl tl' : list A),
-  Permutation l l' -> Permutation tl tl' ->
-  Permutation (l ++ a :: tl) (l' ++ a :: tl').
-Proof.
-  intros; apply Permutation_app; auto.
-Qed.
-
-Lemma Permutation_cons_append : forall (l : list A) x,
-  Permutation (x :: l) (l ++ x :: nil).
-Proof. induction l; intros; auto. simpl. rewrite <- IHl; auto. Qed.
-Local Hint Resolve Permutation_cons_append.
-
-Theorem Permutation_app_comm : forall (l l' : list A),
-  Permutation (l ++ l') (l' ++ l).
-Proof.
-  induction l as [|x l]; simpl; intro l'.
-  rewrite app_nil_r; trivial. rewrite IHl.
-  rewrite app_comm_cons, Permutation_cons_append.
-  now rewrite <- app_assoc.
-Qed.
-Local Hint Resolve Permutation_app_comm.
-
-Theorem Permutation_cons_app : forall (l l1 l2:list A) a,
-  Permutation l (l1 ++ l2) -> Permutation (a :: l) (l1 ++ a :: l2).
-Proof.
-  intros l l1 l2 a H. rewrite H.
-  rewrite app_comm_cons, Permutation_cons_append.
-  now rewrite <- app_assoc.
-Qed.
-Local Hint Resolve Permutation_cons_app.
-
-Theorem Permutation_middle : forall (l1 l2:list A) a,
-  Permutation (a :: l1 ++ l2) (l1 ++ a :: l2).
-Proof.
-  auto.
-Qed.
-Local Hint Resolve Permutation_middle.
-
-Theorem Permutation_rev : forall (l : list A), Permutation l (rev l).
-Proof.
-  induction l as [| x l]; simpl; trivial. now rewrite IHl at 1.
-Qed.
-
-Global Instance Permutation_rev' :
- Proper (@Permutation A ==> @Permutation A) (@rev A) | 10.
-Proof.
-  repeat intro; now rewrite <- 2 Permutation_rev.
-Qed.
-
-Theorem Permutation_length : forall (l l' : list A),
- Permutation l l' -> length l = length l'.
-Proof.
-  intros l l' Hperm; induction Hperm; simpl; auto. now transitivity (length l').
-Qed.
-
-Global Instance Permutation_length' :
- Proper (@Permutation A ==> Logic.eq) (@length A) | 10.
-Proof.
-  exact Permutation_length.
-Qed.
-
-Theorem Permutation_ind_bis :
- forall P : list A -> list A -> Prop,
-   P [] [] ->
-   (forall x l l', Permutation l l' -> P l l' -> P (x :: l) (x :: l')) ->
-   (forall x y l l', Permutation l l' -> P l l' -> P (y :: x :: l) (x :: y :: l')) ->
-   (forall l l' l'', Permutation l l' -> P l l' -> Permutation l' l'' -> P l' l'' -> P l l'') ->
-   forall l l', Permutation l l' -> P l l'.
-Proof.
-  intros P Hnil Hskip Hswap Htrans.
-  induction 1; auto.
-  apply Htrans with (x::y::l); auto.
-  apply Hswap; auto.
-  induction l; auto.
-  apply Hskip; auto.
-  apply Hskip; auto.
-  induction l; auto.
-  eauto.
-Qed.
-
-Ltac break_list l x l' H :=
-  destruct l as [|x l']; simpl in *;
-  injection H; intros; subst; clear H.
-
-Theorem Permutation_nil_app_cons : forall (l l' : list A) (x : A),
- ~ Permutation nil (l++x::l').
-Proof.
-  intros l l' x HF.
-  apply Permutation_nil in HF. destruct l; discriminate.
-Qed.
-
-Theorem Permutation_app_inv : forall (l1 l2 l3 l4:list A) a,
-  Permutation (l1++a::l2) (l3++a::l4) -> Permutation (l1++l2) (l3 ++ l4).
-Proof.
-  intros l1 l2 l3 l4 a; revert l1 l2 l3 l4.
-  set (P l l' :=
-       forall l1 l2 l3 l4, l=l1++a::l2 -> l'=l3++a::l4 ->
-       Permutation (l1++l2) (l3++l4)).
-  cut (forall l l', Permutation l l' -> P l l').
-  intros H; intros; eapply H; eauto.
-  apply (Permutation_ind_bis P); unfold P; clear P.
-  - (* nil *)
-    intros; now destruct l1.
-  - (* skip *)
-    intros x l l' H IH; intros.
-    break_list l1 b l1' H0; break_list l3 c l3' H1.
-    auto.
-    now rewrite H.
-    now rewrite <- H.
-    now rewrite (IH _ _ _ _ eq_refl eq_refl).
-  - (* swap *)
-    intros x y l l' Hp IH; intros.
-    break_list l1 b l1' H; break_list l3 c l3' H0.
-    auto.
-    break_list l3' b l3'' H.
-    auto.
-    constructor. now rewrite Permutation_middle.
-    break_list l1' c l1'' H1.
-    auto.
-    constructor. now rewrite Permutation_middle.
-    break_list l3' d l3'' H; break_list l1' e l1'' H1.
-    auto.
-    rewrite perm_swap. constructor. now rewrite Permutation_middle.
-    rewrite perm_swap. constructor. now rewrite Permutation_middle.
-    now rewrite perm_swap, (IH _ _ _ _ eq_refl eq_refl).
-  - (*trans*)
-    intros.
-    destruct (In_split a l') as (l'1,(l'2,H6)).
-    rewrite <- H.
-    subst l.
-    apply in_or_app; right; red; auto.
-    apply perm_trans with (l'1++l'2).
-    apply (H0 _ _ _ _ H3 H6).
-    apply (H2 _ _ _ _ H6 H4).
-Qed.
-
-Theorem Permutation_cons_inv l l' a :
- Permutation (a::l) (a::l') -> Permutation l l'.
-Proof.
-  intro H; exact (Permutation_app_inv [] l [] l' a H).
-Qed.
-
-Theorem Permutation_cons_app_inv l l1 l2 a :
- Permutation (a :: l) (l1 ++ a :: l2) -> Permutation l (l1 ++ l2).
-Proof.
-  intro H; exact (Permutation_app_inv [] l l1 l2 a H).
-Qed.
-
-Theorem Permutation_app_inv_l : forall l l1 l2,
- Permutation (l ++ l1) (l ++ l2) -> Permutation l1 l2.
-Proof.
-  induction l; simpl; auto.
-  intros.
-  apply IHl.
-  apply Permutation_cons_inv with a; auto.
-Qed.
-
-Theorem Permutation_app_inv_r : forall l l1 l2,
- Permutation (l1 ++ l) (l2 ++ l) -> Permutation l1 l2.
-Proof.
-  induction l.
-  intros l1 l2; do 2 rewrite app_nil_r; auto.
-  intros.
-  apply IHl.
-  apply Permutation_app_inv with a; auto.
-Qed.
-
-Lemma Permutation_length_1_inv: forall a l, Permutation [a] l -> l = [a].
-Proof.
-  intros a l H; remember [a] as m in H.
-  induction H; try (injection Heqm as -> ->; clear Heqm);
-    discriminate || auto.
-  apply Permutation_nil in H as ->; trivial.
-Qed.
-
-Lemma Permutation_length_1: forall a b, Permutation [a] [b] -> a = b.
-Proof.
-  intros a b H.
-  apply Permutation_length_1_inv in H; injection H as ->; trivial.
-Qed.
-
-Lemma Permutation_length_2_inv :
-  forall a1 a2 l, Permutation [a1;a2] l -> l = [a1;a2] \/ l = [a2;a1].
-Proof.
-  intros a1 a2 l H; remember [a1;a2] as m in H.
-  revert a1 a2 Heqm.
-  induction H; intros; try (injection Heqm; intros; subst; clear Heqm);
-    discriminate || (try tauto).
-  apply Permutation_length_1_inv in H as ->; left; auto.
-  apply IHPermutation1 in Heqm as [H1|H1]; apply IHPermutation2 in H1 as ();
-    auto.
-Qed.
-
-Lemma Permutation_length_2 :
-  forall a1 a2 b1 b2, Permutation [a1;a2] [b1;b2] ->
-    a1 = b1 /\ a2 = b2 \/ a1 = b2 /\ a2 = b1.
-Proof.
-  intros a1 b1 a2 b2 H.
-  apply Permutation_length_2_inv in H as [H|H]; injection H as -> ->; auto.
-Qed.
-
-Let in_middle l l1 l2 (a:A) : l = l1 ++ a :: l2 ->
- forall x, In x l <-> a = x \/ In x (l1++l2).
-Proof.
- intros; subst; rewrite !in_app_iff; simpl. tauto.
-Qed.
-
-Lemma NoDup_cardinal_incl (l l' : list A) : NoDup l -> NoDup l' ->
-  length l = length l' -> incl l l' -> incl l' l.
-Proof.
- intros N. revert l'. induction N as [|a l Hal Hl IH].
- - destruct l'; now auto.
- - intros l' Hl' E H x Hx.
-   assert (Ha : In a l') by (apply H; simpl; auto).
-   destruct (in_split _ _ Ha) as (l1 & l2 & H12). clear Ha.
-   rewrite in_middle in Hx; eauto.
-   destruct Hx as [Hx|Hx]; [left|right]; auto.
-   apply (IH (l1++l2)); auto.
-   * apply NoDup_remove_1 with a; rewrite <- H12; auto.
-   * apply eq_add_S.
-     simpl in E; rewrite E, H12, !app_length; simpl; auto with arith.
-   * intros y Hy. assert (Hy' : In y l') by (apply H; simpl; auto).
-     rewrite in_middle in Hy'; eauto.
-     destruct Hy'; auto. subst y; intuition.
-Qed.
-
-Lemma NoDup_Permutation l l' : NoDup l -> NoDup l' ->
-  (forall x:A, In x l <-> In x l') -> Permutation l l'.
-Proof.
- intros N. revert l'. induction N as [|a l Hal Hl IH].
- - destruct l'; simpl; auto.
-   intros Hl' H. exfalso. rewrite (H a); auto.
- - intros l' Hl' H.
-   assert (Ha : In a l') by (apply H; simpl; auto).
-   destruct (In_split _ _ Ha) as (l1 & l2 & H12).
-   rewrite H12.
-   apply Permutation_cons_app.
-   apply IH; auto.
-   * apply NoDup_remove_1 with a; rewrite <- H12; auto.
-   * intro x. split; intros Hx.
-     + assert (Hx' : In x l') by (apply H; simpl; auto).
-       rewrite in_middle in Hx'; eauto.
-       destruct Hx'; auto. subst; intuition.
-     + assert (Hx' : In x l') by (rewrite (in_middle l1 l2 a); eauto).
-       rewrite <- H in Hx'. destruct Hx'; auto.
-       subst. destruct (NoDup_remove_2 _ _ _ Hl' Hx).
-Qed.
-
-Lemma NoDup_Permutation_bis l l' : NoDup l -> NoDup l' ->
-  length l = length l' -> incl l l' -> Permutation l l'.
-Proof.
- intros. apply NoDup_Permutation; auto.
- split; auto. apply NoDup_cardinal_incl; auto.
-Qed.
-
-Lemma Permutation_NoDup l l' : Permutation l l' -> NoDup l -> NoDup l'.
-Proof.
- induction 1; auto.
- * inversion_clear 1; constructor; eauto using Permutation_in.
- * inversion_clear 1 as [|? ? H1 H2]. inversion_clear H2; simpl in *.
-   constructor. simpl; intuition. constructor; intuition.
-Qed.
-
-Global Instance Permutation_NoDup' :
- Proper (@Permutation A ==> iff) (@NoDup A) | 10.
-Proof.
-  repeat red; eauto using Permutation_NoDup.
-Qed.
-
-End Permutation_properties.
-
-Section Permutation_map.
-
-Variable A B : Type.
-Variable f : A -> B.
-
-Lemma Permutation_map l l' :
-  Permutation l l' -> Permutation (map f l) (map f l').
-Proof.
- induction 1; simpl; eauto.
-Qed.
-
-Global Instance Permutation_map' :
-  Proper (@Permutation A ==> @Permutation B) (map f) | 10.
-Proof.
-  exact Permutation_map.
-Qed.
-
-End Permutation_map.
-
-Section Injection.
-
-Definition injective {A B} (f : A->B) :=
- forall x y, f x = f y -> x = y.
-
-Lemma injective_map_NoDup {A B} (f:A->B) (l:list A) :
- injective f -> NoDup l -> NoDup (map f l).
-Proof.
- intros Hf. induction 1 as [|x l Hx Hl IH]; simpl; constructor; trivial.
- rewrite in_map_iff. intros (y & Hy & Hy'). apply Hf in Hy. now subst.
-Qed.
-
-Lemma injective_bounded_surjective n f :
- injective f ->
- (forall x, x < n -> f x < n) ->
- (forall y, y < n -> exists x, x < n /\ f x = y).
-Proof.
- intros Hf H.
- set (l := seq 0 n).
- assert (P : incl (map f l) l).
- { intros x. rewrite in_map_iff. intros (y & <- & Hy').
-   unfold l in *. rewrite in_seq in *. simpl in *.
-   destruct Hy' as (_,Hy'). auto with arith. }
- assert (P' : incl l (map f l)).
- { unfold l.
-   apply NoDup_cardinal_incl; auto using injective_map_NoDup, seq_NoDup.
-   now rewrite map_length. }
- intros x Hx.
- assert (Hx' : In x l) by (unfold l; rewrite in_seq; auto with arith).
- apply P' in Hx'.
- rewrite in_map_iff in Hx'. destruct Hx' as (y & Hy & Hy').
- exists y; split; auto. unfold l in *; rewrite in_seq in Hy'.
- destruct Hy'; auto with arith.
-Qed.
-
-Lemma nat_bijection_Permutation n f :
- injective f -> (forall x, x < n -> f x < n) ->
- let l := seq 0 n in Permutation (map f l) l.
-Proof.
- intros Hf BD.
- apply NoDup_Permutation_bis; auto using injective_map_NoDup, seq_NoDup.
- * now rewrite map_length.
- * intros x. rewrite in_map_iff. intros (y & <- & Hy').
-   rewrite in_seq in *. simpl in *.
-   destruct Hy' as (_,Hy'). auto with arith.
-Qed.
-
-End Injection.
-
-Section Permutation_alt.
-Variable A:Type.
-Implicit Type a : A.
-Implicit Type l : list A.
-
-(** Alternative characterization of permutation
-    via [nth_error] and [nth] *)
-
-Let adapt f n :=
- let m := f (S n) in if le_lt_dec m (f 0) then m else pred m.
-
-Let adapt_injective f : injective f -> injective (adapt f).
-Proof.
- unfold adapt. intros Hf x y EQ.
- destruct le_lt_dec as [LE|LT]; destruct le_lt_dec as [LE'|LT'].
- - now apply eq_add_S, Hf.
- - apply Lt.le_lt_or_eq in LE.
-   destruct LE as [LT|EQ']; [|now apply Hf in EQ'].
-   unfold lt in LT. rewrite EQ in LT.
-   rewrite <- (Lt.S_pred _ _ LT') in LT.
-   elim (Lt.lt_not_le _ _ LT' LT).
- - apply Lt.le_lt_or_eq in LE'.
-   destruct LE' as [LT'|EQ']; [|now apply Hf in EQ'].
-   unfold lt in LT'. rewrite <- EQ in LT'.
-   rewrite <- (Lt.S_pred _ _ LT) in LT'.
-   elim (Lt.lt_not_le _ _ LT LT').
- - apply eq_add_S, Hf.
-   now rewrite (Lt.S_pred _ _ LT), (Lt.S_pred _ _ LT'), EQ.
-Qed.
-
-Let adapt_ok a l1 l2 f : injective f -> length l1 = f 0 ->
- forall n, nth_error (l1++a::l2) (f (S n)) = nth_error (l1++l2) (adapt f n).
-Proof.
- unfold adapt. intros Hf E n.
- destruct le_lt_dec as [LE|LT].
- - apply Lt.le_lt_or_eq in LE.
-   destruct LE as [LT|EQ]; [|now apply Hf in EQ].
-   rewrite <- E in LT.
-   rewrite 2 nth_error_app1; auto.
- - rewrite (Lt.S_pred _ _ LT) at 1.
-   rewrite <- E, (Lt.S_pred _ _ LT) in LT.
-   rewrite 2 nth_error_app2; auto with arith.
-   rewrite <- Minus.minus_Sn_m; auto with arith.
-Qed.
-
-Lemma Permutation_nth_error l l' :
- Permutation l l' <->
-  (length l = length l' /\
-   exists f:nat->nat,
-    injective f /\ forall n, nth_error l' n = nth_error l (f n)).
-Proof.
- split.
- { intros P.
-   split; [now apply Permutation_length|].
-   induction P.
-   - exists (fun n => n).
-     split; try red; auto.
-   - destruct IHP as (f & Hf & Hf').
-     exists (fun n => match n with O => O | S n => S (f n) end).
-     split; try red.
-     * intros [|y] [|z]; simpl; now auto.
-     * intros [|n]; simpl; auto.
-   - exists (fun n => match n with 0 => 1 | 1 => 0 | n => n end).
-     split; try red.
-     * intros [|[|z]] [|[|t]]; simpl; now auto.
-     * intros [|[|n]]; simpl; auto.
-   - destruct IHP1 as (f & Hf & Hf').
-     destruct IHP2 as (g & Hg & Hg').
-     exists (fun n => f (g n)).
-     split; try red.
-     * auto.
-     * intros n. rewrite <- Hf'; auto. }
- { revert l. induction l'.
-   - intros [|l] (E & _); now auto.
-   - intros l (E & f & Hf & Hf').
-     simpl in E.
-     assert (Ha : nth_error l (f 0) = Some a)
-      by (symmetry; apply (Hf' 0)).
-     destruct (nth_error_split l (f 0) Ha) as (l1 & l2 & L12 & L1).
-     rewrite L12. rewrite <- Permutation_middle. constructor.
-     apply IHl'; split; [|exists (adapt f); split].
-     * revert E. rewrite L12, !app_length. simpl.
-       rewrite <- plus_n_Sm. now injection 1.
-     * now apply adapt_injective.
-     * intro n. rewrite <- (adapt_ok a), <- L12; auto.
-       apply (Hf' (S n)). }
-Qed.
-
-Lemma Permutation_nth_error_bis l l' :
- Permutation l l' <->
-  exists f:nat->nat,
-    injective f /\
-    (forall n, n < length l -> f n < length l) /\
-    (forall n, nth_error l' n = nth_error l (f n)).
-Proof.
- rewrite Permutation_nth_error; split.
- - intros (E & f & Hf & Hf').
-   exists f. do 2 (split; trivial).
-   intros n Hn.
-   destruct (Lt.le_or_lt (length l) (f n)) as [LE|LT]; trivial.
-   rewrite <- nth_error_None, <- Hf', nth_error_None, <- E in LE.
-   elim (Lt.lt_not_le _ _ Hn LE).
- - intros (f & Hf & Hf2 & Hf3); split; [|exists f; auto].
-   assert (H : length l' <= length l') by auto with arith.
-   rewrite <- nth_error_None, Hf3, nth_error_None in H.
-   destruct (Lt.le_or_lt (length l) (length l')) as [LE|LT];
-    [|apply Hf2 in LT; elim (Lt.lt_not_le _ _ LT H)].
-   apply Lt.le_lt_or_eq in LE. destruct LE as [LT|EQ]; trivial.
-   rewrite <- nth_error_Some, Hf3, nth_error_Some in LT.
-   destruct (injective_bounded_surjective Hf Hf2 LT) as (y & Hy & Hy').
-   apply Hf in Hy'. subst y. elim (Lt.lt_irrefl _ Hy).
-Qed.
-
-Lemma Permutation_nth l l' d :
- Permutation l l' <->
-  (let n := length l in
-   length l' = n /\
-   exists f:nat->nat,
-    (forall x, x < n -> f x < n) /\
-    (forall x y, x < n -> y < n -> f x = f y -> x = y) /\
-    (forall x, x < n -> nth x l' d = nth (f x) l d)).
-Proof.
- split.
- - intros H.
-   assert (E := Permutation_length H).
-   split; auto.
-   apply Permutation_nth_error_bis in H.
-   destruct H as (f & Hf & Hf2 & Hf3).
-   exists f. split; [|split]; auto.
-   intros n Hn. rewrite <- 2 nth_default_eq. unfold nth_default.
-    now rewrite Hf3.
- - intros (E & f & Hf1 & Hf2 & Hf3).
-   rewrite Permutation_nth_error.
-   split; auto.
-   exists (fun n => if le_lt_dec (length l) n then n else f n).
-   split.
-   * intros x y.
-     destruct le_lt_dec as [LE|LT];
-      destruct le_lt_dec as [LE'|LT']; auto.
-     + apply Hf1 in LT'. intros ->.
-       elim (Lt.lt_irrefl (f y)). eapply Lt.lt_le_trans; eauto.
-     + apply Hf1 in LT. intros <-.
-       elim (Lt.lt_irrefl (f x)). eapply Lt.lt_le_trans; eauto.
-   * intros n.
-     destruct le_lt_dec as [LE|LT].
-     + assert (LE' : length l' <= n) by (now rewrite E).
-       rewrite <- nth_error_None in LE, LE'. congruence.
-     + assert (LT' : n < length l') by (now rewrite E).
-       specialize (Hf3 n LT). rewrite <- 2 nth_default_eq in Hf3.
-       unfold nth_default in Hf3.
-       apply Hf1 in LT.
-       rewrite <- nth_error_Some in LT, LT'.
-       do 2 destruct nth_error; congruence.
-Qed.
-
-End Permutation_alt.
-
-(* begin hide *)
-Notation Permutation_app_swap := Permutation_app_comm (only parsing).
-(* end hide *)
diff --git a/samples/Coq/Sorting.v b/samples/Coq/Sorting.v
deleted file mode 100755
index edb10c63..00000000
--- a/samples/Coq/Sorting.v
+++ /dev/null
@@ -1,2 +0,0 @@
-Require Export Sorted.
-Require Export Mergesort.
diff --git a/samples/Coq/interval_discr.v b/samples/Coq/interval_discr.v
deleted file mode 100644
index ed2c0e37..00000000
--- a/samples/Coq/interval_discr.v
+++ /dev/null
@@ -1,419 +0,0 @@
-(** Sketch of the proof of {p:nat|p<=n} = {p:nat|p<=m} -> n=m
-
-  - preliminary results on the irrelevance of boundedness proofs
-  - introduce the notion of finite cardinal |A|
-  - prove that |{p:nat|p<=n}| = n
-  - prove that |A| = n /\ |A| = m -> n = m if equality is decidable on A
-  - prove that equality is decidable on A
-  - conclude
-*)
-
-(** * Preliminary results on [nat] and [le] *)
-
-(** Proving axiom K on [nat] *)
-
-Require Import Eqdep_dec.
-Require Import Arith.
-
-Theorem eq_rect_eq_nat :
-  forall (p:nat) (Q:nat->Type) (x:Q p) (h:p=p), x = eq_rect p Q x p h.
-Proof.
-intros.
-apply K_dec_set with (p := h).
-apply eq_nat_dec.
-reflexivity.
-Qed.
-
-(** Proving unicity of proofs of [(n<=m)%nat] *)
-
-Scheme le_ind' := Induction for le Sort Prop.
-
-Theorem le_uniqueness_proof : forall (n m : nat) (p q : n <= m), p = q.
-Proof.
-induction p using le_ind'; intro q.
- replace (le_n n) with
-  (eq_rect _ (fun n0 => n <= n0) (le_n n) _ (refl_equal n)).
- 2:reflexivity.
-  generalize (refl_equal n).
-    pattern n at 2 4 6 10, q; case q; [intro | intros m l e].
-     rewrite <- eq_rect_eq_nat; trivial.
-     contradiction (le_Sn_n m); rewrite <- e; assumption.
- replace (le_S n m p) with
-  (eq_rect _ (fun n0 => n <= n0) (le_S n m p) _ (refl_equal (S m))).
- 2:reflexivity.
-  generalize (refl_equal (S m)).
-    pattern (S m) at 1 3 4 6, q; case q; [intro Heq | intros m0 l HeqS].
-     contradiction (le_Sn_n m); rewrite Heq; assumption.
-     injection HeqS; intro Heq; generalize l HeqS.
-      rewrite <- Heq; intros; rewrite <- eq_rect_eq_nat.
-      rewrite (IHp l0); reflexivity.
-Qed.
-
-(** Proving irrelevance of boundedness proofs while building
-    elements of interval *)
-
-Lemma dep_pair_intro :
-  forall (n x y:nat) (Hx : x<=n) (Hy : y<=n), x=y ->
-    exist (fun x => x <= n) x Hx = exist (fun x => x <= n) y Hy.
-Proof.
-intros n x y Hx Hy Heq.
-generalize Hy.
-rewrite <- Heq.
-intros.
-rewrite (le_uniqueness_proof x n Hx Hy0).
-reflexivity.
-Qed.
-
-(** * Proving that {p:nat|p<=n} = {p:nat|p<=m} -> n=m *)
-
-(** Definition of having finite cardinality [n+1] for a set [A] *)
-
-Definition card (A:Set) n :=
-  exists f,
-    (forall x:A, f x <= n) /\
-    (forall x y:A, f x = f y -> x = y) /\
-    (forall m, m <= n -> exists x:A, f x = m).
-
-Require Import Arith.
-
-(** Showing that the interval [0;n] has cardinality [n+1] *)
-
-Theorem card_interval : forall n, card {x:nat|x<=n} n.
-Proof.
-intro n.
-exists (fun x:{x:nat|x<=n} => proj1_sig x).
-split.
-(* bounded *)
-intro x; apply (proj2_sig x).
-split.
-(* injectivity *)
-intros (p,Hp) (q,Hq).
-simpl.
-intro Hpq.
-apply dep_pair_intro; assumption.
-(* surjectivity *)
-intros m Hmn.
-exists (exist (fun x : nat => x <= n) m Hmn).
-reflexivity.
-Qed.
-
-(** Showing that equality on the interval [0;n] is decidable *)
-
-Lemma interval_dec :
-  forall n (x y : {m:nat|m<=n}), {x=y}+{x<>y}.
-Proof.
-intros n (p,Hp).
-induction p; intros ([|q],Hq).
-left.
-  apply dep_pair_intro.
-  reflexivity.
-right.
-  intro H; discriminate H.
-right.
-  intro H; discriminate H.
-assert (Hp' : p <= n).
-  apply le_Sn_le; assumption.
-assert (Hq' : q <= n).
-  apply le_Sn_le; assumption.
-destruct (IHp Hp' (exist (fun m => m <= n) q Hq'))
-  as [Heq|Hneq].
-left.
-  injection Heq; intro Heq'.
-  apply dep_pair_intro.
-  apply eq_S.
-  assumption.
-right.
-  intro HeqS.
-  injection HeqS; intro Heq.
-  apply Hneq.
-  apply dep_pair_intro.
-  assumption.
-Qed.
-
-(** Showing that the cardinality relation is functional on decidable sets *)
-
-Lemma card_inj_aux :
-  forall (A:Type) f g n,
-    (forall x:A, f x <= 0) ->
-    (forall x y:A, f x = f y -> x = y) ->
-    (forall m, m <= S n -> exists x:A, g x = m)
-     -> False.
-Proof.
-intros A f g n Hfbound Hfinj Hgsurj.
-destruct (Hgsurj (S n) (le_n _)) as (x,Hx).
-destruct (Hgsurj n (le_S _ _ (le_n _))) as (x',Hx').
-assert (Hfx : 0 = f x).
-apply le_n_O_eq.
-apply Hfbound.
-assert (Hfx' : 0 = f x').
-apply le_n_O_eq.
-apply Hfbound.
-assert (x=x').
-apply Hfinj.
-rewrite <- Hfx.
-rewrite <- Hfx'.
-reflexivity.
-rewrite H in Hx.
-rewrite Hx' in Hx.
-apply (n_Sn _ Hx).
-Qed.
-
-(** For [dec_restrict], we use a lemma on the negation of equality
-that requires proof-irrelevance. It should be possible to avoid this
-lemma by generalizing over a first-order definition of [x<>y], say
-[neq] such that [{x=y}+{neq x y}] and [~(x=y /\ neq x y)]; for such
-[neq], unicity of proofs could be proven *)
-
-  Require Import Classical.
-  Lemma neq_dep_intro :
-   forall (A:Set) (z x y:A) (p:x<>z) (q:y<>z), x=y ->
-      exist (fun x => x <> z) x p = exist (fun x => x <> z) y q.
-  Proof.
-  intros A z x y p q Heq.
-   generalize q; clear q; rewrite <- Heq; intro q.
-   rewrite (proof_irrelevance _ p q); reflexivity.
-  Qed.
-
-Lemma dec_restrict :
-  forall (A:Set),
-    (forall x y :A, {x=y}+{x<>y}) ->
-     forall z (x y :{a:A|a<>z}), {x=y}+{x<>y}.
-Proof.
-intros A Hdec z (x,Hx) (y,Hy).
-destruct (Hdec x y) as [Heq|Hneq].
-left; apply neq_dep_intro; assumption.
-right; intro Heq; injection Heq; exact Hneq.
-Qed.
-
-Lemma pred_inj : forall n m,
-  0 <> n -> 0 <> m -> pred m = pred n -> m = n.
-Proof.
-destruct n.
-intros m H; destruct H; reflexivity.
-destruct m.
-intros _ H; destruct H; reflexivity.
-simpl; intros _ _ H.
-rewrite H.
-reflexivity.
-Qed.
-
-Lemma le_neq_lt : forall n m, n <= m -> n<>m -> n < m.
-Proof.
-intros n m Hle Hneq.
-destruct (le_lt_eq_dec n m Hle).
-assumption.
-contradiction.
-Qed.
-
-Lemma inj_restrict :
-  forall (A:Set) (f:A->nat) x y z,
-    (forall x y : A, f x = f y -> x = y)
-    -> x <> z -> f y < f z -> f z <= f x
-    -> pred (f x) = f y
-    -> False.
-
-(* Search error sans le type de f !! *)
-Proof.
-intros A f x y z Hfinj Hneqx Hfy Hfx Heq.
-assert (f z <> f x).
-  apply sym_not_eq.
-  intro Heqf.
-  apply Hneqx.
-  apply Hfinj.
-  assumption.
-assert (f x = S (f y)).
-  assert (0 < f x).
-    apply le_lt_trans with (f z).
-    apply le_O_n.
-    apply le_neq_lt; assumption.
-  apply pred_inj.
-  apply O_S.
-  apply lt_O_neq; assumption.
-  exact Heq.
-assert (f z <= f y).
-destruct (le_lt_or_eq _ _ Hfx).
-  apply lt_n_Sm_le.
-  rewrite <- H0.
-  assumption.
-  contradiction Hneqx.
-  symmetry.
-  apply Hfinj.
-  assumption.
-contradiction (lt_not_le (f y) (f z)).
-Qed.
-
-Theorem card_inj : forall m n (A:Set),
-  (forall x y :A, {x=y}+{x<>y}) ->
-  card A m -> card A n -> m = n.
-Proof.
-induction m; destruct n;
-intros A Hdec
- (f,(Hfbound,(Hfinj,Hfsurj)))
- (g,(Hgbound,(Hginj,Hgsurj))).
-(* 0/0 *)
-reflexivity.
-(* 0/Sm *)
-destruct (card_inj_aux _ _ _ _ Hfbound Hfinj Hgsurj).
-(* Sn/0 *)
-destruct (card_inj_aux _ _ _ _ Hgbound Hginj Hfsurj).
-(* Sn/Sm *)
-destruct (Hgsurj (S n) (le_n _)) as (xSn,HSnx).
-rewrite IHm with (n:=n) (A := {x:A|x<>xSn}).
-reflexivity.
-(* decidability of eq on {x:A|x<>xSm} *)
-apply dec_restrict.
-assumption.
-(* cardinality of {x:A|x<>xSn} is m *)
-pose (f' := fun x' : {x:A|x<>xSn} =>
-    let (x,Hneq) := x' in
-    if le_lt_dec (f xSn) (f x)
-    then pred (f x)
-    else f x).
-exists f'.
-split.
-(* f' is bounded *)
-unfold f'.
-intros (x,_).
-destruct (le_lt_dec (f xSn) (f x)) as [Hle|Hge].
-change m with (pred (S m)).
-apply le_pred.
-apply Hfbound.
-apply le_S_n.
-apply le_trans with (f xSn).
-exact Hge.
-apply Hfbound.
-split.
-(* f' is injective *)
-unfold f'.
-intros (x,Hneqx) (y,Hneqy) Heqf'.
-destruct (le_lt_dec (f xSn) (f x)) as [Hlefx|Hgefx];
-destruct (le_lt_dec (f xSn) (f y)) as [Hlefy|Hgefy].
-(* f xSn <= f x et f xSn <= f y *)
-assert (Heq : x = y).
-  apply Hfinj.
-  assert (f xSn <> f y).
-    apply sym_not_eq.
-    intro Heqf.
-    apply Hneqy.
-    apply Hfinj.
-    assumption.
-  assert (0 < f y).
-    apply le_lt_trans with (f xSn).
-    apply le_O_n.
-    apply le_neq_lt; assumption.
-  assert (f xSn <> f x).
-    apply sym_not_eq.
-    intro Heqf.
-    apply Hneqx.
-    apply Hfinj.
-    assumption.
-  assert (0 < f x).
-    apply le_lt_trans with (f xSn).
-    apply le_O_n.
-    apply le_neq_lt; assumption.
-  apply pred_inj.
-  apply lt_O_neq; assumption.
-  apply lt_O_neq; assumption.
-  assumption.
-apply neq_dep_intro; assumption.
-(* f y < f xSn <= f x *)
-destruct (inj_restrict A f x y xSn); assumption.
-(* f x < f xSn <= f y *)
-symmetry in Heqf'.
-destruct (inj_restrict A f y x xSn); assumption.
-(* f x < f xSn et f y < f xSn *)
-assert (Heq : x=y).
-  apply Hfinj; assumption.
-apply neq_dep_intro; assumption.
-(* f' is surjective *)
-intros p Hlep.
-destruct (le_lt_dec (f xSn) p) as [Hle|Hlt].
-(* case f xSn <= p *)
-destruct (Hfsurj (S p) (le_n_S _ _ Hlep)) as (x,Hx).
-assert (Hneq : x <> xSn).
-  intro Heqx.
-  rewrite Heqx in Hx.
-  rewrite Hx in Hle.
-  apply le_Sn_n with p; assumption.
-exists (exist (fun a => a<>xSn) x Hneq).
-unfold f'.
-destruct (le_lt_dec (f xSn) (f x)) as [Hle'|Hlt'].
-rewrite Hx; reflexivity.
-rewrite Hx in Hlt'.
-contradiction (le_not_lt (f xSn) p).
-apply lt_trans with (S p).
-apply lt_n_Sn.
-assumption.
-(* case p < f xSn *)
-destruct (Hfsurj p (le_S _ _ Hlep)) as (x,Hx).
-assert (Hneq : x <> xSn).
-  intro Heqx.
-  rewrite Heqx in Hx.
-  rewrite Hx in Hlt.
-  apply (lt_irrefl p).
-  assumption.
-exists (exist (fun a => a<>xSn) x Hneq).
-unfold f'.
-destruct (le_lt_dec (f xSn) (f x)) as [Hle'|Hlt'].
-  rewrite Hx in Hle'.
-  contradiction (lt_irrefl p).
-  apply lt_le_trans with (f xSn); assumption.
-  assumption.
-(* cardinality of {x:A|x<>xSn} is n *)
-pose (g' := fun x' : {x:A|x<>xSn} =>
-   let (x,Hneq) := x' in
-   if Hdec x xSn then 0 else g x).
-exists g'.
-split.
-(* g is bounded *)
-unfold g'.
-intros (x,_).
-destruct (Hdec x xSn) as [_|Hneq].
-apply le_O_n.
-assert (Hle_gx:=Hgbound x).
-destruct (le_lt_or_eq _ _ Hle_gx).
-apply lt_n_Sm_le.
-assumption.
-contradiction Hneq.
-apply Hginj.
-rewrite HSnx.
-assumption.
-split.
-(* g is injective *)
-unfold g'.
-intros (x,Hneqx) (y,Hneqy) Heqg'.
-destruct (Hdec x xSn) as [Heqx|_].
-contradiction Hneqx.
-destruct (Hdec y xSn) as [Heqy|_].
-contradiction Hneqy.
-assert (Heq : x=y).
-  apply Hginj; assumption.
-apply neq_dep_intro; assumption.
-(* g is surjective *)
-intros p Hlep.
-destruct (Hgsurj p (le_S _ _ Hlep)) as (x,Hx).
-assert (Hneq : x<>xSn).
-  intro Heq.
-  rewrite Heq in Hx.
-  rewrite Hx in HSnx.
-  rewrite HSnx in Hlep.
-  contradiction (le_Sn_n _ Hlep).
-exists (exist (fun a => a<>xSn) x Hneq).
-simpl.
-destruct (Hdec x xSn) as [Heqx|_].
-contradiction Hneq.
-assumption.
-Qed.
-
-(** Conclusion *)
-
-Theorem interval_discr :
-  forall n m, {p:nat|p<=n} = {p:nat|p<=m} -> n=m.
-Proof.
-intros n m Heq.
-apply card_inj with (A := {p:nat|p<=n}).
-apply interval_dec.
-apply card_interval.
-rewrite Heq.
-apply card_interval.
-Qed.

From 4f1e5c34b124ca418ab0ecaf2269f2a017d985c0 Mon Sep 17 00:00:00 2001
From: Alhadis <gardnerjohng@gmail.com>
Date: Thu, 3 Nov 2016 02:45:59 +1100
Subject: [PATCH 2/2] Add permissive-licensed Coq samples

BSD-2-Clause: https://github.com/jscert/jscert

  * JSCorrectness.v
  * JSInterpreterExtraction.v
  * JSNumber.v
  * JSPrettyInterm.v

MIT/Expat: https://github.com/clarus/coq-atm

  * Computation.v
  * Main.v
  * Spec.v
---
 samples/Coq/Computation.v             |   85 +
 samples/Coq/JsCorrectness.v           | 5944 +++++++++++++++++++++++++
 samples/Coq/JsInterpreterExtraction.v |  249 ++
 samples/Coq/JsNumber.v                | 1051 +++++
 samples/Coq/JsPrettyInterm.v          | 1766 ++++++++
 samples/Coq/Main.v                    |   42 +
 samples/Coq/Spec.v                    |   62 +
 7 files changed, 9199 insertions(+)
 create mode 100644 samples/Coq/Computation.v
 create mode 100644 samples/Coq/JsCorrectness.v
 create mode 100644 samples/Coq/JsInterpreterExtraction.v
 create mode 100644 samples/Coq/JsNumber.v
 create mode 100644 samples/Coq/JsPrettyInterm.v
 create mode 100644 samples/Coq/Main.v
 create mode 100644 samples/Coq/Spec.v

diff --git a/samples/Coq/Computation.v b/samples/Coq/Computation.v
new file mode 100644
index 00000000..646b66db
--- /dev/null
+++ b/samples/Coq/Computation.v
@@ -0,0 +1,85 @@
+(** The definition of computations, used to represent interactive programs. *)
+Require Import Coq.NArith.NArith.
+Require Import ListString.All.
+
+Local Open Scope type.
+
+(** System calls. *)
+Module Command.
+  Inductive t :=
+  | AskCard
+  | AskPIN
+  | CheckPIN (pin : N)
+  | AskAmount
+  | CheckAmount (amount : N)
+  | GiveCard
+  | GiveAmount (amount : N)
+  | ShowError (message : LString.t).
+
+  (** The type of an answer for a command depends on the value of the command. *)
+  Definition answer (command : t) : Type :=
+    match command with
+    | AskCard => bool (* If the given card seems valid. *)
+    | AskPIN => option N (* A number or cancellation. *)
+    | CheckPIN _ => bool (* If the PIN number is valid. *)
+    | AskAmount => option N (* A number or cancellation. *)
+    | CheckAmount _ => bool (* If the amount can be withdrawn. *)
+    | GiveCard => bool (* If the card was given. *)
+    | GiveAmount _ => bool (* If the money was given. *)
+    | ShowError _ => unit (* Show an error message. *)
+    end.
+End Command.
+
+(** Computations with I/Os. *)
+Module C.
+  (** A computation can either does nothing, or do a system call and wait
+      for the answer to run another computation. *)
+  Inductive t : Type :=
+  | Ret : t
+  | Call : forall (command : Command.t), (Command.answer command -> t) -> t.
+  Arguments Ret.
+  Arguments Call _ _.
+
+  (** Some optional notations. *)
+  Module Notations.
+    (** A nicer notation for `Ret`. *)
+    Definition ret : t :=
+      Ret.
+
+    (** We define an explicit apply function so that Coq does not try to expand
+        the notations everywhere. *)
+    Definition apply {A B} (f : A -> B) (x : A) := f x.
+
+    (** System call. *)
+    Notation "'call!' answer ':=' command 'in' X" :=
+      (Call command (fun answer => X))
+      (at level 200, answer ident, command at level 100, X at level 200).
+
+    (** System call with typed answer. *)
+    Notation "'call!' answer : A ':=' command 'in' X" :=
+      (Call command (fun (answer : A) => X))
+      (at level 200, answer ident, command at level 100, A at level 200, X at level 200).
+
+    (** System call ignoring the answer. *)
+    Notation "'do_call!' command 'in' X" :=
+      (Call command (fun _ => X))
+      (at level 200, command at level 100, X at level 200).
+
+    (** This notation is useful to compose computations which wait for a
+        continuation. We do not have an explicit bind operator to simplify the
+        language and the proofs. *)
+    Notation "'let!' x ':=' X 'in' Y" :=
+      (apply X (fun x => Y))
+      (at level 200, x ident, X at level 100, Y at level 200).
+
+    (** Let with a typed answer. *)
+    Notation "'let!' x : A ':=' X 'in' Y" :=
+      (apply X (fun (x : A) => Y))
+      (at level 200, x ident, X at level 100, A at level 200, Y at level 200).
+
+    (** Let ignoring the answer. *)
+    Notation "'do!' X 'in' Y" :=
+      (apply X (fun _ => Y))
+      (at level 200, X at level 100, Y at level 200).
+  End Notations.
+End C.
diff --git a/samples/Coq/JsCorrectness.v b/samples/Coq/JsCorrectness.v
new file mode 100644
index 00000000..fbb79850
--- /dev/null
+++ b/samples/Coq/JsCorrectness.v
@@ -0,0 +1,5944 @@
+Set Implicit Arguments.
+Require Import Shared.
+Require Import LibFix LibList.
+Require Import JsSyntax JsSyntaxAux JsCommon JsCommonAux JsPreliminary.
+Require Import JsInterpreterMonads JsInterpreter JsPrettyInterm JsPrettyRules.
+
+Ltac tryfalse_nothing :=
+  try match goal with x: nothing |- _ => destruct x end;
+  tryfalse.
+
+(**************************************************************)
+(** ** Implicit Types -- copied from JsPreliminary *)
+
+Implicit Type b : bool.
+Implicit Type n : number.
+Implicit Type k : int.
+Implicit Type s : string.
+Implicit Type i : literal.
+Implicit Type l : object_loc.
+Implicit Type w : prim.
+Implicit Type v : value.
+Implicit Type r : ref.
+Implicit Type ty : type.
+
+Implicit Type rt : restype.
+Implicit Type rv : resvalue.
+Implicit Type lab : label.
+Implicit Type labs : label_set.
+Implicit Type R : res.
+Implicit Type o : out.
+Implicit Type ct : codetype.
+
+Implicit Type x : prop_name.
+Implicit Type str : strictness_flag.
+Implicit Type m : mutability.
+Implicit Type Ad : attributes_data.
+Implicit Type Aa : attributes_accessor.
+Implicit Type A : attributes.
+Implicit Type Desc : descriptor.
+Implicit Type D : full_descriptor.
+
+Implicit Type L : env_loc.
+Implicit Type E : env_record.
+Implicit Type Ed : decl_env_record.
+Implicit Type X : lexical_env.
+Implicit Type O : object.
+Implicit Type S : state.
+Implicit Type C : execution_ctx.
+Implicit Type P : object_properties_type.
+Implicit Type W : result.
+
+Implicit Type e : expr.
+Implicit Type p : prog.
+Implicit Type t : stat.
+
+Implicit Type T : Type.
+
+
+(**************************************************************)
+(** Correctness Properties *)
+
+Record runs_type_correct runs :=
+  make_runs_type_correct {
+    runs_type_correct_expr : forall S C e o,
+       runs_type_expr runs S C e = o ->
+       red_expr S C (expr_basic e) o;
+    runs_type_correct_stat : forall S C t o,
+       runs_type_stat runs S C t = o ->
+       red_stat S C (stat_basic t) o;
+    runs_type_correct_prog : forall S C p o,
+       runs_type_prog runs S C p = o ->
+       red_prog S C (prog_basic p) o;
+
+    runs_type_correct_call : forall S C l v vs o,
+       runs_type_call runs S C l v vs = o ->
+       red_expr S C (spec_call l v vs) o;
+
+    runs_type_correct_call_prealloc : forall S C l B args o,
+       runs_type_call_prealloc runs S C B l args = result_some (specret_out o) ->
+       red_expr S C (spec_call_prealloc B l args) o;
+
+    runs_type_correct_construct : forall S C co l args o, 
+      runs_type_construct runs S C co l args = o ->
+      red_expr S C (spec_construct_1 co l args) o;
+
+    runs_type_correct_function_has_instance : forall S C (lo lv : object_loc) o,
+       runs_type_function_has_instance runs S lo lv = o ->
+       red_expr S C (spec_function_has_instance_2 lv lo) o;
+
+    runs_type_correct_get_args_for_apply : forall S C array (index n : int) y,
+       runs_type_get_args_for_apply runs S C array index n = result_some y ->
+       red_spec S C (spec_function_proto_apply_get_args array index n) y;
+
+    runs_type_correct_object_has_instance : forall S C B l v o,
+       runs_type_object_has_instance runs S C B l v = result_some (specret_out o) ->
+       red_expr S C (spec_object_has_instance_1 B l v) o;
+
+    runs_type_correct_stat_while : forall S C rv ls e t o,
+       runs_type_stat_while runs S C rv ls e t = o ->
+       red_stat S C (stat_while_1 ls e t rv) o;
+    runs_type_correct_stat_do_while : forall S C rv ls e t o,
+       runs_type_stat_do_while runs S C rv ls e t = o ->
+       red_stat S C (stat_do_while_1 ls t e rv) o;
+    runs_type_correct_stat_for_loop : forall S C labs rv eo2 eo3 t o,
+       runs_type_stat_for_loop runs S C labs rv eo2 eo3 t = o ->
+       red_stat S C (stat_for_2 labs rv eo2 eo3 t) o;
+    runs_type_correct_object_delete : forall S C l x str o,
+       runs_type_object_delete runs S C l x str = o ->
+       red_expr S C (spec_object_delete l x str) o;
+    runs_type_correct_object_get_own_prop : forall S C l x sp,
+       runs_type_object_get_own_prop runs S C l x = result_some sp ->
+       red_spec S C (spec_object_get_own_prop l x) sp;
+    runs_type_correct_object_get_prop : forall S C l x sp,
+       runs_type_object_get_prop runs S C l x = result_some sp ->
+       red_spec S C (spec_object_get_prop l x) sp;
+    runs_type_correct_object_get : forall S C l x o,
+       runs_type_object_get runs S C l x = o ->
+       red_expr S C (spec_object_get l x) o;
+    runs_type_correct_object_proto_is_prototype_of : forall S C lthis l o,
+       runs_type_object_proto_is_prototype_of runs S lthis l = o ->
+       red_expr S C (spec_call_object_proto_is_prototype_of_2_3 lthis l) o;
+    runs_type_correct_object_put : forall S C l x v str o,
+       runs_type_object_put runs S C l x v str = o ->
+       red_expr S C (spec_object_put l x v str) o;
+    runs_type_correct_equal : forall S C v1 v2 o,
+       runs_type_equal runs S C v1 v2 = o ->
+       red_expr S C (spec_equal v1 v2) o;
+    runs_type_correct_to_integer : forall S C v o,
+       runs_type_to_integer runs S C v = o ->
+       red_expr S C (spec_to_integer v) o;
+    runs_type_correct_to_string : forall S C v o,
+       runs_type_to_string runs S C v = o ->
+       red_expr S C (spec_to_string v) o;
+
+    (* ARRAYS *)
+    runs_type_correct_array_element_list : forall S C l oes o k,
+       runs_type_array_element_list runs S C l oes k = o ->
+       red_expr S C (expr_array_3 l oes k) o;
+
+    runs_type_correct_object_define_own_prop_array_loop : 
+      forall S C l newLen oldLen newLenDesc newWritable throw o 
+             (def : state -> prop_name -> descriptor -> strictness_flag -> specres nothing) 
+             (def_correct : forall S str o x Desc,
+                def S x Desc str = res_out o ->
+                red_expr S C (spec_object_define_own_prop_1 builtin_define_own_prop_default l x Desc str) o),
+       runs_type_object_define_own_prop_array_loop runs S C l newLen oldLen newLenDesc newWritable throw def = o -> 
+       red_expr S C (spec_object_define_own_prop_array_3l l newLen oldLen newLenDesc newWritable throw) o;
+
+     runs_type_correct_array_join_elements : forall S C l k length sep s o, 
+       runs_type_array_join_elements runs S C l k length sep s = result_some (specret_out o) ->
+       red_expr S C (spec_call_array_proto_join_elements l k length sep s) o
+  }.
+
+
+(**************************************************************)
+(** Useful Tactics *)
+
+Ltac absurd_neg :=
+  let H := fresh in
+  introv H; inverts H; tryfalse.
+
+Hint Constructors abort.
+
+
+(**************************************************************)
+(** General Lemmas *)
+
+Lemma arguments_from_spec_1 : forall args,
+  exists v, arguments_from args (v::nil)
+         /\ get_arg 0 args = v.
+Proof.
+  Hint Constructors arguments_from.
+  intros. destruct args as [|v vs].
+  exists undef. splits*.
+  exists v. splits*.
+Qed.
+
+
+Lemma res_overwrite_value_if_empty_empty : forall R,
+  res_overwrite_value_if_empty resvalue_empty R = R.
+Proof. introv. unfolds. cases_if~. destruct R; simpls; inverts~ e. Qed.
+
+Lemma res_type_res_overwrite_value_if_empty : forall rv R,
+  res_type R = res_type (res_overwrite_value_if_empty rv R).
+Proof.
+  introv. destruct R. unfold res_overwrite_value_if_empty. simpl.
+  cases_if; reflexivity.
+Qed.
+
+Lemma res_label_res_overwrite_value_if_empty : forall rv R,
+  res_label R = res_label (res_overwrite_value_if_empty rv R).
+Proof.
+  introv. destruct R. unfold res_overwrite_value_if_empty. simpl.
+  cases_if; reflexivity.
+Qed.
+
+Lemma res_overwrite_value_if_empty_resvalue : forall rv1 rv2, exists rv3,
+  res_normal rv3 = res_overwrite_value_if_empty rv1 rv2 /\ (rv3 = rv1 \/ rv3 = rv2).
+Proof. introv. unfolds res_overwrite_value_if_empty. cases_if*. Qed.
+
+
+Lemma get_arg_correct : forall args vs,
+  arguments_from args vs ->
+  forall num,
+    num < length vs ->
+    get_arg num args = LibList.nth num vs.
+Proof.
+  introv A. induction~ A.
+   introv I. false I. lets (I'&_): (rm I). inverts~ I'.
+   introv I. destruct* num. rewrite nth_succ. rewrite <- IHA.
+    unfolds. repeat rewrite~ nth_def_nil.
+    rewrite length_cons in I. nat_math.
+   introv I. destruct* num. rewrite nth_succ. rewrite <- IHA.
+    unfolds. rewrite~ nth_def_succ.
+    rewrite length_cons in I. nat_math.
+Qed.
+
+Lemma get_arg_correct_0 : forall args,
+  arguments_from args (get_arg 0 args :: nil).
+Proof. introv. destruct args; do 2 constructors. Qed.
+
+Lemma get_arg_correct_1 : forall args,
+  arguments_from args (get_arg 0 args :: get_arg 1 args :: nil).
+Proof. introv. destruct args as [|? [|? ?]]; do 3 constructors. Qed.
+
+Lemma get_arg_correct_2 : forall args,
+  arguments_from args (get_arg 0 args :: get_arg 1 args :: get_arg 2 args :: nil).
+Proof. introv. destruct args as [|? [|? [|? ?]]]; do 4 constructors. Qed.
+
+Lemma get_arg_first_and_rest_correct : forall args v lv,
+  (v, lv) = get_arg_first_and_rest args <-> 
+  arguments_first_and_rest args (v, lv).
+Proof.
+  induction args; introv; splits; introv Hyp; 
+  unfolds get_arg_first_and_rest; unfolds get_arg; 
+  simpls; inverts~ Hyp.
+Qed.
+
+Lemma and_impl_left : forall P1 P2 P3 : Prop,
+  (P1 -> P2) ->
+  P1 /\ P3 ->
+  P2 /\ P3.
+Proof. auto*. Qed.
+
+Ltac applys_and_base L :=
+  applys~ and_impl_left; [applys~ L|]; try reflexivity.
+
+Tactic Notation "applys_and" constr(E) :=
+  applys_and_base (>> E).
+
+Tactic Notation "applys_and" constr(E) constr(A1) :=
+  applys_and_base (>> E A1).
+
+Tactic Notation "applys_and" constr(E) constr(A1) constr(A2) :=
+  applys_and_base (>> E A1 A2).
+
+Tactic Notation "applys_and" constr(E) constr(A1) constr(A2) constr(A3) :=
+  applys_and_base (>> E A1 A2 A3).
+
+Ltac constructors_and :=
+  let H := fresh in
+  eapply and_impl_left; [ intro H; constructors; exact H |].
+
+
+Lemma run_callable_correct : forall S v co,
+  run_callable S v = Some co ->
+  callable S v co.
+Proof.
+  introv E. destruct v; simpls~.
+   inverts~ E.
+   sets_eq <- B: (pick_option (object_binds S o)). destruct B; simpls; tryfalse.
+    exists o0. splits~. forwards~: @pick_option_correct EQB. inverts~ E.
+Qed.
+
+
+(**************************************************************)
+(** Monadic Constructors, Lemmas *)
+
+(* Shared defs *)
+
+(** [eqabort o1 o] assert that [o1] and [o] are equal
+    and satisfy the [abort] predicate. *)
+
+Definition eqabort o1 o :=
+  o = o1 /\ abort o.
+
+Ltac prove_abort :=
+  solve [ assumption | (constructor; absurd_neg) ].
+
+(** [isout W Pred] asserts that [W] is in fact
+    an outcome that satisfies [Pred]. *)
+
+Definition isout W (Pred:out->Prop) :=
+  exists o1, W = res_out o1 /\ Pred o1.
+
+Hint Unfold isout.
+Hint Unfold eqabort.
+
+(* Generic *)
+
+Lemma if_empty_label_out : forall T K S R (o : T),
+  if_empty_label S R K = result_some o ->
+  res_label R = label_empty /\ K tt = result_some o.
+Proof. introv H. unfolds in H. cases_if; tryfalse. eexists; auto*. Qed.
+
+Lemma if_some_out : forall (A B : Type) (oa : option A) K (b : B),
+  if_some oa K = result_some b ->
+  exists (a:A), oa = Some a /\ K a = result_some b.
+Proof. introv E. destruct* oa; tryfalse. Qed.
+
+Lemma if_result_some_out : forall (A B : Type) (W : resultof A) K (b : B),
+  if_result_some W K = result_some b ->
+  exists (y : A), W = result_some y /\ K y = result_some b.
+Proof. introv H. destruct* W; tryfalse. Qed.
+
+Lemma if_some_or_default_out : forall (A B : Type) (oa : option A) d K (b : B),
+  if_some_or_default oa d K = b ->
+     (oa = None /\ d = b)
+  \/ (exists a, oa = Some a /\ K a = b).
+Proof. introv E. destruct* oa; tryfalse. Qed.
+
+
+(* Results *)
+
+Definition if_ter_post (K : _ -> _ -> result) o o1 :=
+     (o1 = out_div /\ o = o1)
+  \/ (exists S R, o1 = out_ter S R /\ K S R = o).
+
+Lemma if_ter_out : forall W K o,
+  if_ter W K = res_out o ->
+  isout W (if_ter_post K o).
+Proof.
+  introv H. destruct W as [[|o1]| | | ]; simpls; tryfalse_nothing.
+  exists o1. splits~. unfolds. destruct o1 as [|S R].
+   inverts* H.
+   jauto.
+Qed.
+
+Definition if_success_state_post rv0 (K : _ -> _ -> result) o o1 :=
+  (o1 = out_div /\ o = o1) \/
+  (exists S R, o1 = out_ter S R /\ res_type R = restype_throw /\ o = out_ter S R) \/
+  (exists S R, o1 = out_ter S R /\ res_type R <> restype_throw /\
+    res_type R <> restype_normal /\ o = out_ter S (res_overwrite_value_if_empty rv0 R)) \/
+  exists S rv, o1 = out_ter S (res_normal rv) /\
+    K S (ifb rv = resvalue_empty then rv0 else rv) = res_out o.
+
+Lemma if_success_state_out : forall rv W K o,
+  if_success_state rv W K = o ->
+  isout W (if_success_state_post rv K o).
+Proof.
+  introv E. forwards~ (o1&WE&P): if_ter_out (rm E). subst W. eexists. splits*.
+  inversion_clear P as [?|(S&R&?&H)]. branch~ 1.
+  substs. destruct R as [rt rv' rl]. destruct~ rt; simpls;
+    try solve [branch 3; repeat eexists; [discriminate | discriminate | inverts~ H]].
+   forwards~ (?&?): if_empty_label_out (rm H). simpls. substs.
+    branch 4. repeat eexists. auto*.
+   inverts H. branch 2. repeat eexists.
+Qed.
+
+Definition if_success_post (K : _ -> _ -> result) o o1 :=
+  eqabort o1 o \/
+  exists S rv, o1 = out_ter S (res_normal rv) /\ K S rv = o.
+
+Lemma if_success_out : forall W K o,
+  if_success W K = res_out o ->
+  isout W (if_success_post K o).
+Proof.
+  introv E. forwards~ (o1&WE&P): if_ter_out (rm E). subst W. eexists. splits*.
+  inversion_clear P as [[? ?]|(S&R&?&H)]. substs. branch~ 1.
+  substs. destruct R as [rt rv' rl]. destruct~ rt; simpls;
+     try solve [inverts H; branch 1; splits~; prove_abort].
+   forwards~ (?&?): if_empty_label_out (rm H). simpls. substs.
+    branch 2. repeat eexists. auto*.
+Qed.
+
+  (* Documentation: same with unfolding:
+    Lemma if_success_out : forall W K o,
+      if_success W K = o ->
+      exists o1, W = res_out o1 /\
+       (   (o = o1 /\ abort o)
+        \/ (exists S rv, o1 = out_ter S rv /\ K S rv = o)).
+  *)
+
+Definition if_void_post (K : _ -> result) o o1 :=
+  eqabort o1 o \/
+  exists S, o1 = out_void S /\ K S = o.
+
+Lemma if_void_out : forall W K o,
+  if_void W K = o ->
+  isout W (if_void_post K o).
+Proof.
+  introv E. unfolds in E.
+  forwards~ (o1&WE&P): if_success_out (rm E). exists o1. split~.
+  unfolds. unfolds in P.
+  inversion_clear P as [[? ?]|(S&R&?&?)]; subst; [ left* | right ].
+  exists S. destruct R; tryfalse. auto.
+Admitted. (*faster*)
+
+(* if_not_throw *)
+
+Definition if_not_throw_post (K : _ -> _ -> result) o o1 :=
+  eqabort o1 o \/
+  (exists S R, o1 = out_ter S R /\
+     ((res_type R <> restype_throw /\ K S R = o) \/
+      (res_type R  = restype_throw /\ o = o1))).
+
+Hint Extern 1 (_ <> _ :> restype) => congruence.
+
+Lemma if_not_throw_out : forall W K o,
+  if_not_throw W K = o -> 
+  isout W (if_not_throw_post K o).
+Proof.
+  introv E. unfolds in E.
+  forwards~ (o1 & WE & P): if_ter_out (rm E).
+  exists o1. split~.
+  unfolds. unfolds in P.
+
+  inversion_clear P as [[? ?] | (S & R & ? & ?)]. branch~ 1.
+  splits~. substs~.
+  right. exists S R; splits~.
+  destruct (res_type R); try solve [left; splits~; discriminate].
+  right; splits~. subst. inverts~ H0.
+Qed.
+
+Definition if_any_or_throw_post (K1 K2 : _ -> _ -> result) o o1 :=
+  (o1 = out_div /\ o = o1) \/
+  (exists S R, o1 = out_ter S R /\
+    (   (res_type R <> restype_throw /\ K1 S R = o)
+     \/ (res_type R = restype_throw /\ exists (v : value), res_value R = v
+           /\ res_label R = label_empty /\ K2 S v = o))). (* Didn't worked when writing [exists (v : value), R = res_throw v]. *)
+
+Lemma if_any_or_throw_out : forall W K1 K2 o,
+  if_any_or_throw W K1 K2 = res_out o ->
+  isout W (if_any_or_throw_post K1 K2 o).
+Proof.
+  introv E. unfolds in E.
+  forwards~ (o1&WE&P): if_ter_out (rm E). exists o1. split~.
+  unfolds. unfolds in P.
+  inversion_clear P as [[? ?]|(S&R&?&?)]; subst; [ left* | right ].
+  exists S R. split~. destruct (res_type R); tryfalse; simple*.
+  right. destruct (res_value R); tryfalse; simple*. split*.
+  forwards*: if_empty_label_out.
+Admitted. (*faster*)
+
+Definition if_success_or_return_post (K1 : state -> result) (K2 : state -> resvalue -> result) o o1 :=
+     (o1 = out_div /\ o = o1)
+  \/ exists S R, o1 = out_ter S R /\
+     (   (res_type R = restype_normal /\ res_label R = label_empty /\ K1 S = o)
+      \/ (res_type R = restype_return /\ res_label R = label_empty /\ K2 S (res_value R) = o)
+      \/ (res_type R <> restype_normal /\ res_type R <> restype_return /\ o1 = o)).
+
+Lemma if_success_or_return_out : forall W (K1 : state -> result) (K2 : state -> resvalue -> result) o,
+  if_success_or_return W K1 K2 = o ->
+  isout W (if_success_or_return_post K1 K2 o).
+Proof.
+  introv E. unfolds in E.
+  forwards~ (o1&WE&P): if_ter_out (rm E). exists o1. split~.
+  unfolds. unfolds in P.
+  inversion_clear P as [[? ?]|(S&R&H&E)]; subst; [ left* | right ].
+  exists S R. split~. destruct (res_type R); tryfalse; simple*.
+  branch 1. forwards*: if_empty_label_out.
+  branch 3. inverts* E.
+  branch 3. inverts* E.
+  branch 2. forwards*: if_empty_label_out.
+  branch 3. inverts* E.
+Admitted. (*faster*)
+
+(* TODO: misssing
+    if_normal_continue_or_break *)
+
+Definition if_break_post (K : _ -> _ -> result) o o1 :=
+     (o1 = out_div /\ o = o1)
+  \/ (exists S R, o1 = out_ter S R /\
+      (   (res_type R <> restype_break /\ o1 = o)
+       \/ (res_type R = restype_break /\ K S R = o))).
+
+Lemma if_break_out : forall W K o,
+  if_break W K = o ->
+  isout W (if_break_post K o).
+Proof.
+  introv E. unfolds in E.
+  forwards~ (o1&WE&P): if_ter_out (rm E). exists o1. split~.
+  unfolds. unfolds in P.
+  inversion_clear P as [[? ?]|(S&R&H&E)]; subst; [ left* | right ].
+  exists S R. split~. destruct (res_type R); try inverts E; simple*.
+Admitted. (*faster*)
+
+Definition if_value_post (K : _ -> _ -> result) o o1 :=
+  eqabort o1 o \/
+  exists S v, o1 = out_ter S (res_val v) /\ K S v = o.
+
+Lemma if_value_out : forall W K o,
+  if_value W K = res_out o ->
+  isout W (if_value_post K o).
+Proof.
+  introv E. unfolds in E.
+  forwards~ (o1&WE&P): if_success_out (rm E). exists o1. split~.
+  unfolds. unfolds in P.
+  inversion_clear P as [[? ?]|(S&R&H&E)]; subst; [ left* | right ].
+  destruct R; tryfalse. exists___*.
+Admitted. (*faster*)
+
+Definition if_bool_post (K : _ -> _ -> result) o o1 :=
+  eqabort o1 o \/
+  exists S z, o1 = out_ter S (res_val (prim_bool z)) /\ K S z = o.
+
+Lemma if_bool_out : forall W K o,
+  if_bool W K = res_out o ->
+  isout W (if_bool_post K o).
+Proof.
+  introv E. unfolds in E.
+  forwards~ (o1&WE&P): if_value_out (rm E). exists o1. split~.
+  unfolds. unfolds in P.
+  inversion_clear P as [[? ?]|(S&R&H&E)]; subst; [ left* | right ].
+  destruct R; tryfalse. destruct p; tryfalse. exists___*.
+Admitted. (*faster*)
+
+
+Definition if_object_post (K : _ -> _ -> result) o o1 :=
+  eqabort o1 o \/
+  exists S l, o1 = out_ter S (res_val (value_object l)) /\ K S l = o.
+
+Lemma if_object_out : forall W K o,
+  if_object W K = res_out o ->
+  isout W (if_object_post K o).
+Proof.
+  introv E. unfolds in E.
+  forwards~ (o1&WE&P): if_value_out (rm E). exists o1. split~.
+  unfolds. unfolds in P.
+  inversion_clear P as [[? ?]|(S&R&H&E)]; subst; [ left* | right ].
+  destruct R; tryfalse. exists___*.
+Admitted. (*faster*)
+
+
+Definition if_string_post (K : _ -> _ -> result) o o1 :=
+  eqabort o1 o \/
+  exists S s, o1 = out_ter S (res_val (prim_string s)) /\ K S s = o.
+
+Lemma if_string_out : forall W K o,
+  if_string W K = res_out o ->
+  isout W (if_string_post K o).
+Proof.
+  introv E. unfolds in E.
+  forwards~ (o1&WE&P): if_value_out (rm E). exists o1. split~.
+  unfolds. unfolds in P.
+  inversion_clear P as [[? ?]|(S&R&H&E)]; subst; [ left* | right ].
+  destruct R; tryfalse. destruct p; tryfalse. exists___*.
+Admitted. (*faster*)
+
+
+Definition if_number_post (K : _ -> _ -> result) o o1 :=
+  eqabort o1 o \/
+  exists S n, o1 = out_ter S (res_val (prim_number n)) /\ K S n = o.
+
+Lemma if_number_out : forall W K o,
+  if_number W K = res_out o ->
+  isout W (if_number_post K o).
+Proof.
+  introv E. unfolds in E.
+  forwards~ (o1 & WE & P): if_value_out (rm E). exists o1. split~.
+  unfolds. unfolds in P.
+  inversion_clear P as [[? ?]|(S&R&H&E)]; subst; [ left* | right ].
+  destruct R; tryfalse. destruct p; tryfalse. exists___*.
+Admitted. (*faster*)
+
+Definition if_prim_post (K : _ -> _ -> result) o o1 :=
+  eqabort o1 o \/
+  exists S w, o1 = out_ter S (res_val (value_prim w)) /\ K S w = o.
+
+Lemma if_prim_out : forall W K o,
+  if_prim W K = res_out o ->
+  isout W (if_prim_post K o).
+Proof.
+  introv E. unfolds in E.
+  forwards~ (o1&WE&P): if_value_out (rm E). exists o1. split~.
+  unfolds. unfolds in P.
+  inversion_clear P as [[? ?]|(S&R&H&E)]; subst; [ left* | right ].
+  destruct R; tryfalse. exists___*.
+Admitted. (*faster*)
+
+Lemma if_abort_out : forall T o K (t : T),
+  if_abort o K = result_some t ->
+  abort o /\ K tt = result_some t.
+Proof. introv H. destruct* o. simpls. cases_if*. Qed.
+
+Definition if_spec_post (A B:Type) K (b:specret B) y :=
+     (exists o, y = specret_out o /\ b = specret_out o /\ abort o)
+  \/ (exists (S:state) (a:A), y = specret_val S a /\ K S a = result_some b).
+
+Lemma if_spec_out : forall (A B : Type) (W : specres A) K (b : specret B),
+  if_spec W K = result_some b ->
+  exists y, W = result_some y /\ if_spec_post K b y.
+Proof.
+  introv E. unfolds in E. unfolds in E.
+  destruct W; tryfalse. exists s. split~.
+  unfolds. destruct s; [ right | left ].
+    exists___*.
+    lets (?&H): if_abort_out E. inverts H. exists___*.
+Admitted. (* faster *)
+
+
+Definition if_ter_spec_post T K (y:specret T) o :=
+     (y = specret_out o /\ abort o)
+  \/ (exists S, exists (R : res), o = out_ter S R /\ K S R = result_some y).
+
+Lemma if_ter_spec : forall T W K (y : specret T),
+  if_ter W K = result_some y ->
+  isout W (if_ter_spec_post K y).
+Proof.
+  introv H. destruct W as [[|o1]| | | ]; simpls; tryfalse_nothing.
+  exists o1. splits~. unfolds. destruct o1 as [|S R].
+   inverts* H.
+   jauto.
+Qed.
+
+Definition if_success_spec_post T K (y:specret T) o :=
+     (y = specret_out o /\ abort o)
+  \/ (exists S, exists (rv : resvalue), o = out_ter S rv /\ K S rv = result_some y).
+
+Lemma if_success_spec : forall T W K (y : specret T),
+  if_success W K = result_some y ->
+  exists (o : out), W = o /\ if_success_spec_post K y o. (* LATER:  Change to [isout] *)
+Proof.
+  introv E. forwards~ (o1&WE&P): if_ter_spec (rm E). subst W. eexists. splits*.
+  inversion_clear P as [[? ?]|(S&R&?&H)]. substs. branch~ 1.
+  substs. destruct R as [rt rv' rl]. destruct~ rt; simpls;
+     try solve [inverts H; branch 1; splits~; prove_abort].
+   forwards~ (?&?): if_empty_label_out (rm H). simpls. substs.
+    branch 2. repeat eexists. auto*.
+Qed.
+
+Definition if_value_spec_post T K (y:specret T) o :=
+     (y = specret_out o /\ abort o)
+  \/ (exists S, exists (v : value), o = out_ter S v /\ K S v = result_some y).
+
+Lemma if_value_spec : forall T W K (y : specret T),
+  if_value W K = result_some y ->
+  exists (o : out), W = o /\ if_value_spec_post K y o.
+Proof.
+  introv E. unfolds in E.
+  forwards~ (o1&WE&P): if_success_spec (rm E). exists o1. split~.
+  unfolds. unfolds in P.
+  inversion_clear P as [[? ?]|(S&R&H&E)]; subst; [ left* | right ].
+  destruct R; tryfalse. exists___*.
+Admitted. (*faster*)
+
+Definition if_prim_spec_post T K (y:specret T) o :=
+     (y = specret_out o /\ abort o)
+  \/ (exists S, exists (w : prim), o = out_ter S w /\ K S w = result_some y).
+
+Lemma if_prim_spec : forall T W K (y : specret T),
+  if_prim W K = result_some y ->
+  exists (o : out), W = o /\ if_prim_spec_post K y o.
+Proof.
+  introv E. unfolds in E.
+  forwards~ (o1&WE&P): if_value_spec (rm E). exists o1. split~.
+  unfolds. unfolds in P.
+  inversion_clear P as [[? ?]|(S&R&H&E)]; subst; [ left* | right ].
+  destruct R; tryfalse. exists___*.
+Admitted. (*faster*)
+
+Definition if_bool_spec_post T K (y:specret T) o :=
+     (y = specret_out o /\ abort o)
+  \/ (exists S, exists (b : bool), o = out_ter S b /\ K S b = result_some y).
+
+Lemma if_bool_spec : forall T W K (y : specret T),
+  if_bool W K = result_some y ->
+  exists (o : out), W = o /\ if_bool_spec_post K y o.
+Proof.
+  introv E. unfolds in E.
+  forwards~ (o1&WE&P): if_value_spec (rm E). exists o1. split~.
+  unfolds. unfolds in P.
+  inversion_clear P as [[? ?]|(S&R&H&E)]; subst; [ left* | right ].
+  destruct R; tryfalse. destruct p; tryfalse. exists___*.
+Admitted. (*faster*)
+
+Definition if_number_spec_post T K (y:specret T) o :=
+     (y = specret_out o /\ abort o)
+  \/ (exists S, exists (n : number), o = out_ter S n /\ K S n = result_some y).
+
+Lemma if_number_spec : forall T W K (y : specret T),
+  if_number W K = result_some y ->
+  exists (o : out), W = o /\ if_number_spec_post K y o.
+Proof.
+  introv E. unfolds in E.
+  forwards~ (o1&WE&P): if_value_spec (rm E). exists o1. split~.
+  unfolds. unfolds in P.
+  inversion_clear P as [[? ?]|(S&R&H&E)]; subst; [ left* | right ].
+  destruct R; tryfalse. destruct p; tryfalse. exists___*.
+Admitted. (*faster*)
+
+Definition if_string_spec_post T K (y:specret T) o :=
+     (y = specret_out o /\ abort o)
+  \/ (exists S, exists (s : string), o = out_ter S s /\ K S s = result_some y).
+
+Lemma if_string_spec : forall T W K (y : specret T),
+  if_string W K = result_some y ->
+  exists (o : out), W = o /\ if_string_spec_post K y o.
+Proof.
+  introv E. unfolds in E.
+  forwards~ (o1&WE&P): if_value_spec (rm E). exists o1. split~.
+  unfolds. unfolds in P.
+  inversion_clear P as [[? ?]|(S&R&H&E)]; subst; [ left* | right ].
+  destruct R; tryfalse. destruct p; tryfalse. exists___*.
+Admitted. (*faster*)
+
+Definition if_object_spec_post T K (y:specret T) o :=
+     (y = specret_out o /\ abort o)
+  \/ (exists S, exists (l : object_loc), o = out_ter S l /\ K S l = result_some y).
+
+Lemma if_object_spec : forall T W K (y : specret T),
+  if_object W K = result_some y ->
+  exists (o : out), W = o /\ if_object_spec_post K y o.
+Proof.
+  introv E. unfolds in E.
+  forwards~ (o1&WE&P): if_value_spec (rm E). exists o1. split~.
+  unfolds. unfolds in P.
+  inversion_clear P as [[? ?]|(S&R&H&E)]; subst; [ left* | right ].
+  destruct R; tryfalse. exists___*.
+Qed.
+
+
+(************************************************************)
+(* ** Correctness Tactics *)
+
+(** [prove_not_intercept] proves a goal of
+    the form "~ abort_intercepted_* _" *)
+
+Ltac prove_not_intercept :=
+let H := fresh in intros H; try solve [ inversion H; false~ ].
+
+Hint Extern 1 (~ abort_intercepted_expr _) => prove_not_intercept.
+Hint Extern 1 (~ abort_intercepted_stat _) => prove_not_intercept.
+Hint Extern 1 (~ abort_intercepted_prog _) => prove_not_intercept.
+
+Ltac abort_tactic L :=
+  try subst; apply L;
+  [ simpl; congruence
+  | try prove_abort
+  | try prove_not_intercept ].
+
+Tactic Notation "abort_expr" :=
+    abort_tactic red_expr_abort.
+Tactic Notation "abort_stat" :=
+    abort_tactic red_stat_abort.
+Tactic Notation "abort_prog" :=
+    abort_tactic red_prog_abort.
+Tactic Notation "abort_spec" :=
+    abort_tactic red_spec_abort.
+Tactic Notation "abort" :=
+  match goal with
+  | |- red_expr _ _ _ _ => abort_expr
+  | |- red_stat _ _ _ _ => abort_stat
+  | |- red_prog _ _ _ _ => abort_prog
+  | |- red_spec _ _ _ _ => abort_spec
+  end.
+
+(** [run_select_ifres] selects the appropriate "out" lemma *)
+
+Ltac run_select_extra T := fail.
+
+Ltac run_select_ifres H :=
+  match type of H with ?T = _ => match T with
+  | @if_ter nothing _ _ => constr:(if_ter_out)
+  | @if_success nothing _ _ => constr:(if_success_out)
+  | @if_value nothing _ _ => constr:(if_value_out)
+  | @if_void nothing _ _ => constr:(if_void_out)
+  | if_break _ _ => constr:(if_break_out)
+  | @if_object nothing _ _ => constr:(if_object_out)
+  | @if_bool nothing _ _ => constr:(if_bool_out)
+  | @if_string nothing _ _ => constr:(if_string_out)
+  | @if_number nothing _ _ => constr:(if_number_out)
+  | @if_prim nothing _ _ => constr:(if_prim_out)
+  | if_ter _ _ => constr:(if_ter_spec)
+  | if_success _ _ => constr:(if_success_spec)
+  | if_value _ _ => constr:(if_value_spec)
+  | if_bool _ _ => constr:(if_bool_spec)
+  | if_string _ _ => constr:(if_string_spec)
+  | if_object _ _ => constr:(if_object_spec)
+  | if_number _ _ => constr:(if_number_spec)
+  | if_prim _ _ => constr:(if_prim_spec)
+  | if_spec _ _ => constr:(if_spec_out)
+  | if_void _ _ => constr:(if_void_out)
+  | if_not_throw _ _ => constr:(if_not_throw_out)
+  | if_any_or_throw _ _ _ => constr:(if_any_or_throw_out)
+  | if_success_or_return _ _ _ => constr:(if_success_or_return_out)
+  | if_success_state _ _ _ => constr:(if_success_state_out)
+  | ?x => run_select_extra T
+  end end.
+
+(* template:
+Ltac run_select_extra T ::=
+  match T with
+  | if_any_or_throw _ _ _ => constr:(if_any_or_throw_out)
+  end.
+*)
+
+(** [run_select_proj] is used to obtain automatically
+    the right correctness lemma out of the correctness record *)
+
+Ltac run_select_proj_extra_error HT := fail.
+Ltac run_select_proj_extra_ref HT := fail.
+Ltac run_select_proj_extra_conversions HT := fail.
+Ltac run_select_proj_extra_construct HT := fail.
+Ltac run_select_proj_extra_get_value HT := fail.
+
+Ltac run_select_proj H :=
+  match type of H with ?T = _ => let HT := get_head T in
+  match HT with
+  | runs_type_expr => constr:(runs_type_correct_expr)
+  | runs_type_stat => constr:(runs_type_correct_stat)
+  | runs_type_prog => constr:(runs_type_correct_prog)
+  | runs_type_call => constr:(runs_type_correct_call)
+  | runs_type_construct => constr:(runs_type_correct_construct)
+  | runs_type_function_has_instance => constr:(runs_type_correct_function_has_instance)
+  | runs_type_object_has_instance => constr:(runs_type_correct_object_has_instance)
+  | runs_type_stat_while => constr:(runs_type_correct_stat_while)
+  | runs_type_stat_do_while => constr:(runs_type_correct_stat_do_while)
+  | runs_type_stat_for_loop => constr:(runs_type_correct_stat_for_loop)
+  | runs_type_object_delete => constr:(runs_type_correct_object_delete)
+  | runs_type_object_get_own_prop => constr:(runs_type_correct_object_get_own_prop)
+  | runs_type_object_get_prop => constr:(runs_type_correct_object_get_prop)
+  | runs_type_object_get => constr:(runs_type_correct_object_get)
+  | runs_type_object_proto_is_prototype_of => constr:(runs_type_correct_object_proto_is_prototype_of)
+  | runs_type_object_put => constr:(runs_type_correct_object_put)
+  | runs_type_equal => constr:(runs_type_correct_equal)
+  | runs_type_to_integer => constr:(runs_type_correct_to_integer)
+  | runs_type_to_string => constr:(runs_type_correct_to_string)
+  | runs_type_array_element_list => constr:(runs_type_correct_array_element_list)
+  | runs_type_object_define_own_prop_array_loop => constr:(runs_type_correct_object_define_own_prop_array_loop)
+  | ?x => run_select_proj_extra_error HT
+  | ?x => run_select_proj_extra_ref HT
+  | ?x => run_select_proj_extra_conversions HT
+  | ?x => run_select_proj_extra_construct HT
+  | ?x => run_select_proj_extra_get_value HT
+  end end.
+
+(** [prove_runs_type_correct] discharges the trivial goal
+    that consists in invoking the induction hypothesis*)
+
+Ltac prove_runs_type_correct :=
+  match goal with |- runs_type_correct _ => assumption end.
+
+(* [run_hyp H] exploits the induction hypothesis
+   on [runs_type_correct] to the hypothesis [H] *)
+
+Ltac run_hyp_core H R :=
+  let H' := fresh in rename H into H';
+  let Proj := run_select_proj H' in
+  lets R: Proj (rm H');
+  try prove_runs_type_correct.
+
+(** [select_ind_hyp] returns the induction hypothesis
+    on [runs_type_correct] *)
+
+Ltac select_ind_hyp tt :=
+  match goal with IH: runs_type_correct _ |- _ => constr:(IH) end.
+
+(* old run_hyp H:
+Ltac run_hyp_core H R :=
+  let H' := fresh in rename H into H';
+  let IH := select_ind_hyp tt in
+  let Proj := run_select_proj H' in
+  lets R: Proj IH (rm H').
+*)
+
+Tactic Notation "run_hyp" hyp(H) "as" simple_intropattern(R) :=
+  run_hyp_core H R.
+
+Tactic Notation "run_hyp" hyp(H) :=
+  let T := fresh in rename H into T;
+  run_hyp T as H.
+
+Tactic Notation "run_hyp" :=
+  match goal with H: _ = result_some _ |- _ => run_hyp H end.
+
+Tactic Notation "run_hyp" "*" hyp(H) :=
+  run_hyp H; auto*.
+
+Tactic Notation "run_hyp" "*" :=
+  run_hyp; auto*.
+
+
+(* [run_pre] exploits the appropriate "out" lemma, whether it comes
+   from the correctness record or it is an auxiliary lemma. *)
+
+Ltac run_pre_ifres H o1 R1 K :=
+   let L := run_select_ifres H in
+   lets (o1&R1&K): L (rm H). (* deconstruction of the "isout" *)
+
+Ltac run_pre_core H o1 R1 K :=
+   run_pre_ifres H o1 R1 K;
+   let O1 := fresh "O1" in
+   try (rename R1 into O1; run_hyp O1 as R1).
+
+Tactic Notation "run_pre" hyp(H) "as" ident(o1) ident(R1) ident(K) :=
+  let T := fresh in rename H into T;
+  run_pre_core T o1 R1 K.
+
+Tactic Notation "run_pre_ifres" "as" ident(o1) ident(R1) :=
+  unfold result_some_out in *; unfold res_to_res_void in * ; unfold result_out in *; unfold res_out in *;
+  (* LATER: improve unfolds *)
+  match goal with H: _ = result_some _ |- _ =>
+    let T := fresh in rename H into T;
+    run_pre_ifres T o1 R1 H end.
+
+Tactic Notation "run_pre" "as" ident(o1) ident(R1) :=
+  unfold result_some_out in *; unfold res_to_res_void in * ; unfold result_out in *; unfold res_out in *;
+  (* LATER: improve unfolds *)
+  match goal with H: _ = result_some _ |- _ =>
+    let T := fresh in rename H into T;
+    run_pre_core T o1 R1 H end.
+
+Tactic Notation "run_pre" "as" ident(o1) :=
+  let R1 := fresh "R1" o1 in
+  run_pre as o1 R1.
+
+Tactic Notation "run_pre" :=
+  let o1 := fresh "o1" in let R1 := fresh "R1" in
+  run_pre as o1 R1.
+
+(** [run_apply Red o1 R1] applys a reduction rule on a given
+    [o1] or reduction reaching [o1]. *)
+
+Tactic Notation "run_apply" constr(Red) constr(o1orR1) :=
+  applys Red o1orR1.
+
+Tactic Notation "run_apply" constr(Red) constr(o1) constr(R1) :=
+  first [ applys Red (rm R1)
+        | applys Red o1 ].
+
+(** [run_post] decomposes the conclusion of the "out"
+    lemma *)
+
+Ltac run_post_run_expr_get_value := fail.
+
+Ltac run_post_extra := fail.
+
+Ltac run_post_core :=
+  let Er := fresh "Er" in
+  let Ab := fresh "Ab" in
+  let S := fresh "S" in
+  let O1 := fresh "O1" in
+  let go H X :=
+    destruct H as [(Er&Ab)|(S&X&O1&H)];
+    [ try abort | try subst_hyp O1 ] in
+  match goal with
+  | H: if_ter_post _ _ _ |- _ =>
+    let R := fresh "R" in go H R
+  | H: if_success_post _ _ _ |- _ =>
+    let rv := fresh "rv" in go H rv
+  | H: if_value_post _ _ _ |- _ =>
+    let v := fresh "v" in go H v
+  | H: if_void_post _ _ _ |- _ =>
+    destruct H as [(Er&Ab)|(S&O1&H)];
+    [ try abort | try subst_hyp O1 ]
+  | H: if_not_throw_post _ _ _ |- _ =>
+    let R := fresh "R" in
+    let N := fresh "N" in let v := fresh "v" in
+    let E := fresh "E" in let L := fresh "L" in
+    destruct H as [(Er & Ab) | (S & R & O1 & [(N & H) | (N & H)])];
+    [try abort | try subst_hyp O1 | try abort]
+  | H: if_break_post _ _ _ |- _ =>
+    let R := fresh "R" in let E := fresh "E" in
+    let HT := fresh "HT" in
+    destruct H as [(Er&E)|(S&R&O1&[(HT&E)|(HT&H)])];
+    [ try abort | try subst_hyp O1 | try subst_hyp O1 ]
+  | H: if_object_post _ _ _ |- _ =>
+    let l := fresh "l" in go H l
+  | H: if_bool_post _ _ _ |- _ =>
+    let b := fresh "b" in go H b
+  | H: if_string_post _ _ _ |- _ =>
+    let s := fresh "s" in go H s
+  | H: if_number_post _ _ _ |- _ =>
+    let m := fresh "m" in go H m
+  | H: if_prim_post _ _ _ |- _ =>
+    let w := fresh "w" in go H w
+  | H: if_ter_spec_post _ _ _ |- _ =>
+    let R := fresh "R" in go H R
+  | H: if_success_spec_post _ _ _ |- _ =>
+    let rv := fresh "rv" in go H rv
+  | H: if_value_spec_post _ _ _ |- _ =>
+    let v := fresh "v" in go H v
+  | H: if_bool_spec_post _ _ _ |- _ =>
+    let b := fresh "b" in go H b
+  | H: if_string_spec_post _ _ _ |- _ =>
+    let s := fresh "s" in go H s
+  | H: if_object_spec_post _ _ _ |- _ =>
+    let l := fresh "l" in go H l
+  | H: if_number_spec_post _ _ _ |- _ =>
+    let m := fresh "m" in go H m
+  | H: if_prim_spec_post _ _ _ |- _ =>
+    let w := fresh "w" in go H w
+  | H: if_spec_post _ _ _ |- _ =>
+    let o := fresh "o" in let Er' := fresh "Er" in
+    let S := fresh "S" in let a := fresh "a" in
+    destruct H as [(o&Er&Er'&Ab)|(S&a&O1&H)];
+    [ try abort | try subst_hyp O1 ]
+  | H: if_any_or_throw_post _ _ _ _ |- _ =>
+    let R := fresh "R" in
+    let N := fresh "N" in let v := fresh "v" in
+    let E := fresh "E" in let L := fresh "L" in
+    destruct H as [(Er&Ab)|(S&R&O1&[(N&H)|(N&v&E&L&H)])];
+    [ try subst_hyp Er; try subst_hyp Ab | try subst_hyp O1 | try subst_hyp O1 ]
+  | H: if_success_or_return_post _ _ _ _ |- _ =>
+     let S := fresh "S" in let R := fresh "R" in
+     let o1 := fresh "o1" in let W1 := fresh "W1" in let O1 := fresh "O1" in
+     let E1 := fresh "E" in let E2 := fresh "E" in
+     destruct H as [(Er&Ab)|(S&R&O1&[(E1&E2&K)|[(E1&E2&K)|(E1&E2&K)]])];
+    [ try subst_hyp Er; try subst_hyp Ab; try abort
+    | try subst_hyp O1 | try subst_hyp O1 | try subst_hyp O1 ]
+  | H: if_success_state_post _ _ _ _ |- _ =>
+    (* LATER: improve the statement of the lemma *)
+     let S := fresh "S" in let R := fresh "R" in
+     let O1 := fresh "O1" in
+     let E1 := fresh "E" in let E2 := fresh "E" in let rv := fresh "rv" in
+     destruct H as [(Er&Ab)|[(S&R&O1&E1&H)|[(S&R&O1&E1&E2&H)|(S&rv&O1&H)]]];
+    [ try subst_hyp Er; try subst_hyp Ab; try abort
+    | try subst_hyp O1 | try subst_hyp O1 | try subst_hyp O1 ]
+  | |- _ => run_post_run_expr_get_value
+  | |- _ => run_post_extra
+  end.
+
+(* template
+Ltac run_post_extra ::=
+  let Er := fresh "Er" in let Ab := fresh "Ab" in
+  let O1 := fresh "O1" in let S := fresh "S" in
+  match goal with
+  | H: if_any_or_throw_post _ _ _ _ |- _ => ...
+  end.
+
+*)
+
+Tactic Notation "run_post" :=
+  run_post_core.
+
+(** [run_inv] simplifies equalities in goals
+    by performing inversions on equalities. *)
+
+Ltac run_inv :=
+  unfold result_some_out in *; unfold res_to_res_void in * ; unfold out_retn in *; unfold result_out in *;
+  repeat
+  match goal with
+  | H: resvalue_value ?v = resvalue_value ?v |- _ => clear H
+  | H: resvalue_value _ = resvalue_value _ |- _ => inverts H
+  | H: res_spec _ _ = _ |- _ => unfold res_spec in H
+  | H: _ = res_spec _ _ |- _ => unfold res_spec in H
+  | H: res_out _ = _ |- _ => unfold res_out in H
+  | H: _ = res_out _ |- _ => unfold res_out in H
+  | H: res_ter _ _ = _ |- _ => unfold res_ter in H
+  | H: _ = res_ter _ _ |- _ => unfold res_ter in H
+  | H: result_some ?o = result_some ?o |- _ => clear H
+  | H: result_some _ = result_some _ |- _ => inverts H
+  | H: out_ter ?S ?R = out_ter ?S ?R |- _ => clear H
+  | H: out_ter _ _ = out_ter _ _ |- _ => inverts H
+  | H: res_intro ?t ?v ?l = res_intro ?t ?v ?l |- _ => clear H
+  | H: res_intro _ _ _ = res_intro _ _ _ |- _ => inverts H
+  | H: ret _ _ = _ |- _ => unfold ret in H
+  | H: _ = ret _ _ |- _ => unfold ret in H
+  | H: ret_void _ = _ |- _ => unfold ret_void in H
+  | H: _ = ret_void _ |- _ => unfold ret_void in H
+  | H: res_void _ = _ |- _ => unfold res_void in H
+  | H: _ = res_void _ |- _ => unfold res_void in H
+  | H: specret_val ?S ?R = specret_val ?S ?R |- _ => clear H
+  | H: specret_val _ _ = specret_val _ _ |- _ => inverts H
+  | H: specret_out ?o = specret_out ?o |- _ => clear H
+  | H: specret_out _ = _ |- _ => inverts H
+  | H: _ = specret_out _ |- _ => inverts H
+  | H: out_from_retn ?sp = out_from_retn ?sp |- _ => clear H
+  | H: out_from_retn _ = out_from_retn _ |- _ => inverts H
+  end.
+
+(** [runs_inv] is the same as [run_inv] followed by subst. *)
+
+Ltac runs_inv :=
+  run_inv; subst.
+
+(** Auxiliary tactics to select/check the current "out" *)
+
+Ltac run_get_current_out tt :=
+  match goal with
+  | |- red_expr _ _ _ ?o => o
+  | |- red_stat _ _ _ ?o => o
+  | |- red_prog _ _ _ ?o => o
+  | |- red_spec _ _ _ ?o => o
+  | |- red_javascript _ ?o => o
+  end.
+
+Ltac run_check_current_out o :=
+  match goal with
+  | |- red_expr _ _ _ o => idtac
+  | |- red_stat _ _ _ o => idtac
+  | |- red_prog _ _ _ o => idtac
+  | |- red_spec _ _ _ o => idtac
+  | |- red_javascript _ o => idtac
+  end.
+
+(** [run_step Red] combines [run_pre], [run_apply Red] and calls
+    [run_post] on the main reduction subgoal, followed
+    with a cleanup using [run_inv] *)
+
+Ltac run_step Red :=
+  let o1 := fresh "o1" in let R1 := fresh "R1" in
+  run_pre as o1 R1;
+  match Red with ltac_wild => idtac | _ =>
+    let o := run_get_current_out tt in
+    run_apply Red o1 R1;
+    try (run_check_current_out o; run_post; run_inv; try assumption)
+  end.
+
+(** [run_step_using Red Lem] combines [run_pre],
+    a forward to exploit the correctness lemma [Lem],
+    [run_apply Red] and calls
+    [run_post] on the main reduction subgoal, followed
+    with a cleanup using [run_inv] *)
+
+Ltac run_step_using Red Lem :=
+  let o1 := fresh "o1" in let O1 := fresh "O1" in
+  let R1 := fresh "R1" in
+  run_pre_ifres as o1 O1;
+  lets R1: Lem (rm O1);
+  try prove_runs_type_correct;
+  match Red with ltac_wild => idtac | _ =>
+    let o := run_get_current_out tt in
+    run_apply Red o1 R1;
+    try (run_check_current_out o; run_post; run_inv; try assumption)
+  end.
+
+(** [run_simpl] is intended for simplyfing simple monads
+    that do not match over a result, then run
+    [run_inv] to clean up the goal. *)
+
+Ltac run_simpl_run_error H T K := fail.
+
+Ltac run_simpl_base H K :=
+  let E := fresh "E" in
+  match type of H with ?T = _ => match T with
+  | if_some _ _ =>
+     let x := fresh "x" in
+     lets (x&E&K): if_some_out (rm H)
+  | if_some_or_default _ _ _ =>
+     let x := fresh "x" in
+     let E1 := fresh "E" in let E2 := fresh "E" in
+     lets [(E1&E2)|(n&E&K)]: if_some_or_default_out (rm H)
+  | if_empty_label _ _ _ =>
+     lets (E&K): if_empty_label_out (rm H)
+  | ?x => run_simpl_run_error H T K
+  | ?x => run_hyp_core H K
+  end end.
+
+
+Ltac run_simpl_core H K :=
+  run_simpl_base H K; run_inv.
+
+Tactic Notation "run_simpl" ident(H) "as" ident(K) :=
+  let T := fresh in rename H into T;
+  run_simpl_core T K.
+
+Tactic Notation "run_simpl" :=
+  unfold result_some_out in *; unfold res_to_res_void in * ; unfold result_out in *; unfold res_out in *;
+  (* LATER: handle unfold *)
+  match goal with H: _ = result_some _ |- _ =>
+    let H' := fresh in rename H into H';
+    run_simpl_core H' H
+  end.
+
+(** [run Red] is the same as [run_step Red].
+    [run] without arguments is the same as [run_simpl].
+    [runs] is same as [run] followed with [subst]. *)
+
+Tactic Notation "run" constr(Red) :=
+  run_step Red.
+
+Tactic Notation "run" "~" constr(Red) :=
+  run Red; auto~.
+
+Tactic Notation "run" "*" constr(Red) :=
+  run Red; auto*.
+
+Tactic Notation "run" constr(Red) "using" constr(Lem) :=
+  run_step_using Red Lem.
+
+Tactic Notation "run" "~" constr(Red) "using" constr(Lem) :=
+  run Red using Lem; auto~.
+
+Tactic Notation "run" "*" constr(Red) "using" constr(Lem) :=
+  run Red using Lem; auto*.
+
+
+Tactic Notation "runs" constr(Red) :=
+  run Red; subst.
+
+Tactic Notation "runs" "~" constr(Red) :=
+  run Red; subst; auto~.
+
+Tactic Notation "runs" "*" constr(Red) :=
+  run Red; subst; auto*.
+
+Tactic Notation "run" :=
+  run_simpl.
+
+Tactic Notation "run" "~" :=
+  run; auto~.
+
+Tactic Notation "run" "*" :=
+  run; auto*.
+
+Tactic Notation "runs" :=
+  run; subst.
+
+Tactic Notation "runs" "~" :=
+  runs; auto~.
+
+Tactic Notation "runs" "*" :=
+  runs; auto*.
+
+
+(* debugging of [run Red]:
+  run_pre as o1 R1.
+    or: run_pre H as o1 R1 K. (* where H is the hypothesis *)
+    or: run_pre_core H o1 R1 K. (* where H is the hypothesis *)
+    or: run_pre_lemma H o1 R1 K. (* where H is the hypothesis *)
+  run_apply __my_red_lemma__ R1. (* where R1 is the red hypothesis *)
+  run_post.
+  run_inv.
+*)
+
+
+(************************************************************)
+(* ** Correctness Lemmas *)
+
+Lemma type_of_prim_not_object : forall w,
+  type_of w <> type_object.
+Proof. destruct w; simpl; try congruence. Qed.
+
+Hint Resolve type_of_prim_not_object.
+
+Lemma is_lazy_op_correct : forall op,
+  match is_lazy_op op with
+  | None => regular_binary_op op
+  | Some b => lazy_op op b
+  end.
+Proof.
+  Hint Constructors lazy_op.
+  unfold regular_binary_op.
+  intros. destruct op; simple*.
+Admitted. (* faster *)
+
+Lemma run_object_method_correct : forall Z (Proj : _ -> Z) S l (z : Z),
+  run_object_method Proj S l = Some z ->
+  object_method Proj S l z.
+Proof.
+  introv B. unfolds. forwards (O&Bi&E): LibOption.map_on_inv B.
+  forwards: @pick_option_correct Bi. exists* O.
+Qed.
+
+Lemma run_object_heap_set_extensible_correct : forall b S l S',
+  run_object_heap_set_extensible b S l = Some S' ->
+  object_heap_set_extensible b S l S'.
+Proof.
+  introv R. unfolds in R. forwards (O&H&E): LibOption.map_on_inv (rm R).
+  forwards: @pick_option_correct (rm H). exists O. splits~.
+Qed.
+
+Lemma build_error_correct : forall S C vproto vmsg o,
+  build_error S vproto vmsg = o ->
+  red_expr S C (spec_build_error vproto vmsg) o.
+Proof.
+  introv R. unfolds in R.
+  match goal with H: context [object_alloc ?s ?o] |- _ => sets_eq X: (object_alloc s o) end.
+  destruct X as (l&S'). cases_if.
+  applys~ red_spec_build_error EQX. run_inv.
+   applys~ red_spec_build_error_1_no_msg.
+Qed.
+
+Lemma run_error_correct' : forall T S ne o C,
+  run_error S ne = (res_out o : specres T) ->
+  red_expr S C (spec_error ne) o /\ abort o.
+Proof.
+  introv R. unfolds in R. run_pre as o1 R1. forwards R0: build_error_correct (rm R1).
+  applys_and red_spec_error R0. run_post.
+   run_inv. splits~. abort.
+   run_inv. splits; [|prove_abort]. apply~ red_spec_error_1.
+Qed.
+
+Lemma run_error_correct : forall T S ne o C,
+  run_error S ne = (res_out o : specres T) ->
+  red_expr S C (spec_error ne) o.
+Proof. intros. applys* run_error_correct'. Qed.
+
+Lemma run_error_correct_2 : forall T S (ne : native_error) o C,
+  run_error S ne = (res_out o : specres T) -> red_expr S C (spec_error ne) o.
+Proof. intros. apply* run_error_correct. Qed.
+
+Hint Resolve run_error_correct run_error_correct_2.
+
+Ltac run_simpl_run_error H T K ::=
+  match T with run_error _ _ =>
+     let N := fresh "N" in
+     let C := match goal with |- _ _ ?C _ _ => constr:(C) end in
+     lets (K&N): run_error_correct C (rm H)
+  end.
+
+Lemma run_error_not_some_out_res : forall S v T,
+  ~ (run_error S native_error_type = result_some (@specret_out T (out_ter S (res_val v)))).
+Proof.
+  set (C := execution_ctx_intro nil nil (value_prim (prim_bool true)) false). introv Hyp.
+  apply run_error_correct' with (C := C) in Hyp. 
+  destruct Hyp as (Hred & Habort).
+  inverts Hred. simpls. inverts H.
+  inverts H3. simpls. inverts H.
+  inverts H0. simpls. inverts H.
+  inverts H9. simpls. inverts H.
+  inverts Habort. unfolds abrupt_res.
+  false~ H0. false~ H3.
+Admitted. (*faster*)
+
+Lemma out_error_or_void_correct : forall S C str (ne : native_error) o,
+  out_error_or_void S str ne = o ->
+  red_expr S C (spec_error_or_void str ne) o /\
+    (~ abort o -> o = out_void S).
+Proof.
+  introv E. unfolds in E. cases_if.
+   applys_and red_spec_error_or_void_true.
+   forwards~ (RC&Cr): run_error_correct' E. splits*.
+   inverts E. splits~. apply~ red_spec_error_or_void_false.
+Qed.
+
+Lemma out_error_or_cst_correct' : forall S C str (ne : native_error) v o,
+  out_error_or_cst S str ne v = o ->
+  red_expr S C (spec_error_or_cst str ne v) o /\
+    (~ abort o -> o = out_ter S v).
+Proof.
+  introv E. unfolds in E. cases_if.
+   applys_and red_spec_error_or_cst_true. forwards~ (RC&Cr): run_error_correct' E. splits*.
+   inverts E. splits~. apply~ red_spec_error_or_cst_false.
+Qed.
+
+(* LATER: clean up redundant proof for the direct case *)
+Lemma out_error_or_cst_correct : forall S C str ne v o,
+  out_error_or_cst S str ne v = o ->
+  red_expr S C (spec_error_or_cst str ne v) o.
+Proof.
+  introv HR. unfolds in HR. case_if.
+  applys* red_spec_error_or_cst_true.
+  run_inv. applys* red_spec_error_or_cst_false.
+Qed.
+
+
+Ltac run_select_proj_extra_error HT ::=
+  match HT with
+  | run_error => constr:(run_error_correct)
+  | run_object_method => constr:(run_object_method_correct)
+  end.
+
+
+(**************************************************************)
+(** ** Object Get *)
+
+Lemma object_has_prop_correct : forall runs S C l x o,
+  runs_type_correct runs ->
+  object_has_prop runs S C l x = o ->
+  red_expr S C (spec_object_has_prop l x) o.
+Proof.
+  introv IH HR. unfolds in HR. run_simpl. run_hyp E as M.
+  applys~ red_spec_object_has_prop M. destruct x0.
+  run red_spec_object_has_prop_1_default using runs_type_correct_object_get_prop.
+  apply~ red_spec_object_has_prop_2. rewrite decide_def. repeat cases_if~.
+Qed.
+
+Lemma run_object_get_prop_correct : forall runs S C l x y,
+  runs_type_correct runs ->
+  run_object_get_prop runs S C l x = result_some y ->
+  red_spec S C (spec_object_get_prop l x) y.
+Proof.
+  introv IH HR. unfolds in HR.
+  run. applys* red_spec_object_get_prop.
+   applys* run_object_method_correct. clear E.
+  destruct x0; tryfalse.
+  run red_spec_object_get_prop_1_default. case_if.
+   subst. run. applys red_spec_object_get_prop_2_undef.
+    applys* run_object_method_correct.
+    destruct x0; tryfalse.
+      destruct p; tryfalse. run_inv. applys red_spec_object_get_prop_3_null.
+      applys red_spec_object_get_prop_3_not_null. run_hyp*.
+  run_inv. destruct a; tryfalse.
+   applys* red_spec_object_get_prop_2_not_undef.
+Admitted. (*faster*)
+
+Lemma object_get_builtin_correct : forall runs S C B (vthis:value) l x o,
+  runs_type_correct runs ->
+  object_get_builtin runs S C B vthis l x = o ->
+  red_expr S C (spec_object_get_1 B vthis l x) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  let_name as Mdefault.
+  asserts Mdefault_correct: (forall S l o,
+    Mdefault S l = res_out o ->
+    red_expr S C (spec_object_get_1 builtin_get_default vthis l x) o).
+    clear HR o. subst. introv HR.
+   run red_spec_object_get_1_default. destruct a as [|[Ad|Aa]].
+    run_inv. applys* red_spec_object_get_2_undef.
+    run_inv. applys* red_spec_object_get_2_data.
+    applys red_spec_object_get_2_accessor.
+     destruct (attributes_accessor_get Aa); tryfalse.
+       destruct p; tryfalse. run_inv.
+        applys* red_spec_object_get_3_accessor_undef.
+       applys* red_spec_object_get_3_accessor_object. run_hyp*.
+  clear EQMdefault.
+  let_name as Mfunction.
+  asserts Mfunction_correct: (forall S o,
+    Mfunction S = res_out o ->
+    red_expr S C (spec_object_get_1 builtin_get_function vthis l x) o).
+    clear HR o. subst. introv HR.
+    run* red_spec_object_get_1_function. clear R1.
+    case_if.
+     applys* red_spec_function_get_1_error.
+     run_inv. applys* red_spec_function_get_1_normal.
+      clear EQMfunction. destruct B; tryfalse.
+      applys~ Mdefault_correct.
+      applys~ Mfunction_correct.
+  (* argument object *)
+  run. forwards* obpm: run_object_method_correct.
+  run. substs. run~ red_spec_object_get_args_obj.
+  destruct a. (* LTAC ARTHUR:  This [a] wasn't properly named. *)
+   apply* red_spec_object_get_args_obj_1_undef.
+   run_hyp. apply~ red_spec_object_get_args_obj_1_attrs.
+Admitted. (* faster *)
+
+
+Lemma run_object_get_correct : forall runs S C l x o,
+  runs_type_correct runs ->
+  run_object_get runs S C l x = o ->
+  red_expr S C (spec_object_get l x) o.
+Proof.
+  introv IH HR. unfolds in HR. run.
+  applys* red_spec_object_get.
+   applys* run_object_method_correct. clear E.
+  applys* object_get_builtin_correct.
+Qed.
+
+
+Lemma object_can_put_correct : forall runs S C l x o,
+  runs_type_correct runs ->
+  object_can_put runs S C l x = o ->
+  red_expr S C (spec_object_can_put l x) o.
+Proof.
+  introv IH HR. unfolds in HR. run. run_hyp E as CP.
+  applys~ red_spec_object_can_put CP. destruct x0.
+  run red_spec_object_can_put_1_default. destruct a.
+   run. run_hyp E as P. applys~ red_spec_object_can_put_2_undef P.
+    destruct x0 as [()|lproto]; tryfalse.
+     run. run_hyp E as E. apply~ red_spec_object_can_put_4_null.
+     run red_spec_object_can_put_4_not_null using run_object_get_prop_correct.
+      destruct a as [|[Ad|Aa]].
+       run. run_hyp E as E. apply~ red_spec_object_can_put_5_undef.
+       run. run_hyp E as E. applys~ red_spec_object_can_put_5_data E. destruct x0.
+        applys~ red_spec_object_can_put_6_extens_true.
+        applys~ red_spec_object_can_put_6_extens_false.
+       run_inv. apply~ red_spec_object_can_put_5_accessor. rewrite decide_def.
+        repeat cases_if~.
+   destruct a; run_inv.
+    apply~ red_spec_object_can_put_2_data.
+    apply~ red_spec_object_can_put_2_accessor. rewrite decide_def. repeat cases_if~.
+Qed.
+
+Lemma object_default_value_correct : forall runs S C l pref o,
+  runs_type_correct runs ->
+  object_default_value runs S C l pref = o ->
+  red_expr S C (spec_object_default_value l pref) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  run. lets H: run_object_method_correct (rm E).
+  applys* red_spec_object_default_value (rm H).
+  destruct x.
+  let_name as M.
+  asserts M_correct: (forall S x (F:state->result) K (o:out),
+      (M S x F = res_out o) ->
+      (forall S' o', (F S' = o') -> red_expr S' C K o') ->
+      red_expr S C (spec_object_default_value_sub_1 l x K) o).
+    clears HR S o. introv HR HK. subst M.
+    run red_spec_object_default_value_sub_1
+      using run_object_get_correct.
+    run. forwards R1: run_callable_correct (rm E).
+    destruct x0.
+      simpls. run. destruct v; tryfalse.
+       run* red_spec_object_default_value_sub_2_callable.
+       destruct v; run_inv.
+         applys* red_spec_object_default_value_sub_3_prim.
+         applys* red_spec_object_default_value_sub_3_object.
+      applys* red_spec_object_default_value_sub_2_not_callable.
+    clear EQM.
+  let_name.
+  applys* red_spec_object_default_value_1_default.
+  applys* red_spec_object_default_value_2.
+  subst. applys* M_correct.
+  clears S o. intros S o HR. simpls.
+  applys* red_spec_object_default_value_3.
+  subst. applys* M_correct.
+  clears S o. intros S o HR. simpls.
+  applys* red_spec_object_default_value_4.
+Admitted. (* faster *)
+
+(** Conversions *)
+
+Lemma to_primitive_correct : forall runs S C v o prefo,
+  runs_type_correct runs ->
+  to_primitive runs S C v prefo = o ->
+  red_expr S C (spec_to_primitive v prefo) o.
+Proof.
+  introv IH HR. unfolds in HR. destruct v.
+  run_inv. applys* red_spec_to_primitive_pref_prim.
+  applys* red_spec_to_primitive_pref_object.
+  applys* object_default_value_correct.
+  run_pre. rewrite R1. run_post; substs~.
+Qed.
+
+Lemma to_number_correct : forall runs S C v o,
+  runs_type_correct runs ->
+  to_number runs S C v = o ->
+  red_expr S C (spec_to_number v) o.
+Proof.
+  introv IH HR. unfolds in HR. destruct v.
+  run_inv. applys* red_spec_to_number_prim.
+  run red_spec_to_number_object using to_primitive_correct.
+  applys* red_spec_to_number_1.
+Qed.
+
+Lemma to_string_correct : forall runs S C v o,
+  runs_type_correct runs ->
+  to_string runs S C v = o ->
+  red_expr S C (spec_to_string v) o.
+Proof.
+  introv IH HR. unfolds in HR. destruct v.
+  run_inv. applys* red_spec_to_string_prim.
+  run red_spec_to_string_object using to_primitive_correct.
+  applys* red_spec_to_string_1.
+Qed.
+
+Lemma to_integer_correct : forall runs S C v o,
+  runs_type_correct runs ->
+  to_integer runs S C v = o ->
+  red_expr S C (spec_to_integer v) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  run red_spec_to_integer using to_number_correct.
+  applys* red_spec_to_integer_1.
+Qed.
+
+Lemma to_int32_correct : forall runs S C v (y:specret int),
+  runs_type_correct runs ->
+  to_int32 runs S C v = result_some y ->
+  red_spec S C (spec_to_int32 v) y.
+Proof.
+  introv IH HR. unfolds in HR.
+  run red_spec_to_int32 using to_number_correct.
+  applys* red_spec_to_int32_1.
+Qed.
+
+Lemma to_uint32_correct : forall runs S C v (y:specret int),
+  runs_type_correct runs ->
+  to_uint32 runs S C v = result_some y ->
+  red_spec S C (spec_to_uint32 v) y.
+Proof.
+  introv IH HR. unfolds in HR.
+  run red_spec_to_uint32 using to_number_correct.
+  applys* red_spec_to_uint32_1.
+Qed.
+
+Ltac run_select_proj_extra_conversions HT ::=
+  match HT with
+  | to_primitive => constr:(to_primitive_correct)
+  | to_number => constr:(to_number_correct)
+  | to_string => constr:(to_string_correct)
+  | to_int32 => constr:(to_int32_correct)
+  | to_uint32 => constr:(to_uint32_correct)
+  end.
+
+Lemma run_object_define_own_prop_array_loop_correct :
+  forall runs S C l newLen oldLen newLenDesc newWritable throw o 
+             (def : state -> prop_name -> descriptor -> strictness_flag -> specres nothing) 
+             (def_correct : forall S str o x Desc,
+                def S x Desc str = res_out o ->
+                red_expr S C (spec_object_define_own_prop_1 builtin_define_own_prop_default l x Desc str) o),
+    runs_type_correct runs ->
+    run_object_define_own_prop_array_loop runs S C l newLen oldLen newLenDesc newWritable throw def = o -> 
+    red_expr S C (spec_object_define_own_prop_array_3l l newLen oldLen newLenDesc newWritable throw) o.
+Proof.
+  introv Hyp HR IH.
+  unfolds run_object_define_own_prop_array_loop.
+  cases_if*. let_name. 
+  applys~ red_spec_object_define_own_prop_array_3l_condition_true. 
+  rewrite <- EQoldLen'.
+  run~ red_spec_object_define_own_prop_array_3l_ii.
+  run~ red_spec_object_define_own_prop_array_3l_ii_1.
+  destruct b; cases_if*; clear n.
+  applys* red_spec_object_define_own_prop_array_3l_ii_2.
+  eapply runs_type_correct_object_define_own_prop_array_loop; eassumption.
+
+  applys* red_spec_object_define_own_prop_array_3l_ii_2_3. 
+  eapply red_spec_object_define_own_prop_array_3l_iii_1. reflexivity.
+  destruct newWritable; try solve [false].
+  let_name as newLenDesc''. rewrite <- EQnewLenDesc''. 
+  apply red_spec_object_define_own_prop_array_3l_iii_2_true.
+  let_name. cases_if*. subst newLenDesc0.
+  run~ red_spec_object_define_own_prop_array_3l_iii_3.
+  applys* red_spec_object_define_own_prop_array_3l_iii_4. 
+  applys* red_spec_object_define_own_prop_reject.
+  applys* out_error_or_cst_correct.
+  let_name as newLenDesc''. rewrite <- EQnewLenDesc''. 
+  apply red_spec_object_define_own_prop_array_3l_iii_2_false.
+  let_name. cases_if*. subst newLenDesc0.
+  run~ red_spec_object_define_own_prop_array_3l_iii_3.
+  applys* red_spec_object_define_own_prop_array_3l_iii_4. 
+  applys* red_spec_object_define_own_prop_reject.
+  applys* out_error_or_cst_correct.
+  
+  applys~ red_spec_object_define_own_prop_array_3l_condition_false.
+  destruct newWritable; cases_if*; clear n.
+  inverts IH. applys* red_spec_object_define_own_prop_array_3n.
+
+  applys* red_spec_object_define_own_prop_array_3m.
+Qed.
+
+Lemma object_define_own_prop_correct : forall runs S C l x Desc str o,
+  runs_type_correct runs ->
+  object_define_own_prop runs S C l x Desc str = o ->
+  red_expr S C (spec_object_define_own_prop l x Desc str) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  let_name as rej. asserts Rej: (forall S str o,
+      rej S str = o ->
+      red_expr S C (spec_object_define_own_prop_reject str) o).
+    clear HR S str o. introv HR. subst.
+    applys* red_spec_object_define_own_prop_reject.
+    applys* out_error_or_cst_correct.
+  let_name as def. asserts Def: (forall S str o x Desc,
+      def S x Desc str = res_out o ->
+      red_expr S C (spec_object_define_own_prop_1 builtin_define_own_prop_default l x Desc str) o).
+    clear HR S str o Desc x. introv HR. subst.
+    run red_spec_object_define_own_prop_1_default.
+    run. applys* red_spec_object_define_own_prop_2.
+      applys* run_object_method_correct. clear E.
+    destruct a.
+      case_if.
+        let_name. run. forwards B: @pick_option_correct (rm E).
+         applys* red_spec_object_define_own_prop_3_undef_true A.
+         case_if; case_if*.
+        subst. applys* red_spec_object_define_own_prop_3_undef_false.
+      let_name as wri. asserts Wri: (forall S A o,
+          wri S A = res_out o ->
+          red_expr S C (spec_object_define_own_prop_write l x A Desc str) o).
+        clear HR o. introv HR. subst.
+        run. forwards B: @pick_option_correct (rm E).
+         applys* red_spec_object_define_own_prop_write.
+        clear EQwri.
+      case_if.
+        run_inv. applys* red_spec_object_define_own_prop_3_includes.
+        applys* red_spec_object_define_own_prop_3_not_include.
+        case_if.
+          run_inv. applys* red_spec_object_define_own_prop_4_reject.
+          applys* red_spec_object_define_own_prop_4_not_reject. case_if.
+            applys* red_spec_object_define_own_prop_5_generic. case_if.
+              applys* red_spec_object_define_own_prop_5_a. case_if;
+               [ | applys* red_spec_object_define_own_prop_6a_reject].
+    let_name. run. forwards B: @pick_option_correct (rm E).
+     applys* red_spec_object_define_own_prop_6a_accept A'.
+     case_if as HC1.
+       destruct a; inverts n2; tryfalse.
+         applys* red_spec_object_define_own_prop_5_b. case_if.
+           applys* red_spec_object_define_own_prop_6b_false_reject.
+           applys* red_spec_object_define_own_prop_6b_false_accept.
+       case_if. destruct a; tryfalse.
+        applys* red_spec_object_define_own_prop_5_c. case_if.
+          applys* red_spec_object_define_own_prop_6c_1.
+          applys* red_spec_object_define_own_prop_6c_2.
+    clear EQdef.
+  run.
+  applys* red_spec_object_define_own_prop.
+    applys* run_object_method_correct.
+  clear E. destruct x0. (* LTAC ARTHUR:  This [x0] wasn't properly named. *)
+    (* default *)
+    applys* Def.
+
+    (* Array object *)
+    run red_spec_object_define_own_prop_array_1. 
+    destruct a; [inverts HR | ]. destruct a; [ | inverts HR].
+    let_name. subst oldLen. 
+    eapply red_spec_object_define_own_prop_array_2. reflexivity.
+    destruct (attributes_data_value a); [ | inverts HR].
+    let_name. let_name. subst descValueOpt.
+    eapply red_spec_object_define_own_prop_array_2_1. reflexivity.
+    eapply red_spec_to_uint32. apply red_spec_to_number_prim. reflexivity.
+    apply red_spec_to_uint32_1. rewrite <- EQoldLen. 
+    case_if. subst x.
+    
+    apply red_spec_object_define_own_prop_array_branch_3_4_3.
+    assert (Hyp : {v | descriptor_value Desc = Some v} + {descriptor_value Desc = None}).
+    {
+      destruct (descriptor_value Desc); [left | right]; auto. exists~ v.
+    } inverts Hyp as Hyp. 
+
+    (* Step 3b *) 
+    destruct Hyp as (v & EQv); rewrite EQv in *.
+    run~ red_spec_object_define_own_prop_array_3_3c; rename a0 into newLen.
+    run~ red_spec_object_define_own_prop_array_3c; rename m into newLenN.
+    case_if*. applys~ red_spec_object_define_own_prop_array_3d.
+    applys* run_error_correct. let_name.
+    applys~ red_spec_object_define_own_prop_array_3e.
+    clear dependent newLenN. case_if*.
+    subst; applys* red_spec_object_define_own_prop_array_3f.
+    case_if*. applys* red_spec_object_define_own_prop_array_3g.
+    applys~ red_spec_object_define_own_prop_array_3g_to_h.
+    rewrite <- EQnewLenDesc. let_name. let_name as newLenDesc'. 
+    cases_if*; lets HnW : n1; rewrite EQnewWritable in n1. 
+    apply red_spec_object_define_own_prop_array_3i.
+    destruct (descriptor_writable newLenDesc); jauto.
+    cases_if*. false~. clear n1 EQnewWritable. rewrite <- EQnewLenDesc'.
+    replace false with newWritable by (destruct newWritable; auto; false).
+    run* red_spec_object_define_own_prop_array_3j. destruct b; case_if*; clear n1.
+    apply red_spec_object_define_own_prop_array_to_3l.
+    applys* run_object_define_own_prop_array_loop_correct.
+    
+    inverts HR. apply red_spec_object_define_own_prop_array_3k.
+    apply red_spec_object_define_own_prop_array_3h.
+    destruct (descriptor_writable newLenDesc); jauto.
+    cases_if*. clear n1 EQnewWritable. subst newLenDesc'. 
+    replace true with newWritable by (destruct newWritable; auto; false).
+    run* red_spec_object_define_own_prop_array_3j. destruct b; case_if*; clear n1.
+    apply red_spec_object_define_own_prop_array_to_3l.
+    applys* run_object_define_own_prop_array_loop_correct.
+
+    inverts HR. applys* red_spec_object_define_own_prop_array_3k.
+    
+    (* Step 3a *) 
+    rewrite Hyp in HR. applys~ red_spec_object_define_own_prop_array_3_3a.
+
+    (* Branching between Step 4 and Step 5 *)
+    applys~ red_spec_object_define_own_prop_array_branch_3_4_4.
+    run red_spec_object_define_own_prop_array_branch_4_5.
+    run red_spec_object_define_own_prop_array_branch_4_5_a.
+    case_if. rename a0 into ilen, s into slen.
+    applys~ red_spec_object_define_own_prop_array_branch_4_5_b_4.
+    run red_spec_object_define_own_prop_array_4a.
+    case_if; rename a0 into index.
+    applys~ red_spec_object_define_own_prop_array_4b.
+    run~ red_spec_object_define_own_prop_array_4c.
+    destruct b; case_if*. case_if.
+    eapply red_spec_object_define_own_prop_array_4c_e. auto. reflexivity. auto.
+    run_inv. applys~ red_spec_object_define_own_prop_array_4f.
+    applys~ red_spec_object_define_own_prop_array_4c_d.
+    applys~ red_spec_object_define_own_prop_array_branch_4_5_b_5.
+    applys~ red_spec_object_define_own_prop_array_5. 
+
+    (* arguments object *)
+    run. forwards~ obpm: run_object_method_correct (rm E).
+    run. subst. run~ red_spec_object_define_own_prop_args_obj.
+    run~ red_spec_object_define_own_prop_args_obj_1. cases_if; substs.
+     let_name. asserts Follow: (forall S o,
+         follow S = result_some (specret_out o) ->
+         red_expr S C spec_args_obj_define_own_prop_6 o).
+       introv RES. rewrite EQfollow in RES. inverts RES.
+       apply* red_spec_object_define_own_prop_args_obj_6.
+     clear EQfollow. destruct a as [|A]. (* LTAC ARTHUR: this [a] has been defined by tactics. *)
+      apply~ red_spec_object_define_own_prop_args_obj_2_true_undef.
+      cases_if.
+       run~ red_spec_object_define_own_prop_args_obj_2_true_acc.
+        apply* red_spec_object_define_own_prop_args_obj_5.
+       let_name as next. asserts Next: (forall S o,
+           next S = result_some (specret_out o) ->
+           red_expr S C (spec_args_obj_define_own_prop_4 l x Desc str x1) o).
+         introv RES. rewrite EQnext in RES. cases_if.
+          run~ red_spec_object_define_own_prop_args_obj_4_false.
+           apply~ red_spec_object_define_own_prop_args_obj_5.
+          apply~ red_spec_object_define_own_prop_args_obj_4_not_false.
+        clear EQnext. sets_eq <- dvDesc: (descriptor_value Desc). destruct dvDesc.
+         run~ red_spec_object_define_own_prop_args_obj_2_true_not_acc_some.
+          apply~ red_spec_object_define_own_prop_args_obj_3.
+         apply~ red_spec_object_define_own_prop_args_obj_2_true_not_acc_none.
+     apply~ red_spec_object_define_own_prop_args_obj_2_false.
+Admitted. (* faster *)
+
+Lemma prim_new_object_correct : forall S C w o,
+  prim_new_object S w = o ->
+  red_expr S C (spec_prim_new_object w) o.
+Proof.
+ introv H. destruct w; tryfalse;
+ unfolds in H;  repeat let_simpl;
+ match goal with H: context [object_alloc ?s ?o] |- _ => sets_eq X: (object_alloc s o) end;
+ destruct X as (l&S').
+ inversion H. applys* red_spec_prim_new_object_bool.
+ inversion H. applys* red_spec_prim_new_object_number.
+ run. applys* red_spec_prim_new_object_string.
+ apply pick_option_correct in E. auto.
+Qed.
+
+(* todo: move to the right place above here *)
+Lemma to_object_correct : forall S C v o,
+  to_object S v = o ->
+  red_expr S C (spec_to_object v) o.
+Proof.
+  hint run_error_correct_2, prim_new_object_correct.
+  introv HR. unfolds in HR. destruct v as [w|l].
+    destruct w.
+      applys* red_spec_to_object_undef_or_null.
+      applys* red_spec_to_object_undef_or_null.
+      applys* red_spec_to_object_prim. rew_logic*. splits; congruence.
+      applys* red_spec_to_object_prim. rew_logic*. splits; congruence.
+      applys* red_spec_to_object_prim. rew_logic*. splits; congruence.
+    run_inv. applys* red_spec_to_object_object.
+Qed.
+
+Lemma run_object_prim_value_correct : forall S l o,
+  run_object_prim_value S l = o ->
+  exists (v : value), o = out_ter S v /\
+  object_prim_value S l v.
+Proof.
+  introv HR. unfolds in HR. do 2 runs. eexists. splits*.
+  forwards~: run_object_method_correct E.
+Qed.
+
+Lemma prim_value_get_correct : forall runs S C v x o,
+  runs_type_correct runs ->
+  prim_value_get runs S C v x = o ->
+  red_expr S C (spec_prim_value_get v x) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  run red_spec_prim_value_get using to_object_correct.
+  applys* red_spec_prim_value_get_1.
+  applys* object_get_builtin_correct.
+Admitted. (*faster*)
+
+Lemma object_put_complete_correct : forall runs S C B vthis l x v str o,
+  runs_type_correct runs ->
+  object_put_complete runs B S C vthis l x v str = o ->
+  red_expr S C (spec_object_put_1 B vthis l x v str) o.
+Proof.
+  introv IH HR. unfolds in HR. destruct B.
+  run red_spec_object_put_1_default using object_can_put_correct. cases_if.
+   run red_spec_object_put_2_true. let_name.
+    asserts follows_correct: (forall Aa o,
+        a = full_descriptor_undef \/ (a = attributes_accessor_of Aa) ->
+        follow tt = res_out o ->
+        red_expr S0 C (spec_object_put_3 vthis l x v str (specret_val S2 a)) o).
+      clear HR. introv N E. substs.
+      run red_spec_object_put_3_not_data using run_object_get_prop_correct. apply* N.
+      clear N. tests Acc: (exists Aa', a0 = attributes_accessor_of Aa').
+       lets (Aa'&?): (rm Acc). let_simpl. substs.
+        sets_eq va': (attributes_accessor_set Aa'). destruct va' as [|la']; tryfalse.
+        run* red_spec_object_put_4_accessor. rewrite <- EQva'. discriminate.
+        apply~ red_spec_object_put_5_return.
+       let_name. asserts E': (follow' tt = o0).
+         destruct a0 as [|()]; try solve [false~ Acc]; exact E.
+        asserts (?&H'): (exists (Ad : attributes_data),
+          a0 = full_descriptor_undef \/ a0 = Ad).
+         destruct a0 as [|()]. exists* (arbitrary : attributes_data). exists* a0. false~ Acc.
+        clear E. substs. destruct vthis.
+         forwards (H&_): out_error_or_void_correct C (rm E').
+          applys* red_spec_object_put_4_not_accessor_prim H.
+         let_simpl. run* red_spec_object_put_4_not_accessor_object using
+           object_define_own_prop_correct. apply~ red_spec_object_put_5_return.
+     destruct a as [|[Ad|Aa]]. applys~ follows_correct (arbitrary : attributes_accessor).
+     clear EQfollow follow follows_correct.
+     destruct vthis as [wthis|lthis].
+      apply~ red_spec_object_put_3_data_prim. apply~ out_error_or_void_correct.
+      let_simpl. run* red_spec_object_put_3_data_object
+        using object_define_own_prop_correct. apply~ red_spec_object_put_5_return.
+     apply~ follows_correct.
+   apply~ red_spec_object_put_2_false. apply~ out_error_or_void_correct.
+Qed.
+
+Lemma prim_value_put_correct : forall runs S C w x v str o,
+  runs_type_correct runs ->
+  prim_value_put runs S C w x v str = o ->
+  red_expr S C (spec_prim_value_put w x v str) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  run red_spec_prim_value_put using to_object_correct.
+  applys* red_spec_prim_value_put_1.
+  applys* object_put_complete_correct.
+Qed.
+
+
+
+(*************************************************************)
+
+Lemma env_record_get_binding_value_correct : forall runs S C L rn rs o,
+  runs_type_correct runs ->
+  env_record_get_binding_value runs S C L rn rs = o ->
+  red_expr S C (spec_env_record_get_binding_value L rn rs) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  run_simpl. forwards B: @pick_option_correct (rm E).
+  applys~ red_spec_env_record_get_binding_value B. destruct x.
+   run_simpl. rewrite <- Heap.binds_equiv_read_option in E. destruct x as [mu v].
+    cases_if.
+     applys~ red_spec_env_record_get_binding_value_1_decl_uninitialized E.
+      apply~ out_error_or_cst_correct.
+     applys~ red_spec_env_record_get_binding_value_1_decl_initialized E.
+      run_inv. apply~ red_spec_returns.
+   run red_spec_env_record_get_binding_value_1_object using object_has_prop_correct.
+    cases_if; run_inv.
+     apply~ red_spec_env_record_get_binding_value_obj_2_true.
+      applys~ run_object_get_correct HR.
+     apply~ red_spec_env_record_get_binding_value_obj_2_false.
+      applys~ out_error_or_cst_correct HR.
+Qed.
+
+
+Lemma throw_result_run_error_correct : forall runs S C ne T (y:specret T),
+  runs_type_correct runs ->
+  throw_result (run_error S ne) = result_some y ->
+  red_spec S C (spec_error_spec ne) y.
+Proof.
+  introv IH HR. unfolds throw_result.
+  lets ([|y1]&E&K): if_result_some_out (rm HR); tryfalse_nothing. run_inv.
+  lets (E2&Ab): run_error_correct' (rm E).
+  applys* red_spec_error_spec.
+  abort.
+Qed.
+
+
+Lemma ref_kind_env_record_inv : forall r,
+  ref_kind_of r = ref_kind_env_record ->
+  exists L, ref_base r = ref_base_type_env_loc L.
+Proof.
+  introv E. unfolds ref_kind_of.
+  destruct (ref_base r).
+    destruct v; tryfalse. destruct p; tryfalse.
+    exists___*.
+Qed.
+
+Lemma ref_kind_base_object_inv : forall r,
+  (ref_kind_of r = ref_kind_primitive_base \/
+     ref_kind_of r = ref_kind_object) ->
+  exists v, ref_base r = ref_base_type_value v.
+Proof.
+  introv E. unfolds ref_kind_of.
+  destruct E; destruct (ref_base r); tryfalse;
+    destruct v; tryfalse; try solve [exists___*].
+Qed.
+
+
+Lemma ref_get_value_correct : forall runs S C rv y,
+  runs_type_correct runs ->
+  ref_get_value runs S C rv = result_some y ->
+  red_spec S C (spec_get_value rv) y.
+Proof.
+  introv IH HR. unfolds in HR. destruct rv; tryfalse.
+  run_inv. applys* red_spec_ref_get_value_value.
+  let_name as M.
+  asserts M_correct: (
+    (  ref_kind_of r = ref_kind_primitive_base
+    \/ ref_kind_of r = ref_kind_object) ->
+    M tt = result_some y ->
+    red_spec S C (spec_get_value r) y).
+   clear HR. introv EQ HR. subst M.
+   asserts: (ref_is_property r). unfolds. destruct* EQ.
+   lets (v&Ev): ref_kind_base_object_inv EQ. rewrite Ev in HR.
+   unfolds ref_has_primitive_base. case_if.
+     run* red_spec_ref_get_value_ref_b_has_primitive_base using prim_value_get_correct.
+      applys* red_spec_ref_get_value_ref_b_1.
+     destruct EQ; tryfalse. destruct v as [|l]; tryfalse.
+     run* red_spec_ref_get_value_ref_b_has_not_primitive_base using run_object_get_correct.
+      applys* red_spec_ref_get_value_ref_b_1.
+    clear EQM.
+  sets_eq k: (ref_kind_of r). destruct k; tryfalse.
+  (* case undef *)
+  applys* red_spec_ref_get_value_ref_a. unfolds*.
+   applys* throw_result_run_error_correct.
+  (* case prim *)
+  applys* M_correct.
+  (* case object *)
+  applys* M_correct.
+  (* case env_record *)
+  lets (L&EQL): ref_kind_env_record_inv (sym_eq EQk).
+  rewrite EQL in HR.
+  run* red_spec_ref_get_value_ref_c using env_record_get_binding_value_correct.
+  applys* red_spec_ref_get_value_ref_c_1.
+Admitted. (*faster*)
+
+
+Lemma object_put_correct : forall runs S C l x v str o,
+  runs_type_correct runs ->
+  object_put runs S C l x v str = o ->
+  red_expr S C (spec_object_put l x v str) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  run. applys red_spec_object_put. apply* run_object_method_correct.
+  applys* object_put_complete_correct.
+Admitted. (*faster*)
+
+Lemma env_record_set_mutable_binding_correct : forall runs S C L x v str o,
+  runs_type_correct runs ->
+  env_record_set_mutable_binding runs S C L x v str = o ->
+  red_expr S C (spec_env_record_set_mutable_binding L x v str) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  run_simpl. forwards B: @pick_option_correct (rm E).
+  applys~ red_spec_env_record_set_mutable_binding B. destruct x0.
+   run_simpl. rewrite <- Heap.binds_equiv_read_option in E. destruct x0 as [mu ?].
+    cases_if; run_inv.
+     applys~ red_spec_env_record_set_mutable_binding_1_decl_mutable E.
+      apply~ red_spec_returns.
+     applys~ red_spec_env_record_set_mutable_binding_1_decl_non_mutable E.
+      apply~ out_error_or_void_correct.
+   apply~ red_spec_env_record_set_mutable_binding_1_object.
+    applys~ object_put_correct HR.
+Qed.
+
+
+Lemma ref_is_property_from_not_unresolvable_value : forall r v,
+  ~ ref_is_unresolvable r ->
+  ref_base r = ref_base_type_value v ->
+  ref_is_property r.
+Proof.
+  introv N E. unfolds ref_is_property, ref_is_unresolvable, ref_kind_of.
+  destruct (ref_base r); tryfalse. destruct* v0. destruct* p.
+Admitted. (* faster *)
+
+
+Lemma ref_put_value_correct : forall runs S C rv v o,
+  runs_type_correct runs ->
+  ref_put_value runs S C rv v = o ->
+  red_expr S C (spec_put_value rv v) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  destruct rv; tryfalse.
+   applys* red_spec_ref_put_value_value.
+   case_if.
+    case_if.
+     applys~ red_spec_ref_put_value_ref_a_1.
+      applys* run_error_correct.
+     applys~ red_spec_ref_put_value_ref_a_2.
+      applys* object_put_correct.
+    case_if.
+     cases (ref_base r); tryfalse.
+      case_if; destruct v0; tryfalse.
+       applys* red_spec_ref_put_value_ref_b_has_primitive_base.
+        applys* prim_value_put_correct.
+       applys* red_spec_ref_put_value_ref_b_has_not_primitive_base.
+        applys* object_put_correct.
+      cases (ref_base r); tryfalse.
+       applys* red_spec_ref_put_value_ref_c.
+       applys* env_record_set_mutable_binding_correct.
+Admitted. (* faster *)
+
+
+Lemma run_expr_get_value_correct : forall runs S C e y,
+  runs_type_correct runs ->
+  run_expr_get_value runs S C e = result_some y ->
+  red_spec S C (spec_expr_get_value e) y.
+Proof.
+  introv IH HR. unfolds in HR.
+  run red_spec_expr_get_value.
+  applys* red_spec_expr_get_value_1.
+   applys* ref_get_value_correct.
+Admitted. (* faster *)
+
+
+Ltac run_select_proj_extra_ref HT ::=
+  match HT with
+  | object_put => constr:(object_put_correct)
+  | ref_put_value => constr:(ref_put_value_correct)
+  | run_expr_get_value => constr:(run_expr_get_value_correct)
+  | object_define_own_prop => constr:(object_define_own_prop_correct)
+  end.
+
+Lemma env_record_create_mutable_binding_correct : forall runs S C L x deletable_opt o,
+  runs_type_correct runs ->
+  env_record_create_mutable_binding runs S C L x deletable_opt = o ->
+  red_expr S C (spec_env_record_create_mutable_binding L x deletable_opt) o.
+Proof.
+  introv IH HR. unfolds in HR. let_simpl.
+  run_simpl. forwards B: @pick_option_correct (rm E).
+  applys~ red_spec_env_record_create_mutable_binding B.
+  destruct x0.
+   cases_if; run_inv. let_simpl. run_inv.
+    apply~ red_spec_env_record_create_mutable_binding_1_decl_indom.
+   run red_spec_env_record_create_mutable_binding_1_object
+     using object_has_prop_correct. cases_if. let_simpl.
+    run* red_spec_env_record_create_mutable_binding_obj_2.
+    apply~ red_spec_env_record_create_mutable_binding_obj_3.
+Qed.
+
+Lemma env_record_create_set_mutable_binding_correct : forall runs S C L x deletable_opt v str o,
+  runs_type_correct runs ->
+  env_record_create_set_mutable_binding runs S C L x deletable_opt v str = o ->
+  red_expr S C (spec_env_record_create_set_mutable_binding L x deletable_opt v str) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  run red_spec_env_record_create_set_mutable_binding
+    using env_record_create_mutable_binding_correct.
+  forwards: env_record_set_mutable_binding_correct IH (rm HR).
+  apply~ red_spec_env_record_create_set_mutable_binding_1.
+Qed.
+
+Lemma env_record_create_immutable_binding_correct : forall S C L x o,
+  env_record_create_immutable_binding S L x = o ->
+  red_expr S C (spec_env_record_create_immutable_binding L x) o.
+Proof.
+  introv HR. unfolds in HR.
+  run_simpl. forwards B: @pick_option_correct (rm E).
+  destruct x0; tryfalse. cases_if. run_inv.
+  applys~ red_spec_env_record_create_immutable_binding B.
+Qed.
+
+Lemma env_record_initialize_immutable_binding_correct : forall S C L x v o,
+  env_record_initialize_immutable_binding S L x v = o ->
+  red_expr S C (spec_env_record_initialize_immutable_binding L x v) o.
+Proof.
+  introv HR. unfolds in HR.
+  run. forwards B: @pick_option_correct (rm E). destruct x0; tryfalse.
+  run. forwards B': @pick_option_correct (rm E). cases_if. let_simpl. run_inv. substs.
+  applys~ red_spec_env_record_initialize_immutable_binding B B'.
+Qed.
+
+(************************************************************)
+(* Treatement of [spec_expr_get_value_conv] *)
+
+Definition if_spec_ter_post_bool (K:state->bool->result) o (y:specret value) :=
+     (y = specret_out o /\ abort o)
+  \/ (exists S, exists (b:bool), y = specret_val S (value_prim b)
+       /\ K S b = o).
+
+Ltac run_post_if_spec_ter_post_bool H := (* todo: integrate into run_post *)
+  let Ab := fresh "Ab" in
+  let Eq := fresh "Eq" in
+  let S1 := fresh "S" in
+  let b := fresh "b" in
+  let O1 := fresh "O1" in
+  destruct H as [(Er&Ab)|(S1&b&O1&H)];
+  [ try abort | try subst_hyp O1 ].
+
+Lemma if_spec_post_to_bool : forall (K:state->bool->result) S C e o y1,
+  red_spec S C (spec_expr_get_value e) y1 ->
+  if_spec_post
+   (fun S v => 'let b := convert_value_to_boolean v in K S b) (specret_out o) y1 ->
+  exists y2,
+     red_spec S C (spec_expr_get_value_conv spec_to_boolean e) y2
+  /\ if_spec_ter_post_bool K o y2.
+Proof.
+  introv HR HP. run_post.
+  exists y1. splits.
+    subst. apply* red_spec_expr_get_value_conv. abort.
+    subst. left. splits; run_inv; auto~.
+  exists (specret_val S1 (value_prim (convert_value_to_boolean a))). splits.
+    applys* red_spec_expr_get_value_conv.
+     applys* red_spec_expr_get_value_conv_1.
+     applys* red_spec_to_boolean.
+     applys* red_spec_expr_get_value_conv_2.
+    right. exists S1 __. split. reflexivity. auto.
+Qed.
+
+(* LATER: avoid the copy-paste, and rename the tactic *)
+
+Definition if_spec_ter_post_object (K:state->object_loc->result) o (y:specret value) :=
+     (y = specret_out o /\ abort o)
+  \/ (exists S, exists (l:object_loc), y = specret_val S (value_object l)
+       /\ K S l = o).
+
+
+Lemma if_spec_post_to_object : forall (K:state->object_loc->result) S C e o y1,
+  red_spec S C (spec_expr_get_value e) y1 ->
+  if_spec_post
+   (fun S v => if_object (to_object S v) K) (specret_out o) y1 ->
+  exists y2,
+     red_spec S C (spec_expr_get_value_conv spec_to_object e) y2
+  /\ if_spec_ter_post_object K o y2.
+Proof.
+  introv HR HP. run_post.
+  exists y1. splits.
+    subst. apply* red_spec_expr_get_value_conv. abort.
+    subst. left. splits; run_inv; auto~.
+  run_pre. lets*: to_object_correct C (rm R1). run_post.
+    subst. exists (specret_out (T:=value) o1). split.
+      applys* red_spec_expr_get_value_conv.
+       applys* red_spec_expr_get_value_conv_1. abort.
+      left. splits~.
+    exists (specret_val S0 (value_object l)). split.
+      applys* red_spec_expr_get_value_conv.
+       applys* red_spec_expr_get_value_conv_1.
+       applys* red_spec_expr_get_value_conv_2.
+      right. exists___*.
+Qed.
+
+
+Definition lift2 T (C:T->value) y :=
+  match y with
+  | specret_val S' (x1,x2) => specret_val S' (C x1, C x2)
+  | specret_out o => specret_out o
+  end.
+
+
+Lemma convert_twice_primitive_correct : forall runs S C v1 v2 y,
+  runs_type_correct runs ->
+  convert_twice_primitive runs S C v1 v2 = result_some y ->
+  red_spec S C (spec_convert_twice (spec_to_primitive_auto v1) (spec_to_primitive_auto v2)) (lift2 value_prim y).
+Proof.
+  introv IH HR. unfolds in HR. unfolds in HR.
+  run red_spec_convert_twice.
+  run red_spec_convert_twice_1.
+  unfolds lift2. applys red_spec_convert_twice_2.
+Admitted. (*faster*)
+
+
+Lemma convert_twice_number_correct : forall runs S C v1 v2 y,
+  runs_type_correct runs ->
+  convert_twice_number runs S C v1 v2 = result_some y ->
+  red_spec S C (spec_convert_twice (spec_to_number v1) (spec_to_number v2)) (lift2 (fun n=>n:value) y).
+Proof.
+  introv IH HR. unfolds in HR. unfolds in HR.
+  run red_spec_convert_twice.
+  run red_spec_convert_twice_1.
+  unfolds lift2. applys red_spec_convert_twice_2.
+Admitted. (*faster*)
+
+Lemma convert_twice_string_correct : forall runs S C v1 v2 y,
+  runs_type_correct runs ->
+  convert_twice_string runs S C v1 v2 = result_some y ->
+  red_spec S C (spec_convert_twice (spec_to_string v1) (spec_to_string v2)) (lift2 (fun s=>s:value) y).
+Proof.
+  introv IH HR. unfolds in HR. unfolds in HR.
+  run red_spec_convert_twice.
+  run red_spec_convert_twice_1.
+  unfolds lift2. applys red_spec_convert_twice_2.
+Admitted. (*faster*)
+
+Lemma get_puremath_op_correct : forall op F,
+  get_puremath_op op = Some F ->
+  puremath_op op F.
+Proof.
+  Hint Constructors puremath_op.
+  introv HR. destruct op; simpls; inverts* HR.
+Admitted. (*faster*)
+
+Lemma get_inequality_op_correct : forall op b1 b2,
+  get_inequality_op op = Some (b1,b2) ->
+  inequality_op op b1 b2.
+Proof.
+  Hint Constructors inequality_op.
+  introv HR. destruct op; simpls; inverts* HR.
+Admitted. (*faster*)
+
+Lemma get_shift_op_correct : forall op F b,
+  get_shift_op op = Some (b,F) ->
+  shift_op op b F.
+Proof.
+  Hint Constructors shift_op.
+  introv HR. destruct op; simpls; inverts* HR.
+Admitted. (*faster*)
+
+Lemma get_bitwise_op_correct : forall op F,
+  get_bitwise_op op = Some F ->
+  bitwise_op op F.
+Proof.
+  Hint Constructors bitwise_op.
+  introv HR. destruct op; simpls; inverts* HR.
+Admitted. (*faster*)
+
+
+(**************************************************************)
+
+Lemma run_object_get_own_prop_correct : forall runs S C l x y,
+  runs_type_correct runs ->
+  run_object_get_own_prop runs S C l x = result_some y ->
+  red_spec S C (spec_object_get_own_prop l x) y.
+Proof.
+  introv IH HR. unfolds in HR. run.
+  applys* red_spec_object_get_own_prop.
+    applys* run_object_method_correct. clear E.
+  let_name as M. asserts M_correct: (forall S y,
+    M S = result_some y ->
+    red_spec S C (spec_object_get_own_prop_1 builtin_get_own_prop_default l x) y).
+    clears HR S. subst. introv HR. run.
+     sets_eq <- Ao: (Heap.read_option x1 x).
+     applys~ red_spec_object_get_own_prop_1_default. eexists. splits.
+      applys run_object_method_correct E.
+      rewrite~ EQAo.
+     clear E. destruct Ao.
+      applys* red_spec_object_get_own_prop_2_some_data.
+      applys* red_spec_object_get_own_prop_2_none.
+    clear EQM.
+  destruct x0.
+  (* default *)
+  subst*.
+  (* argument object *)
+  run~ red_spec_object_get_own_prop_args_obj. destruct a as [|A]. (* LTAC ARTHUR: this [a] has been defined by tactics. *)
+   inverts HR. applys~ red_spec_object_get_own_prop_args_obj_1_undef.
+   run. forwards~ obpm: run_object_method_correct (rm E).
+   run. subst. run~ red_spec_object_get_own_prop_args_obj_1_attrs.
+   let_name. asserts Follow: (forall S A y,
+       follow S A = result_some y ->
+       red_spec S C (spec_args_obj_get_own_prop_4 A) y).
+     introv RES. rewrite EQfollow in RES. inverts RES.
+     apply~ red_spec_object_get_own_prop_args_obj_4.
+   clear EQfollow. destruct a. (* LTAC ARTHUR: idem. *)
+    apply* red_spec_object_get_own_prop_args_obj_2_undef.
+    run~ red_spec_object_get_own_prop_args_obj_2_attrs using run_object_get_correct.
+    destruct A as [Ad|]; tryfalse.
+    apply~ red_spec_object_get_own_prop_args_obj_3.
+  (* string *)
+  run~ red_spec_object_get_own_prop_string. destruct a as [|A]. (* LTAC ARTHUR: this [a] has been defined by tactics. *)
+   run red_spec_object_get_own_prop_string_1_undef using to_int32_correct.
+    run red_spec_object_get_own_prop_string_2.
+    cases_if.
+     inverts HR. apply~ red_spec_object_get_own_prop_string_3_different.
+     subst x. run_pre. forwards* (v&EQo&Opv): run_object_prim_value_correct. run_post.
+       inverts Ab as Ab'; false. inverts H0. false Ab'. reflexivity.
+     inverts EQo. applys~ red_spec_object_get_own_prop_string_3_same Opv.
+     run~ red_spec_object_get_own_prop_string_4.
+     let_name. apply~ red_spec_object_get_own_prop_string_5. cases_if.
+      inverts HR. apply~ red_spec_object_get_own_prop_string_6_outofbounds. math.
+      inverts HR. apply~ red_spec_object_get_own_prop_string_6_inbounds. math.
+   inverts HR. apply~ red_spec_object_get_own_prop_string_1_attrs.
+Admitted. (*faster*)
+
+
+Lemma run_function_has_instance_correct : forall runs S C (lo lv : object_loc) o,
+  runs_type_correct runs ->
+  run_function_has_instance runs S lo lv = o ->
+  red_expr S C (spec_function_has_instance_2 lv lo) o.
+Proof.
+  intros runs IH lo S C lv o HR. unfolds in HR. run_simpl.
+  forwards~ M: run_object_method_correct (rm E).
+  applys~ red_spec_function_has_instance_2 M.
+  destruct x as [()|lproto]; tryfalse; run_inv.
+   apply~ red_spec_function_has_instance_3_null.
+   cases_if; run_inv.
+    apply~ red_spec_function_has_instance_3_eq.
+    apply~ red_spec_function_has_instance_3_neq.
+     applys~ runs_type_correct_function_has_instance HR.
+Qed.
+
+
+Lemma run_object_has_instance_correct : forall runs S C B l v o,
+  runs_type_correct runs ->
+  run_object_has_instance runs S C B l v = result_some (specret_out o) ->
+  red_expr S C (spec_object_has_instance_1 B l v) o.
+Proof.
+  introv IH HR. unfolds in HR. destruct B.
+  destruct v.
+  run_inv. applys* red_spec_object_has_instance_1_function_prim.
+  run red_spec_object_has_instance_1_function_object
+    using run_object_get_correct.
+  destruct v.
+  applys* red_spec_function_has_instance_1_prim.
+  applys red_spec_function_has_instance_1_object.
+   applys* runs_type_correct_function_has_instance.
+
+   repeat run; apply run_object_method_correct in E;
+   apply run_object_method_correct in E1; subst.
+   apply red_spec_object_has_instance_after_bind.
+   applys~ red_spec_function_has_instance_after_bind_1. eassumption. 
+   destruct x1. applys* red_spec_function_has_instance_after_bind_2_some.
+   applys* runs_type_correct_object_has_instance.
+   applys* red_spec_function_has_instance_after_bind_2_none.
+Admitted. (* faster*)
+
+
+Lemma run_binary_op_correct : forall runs S C (op : binary_op) v1 v2 o,
+  runs_type_correct runs ->
+  run_binary_op runs S C op v1 v2 = o ->
+  red_expr S C (expr_binary_op_3 op v1 v2) o.
+Proof.
+
+  introv IH HR. unfolds in HR.
+  (* Add *)
+  case_if. subst.
+  run red_expr_binary_op_add using convert_twice_primitive_correct.
+  destruct a as [w1 w2]. case_if.
+  run* red_expr_binary_op_add_1_string using convert_twice_string_correct.
+  destruct a as [s1 s2]. run_inv.
+  applys* red_expr_binary_op_add_string_1.
+  run* red_expr_binary_op_add_1_number using convert_twice_number_correct.
+  destruct a as [n1 n2]. run_inv.
+  applys* red_expr_puremath_op_1.
+  (* Puremath *)
+  case_if. run.
+  run red_expr_puremath_op using convert_twice_number_correct.
+  applys* get_puremath_op_correct.
+  destruct a as [n1 n2]. run_inv.
+  applys* red_expr_puremath_op_1.
+  (* Shiftop *)
+  case_if. run. destruct x as [b F].
+  lets M: red_expr_shift_op b. case_if; subst.
+  run* M. applys* get_shift_op_correct.
+    run red_expr_shift_op_1. applys* red_expr_shift_op_2.
+  run* M. applys* get_shift_op_correct.
+    run red_expr_shift_op_1. applys* red_expr_shift_op_2.
+  (* bitwise *)
+  case_if. run.
+  run red_expr_bitwise_op. applys* get_bitwise_op_correct.
+  run red_expr_bitwise_op_1. applys* red_expr_bitwise_op_2.
+  (* inequality *)
+  clear n H H0 H1.
+  case_if. run. destruct x as [b1 b2].
+  applys red_expr_inequality_op. applys* get_inequality_op_correct.
+  run red_expr_inequality_op_1 using convert_twice_primitive_correct.
+  destruct a as [w1 w2]. let_name. destruct p as [wa wb]. simpls.
+  sets_eq wr: (inequality_test_primitive wa wb).
+  run_inv. applys_eq* (>> red_expr_inequality_op_2 EQp EQwr) 1.
+   fequals. case_if; case_if; case_if*; case_if*; case_if*; case_if*; case_if*; case_if*.
+  (* instanceof *)
+  case_if. subst.
+  destruct v2.
+  applys* red_expr_binary_op_instanceof_non_object.
+  run. lets M: run_object_method_correct (rm E).
+  destruct x.
+  applys* red_expr_binary_op_instanceof_normal.
+   simpls.
+   applys* red_spec_object_has_instance.
+   applys* run_object_has_instance_correct.
+  applys* red_expr_binary_op_instanceof_non_instance.
+  (* in *)
+  case_if. subst. destruct v2.
+  applys* red_expr_binary_op_in_non_object.
+  run red_expr_binary_op_in_object.
+    applys* red_expr_binary_op_in_1.
+    applys* object_has_prop_correct.
+  (* equal *)
+  clear n n0 H. case_if. subst.
+  applys* red_expr_binary_op_equal.
+    applys* runs_type_correct_equal.
+  (* disequal *)
+  case_if. subst.
+  run red_expr_binary_op_disequal.
+  applys* red_expr_binary_op_disequal_1.
+  (* strict equality *)
+  case_if. subst.
+  run_inv. applys* red_expr_binary_op_strict_equal.
+  (* strict disequality *)
+  case_if. subst.
+  run_inv. applys* red_expr_binary_op_strict_disequal.
+  (* coma *)
+  case_if. subst.
+  run_inv. applys* red_expr_binary_op_coma.
+Admitted. (*faster*)
+
+(**************************************************************)
+(* Auxiliary results for [array_args_map_loop] *)
+
+Lemma array_args_map_loop_no_abort : forall oes runs S o l C k,
+  array_args_map_loop runs S C l oes k = o -> exists S', o = out_ter S' res_empty.
+Proof.
+  inductions oes; introv Hyp.
+
+  + simpls. exists S. inverts~ Hyp. 
+  + simpls. run. eapply IHoes; eassumption.
+Qed.
+
+Lemma array_args_map_loop_correct : forall oes runs S S' l C k,
+   array_args_map_loop runs S C l oes k = res_void S' ->
+   red_expr S C (spec_call_array_new_3 l oes k) (out_ter S' l).
+Proof.
+  induction oes; introv Hyp.
+
+  + simpls. inverts Hyp. apply red_spec_call_array_new_3_empty.
+  + simpls. unfolds res_void. run. rename x into S''.
+    apply pick_option_correct in E.
+    applys~ red_spec_call_array_new_3_nonempty. exact E.
+    jauto.
+Qed.
+
+(**************************************************************)
+(* Auxiliary results for [spec_expr_get_value_conv] *)
+
+Lemma run_construct_prealloc_correct : forall runs S C B args o,
+  runs_type_correct runs ->
+  run_construct_prealloc runs S C B args = o ->
+  red_expr S C (spec_construct_prealloc B args) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  destruct B.
+  (* prealloc_global *)
+  discriminate.
+  (* prealloc_global_eval *)
+  discriminate.
+  (* prealloc_global_parse_int *)
+  discriminate.
+  (* prealloc_global_parse_float *)
+  discriminate.
+  (* prealloc_global_is_finite *)
+  discriminate.
+  (* prealloc_global_is_nan *)
+  discriminate.
+  (* prealloc_global_decode_uri *)
+  discriminate.
+  (* prealloc_global_decode_uri_component *)
+  discriminate.
+  (* prealloc_global_encode_uri *)
+  discriminate.
+  (* prealloc_global_encode_uri_component *)
+  discriminate.
+  (* prealloc_object *)
+  let_name. subst.
+  applys* red_spec_call_object_new.
+    applys* get_arg_correct_0.
+  destruct (get_arg 0 args) as [p | l]; unfolds call_object_new; [destruct p | ]; simpls; repeat let_name; try destruct p as (l & S'); substs.
+  inverts HR. applys* red_spec_call_object_new_1_null_or_undef.
+  inverts HR. applys* red_spec_call_object_new_1_null_or_undef.
+  applys* red_spec_call_object_new_1_prim.
+  applys* to_object_correct.
+  applys* red_spec_call_object_new_1_prim.
+  applys* to_object_correct.
+  applys* red_spec_call_object_new_1_prim.
+  applys* to_object_correct.
+  inverts HR. applys* red_spec_call_object_new_1_object.  
+  (* prealloc_object_get_proto_of *)
+  discriminate.
+  (* prealloc_object_get_own_prop_descriptor *)
+  discriminate.
+  (* prealloc_object_get_own_prop_name *)
+  discriminate.
+  (* prealloc_object_create *)
+  discriminate.
+  (* prealloc_object_define_prop *)
+  discriminate.
+  (* prealloc_object_define_props *)
+  discriminate.
+  (* prealloc_object_seal *)
+  discriminate.
+  (* prealloc_object_freeze *)
+  discriminate.
+  (* prealloc_object_prevent_extensions *)
+  discriminate.
+  (* prealloc_object_is_sealed *)
+  discriminate.
+  (* prealloc_object_is_frozen *)
+  discriminate.
+  (* prealloc_object_is_extensible *)
+  discriminate.
+  (* prealloc_object_keys *)
+  discriminate.
+  (* prealloc_object_keys_call *)
+  discriminate.
+  (* prealloc_object_proto *)
+  discriminate.
+  (* prealloc_object_proto_to_string *)
+  discriminate.
+  (* prealloc_object_proto_value_of *)
+  discriminate.
+  (* prealloc_object_proto_has_own_prop *)
+  discriminate.
+  (* prealloc_object_proto_is_prototype_of *)
+  discriminate.
+  (* prealloc_object_proto_prop_is_enumerable *)
+  discriminate.
+  (* prealloc_function *)
+  discriminate. (* LATER *)
+  (* prealloc_function_proto *)
+  discriminate.
+  (* prealloc_function_proto_to_string *)
+  discriminate.
+  (* prealloc_function_proto_apply *)
+  discriminate.
+  (* prealloc_function_proto_call *)
+  discriminate.
+  (* prealloc_function_proto_bind *)
+  discriminate.
+  (* prealloc_bool *)
+  repeat let_name.
+  applys* red_spec_construct_bool.
+  apply get_arg_correct_0.
+  applys* red_spec_to_boolean.
+  destruct p as (l & S').
+  inverts HR.
+  applys* red_spec_construct_bool_1.
+  substs~. 
+  (* prealloc_bool_proto *)
+  discriminate.
+  (* prealloc_bool_proto_to_string *)
+  discriminate.
+  (* prealloc_bool_proto_value_of *)
+  discriminate.
+  (* prealloc_number *)
+  let_name. cases_if*.
+  subst. repeat let_name. 
+  remember (object_alloc S O) as p.
+  destruct p as (l & S1).
+  inverts HR.
+  applys* red_spec_construct_number_nil.
+  applys* red_spec_construct_number_1. substs~.
+  let_name. subst.
+  run~ red_spec_construct_number_not_nil.
+  applys~ get_arg_correct_0.
+  repeat let_name.
+  remember (object_alloc S0 O) as p.
+  destruct p as (l & S1).
+  inverts HR.
+  applys* red_spec_construct_number_1.
+  substs~.
+  (* prealloc_number_proto *)
+  discriminate.
+  (* prealloc_number_proto_to_string *)
+  discriminate.
+  (* prealloc_number_proto_value_of *)
+  discriminate.
+  (* prealloc_number_proto_to_fixed *)
+  discriminate.
+  (* prealloc_number_proto_to_exponential *)
+  discriminate.
+  (* prealloc_number_proto_to_precision *)
+  discriminate.
+
+  (* prealloc_array *)
+  repeat let_name. destruct p as (l & S'). repeat let_name.
+  subst arg_len. destruct args. case_if*. 
+
+  applys~ red_spec_call_array_new_no_args. 
+  eapply red_spec_call_array_new_1; try eassumption. 
+  run. apply pick_option_correct in E.
+  applys* red_spec_call_array_new_2.
+  simpls. run. apply red_spec_call_array_new_3_empty.
+  destruct args. case_if*. clear e.
+  
+  unfolds get_arg. unfolds nth_def. subst v. 
+  applys~ red_spec_call_array_new_single_arg.
+  applys~ red_spec_call_array_new_single_allocate; try (subst; eassumption).
+
+  destruct v0; [destruct p | ]; subst;
+  try solve [run; rename x into S''; run; rename x into S'''; apply pick_option_correct in E; apply pick_option_correct in E0;
+             apply (red_spec_call_array_new_single_not_prim_number S' S'') with (n := JsNumber.of_int 0); jauto;
+             introv Heq; inverts Heq].
+  
+  run~ red_spec_call_array_new_single_prim_number. cases_if*.
+  run; rename x into S''; apply pick_option_correct in E.
+  applys~ red_spec_call_array_new_single_number_correct.
+  applys~ red_spec_call_array_new_single_set_length.
+  applys~ red_spec_call_array_new_single_number_incorrect.
+  applys run_error_correct HR.
+  
+  cases_if*. eapply red_spec_call_array_new_multiple_args. reflexivity.
+  eapply red_spec_call_array_new_1; try eassumption.
+  run. apply pick_option_correct in E.
+  applys* red_spec_call_array_new_2.
+  remember (v1 :: args) as args'; clear dependent v1. 
+  run_pre. run_post; subst.
+  apply array_args_map_loop_no_abort in R1.
+  destruct R1 as (S'' & Heq_o'). subst. inverts Ab.
+  false~ H0. inverts HR.
+  eapply array_args_map_loop_correct. eassumption.
+
+  (* prealloc_array_is_array *)
+  discriminate.
+  (* prealloc_array_proto *)
+  discriminate.
+  (* prealloc_array_proto_to_string *)
+  discriminate.
+  (* prealloc_array_proto_join *)
+  discriminate.
+  (* prealloc_array_proto_pop *)
+  discriminate.
+  (* prealloc_array_proto_push *)
+  discriminate.
+  (* prealloc_string *)
+  repeat let_name.
+  cases_if*. subst.
+  symmetry in EQarg_len. apply length_zero_inv in EQarg_len. subst.
+  apply red_spec_construct_string_empty. 
+  let_name.
+  match goal with H: context [object_alloc ?s ?o] |- _ => sets_eq X: (object_alloc s o) end.
+  destruct X as (l & S'). let_name. subst.
+  run. rename x into S''. apply pick_option_correct in E.
+  remember (object_with_primitive_value
+             (object_with_get_own_property
+                (object_new prealloc_string_proto "String")
+                builtin_get_own_prop_string) "") as O.
+  applys* red_spec_construct_string_2; substs~.
+  applys* red_spec_construct_string_non_empty.
+  subst. destruct args; jauto; discriminate.
+  apply get_arg_correct_0. subst.
+  run red_spec_construct_string_1 using to_string_correct.
+  let_name.
+  match goal with H: context [object_alloc ?s ?o] |- _ => sets_eq X: (object_alloc s o) end.
+  destruct X as (l & S'). let_name. subst.
+  run. rename x into S''. apply pick_option_correct in E.
+  remember (object_with_primitive_value
+             (object_with_get_own_property
+                (object_new prealloc_string_proto "String")
+                builtin_get_own_prop_string) "") as O.
+  applys* red_spec_construct_string_2; substs~.
+  (* prealloc_string_proto *)
+  discriminate.
+  (* prealloc_string_proto_to_string *)
+  discriminate.
+  (* prealloc_string_proto_value_of *)
+  discriminate.
+  (* prealloc_string_proto_char_at *)
+  discriminate.
+  (* prealloc_string_proto_char_code_at *)
+  discriminate.
+  (* prealloc_math *)
+  discriminate.
+  (* prealloc_mathop *)
+  discriminate.
+  (* prealloc_date *)
+  discriminate.
+  (* prealloc_regexp *)
+  discriminate.
+  (* prealloc_error *)
+  let_name. apply~ red_spec_construct_error.
+    apply~ get_arg_correct_0.
+  substs. apply* build_error_correct.  
+  (* prealloc_error_proto *)
+  discriminate.
+  (* prealloc_native_error *)  
+  let_name. apply~ red_spec_construct_native_error.
+    apply~ get_arg_correct_0.
+  substs. apply* build_error_correct.
+  (* prealloc_native_error_proto *)
+  discriminate. (* TODO *)
+  (* prealloc_error_proto_to_string *)
+  discriminate.
+  (* prealloc_throw_type_error *)
+  discriminate.
+  (* prealloc_json *)
+  discriminate.
+Admitted. (*faster*)
+
+Lemma run_construct_default_correct : forall runs S C l args o,
+  runs_type_correct runs ->
+  run_construct_default runs S C l args = res_out o ->
+  red_expr S C (spec_construct_default l args) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  run red_spec_construct_default using run_object_get_correct.
+  let_simpl. let_simpl. let_name. destruct p as [l' S2].
+  run* red_spec_construct_default_1. rewrite* EQp. case_if; case_if*.
+  let_simpl. run_inv.
+  applys* red_spec_function_construct_2. case_if; case_if*.
+Admitted. (*faster*)
+
+Lemma run_construct_correct : forall runs S C co l args o,
+  runs_type_correct runs ->
+  run_construct runs S C co l args = o ->
+  red_expr S C (spec_construct_1 co l args) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  destruct co.
+    applys* red_spec_construct_1_default. applys* run_construct_default_correct.
+
+    repeat run. apply run_object_method_correct in E.  
+    apply run_object_method_correct in E1; subst.
+    applys* red_spec_construct_1_after_bind.
+    destruct x1. repeat run. let_name. 
+    apply run_object_method_correct in E0; subst. 
+    applys* red_spec_construct_1_after_bind_1_some.
+    applys* runs_type_correct_construct.
+    applys* red_spec_construct_1_after_bind_1_none.
+
+    applys* red_spec_construct_1_prealloc. applys* run_construct_prealloc_correct.
+Admitted. (* faster *)
+
+
+Lemma creating_function_object_proto_correct : forall runs S C l o,
+  runs_type_correct runs ->
+  creating_function_object_proto runs S C l = o ->
+  red_expr S C (spec_creating_function_object_proto l) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  run red_spec_creating_function_object_proto
+    using run_construct_prealloc_correct.
+  let_simpl. run red_spec_creating_function_object_proto_1.
+  let_simpl. applys* red_spec_creating_function_object_proto_2. run_hyp*.
+Admitted. (* faster *)
+
+
+Lemma creating_function_object_correct : forall runs S C names bd X str o,
+  runs_type_correct runs ->
+  creating_function_object runs S C names bd X str = o ->
+  red_expr S C (spec_creating_function_object names bd X str) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  let_simpl. let_simpl. let_simpl. let_simpl. let_name. destruct p as [l S1].
+  let_simpl. run* red_spec_creating_function_object.
+  run red_spec_creating_function_object_1
+    using creating_function_object_proto_correct.
+  case_if; destruct str; tryfalse.
+    run_inv. applys* red_spec_creating_function_object_2_not_strict.
+    let_simpl. let_simpl.
+     run* red_spec_creating_function_object_2_strict. clear EQp.
+     run* red_spec_creating_function_object_3.
+     applys* red_spec_creating_function_object_4.
+Admitted. (* faster*)
+
+
+Lemma env_record_has_binding_correct : forall runs S C L x o,
+  runs_type_correct runs ->
+  env_record_has_binding runs S C L x = o ->
+  red_expr S C (spec_env_record_has_binding L x) o.
+Proof.
+  introv IH HR. unfolds in HR. run_simpl.
+  forwards B: @pick_option_correct (rm E).
+  applys~ red_spec_env_record_has_binding B. destruct x0; run_inv.
+   apply~ red_spec_env_record_has_binding_1_decl.
+    rewrite decide_def; auto.
+   apply~ red_spec_env_record_has_binding_1_object.
+    apply* object_has_prop_correct.
+Qed.
+
+
+Lemma binding_inst_function_decls_correct : forall runs S C args L fds str bconfig o,
+  runs_type_correct runs ->
+  binding_inst_function_decls runs S C L fds str bconfig = o ->
+  red_expr S C (spec_binding_inst_function_decls args L fds str bconfig) o.
+Proof.
+  introv IH HR. gen S o. induction fds; introv HR.
+  simpls. run_inv. applys* red_spec_binding_inst_function_decls_nil.
+  simpls. let_name. let_name. let_name. let_name.
+  run (@red_spec_binding_inst_function_decls_cons str_fd)
+    using creating_function_object_correct. subst*. subst*. clear R1.
+  let_name as M. rename a into fd. rename l into fo.
+  asserts M_correct: (forall S o,
+      M S = o ->
+      red_expr S C (spec_binding_inst_function_decls_5 args L fd fds str fo bconfig) o).
+    clears HR S o. introv HR. subst M.
+    subst fname. run red_spec_binding_inst_function_decls_5
+      using env_record_set_mutable_binding_correct.
+    applys* red_spec_binding_inst_function_decls_6.
+    clear EQM.
+  subst fname. run red_spec_binding_inst_function_decls_1
+    using env_record_has_binding_correct.
+  case_if; subst.
+    case_if; try subst L.
+      run red_spec_binding_inst_function_decls_2_true_global
+        using run_object_get_prop_correct.
+       destruct a; tryfalse. case_if.
+         let_name. run* red_spec_binding_inst_function_decls_3_true.
+          applys* red_spec_binding_inst_function_decls_4.
+         applys red_spec_binding_inst_function_decls_3_false.
+           destruct (attributes_configurable a); tryfalse; auto. (* LATER: cleanup *)
+          case_if.
+            applys* red_spec_binding_inst_function_decls_3a_type_error.
+            applys* red_spec_binding_inst_function_decls_3a_no_error.
+        applys* red_spec_binding_inst_function_decls_2_true.
+    run red_spec_binding_inst_function_decls_2_false
+      using env_record_create_mutable_binding_correct.
+     applys* red_spec_binding_inst_function_decls_4.
+Admitted. (* faster *)
+
+
+Lemma binding_inst_var_decls_correct : forall runs S C L vds bconfig str o,
+  runs_type_correct runs ->
+  binding_inst_var_decls runs S C L vds bconfig str = o ->
+  red_expr S C (spec_binding_inst_var_decls L vds bconfig str) o.
+Proof.
+  introv IH HR. gen S o. induction vds; introv HR.
+  simpls. run_inv. applys* red_spec_binding_inst_var_decls_nil.
+  simpls. let_simpl.
+  run red_spec_binding_inst_var_decls_cons
+    using env_record_has_binding_correct.
+  case_if; subst.
+    applys* red_spec_binding_inst_var_decls_1_true.
+    run red_spec_binding_inst_var_decls_1_false
+      using env_record_create_set_mutable_binding_correct.
+     applys* red_spec_binding_inst_var_decls_2.
+Admitted. (* faster *)
+
+Lemma binding_inst_formal_params_correct : forall runs S C L args names str o,
+  runs_type_correct runs ->
+  binding_inst_formal_params runs S C L args names str = o ->
+  red_expr S C (spec_binding_inst_formal_params args L names str) o.
+Proof.
+  introv IH HR. gen S args o. induction names; introv HR.
+  simpls. run_inv. applys* red_spec_binding_inst_formal_params_empty.
+  simpls.
+  let_name. let_name.
+  run (@red_spec_binding_inst_formal_params_non_empty v args')
+    using env_record_has_binding_correct.
+    subst v args'. destruct* args.
+  let_name as M. asserts M_correct: (forall S o,
+      M S = o ->
+      red_expr S C (spec_binding_inst_formal_params_3 args' L a names str v) o).
+    clears HR S o. introv HR. subst M.
+    run red_spec_binding_inst_formal_params_3
+      using env_record_set_mutable_binding_correct.
+    applys* red_spec_binding_inst_formal_params_4.
+    clear EQM.
+  case_if; subst.
+    applys* red_spec_binding_inst_formal_params_1_declared.
+     run red_spec_binding_inst_formal_params_1_not_declared
+       using env_record_create_mutable_binding_correct.
+    applys* red_spec_binding_inst_formal_params_2.
+Admitted. (* faster *)
+
+
+Lemma make_arg_getter_correct : forall runs S C x X o,
+  runs_type_correct runs ->
+  make_arg_getter runs S C x X = o ->
+  red_expr S C (spec_make_arg_getter x X) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  apply~ red_spec_make_arg_getter. applys~ creating_function_object_correct HR.
+Qed.
+
+Lemma make_arg_setter_correct : forall runs S C x X o,
+  runs_type_correct runs ->
+  make_arg_setter runs S C x X = o ->
+  red_expr S C (spec_make_arg_setter x X) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  apply~ red_spec_make_arg_setter. applys~ creating_function_object_correct HR.
+Qed.
+
+Lemma arguments_object_map_loop_correct : forall runs S C l xs len args args' X str lmap xsmap o,
+  runs_type_correct runs ->
+  len = length args ->
+  arguments_object_map_loop runs S C l xs len args X str lmap xsmap = o ->
+  red_expr S C (spec_arguments_object_map_2 l xs (args ++ args') X str lmap xsmap (len - 1)) o.
+Proof.
+  introv IH EQlen HR. gen o args args' S xsmap. induction len; introv EQlen HR.
+   simpls. apply~ red_spec_arguments_object_map_2_negative. math. cases_if.
+     substs. inverts HR. apply~ red_spec_arguments_object_map_8_nil.
+     run. let_name. inverts HR. forwards~ B: @pick_option_correct E.
+     applys~ red_spec_arguments_object_map_8_cons B. substs*.
+   unfolds in HR. fold arguments_object_map_loop in HR.
+    let_name. destruct tdl as (rmlargs&largs).
+    forwards EQargs: take_drop_last_spec EQtdl; [destruct args; tryfalse; discriminate|].
+    forwards EQlargs: take_drop_last_length EQtdl; [destruct args; tryfalse; discriminate|].
+    clear EQtdl. simpl in HR.
+    let_name. let_name. asserts Loop: (forall S xsmap o,
+        arguments_object_map_loop' S xsmap = o ->
+        red_expr S C (spec_arguments_object_map_2 l xs (rmlargs ++ largs :: args') X str lmap xsmap (len - 1)) o).
+      clear HR. introv RES. subst arguments_object_map_loop'. apply* IHlen. math.
+    clear EQarguments_object_map_loop'.
+    asserts_rewrite (Datatypes.S len - 1 = len). math.
+    run~ red_spec_arguments_object_map_2_positive using object_define_own_prop_correct.
+      clear HR. subst args. rew_app. applys~ ZNth_app_r ZNth_here. math.
+      subst A. auto*.
+    clear R1 EQA. cases_if.
+     apply~ red_spec_arguments_object_map_3_next.
+       apply~ nat_int_ge.
+      rewrite EQargs. rew_app. apply~ Loop.
+     let_name. asserts ZN: (ZNth len xs x).
+        apply Nth_to_ZNth. forwards (x'&N): length_Nth_lt len xs. math.
+        forwards EQx': Nth_to_nth_def "" N. subst x'. rewrite~ <- EQx in N.
+      cases_if.
+       applys~ red_spec_arguments_object_map_3_cont_next ZN.
+        rewrite EQargs. rew_app. apply~ Loop.
+       applys~ red_spec_arguments_object_map_3_cont_cont ZN.
+        rew_logic in n0. destruct n0 as [? NI]. splits.
+         destruct~ str; false.
+         auto*.
+        run red_spec_arguments_object_map_4 using make_arg_getter_correct.
+        run red_spec_arguments_object_map_5 using make_arg_setter_correct.
+        let_name. run~ red_spec_arguments_object_map_6.
+          rewrite EQA' in R1. simpl in R1.
+          simpl. auto*.
+        apply~ red_spec_arguments_object_map_7.
+        rewrite EQargs. rew_app. apply~ Loop.
+Admitted. (* faster *)
+
+Lemma arguments_object_map_correct : forall runs S C l xs args X str o,
+  runs_type_correct runs ->
+  arguments_object_map runs S C l xs args X str = o ->
+  red_expr S C (spec_arguments_object_map l xs args X str) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  run red_spec_arguments_object_map using run_construct_prealloc_correct.
+  apply~ red_spec_arguments_object_map_1.
+  rewrite <- (app_nil_r args).
+  apply* arguments_object_map_loop_correct; rew_app~.
+Qed.
+
+Lemma create_arguments_object_correct : forall runs S C lf xs args X str o,
+  runs_type_correct runs ->
+  create_arguments_object runs S C lf xs args X str = o ->
+  red_expr S C (spec_create_arguments_object lf xs args X str) o.
+Proof.
+  introv IH HR. unfolds in HR. let_name. let_name. destruct p as [l S'].
+  let_name. run* red_spec_create_arguments_object; try solve [ substs* ].
+  clear EQA EQO EQp A. run red_spec_create_arguments_object_1
+    using arguments_object_map_correct. cases_if.
+   let_name. let_name.
+    run* red_spec_create_arguments_object_2_strict; try solve [ substs* ].
+    clear EQA. run red_spec_create_arguments_object_3.
+    apply~ red_spec_create_arguments_object_4.
+   let_name.
+    run* red_spec_create_arguments_object_2_non_strict; try solve [ substs* ].
+    clear EQA. apply~ red_spec_create_arguments_object_4.
+Qed.
+
+Lemma binding_inst_arg_obj_correct : forall runs S C lf p xs args L o,
+  runs_type_correct runs ->
+  binding_inst_arg_obj runs S C lf p xs args L = o ->
+  red_expr S C (spec_binding_inst_arg_obj lf p xs args L) o.
+Proof.
+  introv IH HR. unfolds in HR. let_name.
+  run~ red_spec_binding_inst_arg_obj using create_arguments_object_correct.
+  cases_if.
+   run red_spec_binding_inst_arg_obj_1_strict
+     using env_record_create_immutable_binding_correct.
+    apply~ red_spec_binding_inst_arg_obj_2.
+    apply~ env_record_initialize_immutable_binding_correct.
+   apply~ red_spec_binding_inst_arg_obj_1_not_strict.
+    applys~ env_record_create_set_mutable_binding_correct HR.
+Qed.
+
+
+Lemma execution_ctx_binding_inst_correct : forall runs S C ct funco (p:prog) args o,
+  runs_type_correct runs ->
+  execution_ctx_binding_inst runs S C ct funco p args = o ->
+  red_expr S C (spec_binding_inst ct funco p args) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  cases (execution_ctx_variable_env C); tryfalse. rename e into L.
+  applys* red_spec_binding_inst. clears TEMP. let_simpl.
+  let_name as M. asserts M_correct: (forall S xs o,
+      M S xs = o ->
+      red_expr S C (spec_binding_inst_3 ct funco p xs args L) o).
+    clear HR S o. introv HR. subst M.
+    let_name. let_name.
+    run red_spec_binding_inst_3
+      using binding_inst_function_decls_correct.
+        subst bconfig. rewrite decide_def. auto.
+        auto.
+    applys red_spec_binding_inst_4.
+    run red_spec_binding_inst_5 using env_record_has_binding_correct.
+    let_name as N. asserts N_correct: (forall S o,
+      N S = o ->
+      red_expr S C (spec_binding_inst_8 p bconfig L) o).
+      clear HR S o. introv HR. subst N.
+      applys red_spec_binding_inst_8.
+        applys* binding_inst_var_decls_correct.
+      clear EQN.
+    destruct ct.
+      destruct funco.
+        destruct b; tryfalse.
+          applys* red_spec_binding_inst_6_no_arguments. rew_logic*.
+          run red_spec_binding_inst_6_arguments
+            using binding_inst_arg_obj_correct.
+           applys* red_spec_binding_inst_7.
+        destruct b; tryfalse.
+         applys* red_spec_binding_inst_6_no_arguments. rew_logic*.
+      applys* red_spec_binding_inst_6_no_arguments.
+       rew_logic*. left. congruence.
+      applys* red_spec_binding_inst_6_no_arguments.
+       rew_logic*. left; congruence.
+  destruct ct; destruct funco; tryfalse.
+    run. lets H: run_object_method_correct (rm E).
+     run. subst. run* red_spec_binding_inst_1_function
+       using binding_inst_formal_params_correct.
+     applys* red_spec_binding_inst_2.
+    applys* red_spec_binding_inst_1_not_function. congruence.
+    applys* red_spec_binding_inst_1_not_function. congruence.
+Admitted. (* faster *)
+
+
+Lemma entering_eval_code_correct : forall runs S C bdirect bd F K o,
+  runs_type_correct runs ->
+  entering_eval_code runs S C bdirect bd F = o ->
+  (forall S' C' o', F S' C' = o' -> red_expr S' C' K o') ->
+  red_expr S C (spec_entering_eval_code bdirect bd K) o.
+Proof.
+  introv IH HR HK. unfolds in HR.
+  let_name. let_name.
+  applys* red_spec_entering_eval_code str C'. case_if; case_if*.
+  let_name. destruct p as [lex S'].
+  let_name. let_name.
+  run_pre. applys* red_spec_entering_eval_code_1 str lex S' C1 o1.
+    rewrite EQp. case_if; case_if*.
+    subst C1. case_if; case_if*.
+    subst p. applys* execution_ctx_binding_inst_correct R1.
+    run_post. clear R1.
+  applys* red_spec_entering_eval_code_2.
+Admitted. (* faster *)
+
+
+Lemma run_eval_correct : forall runs S C (is_direct_call : bool) vs o,
+  runs_type_correct runs ->
+  run_eval runs S C is_direct_call vs = o ->
+  red_expr S C (spec_call_global_eval is_direct_call vs) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  lets (v&H&E): arguments_from_spec_1 vs. rewrites (rm E) in *.
+  applys* red_spec_call_global_eval (rm H).
+  destruct v;
+   [| run_inv; applys* red_spec_call_global_eval_1_not_string; simpl; congruence].
+  destruct p; run_inv;
+     try (applys* red_spec_call_global_eval_1_not_string; simpl; congruence).
+  let_name. destruct (pick_option (parse s str)) eqn:P.
+   forwards B: @pick_option_correct (rm P).
+    applys* red_spec_call_global_eval_1_string_parse.
+    applys* entering_eval_code_correct (rm HR).
+    clear - IH. introv HR. run red_spec_call_global_eval_2.
+    sets_eq RT: (res_type R). destruct RT; tryfalse.
+     run. cases (res_value R); tryfalse; run_inv.
+      applys* red_spec_call_global_eval_3_normal_empty.
+      destruct R. simpls. subst.
+       applys* red_spec_call_global_eval_3_normal_value.
+     run_inv. applys* red_spec_call_global_eval_3_throw.
+   applys red_spec_call_global_eval_1_string_not_parse.
+    introv Pa. forwards (?&Par): @pick_option_defined (ex_intro _ p Pa).
+     rewrite Par in P. false.
+    applys run_error_correct HR.
+Admitted. (*faster*)
+
+Lemma run_list_expr_correct : forall runs S C es y,
+  runs_type_correct runs ->
+  run_list_expr runs S C nil es = result_some y ->
+  red_spec S C (spec_list_expr es) y.
+Proof.
+  introv IH. cuts M: (forall es S C vs y,
+      run_list_expr runs S C vs es = result_some y ->
+      red_spec S C (spec_list_expr_1 (rev vs) es) y).
+    intros HR. apply red_spec_list_expr. applys* M (@nil value).
+  clears S C es y. intros es. induction es; introv HR.
+  simpls. run_inv. applys* red_spec_list_expr_1_nil.
+  simpls. run red_spec_list_expr_1_cons.
+   applys red_spec_list_expr_2. forwards M: IHes HR.
+   rew_list in M. auto.
+Admitted. (*faster*)
+
+
+Lemma run_call_default_correct : forall runs S C lf o,
+  runs_type_correct runs ->
+  run_call_default runs S C lf = o ->
+  red_expr S C (spec_call_default_1 lf) o.
+Proof.
+  introv IH HR. unfolds in HR. let_simpl.
+  run. applys* red_spec_call_default_1.
+    applys* run_object_method_correct. clear E.
+  destruct x.
+    case_if.
+      applys* red_spec_call_default_2_empty_body.
+       run_inv. applys* red_spec_call_default_3_normal.
+      run* red_spec_call_default_2_body.
+        destruct R as [RT RV RL]; simpls. subst.
+         applys red_spec_call_default_3_normal.
+        destruct R as [RT RV RL]; simpls. subst.
+         applys red_spec_call_default_3_return.
+        subst. abort.
+    applys* red_spec_call_default_2_empty_body.
+     run_inv. applys* red_spec_call_default_3_normal.
+Admitted. (* faster *)
+
+
+Lemma env_record_implicit_this_value_correct : forall S C L v,
+  env_record_implicit_this_value S L = Some v ->
+  red_expr S C (spec_env_record_implicit_this_value L) (out_ter S v).
+Proof.
+  introv HR. unfolds in HR.
+  run_simpl HR as H; tryfalse. inverts H. forwards B: @pick_option_correct (rm E).
+  applys~ red_spec_env_record_implicit_this_value B. destruct n.
+   applys~ red_spec_env_record_implicit_this_value_1_decl.
+   applys~ red_spec_env_record_implicit_this_value_1_object.
+Qed.
+
+Lemma run_expr_call_correct : forall runs S C e1 e2s o,
+  runs_type_correct runs ->
+  run_expr_call runs S C e1 e2s = o ->
+  red_expr S C (expr_call e1 e2s) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  let_name. run red_expr_call.
+  run red_expr_call_1 using ref_get_value_correct.
+  run red_expr_call_2 using run_list_expr_correct.
+  destruct a.
+    applys* red_expr_call_3.
+  case_if.
+  applys* red_expr_call_3_callable.
+  rename o0 into l. rename a0 into vs.
+  let_name as M. asserts M_correct: (forall S0 vthis o,
+      M vthis = o ->
+      red_expr S0 C (expr_call_5 l is_eval_direct vs (out_ter S3 vthis)) o).
+    clear HR S o. introv HR. subst M.
+    case_if.
+      subst. applys red_expr_call_5_eval. applys* run_eval_correct.
+      applys* red_expr_call_5_not_eval. apply* IH.
+    clear EQM.
+  subst. destruct rv; tryfalse.
+    applys* red_expr_call_4_not_ref.
+    cases (ref_base r).
+      case_if. applys* red_expr_call_4_prop.
+      run. applys* red_expr_call_4_env.
+       applys* env_record_implicit_this_value_correct.
+  (* other branch *)
+  applys* red_expr_call_3.
+Admitted. (*faster*)
+
+Ltac run_select_proj_extra_construct HT ::=
+  match HT with
+  | run_construct_prealloc => constr:(run_construct_prealloc_correct)
+  | run_construct => constr:(run_construct_correct)
+  | run_call_default => constr:(run_call_default_correct)
+  | creating_function_object_proto => constr:(creating_function_object_proto_correct)
+  | creating_function_object => constr:(creating_function_object_correct)
+  | run_list_expr => constr:(run_list_expr_correct)
+  | execution_ctx_binding_inst => constr:(execution_ctx_binding_inst_correct)
+  end.
+
+
+(**************************************************************)
+(** ** Property descriptors *)
+
+Lemma from_prop_descriptor_correct : forall runs S0 S C D o,
+  runs_type_correct runs ->
+  from_prop_descriptor runs S C D = o ->
+  red_expr S0 C (spec_from_descriptor (ret S D)) o.
+Proof.
+  introv IH HR. unfolds in HR. destruct D.
+  run_inv. applys* red_spec_from_descriptor_undef.
+  run* red_spec_from_descriptor_some.
+  rename a into A.
+  let_name as M. asserts M_correct: (forall S0 S b o,
+    M S b = res_out o ->
+    red_expr S0 C (spec_from_descriptor_4 l A (out_ter S b)) o).
+   clear HR S o. introv HR. subst M.
+    let_name. run* red_spec_from_descriptor_4. congruence.
+    let_name. run* red_spec_from_descriptor_5. congruence.
+    applys* red_spec_from_descriptor_6.
+    clear EQM.
+  destruct A.
+    let_name. run* red_spec_from_descriptor_1_data. congruence.
+     let_name. run red_spec_from_descriptor_2_data. congruence.
+     applys* M_correct.
+    let_name. run red_spec_from_descriptor_1_accessor. congruence.
+     let_name. run red_spec_from_descriptor_3_accessor. congruence.
+     applys* M_correct.
+Admitted. (*faster*)
+
+
+(**************************************************************)
+(** ** Object Initialisation *)
+
+Lemma create_new_function_in_correct : forall runs S C args bd o,
+  runs_type_correct runs ->
+  create_new_function_in runs S C args bd = o ->
+  red_expr S C (spec_create_new_function_in C args bd) o.
+Proof.
+  introv IH HR. unfolds in HR. applys red_spec_create_new_function_in.
+  applys* creating_function_object_correct.
+Qed.
+
+Lemma init_object_correct : forall runs S C l (pds : propdefs) o,
+  runs_type_correct runs ->
+  init_object runs S C l pds = o ->
+  red_expr S C (expr_object_1 l pds) o.
+Proof.
+  introv IH. gen S. induction pds as [|(pn&pb) pds]; introv HR.
+  simpls. run_inv. applys red_expr_object_1_nil.
+  simpls. let_name. let_name.
+  asserts follows_correct: (forall S Desc, follows S Desc = res_out o ->
+      red_expr S C (expr_object_4 l x Desc pds) o).
+    subst follows. clear HR. introv HR.
+    run red_expr_object_4 using object_define_own_prop_correct.
+     applys* red_expr_object_5.
+    clear EQfollows.
+  applys* red_expr_object_1_cons x.
+  destruct pb.
+   run red_expr_object_2_val.
+    applys* red_expr_object_3_val.
+   run red_expr_object_2_get using create_new_function_in_correct.
+    applys* red_expr_object_3_get.
+   run red_expr_object_2_set using create_new_function_in_correct.
+    applys* red_expr_object_3_set.
+Qed.
+
+Lemma red_expr_array_3_object_loc_eq : forall ElementList S S' C l l' k,
+  red_expr S C (expr_array_3 l ElementList k) (out_ter S' l') -> l = l'.
+Proof.
+  induction ElementList using (measure_induction length).
+  destruct ElementList; introv Hyp.
+
+  + inverts~ Hyp. inverts~ H0. 
+
+  + destruct o.
+    - inverts Hyp. inverts H0. 
+      inverts H8.  inverts H1. unfolds abrupt_res. false~ H4.
+      inverts H10. inverts H1. unfolds abrupt_res. false~ H4.
+      inverts H12. inverts H1. unfolds abrupt_res. false~ H4.
+      inverts H13. inverts H1. unfolds abrupt_res. false~ H4.
+      inverts H14. inverts H1. unfolds abrupt_res. false~ H4.
+      specializes~ H H6. rew_length; nat_math.
+
+    - inverts Hyp. inverts H0.
+      specializes~ H H10. 
+      inverts H4.
+      * rew_length; nat_math.
+      * destruct H as (e & oes' & Heq). subst.
+        rewrite H3. rew_length.
+        destruct Elision. rewrite app_nil_l in H3.
+        inverts H3. rew_length; nat_math.
+Admitted. (*faster*)
+
+Lemma run_array_element_list_correct : forall runs S C l oes o k,
+  runs_type_correct runs ->
+  run_array_element_list runs S C l oes k = o ->
+  red_expr S C (expr_array_3 l oes k) o.
+Proof.
+  introv IH HR. gen runs S C l o. 
+  destruct oes; intros. 
+
+  + inverts HR. apply red_expr_array_3_nil.
+
+  + destruct o.
+    - unfolds run_array_element_list.       
+      let_name. subst. 
+      run~ red_expr_array_3_some_val; rename a into v.
+      run~ red_expr_array_3_get_len using run_object_get_correct.
+      run~ red_expr_array_3_convert_len.
+      run~ red_expr_array_3_add_len.
+      let_name. subst. run~ red_expr_array_3_def_own_prop.
+      run red_expr_array_3_next. substs~. 
+      
+    - simpls. let_name.   
+      eapply red_expr_array_3_none.
+      * apply elision_head_decomposition. 
+      * jauto. * jauto. * jauto.                        
+      * substs. applys* runs_type_correct_array_element_list. 
+Qed.
+
+Lemma init_array_correct : forall runs S C l oes o,
+  runs_type_correct runs ->
+  init_array runs S C l oes = o ->
+  red_expr S C (expr_array_1 l oes) o.
+Proof.
+  introv IH HR. unfolds in HR. let_name. let_name. 
+  apply red_expr_array_1 with (ElementList := ElementList) 
+                              (Elision := list_repeat None ElisionLength) 
+                              (ElisionLength := ElisionLength); 
+    try solve [try rewrite my_Z_of_nat_def; substs~]. 
+  
+  run red_expr_array_2.
+  eapply run_array_element_list_correct; eassumption.
+  apply run_array_element_list_correct in R1; auto. 
+  apply red_expr_array_3_object_loc_eq in R1. subst l0.
+    
+  apply red_expr_array_add_length.  
+    run red_expr_array_add_length_0 using run_object_get_correct.
+    run red_expr_array_add_length_1. run red_expr_array_add_length_2. 
+    run red_expr_array_add_length_3. apply red_expr_array_add_length_4.
+Qed.
+
+Lemma lexical_env_get_identifier_ref_correct : forall runs S C lexs x str y,
+  runs_type_correct runs ->
+  lexical_env_get_identifier_ref runs S C lexs x str = result_some y ->
+  red_spec S C (spec_lexical_env_get_identifier_ref lexs x str) y.
+Proof.
+  introv IH. gen S C. induction lexs; introv HR.
+  simpls. run_inv.
+   applys* red_spec_lexical_env_get_identifier_ref_nil.
+  simpls.
+  applys red_spec_lexical_env_get_identifier_ref_cons.
+  run red_spec_lexical_env_get_identifier_ref_cons_1 using env_record_has_binding_correct.
+  cases_if; run_inv.
+   apply~ red_spec_lexical_env_get_identifier_ref_cons_2_true.
+   apply~ red_spec_lexical_env_get_identifier_ref_cons_2_false.
+Qed.
+
+Lemma run_typeof_value_correct : forall S v,
+  run_typeof_value S v = typeof_value S v.
+Proof. intros. destruct v; simpl. auto. case_if; case_if*. Qed.
+
+Ltac run_select_proj_extra_get_value HT ::=
+  match HT with
+  | ref_get_value => constr:(ref_get_value_correct)
+  end.
+
+
+(**************************************************************)
+(** ** Main theorem *)
+
+Hint Extern 1 (regular_unary_op _) =>
+    intros ?; false_invert.
+
+Lemma prepost_op_correct : forall u F ispre,
+  run_prepost_op u = Some (F,ispre) ->
+  prepost_op u F ispre.
+Proof.
+  Hint Constructors prepost_op.
+  introv HR. destruct u; simpls; inverts* HR.
+Qed.
+
+
+Lemma object_delete_default_correct : forall runs S C l x str o,
+  runs_type_correct runs ->
+  object_delete_default runs S C l x str = o ->
+  red_expr S C (spec_object_delete_1 builtin_delete_default l x str) o.
+Proof.
+  introv IH HR. unfolds in HR. run red_spec_object_delete_1_default. destruct a.
+   run_inv. applys red_spec_object_delete_2_undef. (* This rule is erroneous, the conclusion should contains [S0] instead [S]. *)
+   case_if.
+     run. forwards B: @pick_option_correct (rm E).
+       applys_eq* red_spec_object_delete_2_some_configurable 1.
+     applys* red_spec_object_delete_3_some_non_configurable.
+      applys* out_error_or_cst_correct.
+Qed.
+
+Lemma object_delete_correct : forall runs S C l x str o,
+  runs_type_correct runs ->
+  object_delete runs S C l x str = o ->
+  red_expr S C (spec_object_delete l x str) o.
+Proof.
+  introv IH HR. unfolds in HR. run. rename x0 into B. (* LTAC ARTHUR *)
+  applys* red_spec_object_delete.
+   applys* run_object_method_correct. clear E.
+  destruct B.
+  (* default *)
+  applys~ object_delete_default_correct HR.
+  (* argument object *)
+  run. forwards* obpm: run_object_method_correct.
+  run. substs. run~ red_spec_object_delete_args_obj.
+  run red_spec_object_delete_args_obj_1 using object_delete_default_correct.
+  cases_if. destruct a. (* LTAC ARTHUR *)
+   apply~ red_spec_object_delete_args_obj_2_else.
+    inverts HR. apply~ red_spec_object_delete_args_obj_4.
+   run red_spec_object_delete_args_obj_2_if.
+    apply~ red_spec_object_delete_args_obj_3.
+    apply~ red_spec_object_delete_args_obj_4.
+   apply~ red_spec_object_delete_args_obj_2_else.
+    inverts HR. apply~ red_spec_object_delete_args_obj_4.
+Qed.
+
+
+Lemma env_record_delete_binding_correct : forall runs S C L x o,
+  runs_type_correct runs ->
+  env_record_delete_binding runs S C L x = o ->
+  red_expr S C (spec_env_record_delete_binding L x) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  run_simpl. forwards B: @pick_option_correct (rm E).
+  applys~ red_spec_env_record_delete_binding B. destruct x0.
+   sets_eq <- ero E: (Heap.read_option d x). destruct ero as [[mu ?]|].
+    rewrite <- Heap.binds_equiv_read_option in E. destruct mu; run_inv;
+     applys~ red_spec_env_record_delete_binding_1_decl_indom E; case_if*.
+    rewrite <- Heap.not_indom_equiv_read_option in E. run_inv.
+     applys~ red_spec_env_record_delete_binding_1_decl_not_indom E.
+   run. apply~ red_spec_env_record_delete_binding_1_object.
+Qed.
+
+
+Lemma identifier_resolution_correct : forall runs S C x y,
+  runs_type_correct runs ->
+  identifier_resolution runs S C x = result_some y ->
+  red_spec S C (spec_identifier_resolution C x) y.
+Proof.
+  introv IH HR.
+  unfolds spec_identifier_resolution, identifier_resolution.
+  applys* lexical_env_get_identifier_ref_correct.
+Qed.
+
+Lemma run_expr_correct : forall runs S C e o,
+  runs_type_correct runs ->
+  run_expr runs S C e = o ->
+  red_expr S C (expr_basic e) o.
+Proof.
+  introv IH R. unfolds in R.
+  destruct e as [ | | | pds | oes | | |  | | | | | | ].
+  (* this *)
+  run_inv. apply~ red_expr_this.
+  (* identifier *)
+  run_inv. run red_expr_identifier using identifier_resolution_correct.
+  applys* red_expr_identifier_1.
+  (* literal *)
+  run_inv. apply~ red_expr_literal.
+  (* object *)
+  run red_expr_object using run_construct_prealloc_correct.
+  applys red_expr_object_0.
+  applys* init_object_correct.
+
+  (* _ARRAYS_ *)
+  run red_expr_array using run_construct_prealloc_correct.
+  applys red_expr_array_0.
+  applys* init_array_correct.
+
+  (* function *)
+  unfolds in R. destruct o0.
+    let_name. destruct p as (lex'&S').
+     destruct lex' as [|L lex']; simpls; tryfalse.
+     run_simpl. forwards: @pick_option_correct (rm E).
+     run* red_expr_function_named using env_record_create_immutable_binding_correct.
+     run red_expr_function_named_1 using creating_function_object_correct.
+     run red_expr_function_named_2 using env_record_initialize_immutable_binding_correct.
+     apply~ red_expr_function_named_3.
+    apply~ red_expr_function_unnamed. applys~ creating_function_object_correct IH.
+  (* Access *)
+  unfolds in R. run red_expr_access.
+  run red_expr_access_1. cases_if.
+    forwards [R1 N]: run_error_correct' C (rm R). applys red_expr_access_2.
+      applys* red_spec_check_object_coercible_undef_or_null.
+      abort.
+    applys red_expr_access_2.
+      applys* red_spec_check_object_coercible_return.
+     run red_expr_access_3.
+     applys* red_expr_access_4.
+  (* member *)
+  run_hyp R. apply~ red_expr_member.
+  (* new *)
+  unfolds in R. run red_expr_new.
+  run red_expr_new_1.
+  destruct a; tryfalse.
+    applys* red_expr_new_2_type_error_not_object.
+    run. lets M: run_object_method_correct (rm E).
+    destruct x; tryfalse.
+      applys red_expr_new_2_construct.
+       applys* red_spec_constructor.
+       applys* run_construct_correct.
+      applys* red_expr_new_2_type_error_no_construct.
+  (* call *)
+  applys* run_expr_call_correct.
+  (* unary operators *)
+  unfolds in R. case_if as N.
+    run* red_expr_prepost. run red_expr_prepost_1_valid.
+     run red_expr_prepost_2. run. destruct x as [F ispre].
+     let_simpl. let_name. lets: prepost_op_correct (rm E).
+     run* red_expr_prepost_3. subst. applys* red_expr_prepost_4.
+    destruct u; try solve [ false n; unfolds; do 2 eexists; constructors ].
+    (* delete *)
+    run red_expr_delete. destruct rv; run_inv.
+      apply~ red_expr_delete_1_not_ref. intro; false_invert.
+      apply~ red_expr_delete_1_not_ref. intro; false_invert.
+      case_if; run_inv.
+        apply~ red_expr_delete_1_ref_unresolvable. cases_if.
+         apply~ red_expr_delete_2_strict. apply* run_error_correct.
+         run_inv. apply~ red_expr_delete_2_not_strict.
+        cases (ref_base r).
+          run* red_expr_delete_1_ref_property using to_object_correct.
+            apply* ref_is_property_from_not_unresolvable_value.
+            apply~ red_expr_delete_3. runs~.
+          rename e0 into L. apply* red_expr_delete_1_ref_env_record. cases_if.
+            apply~ red_expr_delete_4_strict. apply* run_error_correct.
+            apply~ red_expr_delete_4_not_strict. applys* env_record_delete_binding_correct.
+    (* void *)
+    run* red_expr_unary_op. applys red_expr_unary_op_1.
+     applys* red_expr_unary_op_void.
+    (* typeof *)
+    run red_expr_typeof. destruct rv; tryfalse.
+      applys* red_expr_typeof_1_value. run_inv. applys* red_expr_typeof_2.
+        applys run_typeof_value_correct.
+      case_if.
+        run_inv. applys* red_expr_typeof_1_ref_unresolvable.
+        run* red_expr_typeof_1_ref_resolvable.
+         applys* red_expr_typeof_2.
+         applys* run_typeof_value_correct.
+   (* add *)
+   run* red_expr_unary_op. applys red_expr_unary_op_1.
+    applys red_expr_unary_op_add. run_hyp*.
+   (* neg *)
+   run* red_expr_unary_op. applys red_expr_unary_op_1.
+    run red_expr_unary_op_neg. applys* red_expr_unary_op_neg_1.
+   (* bitwise not *)
+   run* red_expr_unary_op. applys red_expr_unary_op_1.
+    run red_expr_unary_op_bitwise_not.
+    applys* red_expr_unary_op_bitwise_not_1.
+   (* not *)
+   run* red_expr_unary_op. applys red_expr_unary_op_1.
+   forwards* M: red_spec_to_boolean a.
+    applys* red_expr_unary_op_not. applys* red_expr_unary_op_not_1.
+  (* binary operators *)
+  unfolds in R. rename b into op.
+  lets: (is_lazy_op_correct op). cases (is_lazy_op op).
+    run* red_expr_binary_op_lazy.
+     let_name. applys* red_expr_lazy_op_1. applys* red_spec_to_boolean.
+     case_if; subst; run_inv.
+       applys* red_expr_lazy_op_2_first.
+       run* red_expr_lazy_op_2_second.
+       applys* red_expr_lazy_op_2_second_1.
+    run* red_expr_binary_op.
+     run red_expr_binary_op_1.
+     applys* red_expr_binary_op_2.
+     inverts R as M. applys* run_binary_op_correct M.
+  (* conditionnal *)
+  unfolds in R.
+  run_pre. lets (y1&R2&K): if_spec_post_to_bool (rm R1) (rm R).
+   applys* red_expr_conditional (rm R2). run_post_if_spec_ter_post_bool K.
+  let_name. run red_expr_conditional_1. case_if in EQe; case_if*.
+  applys* red_expr_conditional_2.
+  (* assign *)
+  unfolds in R. run red_expr_assign. let_name. rename rv into rv1.
+  asserts follow_correct: (forall S0 S rv o, follow S rv = o ->
+     exists v, rv = resvalue_value v /\ red_expr S0 C (expr_assign_4 rv1 (ret S v)) o).
+    subst follow. clear R. introv HR.
+    destruct rv; tryfalse. exists v. split~.
+    run red_expr_assign_4_put_value.
+    applys* red_expr_assign_5_return.
+    clear EQfollow.
+  destruct o0.
+    run red_expr_assign_1_compound using ref_get_value_correct.
+      run red_expr_assign_2_compound_get_value.
+        run red_expr_assign_3_compound_op using run_binary_op_correct.
+        forwards (v&?&?): follow_correct (rm R). subst.
+        applys* red_expr_assign_3'.
+    run red_expr_assign_1_simple.
+    forwards (v&?&?): follow_correct (rm R). run_inv. auto*.
+Admitted. (*faster*)
+
+
+(* Hints for automatically applying "run_hyp" in obvious cases *)
+Hint Extern 1 (red_stat ?S ?C ?s ?o) =>
+  match goal with H: _ = result_some o |- _ => run_hyp H end.
+Hint Extern 1 (red_expr ?S ?C ?s ?o) =>
+  match goal with H: _ = result_some o |- _ => run_hyp H end.
+
+
+Lemma run_var_decl_item_correct : forall runs S C x eo o,
+  runs_type_correct runs ->
+  run_var_decl_item runs S C x eo = o ->
+  red_stat S C (stat_var_decl_item (x,eo)) o.
+Proof.
+  introv IH HR. unfolds in HR. destruct eo.
+  run red_stat_var_decl_item_some using identifier_resolution_correct.
+   run red_stat_var_decl_item_1. run red_stat_var_decl_item_2.
+   applys* red_stat_var_decl_item_3.
+  run_inv. applys* red_stat_var_decl_item_none.
+Admitted. (* faster *)
+
+Lemma run_var_decl_correct : forall runs S C ls o,
+  runs_type_correct runs ->
+  run_var_decl runs S C ls = o ->
+  red_stat S C (stat_var_decl ls) o.
+Proof.
+  introv IH. gen S. induction ls as [|[x eo]]; introv HR.
+  simpls. run_inv. applys* red_stat_var_decl_nil.
+  simpls. run red_stat_var_decl_cons using run_var_decl_item_correct.
+   applys* red_stat_var_decl_1.
+Admitted. (* faster *)
+
+
+Lemma run_elements_correct : forall runs S C str ls o,
+  runs_type_correct runs ->
+  run_elements runs S C ls = o ->
+  red_prog S C (prog_intro str (rev ls)) o.
+Proof.
+  introv IH HR. gen S C str o.
+  induction ls; introv HR; unfolds in HR; rew_list.
+  run_inv. applys* red_prog_nil.
+  run_pre. eauto. applys* red_prog_cons. run_post. clear R1.
+   (* run* red_prog_cons. ==> LATER: should work*)
+  destruct a.
+  run red_prog_1_stat. applys* red_prog_2.
+  run_inv. applys red_prog_1_funcdecl.
+Admitted. (*faster*)
+
+
+Lemma run_block_correct : forall runs S C ls o,
+  runs_type_correct runs ->
+  run_block runs S C ls = o ->
+  red_stat S C (stat_block (rev ls)) o.
+Proof.
+  introv IH HR. gen S C o.
+  induction ls; introv HR; unfolds in HR; rew_list.
+  run_inv. applys* red_stat_block_nil.
+  run_pre. eauto. applys* red_stat_block_cons.
+  run_post. clear R1.
+   (* run* red_stat_block_cons. ==> LATER: should work*)
+  run red_stat_block_1.
+  subst. applys* red_stat_block_2_throw.
+  subst. applys* red_stat_block_2_not_throw.
+  applys* red_stat_block_2_not_throw. simple*.
+   unfolds res_overwrite_value_if_empty. case_if; case_if*.
+Admitted. (*faster*)
+
+Lemma run_stat_switch_no_default_end_correct : forall runs S C rv scs o,
+  runs_type_correct runs ->
+  run_stat_switch_end runs S C rv scs = o ->
+  red_stat S C (stat_switch_nodefault_5 rv scs) o.
+Proof.
+  introv IH HR. gen S C rv o. induction scs; introv HR; unfolds in HR.
+   run_inv. apply~ red_stat_switch_nodefault_5_nil.
+   destruct a as [e ts]. run red_stat_switch_nodefault_5_cons.
+    forwards~ H: run_block_correct R1. rew_list~ in H.
+    substs. abort.
+    substs. tests: (res_is_normal R).
+     apply~ red_stat_switch_nodefault_6_abrupt.
+    apply~ red_stat_switch_nodefault_6_normal. apply* IHscs. repeat case_if*.
+Qed.
+
+Lemma run_stat_switch_no_default_correct : forall runs S C vi rv scs o,
+  runs_type_correct runs ->
+  run_stat_switch_no_default runs S C vi rv scs = o ->
+  red_stat S C (stat_switch_nodefault_1 vi rv scs) o.
+Proof.
+  introv IH HR. gen S C vi rv o. induction scs; introv HR; unfolds in HR.
+   run_inv. apply~ red_stat_switch_nodefault_1_nil.
+    apply~ red_stat_switch_nodefault_5_nil.
+   destruct a. run red_stat_switch_nodefault_1_cons. let_simpl.
+   apply~ red_stat_switch_nodefault_2. case_if.
+    run red_stat_switch_nodefault_3_true using run_block_correct. rew_list~ in R1.
+     apply~ red_stat_switch_nodefault_4.
+     applys~ run_stat_switch_no_default_end_correct HR.
+    apply~ red_stat_switch_nodefault_3_false.
+Qed.
+
+Lemma run_stat_switch_with_default_end_correct : forall runs S C rv scs o,
+  runs_type_correct runs ->
+  run_stat_switch_end runs S C rv scs = o ->
+  red_stat S C (stat_switch_default_7 rv scs) o.
+Proof.
+  introv IH HR. gen S C rv o. induction scs; introv HR; unfolds in HR.
+   run_inv. apply~ red_stat_switch_default_7_nil.
+   destruct a as [e ts]. run red_stat_switch_default_7_cons.
+    forwards~ H: run_block_correct R1. rew_list~ in H.
+    substs. abort.
+    substs. tests: (res_is_normal R).
+     apply~ red_stat_switch_default_8_abrupt.
+    apply~ red_stat_switch_default_8_normal. apply* IHscs. repeat case_if*.
+Qed.
+
+Lemma run_stat_switch_with_default_default_correct : forall runs S C vi rv ts scs o,
+  runs_type_correct runs ->
+  run_stat_switch_with_default_default runs S C ts scs = o ->
+  red_stat S C (stat_switch_default_5 vi rv ts scs) o.
+Proof.
+  introv IH HR. unfolds in HR. run red_stat_switch_default_5
+    using run_block_correct. rew_list~ in R1.
+  apply~ red_stat_switch_default_6.
+  applys~ run_stat_switch_with_default_end_correct HR.
+Qed.
+
+Lemma run_stat_switch_with_default_B_correct : forall runs S C vi rv ts scs o,
+  runs_type_correct runs ->
+  run_stat_switch_with_default_B runs S C vi rv ts scs = o ->
+  red_stat S C (stat_switch_default_B_1 vi rv ts scs) o.
+Proof.
+  introv IH HR. gen S C vi rv ts o. induction scs; introv HR; unfolds in HR.
+   apply~ red_stat_switch_default_B_1_nil.
+    applys~ run_stat_switch_with_default_default_correct HR.
+   destruct a. run red_stat_switch_default_B_1_cons. let_simpl.
+    apply~ red_stat_switch_default_B_2. case_if.
+    run red_stat_switch_default_B_3_true using run_block_correct. rew_list~ in R1.
+     apply~ red_stat_switch_default_B_4.
+     applys~ run_stat_switch_with_default_end_correct HR.
+    apply~ red_stat_switch_default_B_3_false.
+Qed.
+
+Lemma run_stat_switch_with_default_A_correct : forall runs S C found vi rv scs1 ts scs2 o,
+  runs_type_correct runs ->
+  run_stat_switch_with_default_A runs S C found vi rv scs1 ts scs2 = o ->
+  red_stat S C (stat_switch_default_A_1 found vi rv scs1 ts scs2) o.
+Proof.
+  introv IH HR. gen S C found vi rv ts scs2 o. induction scs1; introv HR; unfolds in HR.
+   case_if.
+    apply~ red_stat_switch_default_A_1_nil_true.
+     applys~ run_stat_switch_with_default_default_correct HR.
+    apply~ red_stat_switch_default_A_1_nil_false.
+     applys~ run_stat_switch_with_default_B_correct HR.
+   destruct a. let_name. asserts follow_correct: (forall S o,
+     follow S = res_out o ->
+     red_stat S C (stat_switch_default_A_4 rv vi l scs1 ts scs2) o).
+     clear HR. introv E. substs. run red_stat_switch_default_A_4
+       using run_block_correct. rew_list~ in R1. abort.
+      substs. applys~ red_stat_switch_default_A_5_abrupt.
+      apply~ red_stat_switch_default_A_5. apply~ IHscs1. repeat case_if~.
+    clear EQfollow. case_if.
+     apply~ red_stat_switch_default_A_1_cons_true.
+     run red_stat_switch_default_A_1_cons_false.
+     apply~ red_stat_switch_default_A_2. let_simpl. cases_if.
+      apply~ red_stat_switch_default_A_3_true.
+      apply~ red_stat_switch_default_A_3_false.
+Qed.
+
+Lemma run_stat_switch_correct : forall runs S C labs e sb o,
+  runs_type_correct runs ->
+  run_stat_switch runs S C labs e sb = o ->
+  red_stat S C (stat_switch labs e sb) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  run red_stat_switch. let_name. asserts follow_correct: (forall S C o1 o,
+      follow o1 = res_out o -> red_stat S C (stat_switch_2 o1 labs) o).
+    clear HR. introv HR. substs.
+    do 2 (run_pre; run_post; run_inv; substs); try solve [abort].
+     case_if; run_inv.
+      destruct R. simpls. substs. apply* red_stat_switch_2_break.
+      abort.
+     apply~ red_stat_switch_2_normal.
+     case_if; run_inv; tryfalse.
+      destruct R. simpls. substs. apply* red_stat_switch_2_break.
+  asserts follow_arg: (forall W o,
+    follow W = res_out o -> exists (o1 : out), W = o1).
+    clear HR follow_correct. introv R. substs.
+    do 2 (run_pre; run_post; run_inv; substs); tryfalse; auto*.
+  clear EQfollow. destruct sb.
+   forwards~ (o1&E): follow_arg HR.
+    applys~ red_stat_switch_1_nodefault o1.
+    applys~ run_stat_switch_no_default_correct E.
+    apply~ follow_correct. rewrite~ <- E.
+   forwards~ (o1&E): follow_arg HR.
+    applys~ red_stat_switch_1_default o1.
+    applys~ run_stat_switch_with_default_A_correct E.
+    apply~ follow_correct. rewrite~ <- E.
+Qed.
+
+Lemma run_stat_for_correct : forall runs S C labs eo1 eo2 eo3 t o,
+  runs_type_correct runs ->
+  run_stat_for runs S C labs eo1 eo2 eo3 t = o ->
+  red_stat S C (stat_for labs eo1 eo2 eo3 t) o.
+Proof.
+  introv IH R. unfolds in R. destruct eo1.
+   run red_stat_for_some. run_hyp.
+    apply~ red_stat_for_1.
+   run_hyp R. apply~ red_stat_for_none.
+Qed.
+
+Lemma run_stat_for_var_correct : forall runs S C labs ds eo2 eo3 t o,
+  runs_type_correct runs ->
+  run_stat_for_var runs S C labs ds eo2 eo3 t = o ->
+  red_stat S C (stat_for_var labs ds eo2 eo3 t) o.
+Proof.
+  introv IH R. unfolds in R.
+  run red_stat_for_var. run_hyp. apply~ red_stat_for_var_1.
+Qed.
+
+
+Lemma run_stat_correct : forall runs S C t o,
+  runs_type_correct runs ->
+  run_stat runs S C t = o ->
+  red_stat S C (stat_basic t) o.
+Proof.
+  introv RC R. unfolds in R.
+  destruct t as [ | | ls | ls | e t1 t2o | labs t e | labs e t | e t
+     | e | eo | labo | labo | t co fo | labs e1 e2 e3 t
+     | labs xeo1s e2 e3 t | labs e1 e2 e3 t | labs str eo e t | eo | ].
+  (* Expression *)
+  run red_stat_expr. apply red_stat_expr_1.
+  (* Label *)
+  unfolds in R. run red_stat_label.
+    tests HC: (res_is_normal R0).
+      inverts HC. run_inv. subst. applys* red_stat_label_1_normal.
+      subst. applys* red_stat_abort. intro M. inverts M. simpls. false.
+    case_if.
+      applys* red_stat_label_1_break_eq. destruct R0; simpls. fequal*.
+      applys* red_stat_abort. constructors. intro N. inverts N. false.
+       intro M. inverts M. simpls. false.
+      (* LATER: change interpreter to make it more faithful *)
+  (* Block *)
+  forwards* E: run_block_correct (rev ls). rew_list* in E.
+  (* Variable declaration *)
+  applys* run_var_decl_correct.
+  (* If *)
+  unfolds in R.
+  run_pre. lets (y1&R2&K): if_spec_post_to_bool (rm R1) (rm R).
+   applys* red_stat_if (rm R2). run_post_if_spec_ter_post_bool K.
+   case_if.
+     applys~ red_stat_if_1_true. apply~ RC.
+     destruct t2o.
+       applys~ red_stat_if_1_false.  apply~ RC.
+       run_inv. applys* red_stat_if_1_false_implicit.
+  (* Do-while *)
+  applys* red_stat_do_while. applys* runs_type_correct_stat_do_while.
+  (* While *)
+  apply~ red_stat_while. applys* runs_type_correct_stat_while.
+  (* With *)
+  unfolds in R.
+  run_pre. lets (y1&R2&K): if_spec_post_to_object (rm R1) (rm R).
+   applys* red_stat_with (rm R2). run_post_if_spec_ter_post_bool K.
+  let_name. let_name. destruct p as [lex' S3]. let_name.
+  subst lex. applys* red_stat_with_1. subst C'. run_inv. run_hyp*.
+  (* Throw *)
+  unfolds in R.
+  run red_stat_throw. applys* red_stat_throw_1.
+  (* Return *)
+  unfolds in R. destruct eo.
+    run red_stat_return_some. apply* red_stat_return_1.
+    inverts* R. applys red_stat_return_none.
+  (* Break *)
+  run_inv. applys* red_stat_break.
+  (* Continue *)
+  run_inv. applys* red_stat_continue.
+  (* Try *)
+  unfolds in R. let_name.
+  asserts finally_correct: (forall S (R:res),
+      finally S R = res_out o ->
+      red_stat S C (stat_try_4 R fo) o).
+    subst finally. clear R. introv HR.
+    destruct fo.
+      simpls. run red_stat_try_4_finally.
+       applys* red_stat_try_5_finally_result.
+      run_inv. applys* red_stat_try_4_no_finally.
+    clear EQfinally.
+  run red_stat_try. abort.
+    applys* red_stat_try_1_no_throw.
+    destruct co as [c|].
+      destruct c as [x t2]. let_name. let_name.
+       destruct p as [lex' S']. destruct lex'; tryfalse.
+       subst lex. run* red_stat_try_1_throw_catch
+        using env_record_create_set_mutable_binding_correct.
+       run red_stat_try_2_catch.
+        applys~ red_stat_try_3_catch_result finally_correct.
+      applys~ red_stat_try_1_throw_no_catch. applys~ finally_correct.
+      rewrite <- R. fequal. destruct R0; simpls; substs~.
+  (* For *)
+  apply* run_stat_for_correct.
+  (* For-var *)
+  apply* run_stat_for_var_correct.
+  (* For-in *)
+  discriminate.
+  (* For-in-var *)
+  discriminate.
+  (* Debugger *)
+  run_inv. apply red_stat_debugger.
+  (* switch *)
+  applys~ run_stat_switch_correct R.
+Admitted. (*faster*)
+
+Lemma run_prog_correct : forall runs S C p o,
+  runs_type_correct runs ->
+  run_prog runs S C p = o ->
+  red_prog S C (prog_basic p) o.
+Proof.
+  introv RC R. unfolds in R. destruct p.
+  forwards*: run_elements_correct (rev l). rew_list* in H.
+Admitted. (*faster*)
+
+(* LATER: generalize statement to handle continuations *)
+Lemma entering_func_code_correct : forall runs S C lf vthis args o,
+  runs_type_correct runs ->
+  entering_func_code runs S C lf vthis args = result_some (specret_out o) ->
+  red_expr S C (spec_entering_func_code lf vthis args (spec_call_default_1 lf)) o.
+Proof.
+  introv IH HR. unfolds in HR. sets_eq K: (spec_call_default_1 lf).
+  run. run. subst x. lets H: run_object_method_correct (rm E).
+  let_name. let_name as M. rename x0 into bd.
+  asserts M_correct: (forall S v o,
+      M S v = res_out o ->
+      red_expr S C (spec_entering_func_code_3 lf args str bd v K) o).
+    clears HR S o. introv HR. subst M.
+    run. run. subst x. lets H: run_object_method_correct (rm E).
+    let_name. destruct p as [lex' S1]. let_name.
+    run* (@red_spec_entering_func_code_3 lex' S1 C').
+    applys* red_spec_entering_func_code_4.
+    subst K. applys* run_call_default_correct.
+    clear EQM.
+  applys* red_spec_entering_func_code str.
+  case_if; subst str.
+    applys* red_spec_entering_func_code_1_strict.
+    destruct vthis.
+      destruct p. (* LATER: improve *)
+        applys* red_spec_entering_func_code_1_null_or_undef.
+        applys* red_spec_entering_func_code_1_null_or_undef.
+        run red_spec_entering_func_code_1_not_object.
+          simpls. splits; congruence.
+          applys* to_object_correct.
+          applys* red_spec_entering_func_code_2.
+        run red_spec_entering_func_code_1_not_object.
+          simpls. splits; congruence.
+          applys* to_object_correct.
+          applys* red_spec_entering_func_code_2.
+        run red_spec_entering_func_code_1_not_object.
+          simpls. splits; congruence.
+          applys* to_object_correct.
+          applys* red_spec_entering_func_code_2.
+      applys* red_spec_entering_func_code_1_object.
+Admitted. (* faster *)
+
+Lemma if_spec_throw_result : forall S K, if_spec (@throw_result descriptor (run_error S native_error_type)) K = @throw_result descriptor (run_error S native_error_type).
+Proof.
+  intros. repeat unfolds.
+  remember (run_error S native_error_type) as Error.
+  unfolds run_error. unfolds if_object.
+  unfolds if_value. unfolds if_success. unfolds if_ter.
+  unfolds if_out_some. unfolds if_result_some. unfolds build_error. 
+  cases_if*; rewrite decide_def in H; cases_if*; clear H.
+  remember (object_alloc S (object_new (prealloc_native_error_proto native_error_type) "Error")) as O.
+  destruct O as (l & S'). simpls.
+  unfolds if_empty_label.
+  cases_if*. subst. simpls. cases_if*.
+Qed.
+
+Lemma run_to_descriptor_correct : forall runs S C v y,
+  runs_type_correct runs ->
+  run_to_descriptor runs S C v = result_some y ->
+  red_spec S C (spec_to_descriptor v) y.
+Proof.
+  introv IH HR. unfold run_to_descriptor in HR.
+  destruct v as [p | l]. 
+
+  apply~ red_spec_to_descriptor_not_object.
+  applys* throw_result_run_error_correct.
+
+  applys* red_spec_to_descriptor_object.
+  run red_spec_to_descriptor_1a using object_has_prop_correct.
+  cases_if*; destruct b; inverts H.
+  + apply red_spec_to_descriptor_1b_false.
+    run red_spec_to_descriptor_2a using object_has_prop_correct.
+    cases_if*; destruct b; inverts H.
+    - apply red_spec_to_descriptor_2b_false.
+      run red_spec_to_descriptor_3a using object_has_prop_correct.
+      cases_if*; destruct b; inverts H.
+      * apply red_spec_to_descriptor_3b_false.
+        run red_spec_to_descriptor_4a using object_has_prop_correct.
+        { 
+          cases_if*; destruct b; inverts H.
+          + apply red_spec_to_descriptor_4b_false.
+            run red_spec_to_descriptor_5a using object_has_prop_correct.
+            cases_if*; destruct b; inverts H.
+            - apply red_spec_to_descriptor_5b_false.
+              run red_spec_to_descriptor_6a using object_has_prop_correct.
+              cases_if*; destruct b; inverts H.
+              * apply red_spec_to_descriptor_6b_false.
+                { 
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+              * run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                {
+                  cases_if*.
+                  rewrite if_spec_throw_result in *.
+                  applys* red_spec_to_descriptor_6c_error.
+                  applys* throw_result_run_error_correct.
+                  simpls. applys* red_spec_to_descriptor_6c_ok.
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+            - run red_spec_to_descriptor_5b_true using run_object_get_correct.
+              cases_if*.
+              * rewrite if_spec_throw_result in *.
+                applys* red_spec_to_descriptor_5c_error.
+                applys* throw_result_run_error_correct.
+              * simpls. applys* red_spec_to_descriptor_5c_ok.
+                run red_spec_to_descriptor_6a using object_has_prop_correct.
+                {
+                  cases_if*; destruct b; inverts H.
+                  + apply red_spec_to_descriptor_6b_false.
+                    cases_if*. 
+                    - applys~ red_spec_to_descriptor_7_error.
+                      applys* throw_result_run_error_correct.
+                    - unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                  + run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                    cases_if*.
+                    - rewrite if_spec_throw_result in *.
+                      applys* red_spec_to_descriptor_6c_error.
+                      applys* throw_result_run_error_correct.
+                    - simpls. applys* red_spec_to_descriptor_6c_ok.
+                      cases_if*. 
+                      * applys~ red_spec_to_descriptor_7_error.
+                        applys* throw_result_run_error_correct.
+                      * unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+          + run red_spec_to_descriptor_4b_true using run_object_get_correct.
+            simpls. applys* red_spec_to_descriptor_4c.
+            run red_spec_to_descriptor_5a using object_has_prop_correct.
+            cases_if*; destruct b; inverts H.
+            - apply red_spec_to_descriptor_5b_false.
+              run red_spec_to_descriptor_6a using object_has_prop_correct.
+              cases_if*; destruct b; inverts H.
+              * apply red_spec_to_descriptor_6b_false.
+                { 
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+              * run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                {
+                  cases_if*.
+                  rewrite if_spec_throw_result in *.
+                  applys* red_spec_to_descriptor_6c_error.
+                  applys* throw_result_run_error_correct.
+                  simpls. applys* red_spec_to_descriptor_6c_ok.
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+            - run red_spec_to_descriptor_5b_true using run_object_get_correct.
+              cases_if*.
+              * rewrite if_spec_throw_result in *.
+                applys* red_spec_to_descriptor_5c_error.
+                applys* throw_result_run_error_correct.
+              * simpls. applys* red_spec_to_descriptor_5c_ok.
+                run red_spec_to_descriptor_6a using object_has_prop_correct.
+                {
+                  cases_if*; destruct b; inverts H.
+                  + apply red_spec_to_descriptor_6b_false.
+                    cases_if*. 
+                    - applys~ red_spec_to_descriptor_7_error.
+                      applys* throw_result_run_error_correct.
+                    - unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                  + run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                    cases_if*.
+                    - rewrite if_spec_throw_result in *.
+                      applys* red_spec_to_descriptor_6c_error.
+                      applys* throw_result_run_error_correct.
+                    - simpls. applys* red_spec_to_descriptor_6c_ok.
+                      cases_if*. 
+                      * applys~ red_spec_to_descriptor_7_error.
+                        applys* throw_result_run_error_correct.
+                      * unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+        }
+      * run red_spec_to_descriptor_3b_true using run_object_get_correct.
+        simpls. applys* red_spec_to_descriptor_3c. 
+        run red_spec_to_descriptor_4a using object_has_prop_correct.
+        { 
+          cases_if*; destruct b; inverts H.
+          + apply red_spec_to_descriptor_4b_false.
+            run red_spec_to_descriptor_5a using object_has_prop_correct.
+            cases_if*; destruct b; inverts H.
+            - apply red_spec_to_descriptor_5b_false.
+              run red_spec_to_descriptor_6a using object_has_prop_correct.
+              cases_if*; destruct b; inverts H.
+              * apply red_spec_to_descriptor_6b_false.
+                { 
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+              * run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                {
+                  cases_if*.
+                  rewrite if_spec_throw_result in *.
+                  applys* red_spec_to_descriptor_6c_error.
+                  applys* throw_result_run_error_correct.
+                  simpls. applys* red_spec_to_descriptor_6c_ok.
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+            - run red_spec_to_descriptor_5b_true using run_object_get_correct.
+              cases_if*.
+              * rewrite if_spec_throw_result in *.
+                applys* red_spec_to_descriptor_5c_error.
+                applys* throw_result_run_error_correct.
+              * simpls. applys* red_spec_to_descriptor_5c_ok.
+                run red_spec_to_descriptor_6a using object_has_prop_correct.
+                {
+                  cases_if*; destruct b; inverts H.
+                  + apply red_spec_to_descriptor_6b_false.
+                    cases_if*. 
+                    - applys~ red_spec_to_descriptor_7_error.
+                      applys* throw_result_run_error_correct.
+                    - unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                  + run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                    cases_if*.
+                    - rewrite if_spec_throw_result in *.
+                      applys* red_spec_to_descriptor_6c_error.
+                      applys* throw_result_run_error_correct.
+                    - simpls. applys* red_spec_to_descriptor_6c_ok.
+                      cases_if*. 
+                      * applys~ red_spec_to_descriptor_7_error.
+                        applys* throw_result_run_error_correct.
+                      * unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+          + run red_spec_to_descriptor_4b_true using run_object_get_correct.
+            simpls. applys* red_spec_to_descriptor_4c.
+            run red_spec_to_descriptor_5a using object_has_prop_correct.
+            cases_if*; destruct b; inverts H.
+            - apply red_spec_to_descriptor_5b_false.
+              run red_spec_to_descriptor_6a using object_has_prop_correct.
+              cases_if*; destruct b; inverts H.
+              * apply red_spec_to_descriptor_6b_false.
+                { 
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+              * run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                {
+                  cases_if*.
+                  rewrite if_spec_throw_result in *.
+                  applys* red_spec_to_descriptor_6c_error.
+                  applys* throw_result_run_error_correct.
+                  simpls. applys* red_spec_to_descriptor_6c_ok.
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+            - run red_spec_to_descriptor_5b_true using run_object_get_correct.
+              cases_if*.
+              * rewrite if_spec_throw_result in *.
+                applys* red_spec_to_descriptor_5c_error.
+                applys* throw_result_run_error_correct.
+              * simpls. applys* red_spec_to_descriptor_5c_ok.
+                run red_spec_to_descriptor_6a using object_has_prop_correct.
+                {
+                  cases_if*; destruct b; inverts H.
+                  + apply red_spec_to_descriptor_6b_false.
+                    cases_if*. 
+                    - applys~ red_spec_to_descriptor_7_error.
+                      applys* throw_result_run_error_correct.
+                    - unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                  + run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                    cases_if*.
+                    - rewrite if_spec_throw_result in *.
+                      applys* red_spec_to_descriptor_6c_error.
+                      applys* throw_result_run_error_correct.
+                    - simpls. applys* red_spec_to_descriptor_6c_ok.
+                      cases_if*. 
+                      * applys~ red_spec_to_descriptor_7_error.
+                        applys* throw_result_run_error_correct.
+                      * unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+        }
+    - run red_spec_to_descriptor_2b_true using run_object_get_correct.
+      simpls. applys* red_spec_to_descriptor_2c.
+      run red_spec_to_descriptor_3a using object_has_prop_correct.
+      cases_if*; destruct b; inverts H.
+      * apply red_spec_to_descriptor_3b_false.
+        run red_spec_to_descriptor_4a using object_has_prop_correct.
+        { 
+          cases_if*; destruct b; inverts H.
+          + apply red_spec_to_descriptor_4b_false.
+            run red_spec_to_descriptor_5a using object_has_prop_correct.
+            cases_if*; destruct b; inverts H.
+            - apply red_spec_to_descriptor_5b_false.
+              run red_spec_to_descriptor_6a using object_has_prop_correct.
+              cases_if*; destruct b; inverts H.
+              * apply red_spec_to_descriptor_6b_false.
+                { 
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+              * run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                {
+                  cases_if*.
+                  rewrite if_spec_throw_result in *.
+                  applys* red_spec_to_descriptor_6c_error.
+                  applys* throw_result_run_error_correct.
+                  simpls. applys* red_spec_to_descriptor_6c_ok.
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+            - run red_spec_to_descriptor_5b_true using run_object_get_correct.
+              cases_if*.
+              * rewrite if_spec_throw_result in *.
+                applys* red_spec_to_descriptor_5c_error.
+                applys* throw_result_run_error_correct.
+              * simpls. applys* red_spec_to_descriptor_5c_ok.
+                run red_spec_to_descriptor_6a using object_has_prop_correct.
+                {
+                  cases_if*; destruct b; inverts H.
+                  + apply red_spec_to_descriptor_6b_false.
+                    cases_if*. 
+                    - applys~ red_spec_to_descriptor_7_error.
+                      applys* throw_result_run_error_correct.
+                    - unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                  + run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                    cases_if*.
+                    - rewrite if_spec_throw_result in *.
+                      applys* red_spec_to_descriptor_6c_error.
+                      applys* throw_result_run_error_correct.
+                    - simpls. applys* red_spec_to_descriptor_6c_ok.
+                      cases_if*. 
+                      * applys~ red_spec_to_descriptor_7_error.
+                        applys* throw_result_run_error_correct.
+                      * unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+          + run red_spec_to_descriptor_4b_true using run_object_get_correct.
+            simpls. applys* red_spec_to_descriptor_4c.
+            run red_spec_to_descriptor_5a using object_has_prop_correct.
+            cases_if*; destruct b; inverts H.
+            - apply red_spec_to_descriptor_5b_false.
+              run red_spec_to_descriptor_6a using object_has_prop_correct.
+              cases_if*; destruct b; inverts H.
+              * apply red_spec_to_descriptor_6b_false.
+                { 
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+              * run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                {
+                  cases_if*.
+                  rewrite if_spec_throw_result in *.
+                  applys* red_spec_to_descriptor_6c_error.
+                  applys* throw_result_run_error_correct.
+                  simpls. applys* red_spec_to_descriptor_6c_ok.
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+            - run red_spec_to_descriptor_5b_true using run_object_get_correct.
+              cases_if*.
+              * rewrite if_spec_throw_result in *.
+                applys* red_spec_to_descriptor_5c_error.
+                applys* throw_result_run_error_correct.
+              * simpls. applys* red_spec_to_descriptor_5c_ok.
+                run red_spec_to_descriptor_6a using object_has_prop_correct.
+                {
+                  cases_if*; destruct b; inverts H.
+                  + apply red_spec_to_descriptor_6b_false.
+                    cases_if*. 
+                    - applys~ red_spec_to_descriptor_7_error.
+                      applys* throw_result_run_error_correct.
+                    - unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                  + run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                    cases_if*.
+                    - rewrite if_spec_throw_result in *.
+                      applys* red_spec_to_descriptor_6c_error.
+                      applys* throw_result_run_error_correct.
+                    - simpls. applys* red_spec_to_descriptor_6c_ok.
+                      cases_if*. 
+                      * applys~ red_spec_to_descriptor_7_error.
+                        applys* throw_result_run_error_correct.
+                      * unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+        }
+      * run red_spec_to_descriptor_3b_true using run_object_get_correct.
+        simpls. applys* red_spec_to_descriptor_3c. 
+        run red_spec_to_descriptor_4a using object_has_prop_correct.
+        { 
+          cases_if*; destruct b; inverts H.
+          + apply red_spec_to_descriptor_4b_false.
+            run red_spec_to_descriptor_5a using object_has_prop_correct.
+            cases_if*; destruct b; inverts H.
+            - apply red_spec_to_descriptor_5b_false.
+              run red_spec_to_descriptor_6a using object_has_prop_correct.
+              cases_if*; destruct b; inverts H.
+              * apply red_spec_to_descriptor_6b_false.
+                { 
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+              * run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                {
+                  cases_if*.
+                  rewrite if_spec_throw_result in *.
+                  applys* red_spec_to_descriptor_6c_error.
+                  applys* throw_result_run_error_correct.
+                  simpls. applys* red_spec_to_descriptor_6c_ok.
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+            - run red_spec_to_descriptor_5b_true using run_object_get_correct.
+              cases_if*.
+              * rewrite if_spec_throw_result in *.
+                applys* red_spec_to_descriptor_5c_error.
+                applys* throw_result_run_error_correct.
+              * simpls. applys* red_spec_to_descriptor_5c_ok.
+                run red_spec_to_descriptor_6a using object_has_prop_correct.
+                {
+                  cases_if*; destruct b; inverts H.
+                  + apply red_spec_to_descriptor_6b_false.
+                    cases_if*. 
+                    - applys~ red_spec_to_descriptor_7_error.
+                      applys* throw_result_run_error_correct.
+                    - unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                  + run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                    cases_if*.
+                    - rewrite if_spec_throw_result in *.
+                      applys* red_spec_to_descriptor_6c_error.
+                      applys* throw_result_run_error_correct.
+                    - simpls. applys* red_spec_to_descriptor_6c_ok.
+                      cases_if*. 
+                      * applys~ red_spec_to_descriptor_7_error.
+                        applys* throw_result_run_error_correct.
+                      * unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+          + run red_spec_to_descriptor_4b_true using run_object_get_correct.
+            simpls. applys* red_spec_to_descriptor_4c.
+            run red_spec_to_descriptor_5a using object_has_prop_correct.
+            cases_if*; destruct b; inverts H.
+            - apply red_spec_to_descriptor_5b_false.
+              run red_spec_to_descriptor_6a using object_has_prop_correct.
+              cases_if*; destruct b; inverts H.
+              * apply red_spec_to_descriptor_6b_false.
+                { 
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+              * run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                {
+                  cases_if*.
+                  rewrite if_spec_throw_result in *.
+                  applys* red_spec_to_descriptor_6c_error.
+                  applys* throw_result_run_error_correct.
+                  simpls. applys* red_spec_to_descriptor_6c_ok.
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+            - run red_spec_to_descriptor_5b_true using run_object_get_correct.
+              cases_if*.
+              * rewrite if_spec_throw_result in *.
+                applys* red_spec_to_descriptor_5c_error.
+                applys* throw_result_run_error_correct.
+              * simpls. applys* red_spec_to_descriptor_5c_ok.
+                run red_spec_to_descriptor_6a using object_has_prop_correct.
+                {
+                  cases_if*; destruct b; inverts H.
+                  + apply red_spec_to_descriptor_6b_false.
+                    cases_if*. 
+                    - applys~ red_spec_to_descriptor_7_error.
+                      applys* throw_result_run_error_correct.
+                    - unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                  + run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                    cases_if*.
+                    - rewrite if_spec_throw_result in *.
+                      applys* red_spec_to_descriptor_6c_error.
+                      applys* throw_result_run_error_correct.
+                    - simpls. applys* red_spec_to_descriptor_6c_ok.
+                      cases_if*. 
+                      * applys~ red_spec_to_descriptor_7_error.
+                        applys* throw_result_run_error_correct.
+                      * unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+         }
+  + run red_spec_to_descriptor_1b_true using run_object_get_correct.
+    simpls. applys* red_spec_to_descriptor_1c.
+    run red_spec_to_descriptor_2a using object_has_prop_correct.
+    cases_if*; destruct b; inverts H.
+    - apply red_spec_to_descriptor_2b_false.
+      run red_spec_to_descriptor_3a using object_has_prop_correct.
+      cases_if*; destruct b; inverts H.
+      * apply red_spec_to_descriptor_3b_false.
+        run red_spec_to_descriptor_4a using object_has_prop_correct.
+        { 
+          cases_if*; destruct b; inverts H.
+          + apply red_spec_to_descriptor_4b_false.
+            run red_spec_to_descriptor_5a using object_has_prop_correct.
+            cases_if*; destruct b; inverts H.
+            - apply red_spec_to_descriptor_5b_false.
+              run red_spec_to_descriptor_6a using object_has_prop_correct.
+              cases_if*; destruct b; inverts H.
+              * apply red_spec_to_descriptor_6b_false.
+                { 
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+              * run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                {
+                  cases_if*.
+                  rewrite if_spec_throw_result in *.
+                  applys* red_spec_to_descriptor_6c_error.
+                  applys* throw_result_run_error_correct.
+                  simpls. applys* red_spec_to_descriptor_6c_ok.
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+            - run red_spec_to_descriptor_5b_true using run_object_get_correct.
+              cases_if*.
+              * rewrite if_spec_throw_result in *.
+                applys* red_spec_to_descriptor_5c_error.
+                applys* throw_result_run_error_correct.
+              * simpls. applys* red_spec_to_descriptor_5c_ok.
+                run red_spec_to_descriptor_6a using object_has_prop_correct.
+                {
+                  cases_if*; destruct b; inverts H.
+                  + apply red_spec_to_descriptor_6b_false.
+                    cases_if*. 
+                    - applys~ red_spec_to_descriptor_7_error.
+                      applys* throw_result_run_error_correct.
+                    - unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                  + run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                    cases_if*.
+                    - rewrite if_spec_throw_result in *.
+                      applys* red_spec_to_descriptor_6c_error.
+                      applys* throw_result_run_error_correct.
+                    - simpls. applys* red_spec_to_descriptor_6c_ok.
+                      cases_if*. 
+                      * applys~ red_spec_to_descriptor_7_error.
+                        applys* throw_result_run_error_correct.
+                      * unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+          + run red_spec_to_descriptor_4b_true using run_object_get_correct.
+            simpls. applys* red_spec_to_descriptor_4c.
+            run red_spec_to_descriptor_5a using object_has_prop_correct.
+            cases_if*; destruct b; inverts H.
+            - apply red_spec_to_descriptor_5b_false.
+              run red_spec_to_descriptor_6a using object_has_prop_correct.
+              cases_if*; destruct b; inverts H.
+              * apply red_spec_to_descriptor_6b_false.
+                { 
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+              * run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                {
+                  cases_if*.
+                  rewrite if_spec_throw_result in *.
+                  applys* red_spec_to_descriptor_6c_error.
+                  applys* throw_result_run_error_correct.
+                  simpls. applys* red_spec_to_descriptor_6c_ok.
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+            - run red_spec_to_descriptor_5b_true using run_object_get_correct.
+              cases_if*.
+              * rewrite if_spec_throw_result in *.
+                applys* red_spec_to_descriptor_5c_error.
+                applys* throw_result_run_error_correct.
+              * simpls. applys* red_spec_to_descriptor_5c_ok.
+                run red_spec_to_descriptor_6a using object_has_prop_correct.
+                {
+                  cases_if*; destruct b; inverts H.
+                  + apply red_spec_to_descriptor_6b_false.
+                    cases_if*. 
+                    - applys~ red_spec_to_descriptor_7_error.
+                      applys* throw_result_run_error_correct.
+                    - unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                  + run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                    cases_if*.
+                    - rewrite if_spec_throw_result in *.
+                      applys* red_spec_to_descriptor_6c_error.
+                      applys* throw_result_run_error_correct.
+                    - simpls. applys* red_spec_to_descriptor_6c_ok.
+                      cases_if*. 
+                      * applys~ red_spec_to_descriptor_7_error.
+                        applys* throw_result_run_error_correct.
+                      * unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+        }
+      * run red_spec_to_descriptor_3b_true using run_object_get_correct.
+        simpls. applys* red_spec_to_descriptor_3c. 
+        run red_spec_to_descriptor_4a using object_has_prop_correct.
+        { 
+          cases_if*; destruct b; inverts H.
+          + apply red_spec_to_descriptor_4b_false.
+            run red_spec_to_descriptor_5a using object_has_prop_correct.
+            cases_if*; destruct b; inverts H.
+            - apply red_spec_to_descriptor_5b_false.
+              run red_spec_to_descriptor_6a using object_has_prop_correct.
+              cases_if*; destruct b; inverts H.
+              * apply red_spec_to_descriptor_6b_false.
+                { 
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+              * run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                {
+                  cases_if*.
+                  rewrite if_spec_throw_result in *.
+                  applys* red_spec_to_descriptor_6c_error.
+                  applys* throw_result_run_error_correct.
+                  simpls. applys* red_spec_to_descriptor_6c_ok.
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+            - run red_spec_to_descriptor_5b_true using run_object_get_correct.
+              cases_if*.
+              * rewrite if_spec_throw_result in *.
+                applys* red_spec_to_descriptor_5c_error.
+                applys* throw_result_run_error_correct.
+              * simpls. applys* red_spec_to_descriptor_5c_ok.
+                run red_spec_to_descriptor_6a using object_has_prop_correct.
+                {
+                  cases_if*; destruct b; inverts H.
+                  + apply red_spec_to_descriptor_6b_false.
+                    cases_if*. 
+                    - applys~ red_spec_to_descriptor_7_error.
+                      applys* throw_result_run_error_correct.
+                    - unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                  + run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                    cases_if*.
+                    - rewrite if_spec_throw_result in *.
+                      applys* red_spec_to_descriptor_6c_error.
+                      applys* throw_result_run_error_correct.
+                    - simpls. applys* red_spec_to_descriptor_6c_ok.
+                      cases_if*. 
+                      * applys~ red_spec_to_descriptor_7_error.
+                        applys* throw_result_run_error_correct.
+                      * unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+          + run red_spec_to_descriptor_4b_true using run_object_get_correct.
+            simpls. applys* red_spec_to_descriptor_4c.
+            run red_spec_to_descriptor_5a using object_has_prop_correct.
+            cases_if*; destruct b; inverts H.
+            - apply red_spec_to_descriptor_5b_false.
+              run red_spec_to_descriptor_6a using object_has_prop_correct.
+              cases_if*; destruct b; inverts H.
+              * apply red_spec_to_descriptor_6b_false.
+                { 
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+              * run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                {
+                  cases_if*.
+                  rewrite if_spec_throw_result in *.
+                  applys* red_spec_to_descriptor_6c_error.
+                  applys* throw_result_run_error_correct.
+                  simpls. applys* red_spec_to_descriptor_6c_ok.
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+            - run red_spec_to_descriptor_5b_true using run_object_get_correct.
+              cases_if*.
+              * rewrite if_spec_throw_result in *.
+                applys* red_spec_to_descriptor_5c_error.
+                applys* throw_result_run_error_correct.
+              * simpls. applys* red_spec_to_descriptor_5c_ok.
+                run red_spec_to_descriptor_6a using object_has_prop_correct.
+                {
+                  cases_if*; destruct b; inverts H.
+                  + apply red_spec_to_descriptor_6b_false.
+                    cases_if*. 
+                    - applys~ red_spec_to_descriptor_7_error.
+                      applys* throw_result_run_error_correct.
+                    - unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                  + run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                    cases_if*.
+                    - rewrite if_spec_throw_result in *.
+                      applys* red_spec_to_descriptor_6c_error.
+                      applys* throw_result_run_error_correct.
+                    - simpls. applys* red_spec_to_descriptor_6c_ok.
+                      cases_if*. 
+                      * applys~ red_spec_to_descriptor_7_error.
+                        applys* throw_result_run_error_correct.
+                      * unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+        }
+    - run red_spec_to_descriptor_2b_true using run_object_get_correct.
+      simpls. applys* red_spec_to_descriptor_2c.
+      run red_spec_to_descriptor_3a using object_has_prop_correct.
+      cases_if*; destruct b; inverts H.
+      * apply red_spec_to_descriptor_3b_false.
+        run red_spec_to_descriptor_4a using object_has_prop_correct.
+        { 
+          cases_if*; destruct b; inverts H.
+          + apply red_spec_to_descriptor_4b_false.
+            run red_spec_to_descriptor_5a using object_has_prop_correct.
+            cases_if*; destruct b; inverts H.
+            - apply red_spec_to_descriptor_5b_false.
+              run red_spec_to_descriptor_6a using object_has_prop_correct.
+              cases_if*; destruct b; inverts H.
+              * apply red_spec_to_descriptor_6b_false.
+                { 
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+              * run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                {
+                  cases_if*.
+                  rewrite if_spec_throw_result in *.
+                  applys* red_spec_to_descriptor_6c_error.
+                  applys* throw_result_run_error_correct.
+                  simpls. applys* red_spec_to_descriptor_6c_ok.
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+            - run red_spec_to_descriptor_5b_true using run_object_get_correct.
+              cases_if*.
+              * rewrite if_spec_throw_result in *.
+                applys* red_spec_to_descriptor_5c_error.
+                applys* throw_result_run_error_correct.
+              * simpls. applys* red_spec_to_descriptor_5c_ok.
+                run red_spec_to_descriptor_6a using object_has_prop_correct.
+                {
+                  cases_if*; destruct b; inverts H.
+                  + apply red_spec_to_descriptor_6b_false.
+                    cases_if*. 
+                    - applys~ red_spec_to_descriptor_7_error.
+                      applys* throw_result_run_error_correct.
+                    - unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                  + run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                    cases_if*.
+                    - rewrite if_spec_throw_result in *.
+                      applys* red_spec_to_descriptor_6c_error.
+                      applys* throw_result_run_error_correct.
+                    - simpls. applys* red_spec_to_descriptor_6c_ok.
+                      cases_if*. 
+                      * applys~ red_spec_to_descriptor_7_error.
+                        applys* throw_result_run_error_correct.
+                      * unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+          + run red_spec_to_descriptor_4b_true using run_object_get_correct.
+            simpls. applys* red_spec_to_descriptor_4c.
+            run red_spec_to_descriptor_5a using object_has_prop_correct.
+            cases_if*; destruct b; inverts H.
+            - apply red_spec_to_descriptor_5b_false.
+              run red_spec_to_descriptor_6a using object_has_prop_correct.
+              cases_if*; destruct b; inverts H.
+              * apply red_spec_to_descriptor_6b_false.
+                { 
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+              * run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                {
+                  cases_if*.
+                  rewrite if_spec_throw_result in *.
+                  applys* red_spec_to_descriptor_6c_error.
+                  applys* throw_result_run_error_correct.
+                  simpls. applys* red_spec_to_descriptor_6c_ok.
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+            - run red_spec_to_descriptor_5b_true using run_object_get_correct.
+              cases_if*.
+              * rewrite if_spec_throw_result in *.
+                applys* red_spec_to_descriptor_5c_error.
+                applys* throw_result_run_error_correct.
+              * simpls. applys* red_spec_to_descriptor_5c_ok.
+                run red_spec_to_descriptor_6a using object_has_prop_correct.
+                {
+                  cases_if*; destruct b; inverts H.
+                  + apply red_spec_to_descriptor_6b_false.
+                    cases_if*. 
+                    - applys~ red_spec_to_descriptor_7_error.
+                      applys* throw_result_run_error_correct.
+                    - unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                  + run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                    cases_if*.
+                    - rewrite if_spec_throw_result in *.
+                      applys* red_spec_to_descriptor_6c_error.
+                      applys* throw_result_run_error_correct.
+                    - simpls. applys* red_spec_to_descriptor_6c_ok.
+                      cases_if*. 
+                      * applys~ red_spec_to_descriptor_7_error.
+                        applys* throw_result_run_error_correct.
+                      * unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+        }
+      * run red_spec_to_descriptor_3b_true using run_object_get_correct.
+        simpls. applys* red_spec_to_descriptor_3c. 
+        run red_spec_to_descriptor_4a using object_has_prop_correct.
+        { 
+          cases_if*; destruct b; inverts H.
+          + apply red_spec_to_descriptor_4b_false.
+            run red_spec_to_descriptor_5a using object_has_prop_correct.
+            cases_if*; destruct b; inverts H.
+            - apply red_spec_to_descriptor_5b_false.
+              run red_spec_to_descriptor_6a using object_has_prop_correct.
+              cases_if*; destruct b; inverts H.
+              * apply red_spec_to_descriptor_6b_false.
+                { 
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+              * run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                {
+                  cases_if*.
+                  rewrite if_spec_throw_result in *.
+                  applys* red_spec_to_descriptor_6c_error.
+                  applys* throw_result_run_error_correct.
+                  simpls. applys* red_spec_to_descriptor_6c_ok.
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+            - run red_spec_to_descriptor_5b_true using run_object_get_correct.
+              cases_if*.
+              * rewrite if_spec_throw_result in *.
+                applys* red_spec_to_descriptor_5c_error.
+                applys* throw_result_run_error_correct.
+              * simpls. applys* red_spec_to_descriptor_5c_ok.
+                run red_spec_to_descriptor_6a using object_has_prop_correct.
+                {
+                  cases_if*; destruct b; inverts H.
+                  + apply red_spec_to_descriptor_6b_false.
+                    cases_if*. 
+                    - applys~ red_spec_to_descriptor_7_error.
+                      applys* throw_result_run_error_correct.
+                    - unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                  + run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                    cases_if*.
+                    - rewrite if_spec_throw_result in *.
+                      applys* red_spec_to_descriptor_6c_error.
+                      applys* throw_result_run_error_correct.
+                    - simpls. applys* red_spec_to_descriptor_6c_ok.
+                      cases_if*. 
+                      * applys~ red_spec_to_descriptor_7_error.
+                        applys* throw_result_run_error_correct.
+                      * unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+          + run red_spec_to_descriptor_4b_true using run_object_get_correct.
+            simpls. applys* red_spec_to_descriptor_4c.
+            run red_spec_to_descriptor_5a using object_has_prop_correct.
+            cases_if*; destruct b; inverts H.
+            - apply red_spec_to_descriptor_5b_false.
+              run red_spec_to_descriptor_6a using object_has_prop_correct.
+              cases_if*; destruct b; inverts H.
+              * apply red_spec_to_descriptor_6b_false.
+                { 
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+              * run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                {
+                  cases_if*.
+                  rewrite if_spec_throw_result in *.
+                  applys* red_spec_to_descriptor_6c_error.
+                  applys* throw_result_run_error_correct.
+                  simpls. applys* red_spec_to_descriptor_6c_ok.
+                  cases_if*. 
+                  + applys~ red_spec_to_descriptor_7_error.
+                    applys* throw_result_run_error_correct.
+                  + unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+            - run red_spec_to_descriptor_5b_true using run_object_get_correct.
+              cases_if*.
+              * rewrite if_spec_throw_result in *.
+                applys* red_spec_to_descriptor_5c_error.
+                applys* throw_result_run_error_correct.
+              * simpls. applys* red_spec_to_descriptor_5c_ok.
+                run red_spec_to_descriptor_6a using object_has_prop_correct.
+                {
+                  cases_if*; destruct b; inverts H.
+                  + apply red_spec_to_descriptor_6b_false.
+                    cases_if*. 
+                    - applys~ red_spec_to_descriptor_7_error.
+                      applys* throw_result_run_error_correct.
+                    - unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                  + run red_spec_to_descriptor_6b_true using run_object_get_correct.
+                    cases_if*.
+                    - rewrite if_spec_throw_result in *.
+                      applys* red_spec_to_descriptor_6c_error.
+                      applys* throw_result_run_error_correct.
+                    - simpls. applys* red_spec_to_descriptor_6c_ok.
+                      cases_if*. 
+                      * applys~ red_spec_to_descriptor_7_error.
+                        applys* throw_result_run_error_correct.
+                      * unfolds in HR. inverts HR. applys~ red_spec_to_descriptor_7_ok. 
+                }
+         }
+Admitted. (* Faster *)
+
+
+Lemma run_object_freeze_correct : forall runs S C l xs o,
+  runs_type_correct runs ->
+  run_object_freeze runs S C l xs = result_some (specret_out o) ->
+  red_expr S C (spec_call_object_freeze_2 l xs) o.
+Proof.
+  introv IH HR. gen S. induction xs; introv HR; unfolds in HR.
+   run. apply~ red_spec_call_object_freeze_2_nil.
+    apply~ run_object_heap_set_extensible_correct.
+   run red_spec_call_object_freeze_2_cons.
+    destruct a0 as [|A]; tryfalse.
+    applys~ red_spec_call_object_freeze_3.
+    run red_spec_call_object_freeze_4.
+     clear. rew_refl. destruct A as [()|()]; simpls; repeat cases_if;
+       simpls; fold_bool; rew_refl in *; intuit; tryfalse; repeat (fequals); tryfalse*.
+     applys~ red_spec_call_object_freeze_5.
+Qed.
+
+Lemma run_object_is_sealed_correct : forall runs S C l xs o,
+  runs_type_correct runs ->
+  run_object_is_sealed runs S C l xs = result_some (specret_out o) ->
+  red_expr S C (spec_call_object_is_sealed_2 l xs) o.
+Proof.
+  introv IH HR. gen S. induction xs; introv HR; unfolds in HR.
+   run. apply~ red_spec_call_object_is_sealed_2_nil.
+    apply~ run_object_method_correct.
+   run red_spec_call_object_is_sealed_2_cons.
+    destruct a0 as [|A]; tryfalse. cases_if as CF.
+     inverts HR. applys~ red_spec_call_object_is_sealed_3_prop_configurable.
+     applys~ red_spec_call_object_is_sealed_3_prop_not_configurable.
+Qed.
+
+Lemma run_object_is_frozen_correct : forall runs S C l xs o,
+  runs_type_correct runs ->
+  run_object_is_frozen runs S C l xs = result_some (specret_out o) ->
+  red_expr S C (spec_call_object_is_frozen_2 l xs) o.
+Proof.
+  introv IH HR. gen S o. induction xs; introv HR; unfolds in HR.
+   run. apply~ red_spec_call_object_is_frozen_2_nil.
+    apply~ run_object_method_correct.
+   run red_spec_call_object_is_frozen_2_cons. let_name.
+   asserts CC: (forall A o, check_configurable A = result_some (specret_out o) ->
+       red_expr S1 C (spec_call_object_is_frozen_5 l xs A) o).
+     rewrite EQcheck_configurable. clear - IHxs. introv HR. cases_if as AC.
+      inverts HR. apply~ red_spec_call_object_is_frozen_5_prop_configurable.
+      apply~ red_spec_call_object_is_frozen_5_prop_not_configurable.
+    clear EQcheck_configurable. destruct a0 as [|[Ad|Aa]].
+     discriminate.
+     apply red_spec_call_object_is_frozen_3_desc_is_data; simpls~. cases_if as W.
+      inverts HR. applys~ red_spec_call_object_is_frozen_4_prop_is_writable.
+      apply~ red_spec_call_object_is_frozen_4_prop_is_not_writable.
+      apply~ red_spec_call_object_is_frozen_3_desc_is_not_data.
+Qed.
+
+Lemma run_object_seal_correct : forall runs S C l xs o,
+  runs_type_correct runs ->
+  run_object_seal runs S C l xs = result_some (specret_out o) ->
+  red_expr S C (spec_call_object_seal_2 l xs) o.
+Proof.
+  introv IH HR. gen o S. induction xs; introv HR; unfolds in HR.
+   run. apply~ red_spec_call_object_seal_2_nil.
+    apply~ run_object_heap_set_extensible_correct.
+   run red_spec_call_object_seal_2_cons.
+    destruct a0 as [|A]; tryfalse.
+    run red_spec_call_object_seal_3.
+      clear. repeat cases_if~. destruct~ A as [()|()].
+    applys~ red_spec_call_object_seal_4.
+Qed.
+
+Lemma run_function_proto_apply_get_args_correct : forall runs S C array (index n : int) y,
+  runs_type_correct runs ->
+  run_get_args_for_apply runs S C array index n = result_some y ->
+  red_spec S C (spec_function_proto_apply_get_args array index n) y.
+Proof.
+  introv IH HR; unfolds run_get_args_for_apply. cases_if*.
+  + run~ red_spec_function_apply_get_args_true.
+    run red_spec_function_apply_get_args_1 using run_object_get_correct.
+    let_name; subst.
+    run red_spec_function_apply_get_args_2 using runs_type_correct_get_args_for_apply.
+    apply red_spec_function_apply_get_args_3.
+  + inverts HR. applys~ red_spec_function_apply_get_args_false.
+Qed.
+
+Lemma push_correct : forall S S' C l args a o runs,
+  runs_type_correct runs ->
+  push runs S' C l args a = result_some (specret_out o) ->
+  red_expr S C (spec_call_array_proto_push_3 l args (specret_val S' a)) o.
+Proof.
+  introv IH HR. 
+  apply red_spec_call_array_proto_push_3. 
+  gen a o S S' C l runs. inductions args; intros.
+  + simpls; let_name; subst. 
+    apply red_spec_call_array_proto_push_4_empty.
+    run red_spec_call_array_proto_push_5.
+    apply red_spec_call_array_proto_push_6.
+  + unfold push in HR. unfolds let_binding. (* Why doesn't let_name work here? *)
+    apply red_spec_call_array_proto_push_4_nonempty. 
+    run red_spec_call_array_proto_push_4_nonempty_1. 
+    run red_spec_call_array_proto_push_4_nonempty_2. 
+    apply red_spec_call_array_proto_push_4_nonempty_3. 
+    applys* IHargs.
+Qed.
+
+Lemma vtsfj_correct : forall runs S C l index sR,
+  runs_type_correct runs ->
+  valueToStringForJoin runs S C l index = result_some sR ->
+  red_spec S C (spec_call_array_proto_join_vtsfj l index) sR.
+Proof.
+  introv IH HR. unfolds in HR.
+  run red_spec_call_array_proto_join_vtsfj. 
+  run red_spec_call_array_proto_join_vtsfj_1 using run_object_get_correct.
+  destruct v as [p | loc].
+  + destruct p; try solve [inverts HR; applys* red_spec_call_array_proto_join_vtsfj_2_undef_null];
+    run* red_spec_call_array_proto_join_vtsfj_2_other; try solve [intuition; inverts H0]; 
+    applys* red_spec_call_array_proto_join_vtsfj_3.
+  + run* red_spec_call_array_proto_join_vtsfj_2_other; try solve [intuition; inverts H0]; 
+    applys* red_spec_call_array_proto_join_vtsfj_3.
+Qed.
+
+Lemma run_array_join_elements_correct : forall runs S C l k length sep sR o,
+  runs_type_correct runs -> 
+  run_array_join_elements runs S C l k length sep sR = o ->
+  red_expr S C (spec_call_array_proto_join_elements l k length sep sR) o.
+Proof.
+  introv IH HR. unfolds in HR. cases_if*.
+  + repeat let_name; subst.
+    applys* red_spec_call_array_proto_join_elements_continue.
+    run* red_spec_call_array_proto_join_elements_1 using vtsfj_correct. 
+    let_name; subst.
+    apply red_spec_call_array_proto_join_elements_2.
+    applys* runs_type_correct_array_join_elements.
+  + inverts HR. applys* red_spec_call_array_proto_join_elements_exit.
+Qed.
+
+Lemma run_call_prealloc_correct : forall runs S C B vthis args o,
+  runs_type_correct runs ->
+  run_call_prealloc runs S C B vthis args = o ->
+  red_expr S C (spec_call_prealloc B vthis args) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  destruct B.
+  (* prealloc_global *)
+  discriminate.
+  (* prealloc_global_eval *)
+  discriminate.
+  (* prealloc_global_parse_int *)
+  discriminate.
+  (* prealloc_global_parse_float *)
+  discriminate.
+  (* prealloc_global_is_finite *)
+  let_name. run red_spec_call_global_is_finite.
+    substs. apply~ get_arg_correct_0.
+  applys red_spec_call_global_is_finite_1.
+  cases_if; fold_bool; rew_refl~.
+  (* prealloc_global_is_nan *)
+  let_name. run red_spec_call_global_is_nan.
+    substs. apply~ get_arg_correct_0.
+  applys red_spec_call_global_is_nan_1.
+  cases_if; fold_bool; rew_refl~.
+  (* prealloc_global_decode_uri *)
+  discriminate.
+  (* prealloc_global_decode_uri_component *)
+  discriminate.
+  (* prealloc_global_encode_uri *)
+  discriminate.
+  (* prealloc_global_encode_uri_component *)
+  discriminate.
+  (* prealloc_object *)
+  let_name. subst.
+  applys* red_spec_call_object_call.
+    applys* get_arg_correct_0.
+  destruct (get_arg 0 args) as [p | l].
+  destruct p.
+  applys* red_spec_call_object_call_1_null_or_undef.
+  apply run_construct_prealloc_correct in HR; auto.  
+  applys* red_spec_call_object_call_1_null_or_undef.
+  apply run_construct_prealloc_correct in HR; auto.  
+  applys* red_spec_call_object_call_1_other.
+  splits; discriminate.
+  applys~ to_object_correct.
+  applys* red_spec_call_object_call_1_other.
+  splits; discriminate.
+  applys~ to_object_correct.
+  applys* red_spec_call_object_call_1_other.
+  splits; discriminate.
+  applys~ to_object_correct.
+  applys* red_spec_call_object_call_1_other.
+  splits; discriminate.
+  applys~ to_object_correct.  
+  (* prealloc_object_get_proto_of *)
+  let_name. apply~ red_spec_call_object_get_proto_of.
+    substs. apply* get_arg_correct_0.
+  rewrite <- EQv in *. destruct v.
+   apply red_spec_call_object_get_proto_of_1_not_object.
+    apply* run_error_correct.
+   run. apply~ red_spec_call_object_get_proto_of_1_object.
+    apply* run_object_method_correct.
+  (* prealloc_object_get_own_prop_descriptor *)
+  let_name. apply~ red_spec_call_object_get_own_prop_descriptor.
+    apply* get_arg_correct_1.
+  rewrite <- EQv in *. destruct v.
+   apply red_spec_call_object_get_own_prop_descriptor_1_not_object.
+     destruct p; discriminate.
+    apply* run_error_correct.
+   run red_spec_call_object_get_own_prop_descriptor_1_object.
+    run red_spec_call_object_get_own_prop_descriptor_2.
+    apply* from_prop_descriptor_correct.
+  (* prealloc_object_get_own_prop_name *)
+  discriminate.
+  (* prealloc_object_create *)
+  discriminate.
+  (* prealloc_object_define_prop *)
+  let_name. let_name. let_name.
+  apply~ red_spec_call_object_object_define_prop.
+    apply* get_arg_correct_2.
+  rewrite <- EQo0 in *. rewrite <- EQp in *. rewrite <- EQattr in *.
+  destruct o0.
+   apply red_spec_call_object_object_define_prop_1_not_object.
+     destruct p0; discriminate.
+    apply* run_error_correct.
+   run red_spec_call_object_object_define_prop_1_object.
+    run red_spec_call_object_object_define_prop_2.
+      apply* run_to_descriptor_correct.
+    run red_spec_call_object_object_define_prop_3.
+    apply* red_spec_call_object_object_define_prop_4.
+  (* prealloc_object_define_props *)
+  discriminate.
+  (* prealloc_object_seal *)
+  let_name. apply~ red_spec_call_object_seal.
+    apply* get_arg_correct_0.
+  rewrite <- EQv in *. destruct v.
+   apply red_spec_call_object_seal_1_not_object.
+     destruct p; discriminate.
+    apply* run_error_correct.
+   run. forwards~ B: @pick_option_correct E.
+    applys~ red_spec_call_object_seal_1_object B.
+    applys~ run_object_seal_correct HR.
+  (* prealloc_object_freeze *)
+  let_name. apply~ red_spec_call_object_freeze.
+    apply* get_arg_correct_0.
+  rewrite <- EQv in *. destruct v.
+   apply red_spec_call_object_freeze_1_not_object.
+     destruct p; discriminate.
+    apply* run_error_correct.
+   run. forwards~ B: @pick_option_correct E.
+    applys~ red_spec_call_object_freeze_1_object B.
+    applys~ run_object_freeze_correct HR.
+  (* prealloc_object_prevent_extensions *)
+  let_name. apply~ red_spec_call_object_prevent_extensions.
+    apply* get_arg_correct_0.
+  rewrite <- EQv in *. destruct v.
+   apply red_spec_call_object_prevent_extensions_not_object.
+     destruct p; discriminate.
+    apply* run_error_correct.
+   run. forwards~ B: @pick_option_correct E.
+    applys~ red_spec_call_object_prevent_extensions_object B.
+  (* prealloc_object_is_sealed *)
+  let_name. apply~ red_spec_call_object_is_sealed.
+    apply* get_arg_correct_0.
+  rewrite <- EQv in *. destruct v.
+   apply red_spec_call_object_is_sealed_1_not_object.
+     destruct p; discriminate.
+    apply* run_error_correct.
+   run. forwards~ B: @pick_option_correct E.
+    applys~ red_spec_call_object_is_sealed_1_object B.
+    applys~ run_object_is_sealed_correct HR.
+  (* prealloc_object_is_frozen *)
+  let_name. apply~ red_spec_call_object_is_frozen.
+    apply* get_arg_correct_0.
+  rewrite <- EQv in *. destruct v.
+   apply red_spec_call_object_is_frozen_1_not_object.
+     destruct p; discriminate.
+    apply* run_error_correct.
+   run. forwards~ B: @pick_option_correct E.
+    applys~ red_spec_call_object_is_frozen_1_object B.
+    applys~ run_object_is_frozen_correct HR.
+  (* prealloc_object_is_extensible *)
+  let_name. apply~ red_spec_call_object_is_extensible.
+    apply* get_arg_correct_0.
+  rewrite <- EQv in *. destruct v.
+   apply red_spec_call_object_is_extensible_1_not_object.
+     destruct p; discriminate.
+    apply* run_error_correct.
+   run. apply~ red_spec_call_object_is_extensible_1_object.
+    apply~ run_object_method_correct.
+  (* prealloc_object_keys *)
+  discriminate.
+  (* prealloc_object_keys_call *)
+  discriminate.
+  (* prealloc_object_proto *)
+  discriminate.
+  (* prealloc_object_proto_to_string *)
+  apply red_spec_call_object_proto_to_string.
+  destruct vthis as [p | l]; [destruct p | ].
+  inverts HR. apply red_spec_call_object_proto_to_string_1_undef.
+  inverts HR. apply red_spec_call_object_proto_to_string_1_null.
+  run red_spec_call_object_proto_to_string_1_other using to_object_correct. rew_logic; splits; discriminate.
+  run. apply run_object_method_correct in E.
+  applys* red_spec_call_object_proto_to_string_2.
+  run red_spec_call_object_proto_to_string_1_other using to_object_correct. rew_logic; splits; discriminate.
+  run. apply run_object_method_correct in E.
+  applys* red_spec_call_object_proto_to_string_2.
+  run red_spec_call_object_proto_to_string_1_other using to_object_correct. rew_logic; splits; discriminate.
+  run. apply run_object_method_correct in E.
+  applys* red_spec_call_object_proto_to_string_2.
+  run red_spec_call_object_proto_to_string_1_other using to_object_correct. rew_logic. splits; discriminate.
+  run. apply run_object_method_correct in E.
+  applys* red_spec_call_object_proto_to_string_2.
+  (* prealloc_object_proto_value_of *)
+  apply~ red_spec_call_object_proto_value_of.
+  apply~ to_object_correct.
+  (* prealloc_object_proto_has_own_prop *)
+  let_name. run red_spec_call_object_proto_has_own_prop.
+    substs. apply~ get_arg_correct_0.
+  run red_spec_call_object_proto_has_own_prop_1 using to_object_correct.
+  run red_spec_call_object_proto_has_own_prop_2.
+  destruct a. (* LTAC ARTHUR *)
+   inverts HR. apply~ red_spec_call_object_proto_has_own_prop_3_undef.
+   inverts HR. apply~ red_spec_call_object_proto_has_own_prop_3_not_undef.
+  (* prealloc_object_proto_is_prototype_of *)
+  let_name. destruct v as [p | l].
+  inverts HR. applys* red_spec_call_object_proto_is_prototype_of_not_object.
+  applys* get_arg_correct_0.
+  applys* red_spec_call_object_proto_is_prototype_of_1_not_object. 
+  rewrite~ <- EQv. 
+  applys* red_spec_call_object_proto_is_prototype_of_not_object. 
+  apply get_arg_correct_0.
+  rewrite <- EQv. run red_spec_call_object_proto_is_prototype_of_1_object using to_object_correct.
+  apply red_spec_call_object_proto_is_prototype_of_2.
+  applys* runs_type_correct_object_proto_is_prototype_of.
+  (* prealloc_object_proto_prop_is_enumerable *)
+  let_name. 
+  applys* red_spec_call_object_proto_prop_is_enumerable.
+  apply get_arg_correct_0. subst.
+  run red_spec_call_object_proto_prop_is_enumerable_1.
+  run red_spec_call_object_proto_prop_is_enumerable_2 using to_object_correct.
+  run red_spec_call_object_proto_prop_is_enumerable_3.
+  destruct a; inverts HR.
+  apply red_spec_call_object_proto_prop_is_enumerable_4_undef.
+  applys* red_spec_call_object_proto_prop_is_enumerable_4_not_undef.
+  (* prealloc_function *)
+  discriminate. (* LATER *)
+  (* prealloc_function_proto *)
+  inverts HR. apply red_spec_call_function_proto_invoked.
+
+  (* prealloc_function_proto_to_string *)
+  cases_if*. applys* red_spec_function_proto_to_string_not_callable.
+
+  (* prealloc_function_proto_apply *)
+  repeat let_name.
+  cases_if*; [ | applys* red_spec_function_apply_1].
+  destruct vthis as [p | func]; [inverts i; inverts H | ]. 
+  applys* red_spec_function_apply_1_2; [apply get_arg_correct_1 | substs].
+  destruct (get_arg 1 args) as [p | array].
+  destruct p;
+    try solve [apply runs_type_correct_call in HR; auto;
+               applys* red_spec_function_apply_2];
+    try solve [apply red_spec_function_apply_3 with (array := func); [splits; discriminate | applys* run_error_correct]].
+  run~ red_spec_function_apply_4 using run_object_get_correct.
+  run red_spec_function_apply_5.
+  run red_spec_function_apply_6 using run_function_proto_apply_get_args_correct. 
+  apply red_spec_function_apply_7. applys* runs_type_correct_call.
+
+  (* prealloc_function_proto_call *)
+  cases_if*; [ | applys* red_spec_call_function_not_callable].
+  destruct vthis as [p | l]; [inverts i; inverts H |].
+  remember (get_arg_first_and_rest args) as gargs; destruct gargs.
+  applys* red_spec_call_function_callable.
+  rewrite* <- get_arg_first_and_rest_correct.
+  applys* runs_type_correct_call.
+
+  (* prealloc_function_proto_bind *)
+  cases_if*; [ | applys* red_spec_function_bind_1].
+  destruct vthis as [p | this]; [inverts HR | ].
+  remember (get_arg_first_and_rest args) as gargs; destruct gargs as (thisArg & A).
+  applys* red_spec_function_bind_2.
+  rewrite* <- get_arg_first_and_rest_correct.
+  repeat let_simpl; 
+  match goal with H: context [object_alloc ?s ?o] |- _ => sets_eq X: (object_alloc s o) end;
+  destruct X as (l & S').  
+  applys* red_spec_function_bind_3.
+  let_name. subst. run red_spec_function_bind_4.
+  run. cases_if*; subst; apply run_object_method_correct in E.
+  applys* red_spec_function_bind_length_true. 
+  run red_spec_function_bind_length_1 using run_object_get_correct.
+  run red_spec_function_bind_length_2. cases_if*; inverts R1.
+  applys* red_spec_function_bind_length_3_zero.
+  applys* red_spec_function_bind_length_3_L.
+  inverts R1. applys* red_spec_function_bind_length_false.
+  repeat let_name. 
+  run; rename x into S''. run. repeat let_name.
+  forwards B: @pick_option_correct (rm E0).
+  applys* red_spec_function_bind_5.
+  applys* red_spec_function_bind_6. rewrite* <- EQA0. substs.
+  run* red_spec_function_bind_7. 
+  run* red_spec_function_bind_8. 
+  apply red_spec_function_bind_9.
+
+  (* prealloc_bool *)
+  inverts HR. apply~ red_spec_call_bool.
+    apply~ get_arg_correct_0.
+  apply~ red_spec_to_boolean.
+  (* prealloc_bool_proto *)
+  discriminate.
+  (* prealloc_bool_proto_to_string *)  
+  destruct vthis as [p | l].
+    destruct p; try solve [
+      apply red_spec_call_bool_proto_to_string_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]]. 
+    inverts HR. applys* red_spec_call_bool_proto_to_string_bool. constructor.
+    remember (run_object_method object_class_ S l). destruct o0.
+    simpls. cases_if*. 
+    remember (run_object_method object_prim_value_ S l). destruct o0.
+    simpls. destruct o0. destruct v. 
+    destruct p.
+      apply red_spec_call_bool_proto_to_string_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      apply red_spec_call_bool_proto_to_string_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      inverts HR. subst. 
+      symmetry in Heqo1, Heqo0. 
+      apply run_object_method_correct in Heqo0. 
+      apply run_object_method_correct in Heqo1. 
+      applys* red_spec_call_bool_proto_to_string_bool.
+      constructor*.
+      apply red_spec_call_bool_proto_to_string_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      apply red_spec_call_bool_proto_to_string_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      apply red_spec_call_bool_proto_to_string_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      apply red_spec_call_bool_proto_to_string_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      simpls.  apply red_spec_call_bool_proto_to_string_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      destruct H3 as (O & Hb & Hv).
+      unfolds run_object_method.
+      assert (exists a, object_binds S l a).
+        eexists; jauto.
+      lets Hyp : (@pick_option_defined _ (object_binds S l) (object_binds_pickable_option S l) H). 
+      destruct Hyp as (a & Heq). 
+      rewrite Heq in Heqo1.
+      simpls. inverts Heqo1.
+      apply red_spec_call_bool_proto_to_string_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      destruct H0 as (O & Hb & Hv).
+      unfolds run_object_method.
+      assert (exists a, object_binds S l a).
+        exists~ O. 
+      lets Hyp : (@pick_option_defined _ (object_binds S l) (object_binds_pickable_option S l) H). 
+      destruct Hyp as (a & Heq). 
+      rewrite Heq in Heqo0.
+      simpls. assert (a = O).
+      {
+        apply pick_option_correct in Heq.
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. rewrite Hv in Heqo0. false*.
+      simpls. apply red_spec_call_bool_proto_to_string_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      destruct H0 as (O & Hb & Hv).
+      unfolds run_object_method.
+      assert (exists a, object_binds S l a).
+        exists~ O. 
+      lets Hyp : (@pick_option_defined _ (object_binds S l) (object_binds_pickable_option S l) H). 
+      destruct Hyp as (a & Heq). 
+      rewrite Heq in Heqo0.
+      simpls. inverts Heqo0. 
+  (* prealloc_bool_proto_value_of *)
+  destruct vthis as [p | l].
+    destruct p; try solve [
+      apply red_spec_call_bool_proto_value_of_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]]. 
+    inverts HR. apply red_spec_call_bool_proto_value_of_bool. constructor.
+    remember (run_object_method object_class_ S l). destruct o0.
+    simpls. cases_if*. 
+    remember (run_object_method object_prim_value_ S l). destruct o0.
+    simpls. destruct o0. destruct v. 
+    destruct p.
+      apply red_spec_call_bool_proto_value_of_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      apply red_spec_call_bool_proto_value_of_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      inverts HR. subst. apply red_spec_call_bool_proto_value_of_bool.
+      symmetry in Heqo1, Heqo0. 
+      apply run_object_method_correct in Heqo0. 
+      apply run_object_method_correct in Heqo1. 
+      constructor*.
+      apply red_spec_call_bool_proto_value_of_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      apply red_spec_call_bool_proto_value_of_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      apply red_spec_call_bool_proto_value_of_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      apply red_spec_call_bool_proto_value_of_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      simpls.  apply red_spec_call_bool_proto_value_of_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      destruct H3 as (O & Hb & Hv).
+      unfolds run_object_method.
+      assert (exists a, object_binds S l a).
+        eexists; jauto.
+      lets Hyp : (@pick_option_defined _ (object_binds S l) (object_binds_pickable_option S l) H). 
+      destruct Hyp as (a & Heq). 
+      rewrite Heq in Heqo1.
+      simpls. inverts Heqo1.
+      apply red_spec_call_bool_proto_value_of_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      destruct H0 as (O & Hb & Hv).
+      unfolds run_object_method.
+      assert (exists a, object_binds S l a).
+        exists~ O. 
+      lets Hyp : (@pick_option_defined _ (object_binds S l) (object_binds_pickable_option S l) H). 
+      destruct Hyp as (a & Heq). 
+      rewrite Heq in Heqo0.
+      simpls. assert (a = O).
+      {
+        apply pick_option_correct in Heq.
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. rewrite Hv in Heqo0. false*.
+      simpls. apply red_spec_call_bool_proto_value_of_not_bool;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      destruct H0 as (O & Hb & Hv).
+      unfolds run_object_method.
+      assert (exists a, object_binds S l a).
+        exists~ O. 
+      lets Hyp : (@pick_option_defined _ (object_binds S l) (object_binds_pickable_option S l) H). 
+      destruct Hyp as (a & Heq). 
+      rewrite Heq in Heqo0.
+      simpls. inverts Heqo0. 
+  (* prealloc_number *)
+  cases_if.
+  substs. inverts HR. apply~ red_spec_call_number_nil.
+  inverts HR. apply~ red_spec_call_number_not_nil.
+    apply~ get_arg_correct_0.
+  apply* to_number_correct.
+  (* prealloc_number_proto *)
+  discriminate.
+  (* prealloc_number_proto_to_string *)
+  discriminate.
+  (* prealloc_number_proto_value_of *)
+  destruct vthis as [p | l].
+    destruct p; try solve [
+      apply red_spec_call_number_proto_value_of_not_number;
+      [introv Hv; inverts Hv | applys* run_error_correct]]. 
+    inverts HR. apply red_spec_call_number_proto_value_of_number. constructor.
+    remember (run_object_method object_class_ S l). destruct o0.
+    simpls. cases_if*. 
+    remember (run_object_method object_prim_value_ S l). destruct o0.
+    simpls. destruct o0. destruct v. 
+    destruct p.
+      apply red_spec_call_number_proto_value_of_not_number;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      apply red_spec_call_number_proto_value_of_not_number;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      apply red_spec_call_number_proto_value_of_not_number;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      inverts HR. subst. apply red_spec_call_number_proto_value_of_number.
+      symmetry in Heqo1, Heqo0. 
+      apply run_object_method_correct in Heqo0. 
+      apply run_object_method_correct in Heqo1. 
+      constructor*.
+      apply red_spec_call_number_proto_value_of_not_number;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      apply red_spec_call_number_proto_value_of_not_number;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      apply red_spec_call_number_proto_value_of_not_number;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      symmetry in Heqo1. apply run_object_method_correct in Heqo1.
+      destruct Heqo1 as (O1 & Hb1 & Hv1).
+      destruct H3 as (O2 & Hb2 & Hv2).
+      assert (O1 = O2).
+      {
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. false~.
+      simpls.  apply red_spec_call_number_proto_value_of_not_number;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      destruct H3 as (O & Hb & Hv).
+      unfolds run_object_method.
+      assert (exists a, object_binds S l a).
+        eexists; jauto.
+      lets Hyp : (@pick_option_defined _ (object_binds S l) (object_binds_pickable_option S l) H). 
+      destruct Hyp as (a & Heq). 
+      rewrite Heq in Heqo1.
+      simpls. inverts Heqo1.
+      apply red_spec_call_number_proto_value_of_not_number;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      destruct H0 as (O & Hb & Hv).
+      unfolds run_object_method.
+      assert (exists a, object_binds S l a).
+        exists~ O. 
+      lets Hyp : (@pick_option_defined _ (object_binds S l) (object_binds_pickable_option S l) H). 
+      destruct Hyp as (a & Heq). 
+      rewrite Heq in Heqo0.
+      simpls. assert (a = O).
+      {
+        apply pick_option_correct in Heq.
+        applys* Heap_binds_func.
+        apply object_loc_comparable. 
+      } subst. rewrite Hv in Heqo0. false*.
+      simpls. apply red_spec_call_number_proto_value_of_not_number;
+      [introv Hv; inverts Hv | applys* run_error_correct]. 
+      destruct H0 as (O & Hb & Hv).
+      unfolds run_object_method.
+      assert (exists a, object_binds S l a).
+        exists~ O. 
+      lets Hyp : (@pick_option_defined _ (object_binds S l) (object_binds_pickable_option S l) H). 
+      destruct Hyp as (a & Heq). 
+      rewrite Heq in Heqo0.
+      simpls. inverts Heqo0. 
+  (* prealloc_number_proto_to_fixed *)
+  discriminate.
+  (* prealloc_number_proto_to_exponential *)
+  discriminate.
+  (* prealloc_number_proto_to_precision *)
+  discriminate.
+
+  (* prealloc_array *)
+  apply run_construct_prealloc_correct in HR; auto.
+  applys* red_spec_call_to_construct_array. auto.
+
+  (* prealloc_array_is_array *)
+  let_name; subst. 
+  applys* red_spec_call_array_is_array_fetch_arg.
+    applys* get_arg_correct_0.
+  destruct (get_arg 0 args). 
+    inverts HR. applys* red_spec_call_array_is_array_1. 
+    run. apply run_object_method_correct in E. 
+    applys* red_spec_call_array_is_array_2_branch.
+    cases_if*; inverts HR.
+      applys* red_spec_call_array_is_array_2.
+      applys* red_spec_call_array_is_array_3.
+
+  (* prealloc_array_proto *)
+  discriminate.
+
+  (* prealloc_array_proto_to_string *)
+  run red_spec_call_array_proto_to_string using to_object_correct.
+  run red_spec_call_array_proto_to_string_1 using run_object_get_correct.
+  cases_if*. 
+  destruct v as [p | array]; inverts HR.
+  applys* red_spec_call_array_proto_to_string_2_true.
+  applys* runs_type_correct_call.
+  applys* red_spec_call_array_proto_to_string_2_false.
+  applys* runs_type_correct_call_prealloc.
+  
+  (* prealloc_array_proto_join *)
+  let_name; subst.
+  run red_spec_call_array_proto_join using to_object_correct.
+  run red_spec_call_array_proto_join_1 using run_object_get_correct.
+  run red_spec_call_array_proto_join_2. let_name; subst.
+  applys* red_spec_call_array_proto_join_3. 
+  apply get_arg_correct_0. cases_if*.
+  run~ red_spec_call_array_proto_join_3_other.
+  cases_if*. inverts HR. applys* red_spec_call_array_proto_join_4.
+  let_name; subst.
+  run~ red_spec_call_array_proto_join_5 using vtsfj_correct. 
+  apply red_spec_call_array_proto_join_6. applys* run_array_join_elements_correct.
+  run~ red_spec_call_array_proto_join_3_undef.
+  cases_if*. inverts HR. applys* red_spec_call_array_proto_join_4.
+  let_name; subst.
+  run~ red_spec_call_array_proto_join_5 using vtsfj_correct. 
+  apply red_spec_call_array_proto_join_6. applys* run_array_join_elements_correct.
+
+  (* prealloc_array_proto_pop *)
+  run red_spec_call_array_proto_pop using to_object_correct. 
+  run red_spec_call_array_proto_pop_1 using run_object_get_correct.
+  run red_spec_call_array_proto_pop_2. cases_if*. subst.
+  apply red_spec_call_array_proto_pop_3_empty.
+  run red_spec_call_array_proto_pop_3_empty_1.
+  apply red_spec_call_array_proto_pop_3_empty_2.
+  applys~ red_spec_call_array_proto_pop_3_nonempty.
+  run red_spec_call_array_proto_pop_3_nonempty_1.
+  run red_spec_call_array_proto_pop_3_nonempty_2 using run_object_get_correct.
+  run red_spec_call_array_proto_pop_3_nonempty_3 using object_delete_default_correct. 
+  run red_spec_call_array_proto_pop_3_nonempty_4.
+  applys~ red_spec_call_array_proto_pop_3_nonempty_5.
+  
+  (* prealloc_array_proto_push *)
+  run red_spec_call_array_proto_push using to_object_correct. 
+  run red_spec_call_array_proto_push_1 using run_object_get_correct.
+  run red_spec_call_array_proto_push_2.
+  applys* push_correct.
+
+  (* prealloc_string *)
+
+  cases_if; substs.
+    inverts HR. apply red_spec_call_string_empty.
+    let_name; substs. run red_spec_call_string_non_empty.
+      apply get_arg_correct_0.
+    apply red_spec_call_string_non_empty_1.
+
+  (* prealloc_string_proto *)
+  discriminate. (* LATER *)
+  (* prealloc_string_proto_to_string *)
+  applys* red_spec_call_string_proto_to_string.
+  destruct vthis as [p | l]. cases_if*. 
+  inverts HR. applys* red_spec_call_string_proto_value_of_prim_string.
+  applys* red_spec_call_string_proto_value_of_bad_type.
+  run. apply run_object_method_correct in E.
+  cases_if*. subst.
+  apply run_object_prim_value_correct in HR.
+  destruct HR as (v & Heq & Hprim). subst.
+  applys* red_spec_call_string_proto_value_of_obj_string.
+  applys* red_spec_call_string_proto_value_of_obj_other.
+  destruct E as (y & Hbind & Hclass).
+  introv (y' & Hbind' & Hclass').
+  assert (y = y'). applys* Heap_binds_func.
+  apply object_loc_comparable. subst. false~.
+   (* prealloc_string_proto_value_of *)
+  destruct vthis as [p | l]. cases_if*. inverts HR. 
+  applys* red_spec_call_string_proto_value_of_prim_string.
+  applys* red_spec_call_string_proto_value_of_bad_type.
+run. apply run_object_method_correct in E.
+  cases_if*. subst.
+  apply run_object_prim_value_correct in HR.
+  destruct HR as (v & Heq & Hprim). subst.
+  applys* red_spec_call_string_proto_value_of_obj_string.
+  applys* red_spec_call_string_proto_value_of_obj_other.
+  destruct E as (y & Hbind & Hclass).
+  introv (y' & Hbind' & Hclass').
+  assert (y = y'). applys* Heap_binds_func.
+  apply object_loc_comparable. subst. false~.
+  (* prealloc_string_proto_char_at *)
+  discriminate.
+  (* prealloc_string_proto_char_code_at *)
+  discriminate.
+  (* prealloc_math *)
+  discriminate.
+  (* prealloc_mathop *)
+  discriminate.
+  (* prealloc_date *)
+  discriminate.
+  (* prealloc_regexp *)
+  discriminate.     
+  (* prealloc_error *)
+  let_name. apply~ red_spec_call_error.
+    apply~ get_arg_correct_0.
+  substs. apply* build_error_correct.
+  (* prealloc_error_proto *)
+  discriminate.
+  (* prealloc_native_error *)
+  let_name. applys* red_spec_call_native_error.
+    apply~ get_arg_correct_0.
+  substs; applys* build_error_correct.
+  (* prealloc_native_error_proto *)
+  discriminate.
+  (* prealloc_error_proto_to_string *)
+  discriminate.
+  (* prealloc_throw_type_error *)
+  apply~ red_spec_call_throw_type_error.
+  apply* run_error_correct.
+  (* prealloc_json *)
+  discriminate.
+Admitted. (* faster *)
+
+Lemma run_call_correct : forall runs S C l v vs o,
+  runs_type_correct runs ->
+  run_call runs S C l v vs = o ->
+  red_expr S C (spec_call l v vs) o.
+Proof.
+  introv IH HR. simpls. unfolds in HR.
+  run. run. subst. lets H: run_object_method_correct (rm E).
+  applys* red_spec_call. clear H.
+  destruct x0.
+    applys* red_spec_call_1_default. applys* red_spec_call_default.
+    applys* entering_func_code_correct.
+
+    repeat run. let_name. subst.
+    apply run_object_method_correct in E; apply run_object_method_correct in E1; 
+    apply run_object_method_correct in E3.
+    applys* red_spec_call_1_after_bind_full.
+    applys* runs_type_correct_call.
+
+    applys* red_spec_call_1_prealloc. applys* run_call_prealloc_correct.
+Admitted. (* faster *)
+
+
+Lemma run_stat_while_correct : forall runs S C rv ls e t o,
+  runs_type_correct runs ->
+  run_stat_while runs S C rv ls e t = o ->
+  red_stat S C (stat_while_1 ls e t rv) o.
+Proof.
+  intros runs IH ls e t S C rv o R. unfolds in R.
+  run_pre. lets (y1&R2&K): if_spec_post_to_bool (rm R1) (rm R).
+   applys~ red_stat_while_1 (rm R2). run_post_if_spec_ter_post_bool K.
+    case_if.
+    run red_stat_while_2_true.
+     let_name. let_simpl. applys red_stat_while_3 rv'. case_if; case_if*.
+     case_if in K.
+       applys red_stat_while_4_not_continue. rew_logic*. case_if in K.
+         run_inv. applys* red_stat_while_5_break.
+         applys* red_stat_while_5_not_break. case_if in K; run_inv.
+           applys* red_stat_while_6_abort.
+           applys* red_stat_while_6_normal. run_hyp*.
+       rew_logic in *. applys* red_stat_while_4_continue. run_hyp*.
+   run_inv. applys red_stat_while_2_false.
+Admitted. (*faster*)
+
+Lemma run_stat_do_while_correct : forall runs S C rv ls e t o,
+  runs_type_correct runs ->
+  run_stat_do_while runs S C rv ls e t = o ->
+  red_stat S C (stat_do_while_1 ls t e rv) o.
+Proof.
+  introv IH R. unfolds in R.
+  run red_stat_do_while_1. do 2 let_name.
+  applys~ red_stat_do_while_2 rv'.
+    repeat cases_if~. clear EQrv'.
+  asserts loop_correct: (forall o, loop tt = res_out o ->
+      red_stat S0 C (stat_do_while_6 ls t e rv') o).
+    clear R. introv H. subst loop.
+     run_pre. lets (y1&R2&K): if_spec_post_to_bool (rm R1) (rm H).
+     applys~ red_stat_do_while_6 (rm R2). run_post_if_spec_ter_post_bool K.
+     cases_if.
+      apply~ red_stat_do_while_7_true. apply* IH.
+      run_inv. apply* red_stat_do_while_7_false.
+  clear EQloop. cases_if in R.
+   apply~ red_stat_do_while_3_continue. rewrite decide_def in H. cases_if~ in H.
+   apply~ red_stat_do_while_3_not_continue.
+     rewrite decide_def in H. cases_if~ in H. clear H. cases_if.
+    run_inv. apply~ red_stat_do_while_4_break.
+    apply~ red_stat_do_while_4_not_break. cases_if; run_inv.
+     apply~ red_stat_do_while_5_abort.
+     apply~ red_stat_do_while_5_normal.
+Admitted. (*faster*)
+
+Lemma run_stat_for_loop_correct : forall runs S C labs rv eo2 eo3 t o,
+  runs_type_correct runs ->
+  run_stat_for_loop runs S C labs rv eo2 eo3 t = o ->
+  red_stat S C (stat_for_2 labs rv eo2 eo3 t) o.
+Proof.
+  introv IH R. unfolds in R. let_name.
+  asserts follows_correct: (forall S o, follows S = res_out o ->
+    red_stat S C (stat_for_4 labs rv eo2 eo3 t) o).
+    clear R. introv R. rewrite EQfollows in R. clear EQfollows.
+    run red_stat_for_4. do 2 let_name. applys~ red_stat_for_5 rv'.
+     repeat cases_if*.
+    clear EQrv'. cases_if.
+     run_inv. apply~ red_stat_for_6_break.
+     apply~ red_stat_for_6_not_break. rew_logic~ in *. cases_if.
+      apply red_stat_for_7_continue. rew_logic~ in *. destruct eo3.
+       run red_stat_for_8_some. subst loop. run_hyp.
+        apply~ red_stat_for_9.
+       subst loop. run_hyp. apply~ red_stat_for_8_none.
+      run_inv. apply~ red_stat_for_7_abort. rew_logic* in *.
+  clear EQfollows. destruct eo2.
+   run_pre. lets (y1&R2&K): if_spec_post_to_bool (rm R1) (rm R).
+    applys~ red_stat_for_2_some (rm R2). run_post_if_spec_ter_post_bool K.
+    cases_if; run_inv.
+     apply~ red_stat_for_3_not_false. discriminate.
+     apply~ red_stat_for_3_false.
+   apply~ red_stat_for_2_none.
+Admitted. (*faster*)
+
+
+Lemma object_proto_is_prototype_of_correct : forall runs S C lthis l o,
+  runs_type_correct runs ->
+  object_proto_is_prototype_of runs S lthis l = o ->
+  red_expr S C (spec_call_object_proto_is_prototype_of_2_3 lthis l) o.
+Proof.
+  introv IH HR. unfolds in HR.
+  run. forwards* Omp: run_object_method_correct.
+  applys~ red_spec_call_object_proto_is_prototype_of_3 Omp.
+  destruct x as [p|]. (* LTAC ARTHUR *)
+   destruct p; inverts HR.
+    apply~ red_spec_call_object_proto_is_prototype_of_4_null.
+   cases_if; substs; inverts HR.
+    apply~ red_spec_call_object_proto_is_prototype_of_4_equal.
+    run_hyp. apply* red_spec_call_object_proto_is_prototype_of_4_not_equal.
+Admitted. (*faster*)
+
+
+Lemma run_equal_correct : forall runs S C v1 v2 o,
+  runs_type_correct runs ->
+  run_equal runs S C v1 v2 = o ->
+  red_expr S C (spec_equal v1 v2) o.
+Proof.
+  introv IH R. unfolds in R. let_simpl.
+  apply~ red_spec_equal. cases_if.
+   run_inv. rewrite e. apply~ red_spec_equal_1_same_type.
+   apply~ red_spec_equal_1_diff_type. let_name.
+   asserts dc_conv_correct: (forall v1 F Ext v2 o,
+     dc_conv v1 F v2 = res_out o ->
+     (forall S v o, F S v = o -> red_expr S C (Ext v) o) ->
+     red_expr S C (spec_equal_3 v1 Ext v2) o).
+     clear R. introv E Cor. substs. run red_spec_equal_3_convert_and_recurse.
+       run_inv. apply* Cor.
+     run_hyp. apply~ red_spec_equal_4_recurse.
+   clear EQdc_conv.
+  Ltac eqcas R :=
+     match type of R with context [ ifb ?P then _ else _ ] =>
+       let x := fresh "x" in set (x := P) in * end;
+     case_if in R as C; [ rewrite If_l; try assumption
+                        | rewrite If_r; try assumption ].
+   eqcas R. run_inv. applys red_spec_equal_2_return.
+   eqcas R. run_inv. applys red_spec_equal_2_return.
+   eqcas R. applys dc_conv_correct R. introv E. applys* to_number_correct E.
+   eqcas R. applys dc_conv_correct R. introv E. applys* to_number_correct E.
+   eqcas R. applys dc_conv_correct R. introv E. applys* to_number_correct E.
+   eqcas R. applys dc_conv_correct R. introv E. applys* to_number_correct E.
+   eqcas R. applys dc_conv_correct R. introv E. applys* to_primitive_correct E.
+   eqcas R. applys dc_conv_correct R. introv E. applys* to_primitive_correct E.
+   run_inv. applys red_spec_equal_2_return.
+Admitted. (* faster *)
+
+Theorem runs_correct : forall num,
+  runs_type_correct (runs num).
+Proof.
+  induction num.
+   constructors;
+     try (introv M; inverts M; introv P; inverts P). 
+     introv Hyp M; inverts M. 
+   constructors.
+     introv. apply~ run_expr_correct.
+     introv. apply~ run_stat_correct.
+     introv. apply~ run_prog_correct.
+     introv. apply~ run_call_correct.
+     introv. apply~ run_call_prealloc_correct.
+     introv. apply~ run_construct_correct.
+     introv. apply~ run_function_has_instance_correct.
+     introv. apply~ run_function_proto_apply_get_args_correct.
+     introv. apply~ run_object_has_instance_correct.
+     introv. apply~ run_stat_while_correct.
+     introv. apply~ run_stat_do_while_correct.
+     introv. apply~ run_stat_for_loop_correct.
+     introv. apply~ object_delete_correct.
+     introv. apply~ run_object_get_own_prop_correct.
+     introv. apply~ run_object_get_prop_correct.
+     introv. apply~ run_object_get_correct.
+     introv. apply~ object_proto_is_prototype_of_correct.
+     introv. apply~ object_put_correct.
+     introv. apply~ run_equal_correct.
+     introv. apply~ to_integer_correct.
+     introv. apply~ to_string_correct.
+     introv. apply~ run_array_element_list_correct.
+     introv Hyp. apply~ run_object_define_own_prop_array_loop_correct.
+     introv. apply~ run_array_join_elements_correct.
+Qed.
+
+Theorem run_javascript_correct : forall runs p o,
+  runs_type_correct runs ->
+  run_javascript runs p = o ->
+  red_javascript p o.
+Proof.
+  introv IH HR. unfolds in HR. run_pre as o1 R1.
+  applys* red_javascript_intro R1. run_post. run_inv. run_hyp.
+  apply~ red_javascript_intro_1.
+Qed.
+
+Corollary run_javascript_correct_num : forall num p o,
+  run_javascript (runs num) p = result_out o ->
+  red_javascript p o.
+Proof.
+  introv IH. applys~ run_javascript_correct IH.
+  apply~ runs_correct.
+Qed. 
+
diff --git a/samples/Coq/JsInterpreterExtraction.v b/samples/Coq/JsInterpreterExtraction.v
new file mode 100644
index 00000000..faa210e1
--- /dev/null
+++ b/samples/Coq/JsInterpreterExtraction.v
@@ -0,0 +1,249 @@
+Set Implicit Arguments.
+Require Import JsSyntax JsInterpreterMonads JsInterpreter JsInit.
+Require Import LibFix LibList.
+
+Require Export Shared.
+Require Export LibTactics LibLogic LibReflect LibList
+  LibOperation LibStruct LibNat LibEpsilon LibFunc LibHeap.
+Require Flocq.Appli.Fappli_IEEE Flocq.Appli.Fappli_IEEE_bits.
+
+
+
+(* Here stands some commands to extract relatively correctly the interpreter to Ocaml. *)
+Extraction Language Ocaml.
+
+Require Import ExtrOcamlBasic.
+Require Import ExtrOcamlNatInt.
+Require Import ExtrOcamlString.
+
+(* Optimal fixpoint. *)
+Extraction Inline FixFun3 FixFun3Mod FixFun4 FixFun4Mod FixFunMod curry3 uncurry3 curry4 uncurry4.
+(* As classical logic statements are now unused, they should not be extracted
+   (otherwise, useless errors will be launched). *)
+Extraction Inline epsilon epsilon_def classicT arbitrary indefinite_description Inhab_witness Fix isTrue.
+
+(**************************************************************)
+(** ** Numerical values *)
+
+(* number *)
+
+Extract Inductive positive => float
+[ "(fun p -> 1. +. (2. *. p))"
+  "(fun p -> 2. *. p)"
+  "1." ]
+"(fun f2p1 f2p f1 p ->
+if p <= 1. then f1 () else if mod_float p 2. = 0. then f2p (floor (p /. 2.)) else f2p1 (floor (p /. 2.)))".
+
+Extract Inductive Z => float [ "0." "" "(~-.)" ]
+"(fun f0 fp fn z -> if z=0. then f0 () else if z>0. then fp z else fn (~-. z))".
+
+Extract Inductive N => float [ "0." "" ]
+"(fun f0 fp n -> if n=0. then f0 () else fp n)".
+
+Extract Constant Z.add => "(+.)".
+Extract Constant Z.succ => "(+.) 1.".
+Extract Constant Z.pred => "(fun x -> x -. 1.)".
+Extract Constant Z.sub => "(-.)".
+Extract Constant Z.mul => "( *. )".
+Extract Constant Z.opp => "(~-.)".
+Extract Constant Z.abs => "abs_float".
+Extract Constant Z.min => "min".
+Extract Constant Z.max => "max".
+Extract Constant Z.compare =>
+ "fun x y -> if x=y then Eq else if x<y then Lt else Gt".
+
+Extract Constant Pos.add => "(+.)".
+Extract Constant Pos.succ => "(+.) 1.".
+Extract Constant Pos.pred => "(fun x -> x -. 1.)".
+Extract Constant Pos.sub => "(-.)".
+Extract Constant Pos.mul => "( *. )".
+Extract Constant Pos.min => "min".
+Extract Constant Pos.max => "max".
+Extract Constant Pos.compare =>
+ "fun x y -> if x=y then Eq else if x<y then Lt else Gt".
+Extract Constant Pos.compare_cont =>
+ "fun x y c -> if x=y then c else if x<y then Lt else Gt".
+
+Extract Constant N.add => "(+.)".
+Extract Constant N.succ => "(+.) 1.".
+Extract Constant N.pred => "(fun x -> x -. 1.)".
+Extract Constant N.sub => "(-.)".
+Extract Constant N.mul => "( *. )".
+Extract Constant N.min => "min".
+Extract Constant N.max => "max".
+Extract Constant N.div => "(fun x y -> if x = 0. then 0. else floor (x /. y))".
+Extract Constant N.modulo => "mod_float".
+Extract Constant N.compare =>
+ "fun x y -> if x=y then Eq else if x<y then Lt else Gt".
+
+Extract Inductive Fappli_IEEE.binary_float => float [
+  "(fun s -> if s then (0.) else (-0.))"
+  "(fun s -> if s then infinity else neg_infinity)"
+  "nan"
+  "(fun (s, m, e) -> failwith ""FIXME: No extraction from binary float allowed yet."")"
+]. 
+
+Extract Constant JsNumber.of_int => "fun x -> x".
+
+Extract Constant JsNumber.nan => "nan".
+Extract Constant JsNumber.zero => "0.".
+Extract Constant JsNumber.neg_zero => "(-0.)".
+Extract Constant JsNumber.one => "1.".
+Extract Constant JsNumber.infinity => "infinity".
+Extract Constant JsNumber.neg_infinity => "neg_infinity".
+Extract Constant JsNumber.max_value => "max_float".
+Extract Constant JsNumber.min_value => "(Int64.float_of_bits Int64.one)".
+Extract Constant JsNumber.pi => "(4. *. atan 1.)".
+Extract Constant JsNumber.e => "(exp 1.)".
+Extract Constant JsNumber.ln2 => "(log 2.)".
+Extract Constant JsNumber.floor => "floor".
+Extract Constant JsNumber.absolute => "abs_float".
+
+Extract Constant JsNumber.from_string =>
+  "(fun s ->
+    try
+      let s = (String.concat """" (List.map (String.make 1) s)) in
+      if s = """" then 0. else float_of_string s
+    with Failure ""float_of_string"" -> nan)
+   (* Note that we're using `float_of_string' there, which does not have the same
+      behavior than JavaScript.  For instance it will read ""022"" as 22 instead of
+      18, which should be the JavaScript result for it. *)".
+
+Extract Constant JsNumber.to_string =>
+  "(fun f -> 
+    prerr_string (""Warning:  JsNumber.to_string called.  This might be responsible for errors.  Argument value:  "" ^ string_of_float f ^ ""."");
+    prerr_newline();
+    let string_of_number n =
+      let sfn = string_of_float n in
+      (if (sfn = ""inf"") then ""Infinity"" else
+       if (sfn = ""-inf"") then ""-Infinity"" else
+       if (sfn = ""nan"") then ""NaN"" else
+       let inum = int_of_float n in
+       if (float_of_int inum = n) then (string_of_int inum) else (string_of_float n)) in
+    let ret = ref [] in (* Ugly, but the API for OCaml string is not very functional... *)
+    String.iter (fun c -> ret := c :: !ret) (string_of_number f);
+    List.rev !ret)
+   (* Note that this is ugly, we should use the spec of JsNumber.to_string here (9.8.1). *)".
+
+Extract Constant JsNumber.add => "(+.)".
+Extract Constant JsNumber.sub => "(-.)".
+Extract Constant JsNumber.mult => "( *. )".
+Extract Constant JsNumber.div => "(/.)".
+Extract Constant JsNumber.fmod => "mod_float".
+Extract Constant JsNumber.neg => "(~-.)".
+Extract Constant JsNumber.sign => "(fun f -> float_of_int (compare f 0.))".
+Extract Constant JsNumber.number_comparable => "(fun n1 n2 -> 0 = compare n1 n2)".
+Extract Constant JsNumber.lt_bool => "(<)".
+
+Extract Constant JsNumber.to_int32 => 
+"fun n ->
+  match classify_float n with
+  | FP_normal | FP_subnormal ->
+    let i32 = 2. ** 32. in
+    let i31 = 2. ** 31. in
+    let posint = (if n < 0. then (-1.) else 1.) *. (floor (abs_float n)) in
+    let int32bit =
+      let smod = mod_float posint i32 in
+      if smod < 0. then smod +. i32 else smod
+    in
+    (if int32bit >= i31 then int32bit -. i32 else int32bit)
+  | _ -> 0.". (* LATER:  do in Coq.  Spec is 9.5, p. 47.*)
+
+Extract Constant JsNumber.to_uint32 =>
+"fun n ->
+  match classify_float n with
+  | FP_normal | FP_subnormal ->
+    let i32 = 2. ** 32. in
+    let posint = (if n < 0. then (-1.) else 1.) *. (floor (abs_float n)) in
+    let int32bit =
+      let smod = mod_float posint i32 in
+      if smod < 0. then smod +. i32 else smod
+    in
+    int32bit
+  | _ -> 0.". (* LAER:  do in Coq.  Spec is 9.6, p47.*)
+
+Extract Constant JsNumber.modulo_32 => "(fun x -> let r = mod_float x 32. in if x < 0. then r +. 32. else r)".
+Extract Constant JsNumber.int32_bitwise_not => "fun x -> Int32.to_float (Int32.lognot (Int32.of_float x))".
+Extract Constant JsNumber.int32_bitwise_and => "fun x y -> Int32.to_float (Int32.logand (Int32.of_float x) (Int32.of_float y))".
+Extract Constant JsNumber.int32_bitwise_or => "fun x y -> Int32.to_float (Int32.logor (Int32.of_float x) (Int32.of_float y))".
+Extract Constant JsNumber.int32_bitwise_xor => "fun x y -> Int32.to_float (Int32.logxor (Int32.of_float x) (Int32.of_float y))".
+Extract Constant JsNumber.int32_left_shift => "(fun x y -> Int32.to_float (Int32.shift_left (Int32.of_float x) (int_of_float y)))".
+Extract Constant JsNumber.int32_right_shift => "(fun x y -> Int32.to_float (Int32.shift_right (Int32.of_float x) (int_of_float y)))".
+Extract Constant JsNumber.uint32_right_shift => 
+"(fun x y ->
+  let i31 = 2. ** 31. in
+  let i32 = 2. ** 32. in
+  let newx = if x >= i31 then x -. i32 else x in
+  let r = Int32.to_float (Int32.shift_right_logical (Int32.of_float newx) (int_of_float y)) in
+  if r < 0. then r +. i32 else r)".
+
+Extract Constant int_of_char => "(fun c -> float_of_int (int_of_char c))".
+
+Extract Constant ascii_comparable => "(=)".
+Extract Constant lt_int_decidable => "(<)".
+Extract Constant le_int_decidable => "(<=)".
+Extract Constant ge_nat_decidable => "(>=)".
+
+(* TODO ARTHUR:  This TLC lemma does not extract to something computable... whereas it should! *)
+Extract Constant prop_eq_decidable => "(=)".
+
+Extract Constant env_loc_global_env_record => "0".
+
+(* The following functions make pattern matches with floats and shall thus be removed. *)
+Extraction Inline Fappli_IEEE.Bplus Fappli_IEEE.binary_normalize Fappli_IEEE_bits.b64_plus.
+Extraction Inline Fappli_IEEE.Bmult Fappli_IEEE.Bmult_FF Fappli_IEEE_bits.b64_mult.
+Extraction Inline Fappli_IEEE.Bdiv Fappli_IEEE_bits.b64_div.
+
+(* New options for the interpreter to work in Coq 8.4 *)
+Set Extraction AccessOpaque.
+
+(* These parameters are implementation-dependant according to the spec.
+   I've chosed some very simple values, but we could choose another thing for them. *)
+Extract Constant object_prealloc_global_proto => "(Coq_value_prim Coq_prim_null)".
+Extract Constant object_prealloc_global_class => "(
+  let rec aux s = function
+  | 0 -> []
+  | n -> let n' = n - 1 in
+    s.[n'] :: aux s n'
+  in let aux2 s =
+    List.rev (aux s (String.length s))
+  in aux2 ""GlobalClass"")".
+
+
+(* Parsing *)
+Extract Constant parse_pickable => "(fun s strict ->
+    let str = String.concat """" (List.map (String.make 1) s) in
+    try
+      let parserExp = Parser_main.exp_from_string ~force_strict:strict str in
+      Some (JsSyntaxInfos.add_infos_prog strict
+        (Translate_syntax.exp_to_prog parserExp))
+    with
+    (* | Translate_syntax.CoqSyntaxDoesNotSupport _ -> assert false (* Temporary *) *)
+    | Parser.ParserFailure _
+    | Parser.InvalidArgument ->
+      prerr_string (""Warning:  Parser error on eval.  Input string:  \"""" ^ str ^ ""\""\n"");
+      None
+  )".
+
+
+(* Debugging *)
+Extract Inlined Constant not_yet_implemented_because => "(fun s ->
+  print_endline (__LOC__ ^ "": Not implemented because: "" ^ Prheap.string_of_char_list s) ;
+  Coq_result_not_yet_implemented)".
+Extract Inlined Constant impossible_because => "(fun s ->
+  print_endline (__LOC__ ^ "": Stuck because: "" ^ Prheap.string_of_char_list s) ;
+  Coq_result_impossible)".
+Extract Inlined Constant impossible_with_heap_because => "(fun s message ->
+  print_endline (__LOC__ ^ "": Stuck!\nState:  "" ^ Prheap.prstate true s
+    ^ ""\nMessage:\t"" ^ Prheap.string_of_char_list message) ;
+  Coq_result_impossible)".
+
+
+(* Final Extraction *)
+Extraction Blacklist string list bool.
+Separate Extraction runs run_javascript.
+
+
+
+(* -- LATER: extract inequality_test_string in more efficient way*)
+
diff --git a/samples/Coq/JsNumber.v b/samples/Coq/JsNumber.v
new file mode 100644
index 00000000..f8c66d3a
--- /dev/null
+++ b/samples/Coq/JsNumber.v
@@ -0,0 +1,1051 @@
+
+
+
+
+<!DOCTYPE html>
+<html lang="en" class="">
+  <head prefix="og: http://ogp.me/ns# fb: http://ogp.me/ns/fb# object: http://ogp.me/ns/object# article: http://ogp.me/ns/article# profile: http://ogp.me/ns/profile#">
+    <meta charset='utf-8'>
+    
+
+    <link crossorigin="anonymous" href="https://assets-cdn.github.com/assets/frameworks-9ad495a7b5d4473ee5031bc7b3e2d60090320bca47a10a6fa472132f678b6160.css" media="all" rel="stylesheet" />
+    <link crossorigin="anonymous" href="https://assets-cdn.github.com/assets/github-3ca4d5a0760c7ca10f98748867f95c64b034bd809a90302ab1caf3adf1b7845c.css" media="all" rel="stylesheet" />
+    
+    
+    <link crossorigin="anonymous" href="https://assets-cdn.github.com/assets/site-bfc167aa91c105811fa2848e54f5ae70b6c18ac4a42adf45cfacf9fbb078a71f.css" media="all" rel="stylesheet" />
+    
+
+    <meta http-equiv="X-UA-Compatible" content="IE=edge">
+    <meta http-equiv="Content-Language" content="en">
+    <meta name="viewport" content="width=device-width">
+    
+    <title>jscert/JsNumber.v at master · jscert/jscert · GitHub</title>
+    <link rel="search" type="application/opensearchdescription+xml" href="/opensearch.xml" title="GitHub">
+    <link rel="fluid-icon" href="https://github.com/fluidicon.png" title="GitHub">
+    <link rel="apple-touch-icon" href="/apple-touch-icon.png">
+    <link rel="apple-touch-icon" sizes="57x57" href="/apple-touch-icon-57x57.png">
+    <link rel="apple-touch-icon" sizes="60x60" href="/apple-touch-icon-60x60.png">
+    <link rel="apple-touch-icon" sizes="72x72" href="/apple-touch-icon-72x72.png">
+    <link rel="apple-touch-icon" sizes="76x76" href="/apple-touch-icon-76x76.png">
+    <link rel="apple-touch-icon" sizes="114x114" href="/apple-touch-icon-114x114.png">
+    <link rel="apple-touch-icon" sizes="120x120" href="/apple-touch-icon-120x120.png">
+    <link rel="apple-touch-icon" sizes="144x144" href="/apple-touch-icon-144x144.png">
+    <link rel="apple-touch-icon" sizes="152x152" href="/apple-touch-icon-152x152.png">
+    <link rel="apple-touch-icon" sizes="180x180" href="/apple-touch-icon-180x180.png">
+    <meta property="fb:app_id" content="1401488693436528">
+
+      <meta content="https://avatars2.githubusercontent.com/u/6460541?v=3&amp;s=400" name="twitter:image:src" /><meta content="@github" name="twitter:site" /><meta content="summary" name="twitter:card" /><meta content="jscert/jscert" name="twitter:title" /><meta content="jscert - A Coq specification of ECMAScript 5 (JavaScript) with verified reference interpreter" name="twitter:description" />
+      <meta content="https://avatars2.githubusercontent.com/u/6460541?v=3&amp;s=400" property="og:image" /><meta content="GitHub" property="og:site_name" /><meta content="object" property="og:type" /><meta content="jscert/jscert" property="og:title" /><meta content="https://github.com/jscert/jscert" property="og:url" /><meta content="jscert - A Coq specification of ECMAScript 5 (JavaScript) with verified reference interpreter" property="og:description" />
+      <meta name="browser-stats-url" content="https://api.github.com/_private/browser/stats">
+    <meta name="browser-errors-url" content="https://api.github.com/_private/browser/errors">
+    <link rel="assets" href="https://assets-cdn.github.com/">
+    
+    <meta name="pjax-timeout" content="1000">
+    
+    <meta name="request-id" content="3CE6BE40:5E08:669BBA1:581A09EB" data-pjax-transient>
+
+    <meta name="msapplication-TileImage" content="/windows-tile.png">
+    <meta name="msapplication-TileColor" content="#ffffff">
+    <meta name="selected-link" value="repo_source" data-pjax-transient>
+
+    <meta name="google-site-verification" content="KT5gs8h0wvaagLKAVWq8bbeNwnZZK1r1XQysX3xurLU">
+<meta name="google-site-verification" content="ZzhVyEFwb7w3e0-uOTltm8Jsck2F5StVihD0exw2fsA">
+    <meta name="google-analytics" content="UA-3769691-2">
+
+<meta content="collector.githubapp.com" name="octolytics-host" /><meta content="github" name="octolytics-app-id" /><meta content="3CE6BE40:5E08:669BBA1:581A09EB" name="octolytics-dimension-request_id" />
+<meta content="/&lt;user-name&gt;/&lt;repo-name&gt;/blob/show" data-pjax-transient="true" name="analytics-location" />
+
+
+
+  <meta class="js-ga-set" name="dimension1" content="Logged Out">
+
+
+
+        <meta name="hostname" content="github.com">
+    <meta name="user-login" content="">
+
+        <meta name="expected-hostname" content="github.com">
+      <meta name="js-proxy-site-detection-payload" content="YWY3ZjVmNzIxY2Q0M2M0NGRjM2VjYjE1YjM5ODg0ZGU2ZTQ4NzFmMTM5ZjM2OWVkNDE3N2YzOWU1YjNiNzQ2NXx7InJlbW90ZV9hZGRyZXNzIjoiNjAuMjMwLjE5MC42NCIsInJlcXVlc3RfaWQiOiIzQ0U2QkU0MDo1RTA4OjY2OUJCQTE6NTgxQTA5RUIiLCJ0aW1lc3RhbXAiOjE0NzgxMDE0ODQsImhvc3QiOiJnaXRodWIuY29tIn0=">
+
+
+      <link rel="mask-icon" href="https://assets-cdn.github.com/pinned-octocat.svg" color="#4078c0">
+      <link rel="icon" type="image/x-icon" href="https://assets-cdn.github.com/favicon.ico">
+
+    <meta name="html-safe-nonce" content="7bed62dca918c83cacd0a87ddbc835b155755d05">
+    <meta content="be822e7ea061a1e8f8b55ffc07bee0313a287211" name="form-nonce" />
+
+    <meta http-equiv="x-pjax-version" content="f983b7972fc2383d0fabea2ac9a3088f">
+    
+
+      
+  <meta name="description" content="jscert - A Coq specification of ECMAScript 5 (JavaScript) with verified reference interpreter">
+  <meta name="go-import" content="github.com/jscert/jscert git https://github.com/jscert/jscert.git">
+
+  <meta content="6460541" name="octolytics-dimension-user_id" /><meta content="jscert" name="octolytics-dimension-user_login" /><meta content="16102974" name="octolytics-dimension-repository_id" /><meta content="jscert/jscert" name="octolytics-dimension-repository_nwo" /><meta content="true" name="octolytics-dimension-repository_public" /><meta content="false" name="octolytics-dimension-repository_is_fork" /><meta content="16102974" name="octolytics-dimension-repository_network_root_id" /><meta content="jscert/jscert" name="octolytics-dimension-repository_network_root_nwo" />
+  <link href="https://github.com/jscert/jscert/commits/master.atom" rel="alternate" title="Recent Commits to jscert:master" type="application/atom+xml">
+
+
+      <link rel="canonical" href="https://github.com/jscert/jscert/blob/master/coq/JsNumber.v" data-pjax-transient>
+  </head>
+
+
+  <body class="logged-out  env-production  vis-public page-blob">
+    <div id="js-pjax-loader-bar" class="pjax-loader-bar"><div class="progress"></div></div>
+    <a href="#start-of-content" tabindex="1" class="accessibility-aid js-skip-to-content">Skip to content</a>
+
+    
+    
+    
+
+
+
+          <header class="site-header js-details-container" role="banner">
+  <div class="container-responsive">
+    <a class="header-logo-invertocat" href="https://github.com/" aria-label="Homepage" data-ga-click="(Logged out) Header, go to homepage, icon:logo-wordmark">
+      <svg aria-hidden="true" class="octicon octicon-mark-github" height="32" version="1.1" viewBox="0 0 16 16" width="32"><path d="M8 0C3.58 0 0 3.58 0 8c0 3.54 2.29 6.53 5.47 7.59.4.07.55-.17.55-.38 0-.19-.01-.82-.01-1.49-2.01.37-2.53-.49-2.69-.94-.09-.23-.48-.94-.82-1.13-.28-.15-.68-.52-.01-.53.63-.01 1.08.58 1.23.82.72 1.21 1.87.87 2.33.66.07-.52.28-.87.51-1.07-1.78-.2-3.64-.89-3.64-3.95 0-.87.31-1.59.82-2.15-.08-.2-.36-1.02.08-2.12 0 0 .67-.21 2.2.82.64-.18 1.32-.27 2-.27.68 0 1.36.09 2 .27 1.53-1.04 2.2-.82 2.2-.82.44 1.1.16 1.92.08 2.12.51.56.82 1.27.82 2.15 0 3.07-1.87 3.75-3.65 3.95.29.25.54.73.54 1.48 0 1.07-.01 1.93-.01 2.2 0 .21.15.46.55.38A8.013 8.013 0 0 0 16 8c0-4.42-3.58-8-8-8z"></path></svg>
+    </a>
+
+    <button class="btn-link float-right site-header-toggle js-details-target" type="button" aria-label="Toggle navigation">
+      <svg aria-hidden="true" class="octicon octicon-three-bars" height="24" version="1.1" viewBox="0 0 12 16" width="18"><path d="M11.41 9H.59C0 9 0 8.59 0 8c0-.59 0-1 .59-1H11.4c.59 0 .59.41.59 1 0 .59 0 1-.59 1h.01zm0-4H.59C0 5 0 4.59 0 4c0-.59 0-1 .59-1H11.4c.59 0 .59.41.59 1 0 .59 0 1-.59 1h.01zM.59 11H11.4c.59 0 .59.41.59 1 0 .59 0 1-.59 1H.59C0 13 0 12.59 0 12c0-.59 0-1 .59-1z"></path></svg>
+    </button>
+
+    <div class="site-header-menu">
+      <nav class="site-header-nav site-header-nav-main">
+        <a href="/personal" class="js-selected-navigation-item nav-item nav-item-personal" data-ga-click="Header, click, Nav menu - item:personal" data-selected-links="/personal /personal">
+          Personal
+</a>        <a href="/open-source" class="js-selected-navigation-item nav-item nav-item-opensource" data-ga-click="Header, click, Nav menu - item:opensource" data-selected-links="/open-source /open-source">
+          Open source
+</a>        <a href="/business" class="js-selected-navigation-item nav-item nav-item-business" data-ga-click="Header, click, Nav menu - item:business" data-selected-links="/business /business/partners /business/features /business/customers /business">
+          Business
+</a>        <a href="/explore" class="js-selected-navigation-item nav-item nav-item-explore" data-ga-click="Header, click, Nav menu - item:explore" data-selected-links="/explore /trending /trending/developers /integrations /integrations/feature/code /integrations/feature/collaborate /integrations/feature/ship /showcases /explore">
+          Explore
+</a>      </nav>
+
+      <div class="site-header-actions">
+            <a class="btn btn-primary site-header-actions-btn" href="/join?source=header-repo" data-ga-click="(Logged out) Header, clicked Sign up, text:sign-up">Sign up</a>
+          <a class="btn site-header-actions-btn mr-1" href="/login?return_to=%2Fjscert%2Fjscert%2Fblob%2Fmaster%2Fcoq%2FJsNumber.v" data-ga-click="(Logged out) Header, clicked Sign in, text:sign-in">Sign in</a>
+      </div>
+
+        <nav class="site-header-nav site-header-nav-secondary mr-md-3">
+          <a class="nav-item" href="/pricing">Pricing</a>
+          <a class="nav-item" href="/blog">Blog</a>
+          <a class="nav-item" href="https://help.github.com">Support</a>
+          <a class="nav-item header-search-link" href="https://github.com/search">Search GitHub</a>
+              <div class="header-search scoped-search site-scoped-search js-site-search" role="search">
+  <!-- '"` --><!-- </textarea></xmp> --></option></form><form accept-charset="UTF-8" action="/jscert/jscert/search" class="js-site-search-form" data-scoped-search-url="/jscert/jscert/search" data-unscoped-search-url="/search" method="get"><div style="margin:0;padding:0;display:inline"><input name="utf8" type="hidden" value="&#x2713;" /></div>
+    <label class="form-control header-search-wrapper js-chromeless-input-container">
+      <div class="header-search-scope">This repository</div>
+      <input type="text"
+        class="form-control header-search-input js-site-search-focus js-site-search-field is-clearable"
+        data-hotkey="s"
+        name="q"
+        placeholder="Search"
+        aria-label="Search this repository"
+        data-unscoped-placeholder="Search GitHub"
+        data-scoped-placeholder="Search"
+        autocapitalize="off">
+    </label>
+</form></div>
+
+        </nav>
+    </div>
+  </div>
+</header>
+
+
+
+    <div id="start-of-content" class="accessibility-aid"></div>
+
+      <div id="js-flash-container">
+</div>
+
+
+    <div role="main">
+        <div itemscope itemtype="http://schema.org/SoftwareSourceCode">
+    <div id="js-repo-pjax-container" data-pjax-container>
+      
+<div class="pagehead repohead instapaper_ignore readability-menu experiment-repo-nav">
+  <div class="container repohead-details-container">
+
+    
+
+<ul class="pagehead-actions">
+
+  <li>
+      <a href="/login?return_to=%2Fjscert%2Fjscert"
+    class="btn btn-sm btn-with-count tooltipped tooltipped-n"
+    aria-label="You must be signed in to watch a repository" rel="nofollow">
+    <svg aria-hidden="true" class="octicon octicon-eye" height="16" version="1.1" viewBox="0 0 16 16" width="16"><path d="M8.06 2C3 2 0 8 0 8s3 6 8.06 6C13 14 16 8 16 8s-3-6-7.94-6zM8 12c-2.2 0-4-1.78-4-4 0-2.2 1.8-4 4-4 2.22 0 4 1.8 4 4 0 2.22-1.78 4-4 4zm2-4c0 1.11-.89 2-2 2-1.11 0-2-.89-2-2 0-1.11.89-2 2-2 1.11 0 2 .89 2 2z"></path></svg>
+    Watch
+  </a>
+  <a class="social-count" href="/jscert/jscert/watchers"
+     aria-label="18 users are watching this repository">
+    18
+  </a>
+
+  </li>
+
+  <li>
+      <a href="/login?return_to=%2Fjscert%2Fjscert"
+    class="btn btn-sm btn-with-count tooltipped tooltipped-n"
+    aria-label="You must be signed in to star a repository" rel="nofollow">
+    <svg aria-hidden="true" class="octicon octicon-star" height="16" version="1.1" viewBox="0 0 14 16" width="14"><path d="M14 6l-4.9-.64L7 1 4.9 5.36 0 6l3.6 3.26L2.67 14 7 11.67 11.33 14l-.93-4.74z"></path></svg>
+    Star
+  </a>
+
+    <a class="social-count js-social-count" href="/jscert/jscert/stargazers"
+      aria-label="134 users starred this repository">
+      134
+    </a>
+
+  </li>
+
+  <li>
+      <a href="/login?return_to=%2Fjscert%2Fjscert"
+        class="btn btn-sm btn-with-count tooltipped tooltipped-n"
+        aria-label="You must be signed in to fork a repository" rel="nofollow">
+        <svg aria-hidden="true" class="octicon octicon-repo-forked" height="16" version="1.1" viewBox="0 0 10 16" width="10"><path d="M8 1a1.993 1.993 0 0 0-1 3.72V6L5 8 3 6V4.72A1.993 1.993 0 0 0 2 1a1.993 1.993 0 0 0-1 3.72V6.5l3 3v1.78A1.993 1.993 0 0 0 5 15a1.993 1.993 0 0 0 1-3.72V9.5l3-3V4.72A1.993 1.993 0 0 0 8 1zM2 4.2C1.34 4.2.8 3.65.8 3c0-.65.55-1.2 1.2-1.2.65 0 1.2.55 1.2 1.2 0 .65-.55 1.2-1.2 1.2zm3 10c-.66 0-1.2-.55-1.2-1.2 0-.65.55-1.2 1.2-1.2.65 0 1.2.55 1.2 1.2 0 .65-.55 1.2-1.2 1.2zm3-10c-.66 0-1.2-.55-1.2-1.2 0-.65.55-1.2 1.2-1.2.65 0 1.2.55 1.2 1.2 0 .65-.55 1.2-1.2 1.2z"></path></svg>
+        Fork
+      </a>
+
+    <a href="/jscert/jscert/network" class="social-count"
+       aria-label="4 users are forked this repository">
+      4
+    </a>
+  </li>
+</ul>
+
+    <h1 class="public ">
+  <svg aria-hidden="true" class="octicon octicon-repo" height="16" version="1.1" viewBox="0 0 12 16" width="12"><path d="M4 9H3V8h1v1zm0-3H3v1h1V6zm0-2H3v1h1V4zm0-2H3v1h1V2zm8-1v12c0 .55-.45 1-1 1H6v2l-1.5-1.5L3 16v-2H1c-.55 0-1-.45-1-1V1c0-.55.45-1 1-1h10c.55 0 1 .45 1 1zm-1 10H1v2h2v-1h3v1h5v-2zm0-10H2v9h9V1z"></path></svg>
+  <span class="author" itemprop="author"><a href="/jscert" class="url fn" rel="author">jscert</a></span><!--
+--><span class="path-divider">/</span><!--
+--><strong itemprop="name"><a href="/jscert/jscert" data-pjax="#js-repo-pjax-container">jscert</a></strong>
+
+</h1>
+
+  </div>
+  <div class="container">
+    
+<nav class="reponav js-repo-nav js-sidenav-container-pjax"
+     itemscope
+     itemtype="http://schema.org/BreadcrumbList"
+     role="navigation"
+     data-pjax="#js-repo-pjax-container">
+
+  <span itemscope itemtype="http://schema.org/ListItem" itemprop="itemListElement">
+    <a href="/jscert/jscert" aria-selected="true" class="js-selected-navigation-item selected reponav-item" data-hotkey="g c" data-selected-links="repo_source repo_downloads repo_commits repo_releases repo_tags repo_branches /jscert/jscert" itemprop="url">
+      <svg aria-hidden="true" class="octicon octicon-code" height="16" version="1.1" viewBox="0 0 14 16" width="14"><path d="M9.5 3L8 4.5 11.5 8 8 11.5 9.5 13 14 8 9.5 3zm-5 0L0 8l4.5 5L6 11.5 2.5 8 6 4.5 4.5 3z"></path></svg>
+      <span itemprop="name">Code</span>
+      <meta itemprop="position" content="1">
+</a>  </span>
+
+    <span itemscope itemtype="http://schema.org/ListItem" itemprop="itemListElement">
+      <a href="/jscert/jscert/issues" class="js-selected-navigation-item reponav-item" data-hotkey="g i" data-selected-links="repo_issues repo_labels repo_milestones /jscert/jscert/issues" itemprop="url">
+        <svg aria-hidden="true" class="octicon octicon-issue-opened" height="16" version="1.1" viewBox="0 0 14 16" width="14"><path d="M7 2.3c3.14 0 5.7 2.56 5.7 5.7s-2.56 5.7-5.7 5.7A5.71 5.71 0 0 1 1.3 8c0-3.14 2.56-5.7 5.7-5.7zM7 1C3.14 1 0 4.14 0 8s3.14 7 7 7 7-3.14 7-7-3.14-7-7-7zm1 3H6v5h2V4zm0 6H6v2h2v-2z"></path></svg>
+        <span itemprop="name">Issues</span>
+        <span class="counter">1</span>
+        <meta itemprop="position" content="2">
+</a>    </span>
+
+  <span itemscope itemtype="http://schema.org/ListItem" itemprop="itemListElement">
+    <a href="/jscert/jscert/pulls" class="js-selected-navigation-item reponav-item" data-hotkey="g p" data-selected-links="repo_pulls /jscert/jscert/pulls" itemprop="url">
+      <svg aria-hidden="true" class="octicon octicon-git-pull-request" height="16" version="1.1" viewBox="0 0 12 16" width="12"><path d="M11 11.28V5c-.03-.78-.34-1.47-.94-2.06C9.46 2.35 8.78 2.03 8 2H7V0L4 3l3 3V4h1c.27.02.48.11.69.31.21.2.3.42.31.69v6.28A1.993 1.993 0 0 0 10 15a1.993 1.993 0 0 0 1-3.72zm-1 2.92c-.66 0-1.2-.55-1.2-1.2 0-.65.55-1.2 1.2-1.2.65 0 1.2.55 1.2 1.2 0 .65-.55 1.2-1.2 1.2zM4 3c0-1.11-.89-2-2-2a1.993 1.993 0 0 0-1 3.72v6.56A1.993 1.993 0 0 0 2 15a1.993 1.993 0 0 0 1-3.72V4.72c.59-.34 1-.98 1-1.72zm-.8 10c0 .66-.55 1.2-1.2 1.2-.65 0-1.2-.55-1.2-1.2 0-.65.55-1.2 1.2-1.2.65 0 1.2.55 1.2 1.2zM2 4.2C1.34 4.2.8 3.65.8 3c0-.65.55-1.2 1.2-1.2.65 0 1.2.55 1.2 1.2 0 .65-.55 1.2-1.2 1.2z"></path></svg>
+      <span itemprop="name">Pull requests</span>
+      <span class="counter">1</span>
+      <meta itemprop="position" content="3">
+</a>  </span>
+
+  <a href="/jscert/jscert/projects" class="js-selected-navigation-item reponav-item" data-selected-links="repo_projects new_repo_project repo_project /jscert/jscert/projects">
+    <svg class="octicon" aria-hidden="true" version="1.1" width="15" height="16" viewBox="0 0 15 16">
+      <path d="M1 15h13V1H1v14zM15 1v14a1 1 0 0 1-1 1H1a1 1 0 0 1-1-1V1a1 1 0 0 1 1-1h13a1 1 0 0 1 1 1zm-4.41 11h1.82c.59 0 .59-.41.59-1V3c0-.59 0-1-.59-1h-1.82C10 2 10 2.41 10 3v8c0 .59 0 1 .59 1zm-4-2h1.82C9 10 9 9.59 9 9V3c0-.59 0-1-.59-1H6.59C6 2 6 2.41 6 3v6c0 .59 0 1 .59 1zM2 13V3c0-.59 0-1 .59-1h1.82C5 2 5 2.41 5 3v10c0 .59 0 1-.59 1H2.59C2 14 2 13.59 2 13z"></path>
+    </svg>
+    Projects
+    <span class="counter">0</span>
+</a>
+
+
+  <a href="/jscert/jscert/pulse" class="js-selected-navigation-item reponav-item" data-selected-links="pulse /jscert/jscert/pulse">
+    <svg aria-hidden="true" class="octicon octicon-pulse" height="16" version="1.1" viewBox="0 0 14 16" width="14"><path d="M11.5 8L8.8 5.4 6.6 8.5 5.5 1.6 2.38 8H0v2h3.6l.9-1.8.9 5.4L9 8.5l1.6 1.5H14V8z"></path></svg>
+    Pulse
+</a>
+  <a href="/jscert/jscert/graphs" class="js-selected-navigation-item reponav-item" data-selected-links="repo_graphs repo_contributors /jscert/jscert/graphs">
+    <svg aria-hidden="true" class="octicon octicon-graph" height="16" version="1.1" viewBox="0 0 16 16" width="16"><path d="M16 14v1H0V0h1v14h15zM5 13H3V8h2v5zm4 0H7V3h2v10zm4 0h-2V6h2v7z"></path></svg>
+    Graphs
+</a>
+
+</nav>
+
+  </div>
+</div>
+
+<div class="container new-discussion-timeline experiment-repo-nav">
+  <div class="repository-content">
+
+    
+
+<a href="/jscert/jscert/blob/4aab3191be47026543e08ff6b8501fae5b26a4b6/coq/JsNumber.v" class="d-none js-permalink-shortcut" data-hotkey="y">Permalink</a>
+
+<!-- blob contrib key: blob_contributors:v21:51955475f0223f4d59bcead4ee65ffa3 -->
+
+<div class="file-navigation js-zeroclipboard-container">
+  
+<div class="select-menu branch-select-menu js-menu-container js-select-menu float-left">
+  <button class="btn btn-sm select-menu-button js-menu-target css-truncate" data-hotkey="w"
+    
+    type="button" aria-label="Switch branches or tags" tabindex="0" aria-haspopup="true">
+    <i>Branch:</i>
+    <span class="js-select-button css-truncate-target">master</span>
+  </button>
+
+  <div class="select-menu-modal-holder js-menu-content js-navigation-container" data-pjax aria-hidden="true">
+
+    <div class="select-menu-modal">
+      <div class="select-menu-header">
+        <svg aria-label="Close" class="octicon octicon-x js-menu-close" height="16" role="img" version="1.1" viewBox="0 0 12 16" width="12"><path d="M7.48 8l3.75 3.75-1.48 1.48L6 9.48l-3.75 3.75-1.48-1.48L4.52 8 .77 4.25l1.48-1.48L6 6.52l3.75-3.75 1.48 1.48z"></path></svg>
+        <span class="select-menu-title">Switch branches/tags</span>
+      </div>
+
+      <div class="select-menu-filters">
+        <div class="select-menu-text-filter">
+          <input type="text" aria-label="Filter branches/tags" id="context-commitish-filter-field" class="form-control js-filterable-field js-navigation-enable" placeholder="Filter branches/tags">
+        </div>
+        <div class="select-menu-tabs">
+          <ul>
+            <li class="select-menu-tab">
+              <a href="#" data-tab-filter="branches" data-filter-placeholder="Filter branches/tags" class="js-select-menu-tab" role="tab">Branches</a>
+            </li>
+            <li class="select-menu-tab">
+              <a href="#" data-tab-filter="tags" data-filter-placeholder="Find a tag…" class="js-select-menu-tab" role="tab">Tags</a>
+            </li>
+          </ul>
+        </div>
+      </div>
+
+      <div class="select-menu-list select-menu-tab-bucket js-select-menu-tab-bucket" data-tab-filter="branches" role="menu">
+
+        <div data-filterable-for="context-commitish-filter-field" data-filterable-type="substring">
+
+
+            <a class="select-menu-item js-navigation-item js-navigation-open selected"
+               href="/jscert/jscert/blob/master/coq/JsNumber.v"
+               data-name="master"
+               data-skip-pjax="true"
+               rel="nofollow">
+              <svg aria-hidden="true" class="octicon octicon-check select-menu-item-icon" height="16" version="1.1" viewBox="0 0 12 16" width="12"><path d="M12 5l-8 8-4-4 1.5-1.5L4 10l6.5-6.5z"></path></svg>
+              <span class="select-menu-item-text css-truncate-target js-select-menu-filter-text">
+                master
+              </span>
+            </a>
+            <a class="select-menu-item js-navigation-item js-navigation-open "
+               href="/jscert/jscert/blob/wellformedness/coq/JsNumber.v"
+               data-name="wellformedness"
+               data-skip-pjax="true"
+               rel="nofollow">
+              <svg aria-hidden="true" class="octicon octicon-check select-menu-item-icon" height="16" version="1.1" viewBox="0 0 12 16" width="12"><path d="M12 5l-8 8-4-4 1.5-1.5L4 10l6.5-6.5z"></path></svg>
+              <span class="select-menu-item-text css-truncate-target js-select-menu-filter-text">
+                wellformedness
+              </span>
+            </a>
+        </div>
+
+          <div class="select-menu-no-results">Nothing to show</div>
+      </div>
+
+      <div class="select-menu-list select-menu-tab-bucket js-select-menu-tab-bucket" data-tab-filter="tags">
+        <div data-filterable-for="context-commitish-filter-field" data-filterable-type="substring">
+
+
+            <a class="select-menu-item js-navigation-item js-navigation-open "
+              href="/jscert/jscert/tree/popl14-results/coq/JsNumber.v"
+              data-name="popl14-results"
+              data-skip-pjax="true"
+              rel="nofollow">
+              <svg aria-hidden="true" class="octicon octicon-check select-menu-item-icon" height="16" version="1.1" viewBox="0 0 12 16" width="12"><path d="M12 5l-8 8-4-4 1.5-1.5L4 10l6.5-6.5z"></path></svg>
+              <span class="select-menu-item-text css-truncate-target" title="popl14-results">
+                popl14-results
+              </span>
+            </a>
+            <a class="select-menu-item js-navigation-item js-navigation-open "
+              href="/jscert/jscert/tree/popl14-release/coq/JsNumber.v"
+              data-name="popl14-release"
+              data-skip-pjax="true"
+              rel="nofollow">
+              <svg aria-hidden="true" class="octicon octicon-check select-menu-item-icon" height="16" version="1.1" viewBox="0 0 12 16" width="12"><path d="M12 5l-8 8-4-4 1.5-1.5L4 10l6.5-6.5z"></path></svg>
+              <span class="select-menu-item-text css-truncate-target" title="popl14-release">
+                popl14-release
+              </span>
+            </a>
+            <a class="select-menu-item js-navigation-item js-navigation-open "
+              href="/jscert/jscert/tree/popl14-camera-ready/coq/JsNumber.v"
+              data-name="popl14-camera-ready"
+              data-skip-pjax="true"
+              rel="nofollow">
+              <svg aria-hidden="true" class="octicon octicon-check select-menu-item-icon" height="16" version="1.1" viewBox="0 0 12 16" width="12"><path d="M12 5l-8 8-4-4 1.5-1.5L4 10l6.5-6.5z"></path></svg>
+              <span class="select-menu-item-text css-truncate-target" title="popl14-camera-ready">
+                popl14-camera-ready
+              </span>
+            </a>
+        </div>
+
+        <div class="select-menu-no-results">Nothing to show</div>
+      </div>
+
+    </div>
+  </div>
+</div>
+
+  <div class="BtnGroup float-right">
+    <a href="/jscert/jscert/find/master"
+          class="js-pjax-capture-input btn btn-sm BtnGroup-item"
+          data-pjax
+          data-hotkey="t">
+      Find file
+    </a>
+    <button aria-label="Copy file path to clipboard" class="js-zeroclipboard btn btn-sm BtnGroup-item tooltipped tooltipped-s" data-copied-hint="Copied!" type="button">Copy path</button>
+  </div>
+  <div class="breadcrumb js-zeroclipboard-target">
+    <span class="repo-root js-repo-root"><span class="js-path-segment"><a href="/jscert/jscert"><span>jscert</span></a></span></span><span class="separator">/</span><span class="js-path-segment"><a href="/jscert/jscert/tree/master/coq"><span>coq</span></a></span><span class="separator">/</span><strong class="final-path">JsNumber.v</strong>
+  </div>
+</div>
+
+
+  <div class="commit-tease">
+      <span class="float-right">
+        <a class="commit-tease-sha" href="/jscert/jscert/commit/da30e0c8f70a20caed7c791b400ec7fe14dab830" data-pjax>
+          da30e0c
+        </a>
+        <relative-time datetime="2015-07-19T20:10:58Z">Jul 20, 2015</relative-time>
+      </span>
+      <div>
+        <img alt="@edgemaster" class="avatar" height="20" src="https://avatars1.githubusercontent.com/u/98555?v=3&amp;s=40" width="20" />
+        <a href="/edgemaster" class="user-mention" rel="contributor">edgemaster</a>
+          <a href="/jscert/jscert/commit/da30e0c8f70a20caed7c791b400ec7fe14dab830" class="message" data-pjax="true" title="Add Math.LN2">Add Math.LN2</a>
+      </div>
+
+    <div class="commit-tease-contributors">
+      <button type="button" class="btn-link muted-link contributors-toggle" data-facebox="#blob_contributors_box">
+        <strong>5</strong>
+         contributors
+      </button>
+          <a class="avatar-link tooltipped tooltipped-s" aria-label="charguer" href="/jscert/jscert/commits/master/coq/JsNumber.v?author=charguer"><img alt="@charguer" class="avatar" height="20" src="https://avatars1.githubusercontent.com/u/1830652?v=3&amp;s=40" width="20" /> </a>
+    <a class="avatar-link tooltipped tooltipped-s" aria-label="brabalan" href="/jscert/jscert/commits/master/coq/JsNumber.v?author=brabalan"><img alt="@brabalan" class="avatar" height="20" src="https://avatars2.githubusercontent.com/u/1021637?v=3&amp;s=40" width="20" /> </a>
+    <a class="avatar-link tooltipped tooltipped-s" aria-label="edgemaster" href="/jscert/jscert/commits/master/coq/JsNumber.v?author=edgemaster"><img alt="@edgemaster" class="avatar" height="20" src="https://avatars1.githubusercontent.com/u/98555?v=3&amp;s=40" width="20" /> </a>
+    <a class="avatar-link tooltipped tooltipped-s" aria-label="Mbodin" href="/jscert/jscert/commits/master/coq/JsNumber.v?author=Mbodin"><img alt="@Mbodin" class="avatar" height="20" src="https://avatars1.githubusercontent.com/u/1829786?v=3&amp;s=40" width="20" /> </a>
+    <a class="avatar-link tooltipped tooltipped-s" aria-label="PetarMax" href="/jscert/jscert/commits/master/coq/JsNumber.v?author=PetarMax"><img alt="@PetarMax" class="avatar" height="20" src="https://avatars2.githubusercontent.com/u/8540490?v=3&amp;s=40" width="20" /> </a>
+
+
+    </div>
+
+    <div id="blob_contributors_box" style="display:none">
+      <h2 class="facebox-header" data-facebox-id="facebox-header">Users who have contributed to this file</h2>
+      <ul class="facebox-user-list" data-facebox-id="facebox-description">
+          <li class="facebox-user-list-item">
+            <img alt="@charguer" height="24" src="https://avatars3.githubusercontent.com/u/1830652?v=3&amp;s=48" width="24" />
+            <a href="/charguer">charguer</a>
+          </li>
+          <li class="facebox-user-list-item">
+            <img alt="@brabalan" height="24" src="https://avatars0.githubusercontent.com/u/1021637?v=3&amp;s=48" width="24" />
+            <a href="/brabalan">brabalan</a>
+          </li>
+          <li class="facebox-user-list-item">
+            <img alt="@edgemaster" height="24" src="https://avatars3.githubusercontent.com/u/98555?v=3&amp;s=48" width="24" />
+            <a href="/edgemaster">edgemaster</a>
+          </li>
+          <li class="facebox-user-list-item">
+            <img alt="@Mbodin" height="24" src="https://avatars3.githubusercontent.com/u/1829786?v=3&amp;s=48" width="24" />
+            <a href="/Mbodin">Mbodin</a>
+          </li>
+          <li class="facebox-user-list-item">
+            <img alt="@PetarMax" height="24" src="https://avatars0.githubusercontent.com/u/8540490?v=3&amp;s=48" width="24" />
+            <a href="/PetarMax">PetarMax</a>
+          </li>
+      </ul>
+    </div>
+  </div>
+
+<div class="file">
+  <div class="file-header">
+  <div class="file-actions">
+
+    <div class="BtnGroup">
+      <a href="/jscert/jscert/raw/master/coq/JsNumber.v" class="btn btn-sm BtnGroup-item" id="raw-url">Raw</a>
+        <a href="/jscert/jscert/blame/master/coq/JsNumber.v" class="btn btn-sm js-update-url-with-hash BtnGroup-item">Blame</a>
+      <a href="/jscert/jscert/commits/master/coq/JsNumber.v" class="btn btn-sm BtnGroup-item" rel="nofollow">History</a>
+    </div>
+
+
+        <button type="button" class="btn-octicon disabled tooltipped tooltipped-nw"
+          aria-label="You must be signed in to make or propose changes">
+          <svg aria-hidden="true" class="octicon octicon-pencil" height="16" version="1.1" viewBox="0 0 14 16" width="14"><path d="M0 12v3h3l8-8-3-3-8 8zm3 2H1v-2h1v1h1v1zm10.3-9.3L12 6 9 3l1.3-1.3a.996.996 0 0 1 1.41 0l1.59 1.59c.39.39.39 1.02 0 1.41z"></path></svg>
+        </button>
+        <button type="button" class="btn-octicon btn-octicon-danger disabled tooltipped tooltipped-nw"
+          aria-label="You must be signed in to make or propose changes">
+          <svg aria-hidden="true" class="octicon octicon-trashcan" height="16" version="1.1" viewBox="0 0 12 16" width="12"><path d="M11 2H9c0-.55-.45-1-1-1H5c-.55 0-1 .45-1 1H2c-.55 0-1 .45-1 1v1c0 .55.45 1 1 1v9c0 .55.45 1 1 1h7c.55 0 1-.45 1-1V5c.55 0 1-.45 1-1V3c0-.55-.45-1-1-1zm-1 12H3V5h1v8h1V5h1v8h1V5h1v8h1V5h1v9zm1-10H2V3h9v1z"></path></svg>
+        </button>
+  </div>
+
+  <div class="file-info">
+      108 lines (68 sloc)
+      <span class="file-info-divider"></span>
+    3.14 KB
+  </div>
+</div>
+
+  
+
+  <div itemprop="text" class="blob-wrapper data type-verilog">
+      <table class="highlight tab-size js-file-line-container" data-tab-size="8">
+      <tr>
+        <td id="L1" class="blob-num js-line-number" data-line-number="1"></td>
+        <td id="LC1" class="blob-code blob-code-inner js-file-line">Set Implicit Arguments.</td>
+      </tr>
+      <tr>
+        <td id="L2" class="blob-num js-line-number" data-line-number="2"></td>
+        <td id="LC2" class="blob-code blob-code-inner js-file-line">Require Export Shared.</td>
+      </tr>
+      <tr>
+        <td id="L3" class="blob-num js-line-number" data-line-number="3"></td>
+        <td id="LC3" class="blob-code blob-code-inner js-file-line">Require Flocq.Appli.Fappli_IEEE Flocq.Appli.Fappli_IEEE_bits.</td>
+      </tr>
+      <tr>
+        <td id="L4" class="blob-num js-line-number" data-line-number="4"></td>
+        <td id="LC4" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L5" class="blob-num js-line-number" data-line-number="5"></td>
+        <td id="LC5" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L6" class="blob-num js-line-number" data-line-number="6"></td>
+        <td id="LC6" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">**************************************************************</span>)</td>
+      </tr>
+      <tr>
+        <td id="L7" class="blob-num js-line-number" data-line-number="7"></td>
+        <td id="LC7" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">**</span> <span class="pl-k">**</span> Type <span class="pl-k">for</span> number (IEEE floats) <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L8" class="blob-num js-line-number" data-line-number="8"></td>
+        <td id="LC8" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L9" class="blob-num js-line-number" data-line-number="9"></td>
+        <td id="LC9" class="blob-code blob-code-inner js-file-line">Definition number : Type :<span class="pl-k">=</span></td>
+      </tr>
+      <tr>
+        <td id="L10" class="blob-num js-line-number" data-line-number="10"></td>
+        <td id="LC10" class="blob-code blob-code-inner js-file-line">  Fappli_IEEE_bits.binary64.</td>
+      </tr>
+      <tr>
+        <td id="L11" class="blob-num js-line-number" data-line-number="11"></td>
+        <td id="LC11" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L12" class="blob-num js-line-number" data-line-number="12"></td>
+        <td id="LC12" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L13" class="blob-num js-line-number" data-line-number="13"></td>
+        <td id="LC13" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">**************************************************************</span>)</td>
+      </tr>
+      <tr>
+        <td id="L14" class="blob-num js-line-number" data-line-number="14"></td>
+        <td id="LC14" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">**</span> <span class="pl-k">**</span> Particular values of numbers <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L15" class="blob-num js-line-number" data-line-number="15"></td>
+        <td id="LC15" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L16" class="blob-num js-line-number" data-line-number="16"></td>
+        <td id="LC16" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">*</span> LATER: find definitions in Flocq <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L17" class="blob-num js-line-number" data-line-number="17"></td>
+        <td id="LC17" class="blob-code blob-code-inner js-file-line">Parameter nan : number.</td>
+      </tr>
+      <tr>
+        <td id="L18" class="blob-num js-line-number" data-line-number="18"></td>
+        <td id="LC18" class="blob-code blob-code-inner js-file-line">Parameter zero : number.</td>
+      </tr>
+      <tr>
+        <td id="L19" class="blob-num js-line-number" data-line-number="19"></td>
+        <td id="LC19" class="blob-code blob-code-inner js-file-line">Parameter neg_zero : number.</td>
+      </tr>
+      <tr>
+        <td id="L20" class="blob-num js-line-number" data-line-number="20"></td>
+        <td id="LC20" class="blob-code blob-code-inner js-file-line">Definition one :<span class="pl-k">=</span> Fappli_IEEE.binary_normalize <span class="pl-c1">53</span> <span class="pl-c1">1024</span> eq_refl eq_refl Fappli_IEEE.mode_NE <span class="pl-c1">1</span> <span class="pl-c1">0</span> false.</td>
+      </tr>
+      <tr>
+        <td id="L21" class="blob-num js-line-number" data-line-number="21"></td>
+        <td id="LC21" class="blob-code blob-code-inner js-file-line">Parameter infinity : number.</td>
+      </tr>
+      <tr>
+        <td id="L22" class="blob-num js-line-number" data-line-number="22"></td>
+        <td id="LC22" class="blob-code blob-code-inner js-file-line">Parameter neg_infinity : number.</td>
+      </tr>
+      <tr>
+        <td id="L23" class="blob-num js-line-number" data-line-number="23"></td>
+        <td id="LC23" class="blob-code blob-code-inner js-file-line">Parameter max_value : number.</td>
+      </tr>
+      <tr>
+        <td id="L24" class="blob-num js-line-number" data-line-number="24"></td>
+        <td id="LC24" class="blob-code blob-code-inner js-file-line">Parameter min_value : number.</td>
+      </tr>
+      <tr>
+        <td id="L25" class="blob-num js-line-number" data-line-number="25"></td>
+        <td id="LC25" class="blob-code blob-code-inner js-file-line">Parameter pi : number.</td>
+      </tr>
+      <tr>
+        <td id="L26" class="blob-num js-line-number" data-line-number="26"></td>
+        <td id="LC26" class="blob-code blob-code-inner js-file-line">Parameter e : number.</td>
+      </tr>
+      <tr>
+        <td id="L27" class="blob-num js-line-number" data-line-number="27"></td>
+        <td id="LC27" class="blob-code blob-code-inner js-file-line">Parameter ln2 : number.</td>
+      </tr>
+      <tr>
+        <td id="L28" class="blob-num js-line-number" data-line-number="28"></td>
+        <td id="LC28" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L29" class="blob-num js-line-number" data-line-number="29"></td>
+        <td id="LC29" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">**************************************************************</span>)</td>
+      </tr>
+      <tr>
+        <td id="L30" class="blob-num js-line-number" data-line-number="30"></td>
+        <td id="LC30" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">**</span> <span class="pl-k">**</span> Conversions on numbers <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L31" class="blob-num js-line-number" data-line-number="31"></td>
+        <td id="LC31" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L32" class="blob-num js-line-number" data-line-number="32"></td>
+        <td id="LC32" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">*</span> LATER: implement definitions <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L33" class="blob-num js-line-number" data-line-number="33"></td>
+        <td id="LC33" class="blob-code blob-code-inner js-file-line">Parameter from_string : string <span class="pl-k">-&gt;</span> number.</td>
+      </tr>
+      <tr>
+        <td id="L34" class="blob-num js-line-number" data-line-number="34"></td>
+        <td id="LC34" class="blob-code blob-code-inner js-file-line">Parameter to_string : number <span class="pl-k">-&gt;</span> string.</td>
+      </tr>
+      <tr>
+        <td id="L35" class="blob-num js-line-number" data-line-number="35"></td>
+        <td id="LC35" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L36" class="blob-num js-line-number" data-line-number="36"></td>
+        <td id="LC36" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">**************************************************************</span>)</td>
+      </tr>
+      <tr>
+        <td id="L37" class="blob-num js-line-number" data-line-number="37"></td>
+        <td id="LC37" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">**</span> <span class="pl-k">**</span> Unary operations on numbers <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L38" class="blob-num js-line-number" data-line-number="38"></td>
+        <td id="LC38" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L39" class="blob-num js-line-number" data-line-number="39"></td>
+        <td id="LC39" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">*</span> LATER: find definitions in Flocq <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L40" class="blob-num js-line-number" data-line-number="40"></td>
+        <td id="LC40" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L41" class="blob-num js-line-number" data-line-number="41"></td>
+        <td id="LC41" class="blob-code blob-code-inner js-file-line">Parameter neg : number <span class="pl-k">-&gt;</span> number.</td>
+      </tr>
+      <tr>
+        <td id="L42" class="blob-num js-line-number" data-line-number="42"></td>
+        <td id="LC42" class="blob-code blob-code-inner js-file-line">Parameter floor : number <span class="pl-k">-&gt;</span> number.</td>
+      </tr>
+      <tr>
+        <td id="L43" class="blob-num js-line-number" data-line-number="43"></td>
+        <td id="LC43" class="blob-code blob-code-inner js-file-line">Parameter absolute : number <span class="pl-k">-&gt;</span> number.</td>
+      </tr>
+      <tr>
+        <td id="L44" class="blob-num js-line-number" data-line-number="44"></td>
+        <td id="LC44" class="blob-code blob-code-inner js-file-line">Parameter sign : number <span class="pl-k">-&gt;</span> number. (<span class="pl-k">*</span> returns arbitrary when <span class="pl-c1">x</span> is zero <span class="pl-k">or</span> nan <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L45" class="blob-num js-line-number" data-line-number="45"></td>
+        <td id="LC45" class="blob-code blob-code-inner js-file-line">Parameter lt_bool : number <span class="pl-k">-&gt;</span> number <span class="pl-k">-&gt;</span> bool.</td>
+      </tr>
+      <tr>
+        <td id="L46" class="blob-num js-line-number" data-line-number="46"></td>
+        <td id="LC46" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L47" class="blob-num js-line-number" data-line-number="47"></td>
+        <td id="LC47" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L48" class="blob-num js-line-number" data-line-number="48"></td>
+        <td id="LC48" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">**************************************************************</span>)</td>
+      </tr>
+      <tr>
+        <td id="L49" class="blob-num js-line-number" data-line-number="49"></td>
+        <td id="LC49" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">**</span> <span class="pl-k">**</span> Binary operations on numbers <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L50" class="blob-num js-line-number" data-line-number="50"></td>
+        <td id="LC50" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L51" class="blob-num js-line-number" data-line-number="51"></td>
+        <td id="LC51" class="blob-code blob-code-inner js-file-line">Definition add : number <span class="pl-k">-&gt;</span> number <span class="pl-k">-&gt;</span> number :<span class="pl-k">=</span></td>
+      </tr>
+      <tr>
+        <td id="L52" class="blob-num js-line-number" data-line-number="52"></td>
+        <td id="LC52" class="blob-code blob-code-inner js-file-line">  Fappli_IEEE_bits.b64_plus Fappli_IEEE.mode_NE.</td>
+      </tr>
+      <tr>
+        <td id="L53" class="blob-num js-line-number" data-line-number="53"></td>
+        <td id="LC53" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L54" class="blob-num js-line-number" data-line-number="54"></td>
+        <td id="LC54" class="blob-code blob-code-inner js-file-line">Parameter sub : number <span class="pl-k">-&gt;</span> number <span class="pl-k">-&gt;</span> number. (<span class="pl-k">*</span> todo: bind <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L55" class="blob-num js-line-number" data-line-number="55"></td>
+        <td id="LC55" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L56" class="blob-num js-line-number" data-line-number="56"></td>
+        <td id="LC56" class="blob-code blob-code-inner js-file-line">Parameter fmod : number <span class="pl-k">-&gt;</span> number <span class="pl-k">-&gt;</span> number. (<span class="pl-k">*</span> todo: bind <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L57" class="blob-num js-line-number" data-line-number="57"></td>
+        <td id="LC57" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L58" class="blob-num js-line-number" data-line-number="58"></td>
+        <td id="LC58" class="blob-code blob-code-inner js-file-line">Definition mult : number <span class="pl-k">-&gt;</span> number <span class="pl-k">-&gt;</span> number :<span class="pl-k">=</span></td>
+      </tr>
+      <tr>
+        <td id="L59" class="blob-num js-line-number" data-line-number="59"></td>
+        <td id="LC59" class="blob-code blob-code-inner js-file-line">  Fappli_IEEE_bits.b64_mult Fappli_IEEE.mode_NE.</td>
+      </tr>
+      <tr>
+        <td id="L60" class="blob-num js-line-number" data-line-number="60"></td>
+        <td id="LC60" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L61" class="blob-num js-line-number" data-line-number="61"></td>
+        <td id="LC61" class="blob-code blob-code-inner js-file-line">Definition div : number <span class="pl-k">-&gt;</span> number <span class="pl-k">-&gt;</span> number :<span class="pl-k">=</span></td>
+      </tr>
+      <tr>
+        <td id="L62" class="blob-num js-line-number" data-line-number="62"></td>
+        <td id="LC62" class="blob-code blob-code-inner js-file-line">  Fappli_IEEE_bits.b64_div Fappli_IEEE.mode_NE.</td>
+      </tr>
+      <tr>
+        <td id="L63" class="blob-num js-line-number" data-line-number="63"></td>
+        <td id="LC63" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L64" class="blob-num js-line-number" data-line-number="64"></td>
+        <td id="LC64" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">*</span> Todo: find comparison operator <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L65" class="blob-num js-line-number" data-line-number="65"></td>
+        <td id="LC65" class="blob-code blob-code-inner js-file-line">Global Instance number_comparable : Comparable number.</td>
+      </tr>
+      <tr>
+        <td id="L66" class="blob-num js-line-number" data-line-number="66"></td>
+        <td id="LC66" class="blob-code blob-code-inner js-file-line">Proof. Admitted.</td>
+      </tr>
+      <tr>
+        <td id="L67" class="blob-num js-line-number" data-line-number="67"></td>
+        <td id="LC67" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L68" class="blob-num js-line-number" data-line-number="68"></td>
+        <td id="LC68" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L69" class="blob-num js-line-number" data-line-number="69"></td>
+        <td id="LC69" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L70" class="blob-num js-line-number" data-line-number="70"></td>
+        <td id="LC70" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">**************************************************************</span>)</td>
+      </tr>
+      <tr>
+        <td id="L71" class="blob-num js-line-number" data-line-number="71"></td>
+        <td id="LC71" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">**</span> <span class="pl-k">**</span> Conversions with Int32 <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L72" class="blob-num js-line-number" data-line-number="72"></td>
+        <td id="LC72" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L73" class="blob-num js-line-number" data-line-number="73"></td>
+        <td id="LC73" class="blob-code blob-code-inner js-file-line">Parameter of_int : int <span class="pl-k">-&gt;</span> number. (<span class="pl-k">*</span> LATER: this is quite complex. Should we make it precise? <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L74" class="blob-num js-line-number" data-line-number="74"></td>
+        <td id="LC74" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L75" class="blob-num js-line-number" data-line-number="75"></td>
+        <td id="LC75" class="blob-code blob-code-inner js-file-line">Parameter to_int32 : number <span class="pl-k">-&gt;</span> int. (<span class="pl-k">*</span> Remark: extracted code could, <span class="pl-k">for</span> efficiency reasons, use Ocaml Int32 <span class="pl-k">*</span>) </td>
+      </tr>
+      <tr>
+        <td id="L76" class="blob-num js-line-number" data-line-number="76"></td>
+        <td id="LC76" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L77" class="blob-num js-line-number" data-line-number="77"></td>
+        <td id="LC77" class="blob-code blob-code-inner js-file-line">Parameter to_uint32 : number <span class="pl-k">-&gt;</span> int.</td>
+      </tr>
+      <tr>
+        <td id="L78" class="blob-num js-line-number" data-line-number="78"></td>
+        <td id="LC78" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L79" class="blob-num js-line-number" data-line-number="79"></td>
+        <td id="LC79" class="blob-code blob-code-inner js-file-line">Parameter to_int16 : number <span class="pl-k">-&gt;</span> int. (<span class="pl-k">*</span> currently <span class="pl-k">not</span> used <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L80" class="blob-num js-line-number" data-line-number="80"></td>
+        <td id="LC80" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L81" class="blob-num js-line-number" data-line-number="81"></td>
+        <td id="LC81" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">*</span> LATER: Check that the OCaml extraction is correct. <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L82" class="blob-num js-line-number" data-line-number="82"></td>
+        <td id="LC82" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L83" class="blob-num js-line-number" data-line-number="83"></td>
+        <td id="LC83" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L84" class="blob-num js-line-number" data-line-number="84"></td>
+        <td id="LC84" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">**************************************************************</span>)</td>
+      </tr>
+      <tr>
+        <td id="L85" class="blob-num js-line-number" data-line-number="85"></td>
+        <td id="LC85" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L86" class="blob-num js-line-number" data-line-number="86"></td>
+        <td id="LC86" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">**</span> Implements the operation that masks all but the <span class="pl-c1">5</span> least significant bits</td>
+      </tr>
+      <tr>
+        <td id="L87" class="blob-num js-line-number" data-line-number="87"></td>
+        <td id="LC87" class="blob-code blob-code-inner js-file-line">   of a non<span class="pl-k">-</span>negative number (obtained as the result of to_uint32 <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L88" class="blob-num js-line-number" data-line-number="88"></td>
+        <td id="LC88" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L89" class="blob-num js-line-number" data-line-number="89"></td>
+        <td id="LC89" class="blob-code blob-code-inner js-file-line">Parameter modulo_32 : int <span class="pl-k">-&gt;</span> int.</td>
+      </tr>
+      <tr>
+        <td id="L90" class="blob-num js-line-number" data-line-number="90"></td>
+        <td id="LC90" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L91" class="blob-num js-line-number" data-line-number="91"></td>
+        <td id="LC91" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">**</span> Implements int32 operation <span class="pl-k">*</span>)</td>
+      </tr>
+      <tr>
+        <td id="L92" class="blob-num js-line-number" data-line-number="92"></td>
+        <td id="LC92" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L93" class="blob-num js-line-number" data-line-number="93"></td>
+        <td id="LC93" class="blob-code blob-code-inner js-file-line">Parameter int32_bitwise_not : int <span class="pl-k">-&gt;</span> int.</td>
+      </tr>
+      <tr>
+        <td id="L94" class="blob-num js-line-number" data-line-number="94"></td>
+        <td id="LC94" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L95" class="blob-num js-line-number" data-line-number="95"></td>
+        <td id="LC95" class="blob-code blob-code-inner js-file-line">Parameter int32_bitwise_and : int <span class="pl-k">-&gt;</span> int <span class="pl-k">-&gt;</span> int.</td>
+      </tr>
+      <tr>
+        <td id="L96" class="blob-num js-line-number" data-line-number="96"></td>
+        <td id="LC96" class="blob-code blob-code-inner js-file-line">Parameter int32_bitwise_or : int <span class="pl-k">-&gt;</span> int <span class="pl-k">-&gt;</span> int.</td>
+      </tr>
+      <tr>
+        <td id="L97" class="blob-num js-line-number" data-line-number="97"></td>
+        <td id="LC97" class="blob-code blob-code-inner js-file-line">Parameter int32_bitwise_xor : int <span class="pl-k">-&gt;</span> int <span class="pl-k">-&gt;</span> int.</td>
+      </tr>
+      <tr>
+        <td id="L98" class="blob-num js-line-number" data-line-number="98"></td>
+        <td id="LC98" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L99" class="blob-num js-line-number" data-line-number="99"></td>
+        <td id="LC99" class="blob-code blob-code-inner js-file-line">Parameter int32_left_shift : int <span class="pl-k">-&gt;</span> int <span class="pl-k">-&gt;</span> int.</td>
+      </tr>
+      <tr>
+        <td id="L100" class="blob-num js-line-number" data-line-number="100"></td>
+        <td id="LC100" class="blob-code blob-code-inner js-file-line">Parameter int32_right_shift : int <span class="pl-k">-&gt;</span> int <span class="pl-k">-&gt;</span> int.</td>
+      </tr>
+      <tr>
+        <td id="L101" class="blob-num js-line-number" data-line-number="101"></td>
+        <td id="LC101" class="blob-code blob-code-inner js-file-line">Parameter uint32_right_shift : int <span class="pl-k">-&gt;</span> int <span class="pl-k">-&gt;</span> int.</td>
+      </tr>
+      <tr>
+        <td id="L102" class="blob-num js-line-number" data-line-number="102"></td>
+        <td id="LC102" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L103" class="blob-num js-line-number" data-line-number="103"></td>
+        <td id="LC103" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L104" class="blob-num js-line-number" data-line-number="104"></td>
+        <td id="LC104" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L105" class="blob-num js-line-number" data-line-number="105"></td>
+        <td id="LC105" class="blob-code blob-code-inner js-file-line">
+</td>
+      </tr>
+      <tr>
+        <td id="L106" class="blob-num js-line-number" data-line-number="106"></td>
+        <td id="LC106" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">**************************************************************</span>)</td>
+      </tr>
+      <tr>
+        <td id="L107" class="blob-num js-line-number" data-line-number="107"></td>
+        <td id="LC107" class="blob-code blob-code-inner js-file-line">(<span class="pl-k">**</span> <span class="pl-k">**</span> Int32 related conversion <span class="pl-k">*</span>)</td>
+      </tr>
+</table>
+
+  </div>
+
+</div>
+
+<button type="button" data-facebox="#jump-to-line" data-facebox-class="linejump" data-hotkey="l" class="d-none">Jump to Line</button>
+<div id="jump-to-line" style="display:none">
+  <!-- '"` --><!-- </textarea></xmp> --></option></form><form accept-charset="UTF-8" action="" class="js-jump-to-line-form" method="get"><div style="margin:0;padding:0;display:inline"><input name="utf8" type="hidden" value="&#x2713;" /></div>
+    <input class="form-control linejump-input js-jump-to-line-field" type="text" placeholder="Jump to line&hellip;" aria-label="Jump to line" autofocus>
+    <button type="submit" class="btn">Go</button>
+</form></div>
+
+  </div>
+  <div class="modal-backdrop js-touch-events"></div>
+</div>
+
+
+    </div>
+  </div>
+
+    </div>
+
+        <div class="container site-footer-container">
+  <div class="site-footer" role="contentinfo">
+    <ul class="site-footer-links float-right">
+        <li><a href="https://github.com/contact" data-ga-click="Footer, go to contact, text:contact">Contact GitHub</a></li>
+      <li><a href="https://developer.github.com" data-ga-click="Footer, go to api, text:api">API</a></li>
+      <li><a href="https://training.github.com" data-ga-click="Footer, go to training, text:training">Training</a></li>
+      <li><a href="https://shop.github.com" data-ga-click="Footer, go to shop, text:shop">Shop</a></li>
+        <li><a href="https://github.com/blog" data-ga-click="Footer, go to blog, text:blog">Blog</a></li>
+        <li><a href="https://github.com/about" data-ga-click="Footer, go to about, text:about">About</a></li>
+
+    </ul>
+
+    <a href="https://github.com" aria-label="Homepage" class="site-footer-mark" title="GitHub">
+      <svg aria-hidden="true" class="octicon octicon-mark-github" height="24" version="1.1" viewBox="0 0 16 16" width="24"><path d="M8 0C3.58 0 0 3.58 0 8c0 3.54 2.29 6.53 5.47 7.59.4.07.55-.17.55-.38 0-.19-.01-.82-.01-1.49-2.01.37-2.53-.49-2.69-.94-.09-.23-.48-.94-.82-1.13-.28-.15-.68-.52-.01-.53.63-.01 1.08.58 1.23.82.72 1.21 1.87.87 2.33.66.07-.52.28-.87.51-1.07-1.78-.2-3.64-.89-3.64-3.95 0-.87.31-1.59.82-2.15-.08-.2-.36-1.02.08-2.12 0 0 .67-.21 2.2.82.64-.18 1.32-.27 2-.27.68 0 1.36.09 2 .27 1.53-1.04 2.2-.82 2.2-.82.44 1.1.16 1.92.08 2.12.51.56.82 1.27.82 2.15 0 3.07-1.87 3.75-3.65 3.95.29.25.54.73.54 1.48 0 1.07-.01 1.93-.01 2.2 0 .21.15.46.55.38A8.013 8.013 0 0 0 16 8c0-4.42-3.58-8-8-8z"></path></svg>
+</a>
+    <ul class="site-footer-links">
+      <li>&copy; 2016 <span title="0.08521s from github-fe154-cp1-prd.iad.github.net">GitHub</span>, Inc.</li>
+        <li><a href="https://github.com/site/terms" data-ga-click="Footer, go to terms, text:terms">Terms</a></li>
+        <li><a href="https://github.com/site/privacy" data-ga-click="Footer, go to privacy, text:privacy">Privacy</a></li>
+        <li><a href="https://github.com/security" data-ga-click="Footer, go to security, text:security">Security</a></li>
+        <li><a href="https://status.github.com/" data-ga-click="Footer, go to status, text:status">Status</a></li>
+        <li><a href="https://help.github.com" data-ga-click="Footer, go to help, text:help">Help</a></li>
+    </ul>
+  </div>
+</div>
+
+
+
+    
+
+    <div id="ajax-error-message" class="ajax-error-message flash flash-error">
+      <svg aria-hidden="true" class="octicon octicon-alert" height="16" version="1.1" viewBox="0 0 16 16" width="16"><path d="M8.865 1.52c-.18-.31-.51-.5-.87-.5s-.69.19-.87.5L.275 13.5c-.18.31-.18.69 0 1 .19.31.52.5.87.5h13.7c.36 0 .69-.19.86-.5.17-.31.18-.69.01-1L8.865 1.52zM8.995 13h-2v-2h2v2zm0-3h-2V6h2v4z"></path></svg>
+      <button type="button" class="flash-close js-flash-close js-ajax-error-dismiss" aria-label="Dismiss error">
+        <svg aria-hidden="true" class="octicon octicon-x" height="16" version="1.1" viewBox="0 0 12 16" width="12"><path d="M7.48 8l3.75 3.75-1.48 1.48L6 9.48l-3.75 3.75-1.48-1.48L4.52 8 .77 4.25l1.48-1.48L6 6.52l3.75-3.75 1.48 1.48z"></path></svg>
+      </button>
+      You can't perform that action at this time.
+    </div>
+
+
+      <script crossorigin="anonymous" src="https://assets-cdn.github.com/assets/compat-30ce4c86c27f88c3d1b4eb03efda59b45d8d7c871880dee0b8f73d5ef1b25fdf.js"></script>
+      <script crossorigin="anonymous" src="https://assets-cdn.github.com/assets/frameworks-35b9c541d341309b930b1c790fa1b27a30c7c44ce10c7f8242890e3d83c8adbd.js"></script>
+      <script async="async" crossorigin="anonymous" src="https://assets-cdn.github.com/assets/github-294739b19304855d2c5077cf4690f1ec89bce7aa73a88859b76dc1f22316a3d8.js"></script>
+      
+      
+      
+      
+    <div class="js-stale-session-flash stale-session-flash flash flash-warn flash-banner d-none">
+      <svg aria-hidden="true" class="octicon octicon-alert" height="16" version="1.1" viewBox="0 0 16 16" width="16"><path d="M8.865 1.52c-.18-.31-.51-.5-.87-.5s-.69.19-.87.5L.275 13.5c-.18.31-.18.69 0 1 .19.31.52.5.87.5h13.7c.36 0 .69-.19.86-.5.17-.31.18-.69.01-1L8.865 1.52zM8.995 13h-2v-2h2v2zm0-3h-2V6h2v4z"></path></svg>
+      <span class="signed-in-tab-flash">You signed in with another tab or window. <a href="">Reload</a> to refresh your session.</span>
+      <span class="signed-out-tab-flash">You signed out in another tab or window. <a href="">Reload</a> to refresh your session.</span>
+    </div>
+    <div class="facebox" id="facebox" style="display:none;">
+  <div class="facebox-popup">
+    <div class="facebox-content" role="dialog" aria-labelledby="facebox-header" aria-describedby="facebox-description">
+    </div>
+    <button type="button" class="facebox-close js-facebox-close" aria-label="Close modal">
+      <svg aria-hidden="true" class="octicon octicon-x" height="16" version="1.1" viewBox="0 0 12 16" width="12"><path d="M7.48 8l3.75 3.75-1.48 1.48L6 9.48l-3.75 3.75-1.48-1.48L4.52 8 .77 4.25l1.48-1.48L6 6.52l3.75-3.75 1.48 1.48z"></path></svg>
+    </button>
+  </div>
+</div>
+
+  </body>
+</html>
+
diff --git a/samples/Coq/JsPrettyInterm.v b/samples/Coq/JsPrettyInterm.v
new file mode 100644
index 00000000..71d35969
--- /dev/null
+++ b/samples/Coq/JsPrettyInterm.v
@@ -0,0 +1,1766 @@
+Set Implicit Arguments.
+Require Export JsSyntax JsSyntaxAux JsPreliminary.
+
+(**************************************************************)
+(** ** Implicit Types -- copied from JsPreliminary  *)
+
+Implicit Type b : bool.
+Implicit Type n : number.
+Implicit Type k : int.
+Implicit Type s : string.
+Implicit Type i : literal.
+Implicit Type l : object_loc.
+Implicit Type w : prim.
+Implicit Type v : value.
+Implicit Type r : ref.
+(*Implicit Type B : builtin.*)
+Implicit Type ty : type.
+
+Implicit Type rt : restype.
+Implicit Type rv : resvalue.
+Implicit Type lab : label.
+Implicit Type labs : label_set.
+Implicit Type R : res.
+Implicit Type o : out.
+
+Implicit Type x : prop_name.
+Implicit Type str : strictness_flag.
+Implicit Type m : mutability.
+Implicit Type Ad : attributes_data.
+Implicit Type Aa : attributes_accessor.
+Implicit Type A : attributes.
+Implicit Type Desc : descriptor.
+Implicit Type D : full_descriptor.
+
+Implicit Type L : env_loc.
+Implicit Type E : env_record.
+Implicit Type Ed : decl_env_record.
+Implicit Type X : lexical_env.
+Implicit Type O : object.
+Implicit Type S : state.
+Implicit Type C : execution_ctx.
+Implicit Type P : object_properties_type.
+
+Implicit Type e : expr.
+Implicit Type p : prog.
+Implicit Type t : stat.
+
+
+(****************************************************************)
+(** ** Intermediate expression for the Pretty-Big-Step semantic *)
+
+(** Grammar of extended expressions *)
+
+Inductive ext_expr :=
+
+  (** Extended expressions include expressions *)
+
+  | expr_basic : expr -> ext_expr
+
+  (** Extended expressions associated with primitive expressions *)
+
+  | expr_identifier_1 : specret ref -> ext_expr
+
+  | expr_object_0 : out -> propdefs -> ext_expr
+  | expr_object_1 : object_loc -> propdefs -> ext_expr
+  | expr_object_2 : object_loc -> string -> propbody -> propdefs -> ext_expr 
+  | expr_object_3_val : object_loc -> string -> specret value -> propdefs -> ext_expr
+  | expr_object_3_get : object_loc -> string -> out -> propdefs -> ext_expr
+  | expr_object_3_set : object_loc -> string -> out -> propdefs -> ext_expr
+  | expr_object_4 : object_loc -> string -> descriptor -> propdefs -> ext_expr
+  | expr_object_5 : object_loc -> propdefs -> out -> ext_expr
+
+
+
+
+
+  (* _ARRAYS_ : support for array intermediate forms *)
+  | expr_array_0 : out -> list (option expr) -> ext_expr
+  | expr_array_1 : object_loc -> list (option expr) -> ext_expr
+  | expr_array_2 : object_loc -> list (option expr) -> int -> ext_expr
+  | expr_array_3 : object_loc -> list (option expr) -> int -> ext_expr
+  | expr_array_3_1 : object_loc -> specret value -> list (option expr) -> int -> ext_expr
+  | expr_array_3_2 : object_loc -> value -> out -> list (option expr) -> int -> ext_expr
+  | expr_array_3_3 : object_loc -> value -> specret int -> list (option expr) -> int -> ext_expr
+  | expr_array_3_4 : object_loc -> value -> out -> list (option expr) -> ext_expr
+  | expr_array_3_5 : object_loc -> out -> list (option expr) -> ext_expr
+
+  | expr_array_add_length   : object_loc -> int -> out -> ext_expr
+  | expr_array_add_length_0 : object_loc -> int -> ext_expr
+  | expr_array_add_length_1 : object_loc -> int -> out -> ext_expr
+  | expr_array_add_length_2 : object_loc -> specret int -> int -> ext_expr
+  | expr_array_add_length_3 : object_loc -> specret int -> ext_expr
+  | expr_array_add_length_4 : object_loc -> out -> ext_expr
+
+
+
+
+
+  | expr_function_1 : string -> list string -> funcbody -> env_loc -> lexical_env -> out -> ext_expr
+  | expr_function_2 : string -> env_loc -> out -> ext_expr
+  | expr_function_3 : object_loc -> out -> ext_expr
+
+  | expr_access_1 : specret value -> expr -> ext_expr (* The left expression has been executed *)
+  | expr_access_2 : value -> specret value -> ext_expr (* The right expression is executed. *)
+  | expr_access_3 : value -> out -> value -> ext_expr
+  | expr_access_4 : value -> out -> ext_expr
+
+  | expr_new_1 : specret value -> list expr -> ext_expr (* The arguments too. *)
+  | expr_new_2 : value -> specret (list value) -> ext_expr (* The call has been executed. *)
+
+  | expr_call_1 : out -> bool -> list expr -> ext_expr
+  | expr_call_2 : res -> bool -> list expr -> specret value -> ext_expr (* The function has been evaluated. *)
+  | expr_call_3 : res -> value -> bool -> specret (list value) -> ext_expr (* The arguments have been executed. *)
+  | expr_call_4 : res -> object_loc -> bool -> list value -> ext_expr
+  | expr_call_5 : object_loc -> bool -> list value -> out -> ext_expr (* The call has been executed. *)
+
+  | spec_eval : bool -> value -> list value -> ext_expr
+
+  | expr_unary_op_1 : unary_op -> (specret value) -> ext_expr (* The argument have been executed. *)
+  | expr_unary_op_2 : unary_op -> value -> ext_expr (* The argument is a value. *)
+  | expr_delete_1 : out -> ext_expr
+  | expr_delete_2 : ref -> ext_expr
+  | expr_delete_3 : ref -> out -> ext_expr
+  | expr_delete_4 : ref -> env_loc -> ext_expr
+  | expr_typeof_1 : out -> ext_expr
+  | expr_typeof_2 : specret value -> ext_expr
+  | expr_prepost_1 : unary_op -> out -> ext_expr
+  | expr_prepost_2 : unary_op -> res -> specret value -> ext_expr
+  | expr_prepost_3 : unary_op -> res -> out -> ext_expr
+  | expr_prepost_4 : value -> out -> ext_expr
+  | expr_unary_op_neg_1 : out -> ext_expr
+  | expr_unary_op_bitwise_not_1 : specret int -> ext_expr
+  | expr_unary_op_not_1 : out -> ext_expr
+  | expr_conditional_1 : specret value -> expr -> expr -> ext_expr
+  | expr_conditional_1': out -> expr -> expr -> ext_expr
+  | expr_conditional_2 : specret value -> ext_expr
+
+  | expr_binary_op_1 : binary_op -> (specret value) -> expr -> ext_expr
+  | expr_binary_op_2 : binary_op -> value -> (specret value) -> ext_expr
+  | expr_binary_op_3 : binary_op -> value -> value -> ext_expr
+  | expr_binary_op_add_1 : specret (value*value) -> ext_expr
+  | expr_binary_op_add_string_1 : specret (value*value) -> ext_expr
+  | expr_puremath_op_1 : (number -> number -> number) -> specret (value*value) -> ext_expr
+  | expr_shift_op_1 : (int -> int -> int) -> specret int -> value -> ext_expr
+  | expr_shift_op_2 : (int -> int -> int) -> int -> specret int -> ext_expr
+  | expr_inequality_op_1 : bool -> bool -> value -> value -> ext_expr
+  | expr_inequality_op_2 : bool -> bool -> specret (value*value) -> ext_expr
+  | expr_binary_op_in_1 : object_loc -> out -> ext_expr
+  | expr_binary_op_disequal_1 : out -> ext_expr
+  | spec_equal : value -> value -> ext_expr
+  | spec_equal_1 : type -> type -> value -> value -> ext_expr
+  | spec_equal_2 : bool -> ext_expr
+  | spec_equal_3 : value -> (value -> ext_expr) -> value -> ext_expr
+  | spec_equal_4 : value -> out -> ext_expr
+  | expr_bitwise_op_1 : (int -> int -> int) -> specret int -> value -> ext_expr
+  | expr_bitwise_op_2 : (int -> int -> int) -> int -> specret int -> ext_expr
+  | expr_lazy_op_1 : bool -> (specret value) -> expr -> ext_expr
+  | expr_lazy_op_2 : bool -> value -> out -> expr -> ext_expr
+  | expr_lazy_op_2_1 : (specret value) -> ext_expr
+
+  | expr_assign_1 : out -> option binary_op -> expr -> ext_expr
+  | expr_assign_2 : res -> (specret value) -> binary_op -> expr -> ext_expr
+  | expr_assign_3 : res -> value -> binary_op -> (specret value) -> ext_expr
+  | expr_assign_3' : res -> out -> ext_expr
+  | expr_assign_4 : res -> (specret value) -> ext_expr
+  | expr_assign_5 : value -> out -> ext_expr
+
+  (** Extended expressions for conversions *)
+
+  | spec_to_primitive : value -> option preftype -> ext_expr
+  | spec_to_boolean : value -> ext_expr
+  | spec_to_number : value -> ext_expr
+  | spec_to_number_1 : out -> ext_expr
+  | spec_to_integer : value -> ext_expr
+  | spec_to_integer_1 : out -> ext_expr
+  | spec_to_string : value -> ext_expr
+  | spec_to_string_1 : out -> ext_expr
+  | spec_to_object : value -> ext_expr
+  | spec_check_object_coercible : value -> ext_expr
+
+  (** Extended expressions for comparison *)
+
+  | spec_eq : value -> value -> ext_expr
+  | spec_eq0 : value -> value -> ext_expr
+  | spec_eq1 : value -> value -> ext_expr
+  | spec_eq2 : ext_expr -> value -> value -> ext_expr
+
+  (** Extended expressions for operations on objects *)
+
+  | spec_object_get : object_loc -> prop_name -> ext_expr
+  | spec_object_get_1 : builtin_get -> value -> object_loc -> prop_name -> ext_expr
+  | spec_object_get_2 : value -> specret full_descriptor -> ext_expr
+  | spec_object_get_3 : value -> value -> ext_expr
+
+  | spec_object_can_put : object_loc -> prop_name -> ext_expr
+  | spec_object_can_put_1 : builtin_can_put -> object_loc -> prop_name -> ext_expr
+  | spec_object_can_put_2 : object_loc -> prop_name -> (specret full_descriptor) -> ext_expr
+
+  (* LATER: shift names since spec_object_can_put_3 is not used *)
+  | spec_object_can_put_4 : object_loc -> prop_name -> value -> ext_expr
+  | spec_object_can_put_5 : object_loc -> specret full_descriptor -> ext_expr
+  | spec_object_can_put_6 : attributes_data -> bool -> ext_expr
+
+  | spec_object_put : object_loc -> prop_name -> value -> bool -> ext_expr
+  | spec_object_put_1 : builtin_put -> value -> object_loc -> prop_name -> value -> bool -> ext_expr
+  | spec_object_put_2 : value -> object_loc -> prop_name -> value -> bool -> out -> ext_expr
+  | spec_object_put_3 : value -> object_loc -> prop_name -> value -> bool -> specret full_descriptor -> ext_expr
+  | spec_object_put_4 : value -> object_loc -> prop_name -> value -> bool -> specret full_descriptor -> ext_expr
+  | spec_object_put_5 : out -> ext_expr
+
+  | spec_object_has_prop : object_loc -> prop_name -> ext_expr
+  | spec_object_has_prop_1 : builtin_has_prop -> object_loc -> prop_name -> ext_expr
+  | spec_object_has_prop_2 : specret full_descriptor -> ext_expr
+
+  | spec_object_delete : object_loc -> prop_name -> bool -> ext_expr
+  | spec_object_delete_1 : builtin_delete -> object_loc -> prop_name -> bool -> ext_expr
+  | spec_object_delete_2 : object_loc -> prop_name -> bool -> (specret full_descriptor) -> ext_expr
+  | spec_object_delete_3 : object_loc -> prop_name -> bool -> bool -> ext_expr
+
+  | spec_object_default_value : object_loc -> option preftype -> ext_expr
+  | spec_object_default_value_1 : builtin_default_value -> object_loc -> option preftype -> ext_expr
+  | spec_object_default_value_2 : object_loc -> preftype -> preftype -> ext_expr
+  | spec_object_default_value_3 : object_loc -> preftype -> ext_expr
+  | spec_object_default_value_4 : ext_expr
+  | spec_object_default_value_sub_1 : object_loc -> string -> ext_expr -> ext_expr
+  | spec_object_default_value_sub_2 : object_loc -> out -> ext_expr -> ext_expr
+  | spec_object_default_value_sub_3 : out -> ext_expr -> ext_expr
+
+  | spec_object_define_own_prop : object_loc -> prop_name -> descriptor -> bool -> ext_expr
+  | spec_object_define_own_prop_1 : builtin_define_own_prop -> object_loc -> prop_name -> descriptor -> bool -> ext_expr
+  | spec_object_define_own_prop_2 : object_loc -> prop_name -> descriptor -> bool -> (specret full_descriptor) -> ext_expr
+  | spec_object_define_own_prop_3 : object_loc -> prop_name -> descriptor -> bool -> full_descriptor -> bool -> ext_expr
+  | spec_object_define_own_prop_4 : object_loc -> prop_name -> attributes -> descriptor -> bool -> ext_expr
+  | spec_object_define_own_prop_5 : object_loc -> prop_name -> attributes -> descriptor -> bool -> ext_expr
+  | spec_object_define_own_prop_6a : object_loc -> prop_name -> attributes -> descriptor -> bool -> ext_expr
+  | spec_object_define_own_prop_6b : object_loc -> prop_name -> attributes -> descriptor -> bool -> ext_expr
+  | spec_object_define_own_prop_6c : object_loc -> prop_name -> attributes -> descriptor -> bool -> ext_expr
+  | spec_object_define_own_prop_reject : bool -> ext_expr
+  | spec_object_define_own_prop_write : object_loc -> prop_name -> attributes -> descriptor -> bool -> ext_expr
+
+  | spec_prim_value_get : value -> prop_name -> ext_expr
+  | spec_prim_value_get_1 : value -> prop_name -> out -> ext_expr
+  | spec_prim_value_put : value -> prop_name -> value -> bool -> ext_expr
+  | spec_prim_value_put_1 : prim -> prop_name -> value -> bool -> out -> ext_expr
+
+  (* ARRAYS *)
+  | spec_object_define_own_prop_array_2 : object_loc -> prop_name -> descriptor -> bool -> (specret full_descriptor) -> ext_expr
+  | spec_object_define_own_prop_array_2_1 : object_loc -> prop_name -> descriptor -> bool -> descriptor -> value -> ext_expr
+  | spec_object_define_own_prop_array_branch_3_4 : object_loc -> prop_name -> descriptor -> bool -> descriptor -> (specret int) -> ext_expr
+  | spec_object_define_own_prop_array_branch_4_5   : object_loc -> prop_name -> descriptor -> bool -> descriptor -> int -> ext_expr
+  | spec_object_define_own_prop_array_branch_4_5_a : object_loc -> prop_name -> (specret int) -> descriptor -> bool -> descriptor -> int -> ext_expr
+  | spec_object_define_own_prop_array_branch_4_5_b : object_loc -> prop_name -> int -> out -> descriptor -> bool -> descriptor -> int -> ext_expr 
+  | spec_object_define_own_prop_array_4a : object_loc -> prop_name -> descriptor -> bool -> descriptor -> int -> ext_expr
+  | spec_object_define_own_prop_array_4b : object_loc -> prop_name -> (specret int) -> descriptor -> bool -> descriptor -> int -> ext_expr
+  | spec_object_define_own_prop_array_4c : object_loc -> int -> descriptor -> bool -> int -> descriptor -> out -> ext_expr
+  | spec_object_define_own_prop_array_5  : object_loc -> prop_name -> descriptor -> bool -> ext_expr
+  | spec_object_define_own_prop_array_3 : object_loc -> descriptor -> bool -> descriptor -> int -> ext_expr
+  | spec_object_define_own_prop_array_3c : object_loc -> value -> (specret int) -> descriptor -> bool -> descriptor -> int -> ext_expr
+  | spec_object_define_own_prop_array_3d_e : object_loc -> out -> int -> descriptor -> bool -> descriptor -> int -> ext_expr
+  | spec_object_define_own_prop_array_3f_g : object_loc -> int -> int -> descriptor -> bool -> descriptor -> ext_expr
+  | spec_object_define_own_prop_array_3h_i : object_loc -> int -> int -> descriptor -> bool -> descriptor -> ext_expr
+  | spec_object_define_own_prop_array_3j : object_loc -> int -> int -> descriptor -> bool -> bool -> descriptor -> ext_expr
+  | spec_object_define_own_prop_array_3k_l : object_loc -> out -> int -> int -> descriptor -> bool -> bool -> descriptor -> ext_expr
+  | spec_object_define_own_prop_array_3l : object_loc -> int -> int -> descriptor -> bool -> bool -> ext_expr
+  | spec_object_define_own_prop_array_3l_ii : object_loc -> int -> int -> descriptor -> bool -> bool -> ext_expr
+  | spec_object_define_own_prop_array_3l_ii_1 : object_loc -> int -> int -> descriptor -> bool -> bool -> out -> ext_expr
+  | spec_object_define_own_prop_array_3l_ii_2 : object_loc -> int -> int -> descriptor -> bool -> bool -> out -> ext_expr
+  | spec_object_define_own_prop_array_3l_iii_1 : object_loc -> int -> descriptor -> bool -> bool -> ext_expr
+  | spec_object_define_own_prop_array_3l_iii_2 : object_loc -> descriptor -> bool -> bool -> ext_expr
+  | spec_object_define_own_prop_array_3l_iii_3 : object_loc -> descriptor -> bool -> ext_expr
+  | spec_object_define_own_prop_array_3l_iii_4 : object_loc -> bool -> out -> ext_expr
+  | spec_object_define_own_prop_array_3m_n : object_loc -> bool -> ext_expr
+
+  (** Extended expressions for operations on references *)
+  | spec_put_value : resvalue -> value -> ext_expr
+
+  (** Extended expressions for operations on environment records *)
+
+  | spec_env_record_has_binding : env_loc -> prop_name -> ext_expr
+  | spec_env_record_has_binding_1 : env_loc -> prop_name -> env_record -> ext_expr
+  | spec_env_record_get_binding_value : env_loc -> prop_name -> bool -> ext_expr
+  | spec_env_record_get_binding_value_1 : env_loc -> prop_name -> bool -> env_record -> ext_expr
+  | spec_env_record_get_binding_value_2 : prop_name -> bool -> object_loc -> out -> ext_expr
+
+  | spec_env_record_create_immutable_binding : env_loc -> prop_name -> ext_expr
+  | spec_env_record_initialize_immutable_binding : env_loc -> prop_name -> value -> ext_expr
+  | spec_env_record_create_mutable_binding : env_loc -> prop_name -> option bool -> ext_expr
+  | spec_env_record_create_mutable_binding_1 : env_loc -> prop_name -> bool -> env_record -> ext_expr
+  | spec_env_record_create_mutable_binding_2 : env_loc -> prop_name -> bool -> object_loc -> out -> ext_expr
+  | spec_env_record_create_mutable_binding_3 : out -> ext_expr
+  | spec_env_record_set_mutable_binding : env_loc -> prop_name -> value -> bool -> ext_expr
+  | spec_env_record_set_mutable_binding_1 : env_loc -> prop_name -> value -> bool -> env_record -> ext_expr
+  | spec_env_record_delete_binding : env_loc -> prop_name -> ext_expr
+  | spec_env_record_delete_binding_1 : env_loc -> prop_name -> env_record -> ext_expr
+
+  | spec_env_record_create_set_mutable_binding : env_loc -> prop_name -> option bool -> value -> bool -> ext_expr
+  | spec_env_record_create_set_mutable_binding_1 : out -> env_loc -> prop_name -> value -> bool -> ext_expr
+
+  | spec_env_record_implicit_this_value : env_loc -> ext_expr
+  | spec_env_record_implicit_this_value_1 : env_loc -> env_record -> ext_expr
+
+
+  (** Extended expressions for operations on property descriptors (8.10) *)
+
+  | spec_from_descriptor : (specret full_descriptor) -> ext_expr
+  | spec_from_descriptor_1 : attributes -> out -> ext_expr
+  | spec_from_descriptor_2 : object_loc -> attributes_data -> out -> ext_expr
+  | spec_from_descriptor_3 : object_loc -> attributes_accessor -> out -> ext_expr
+  | spec_from_descriptor_4 : object_loc -> attributes -> out -> ext_expr
+  | spec_from_descriptor_5 : object_loc -> attributes -> out -> ext_expr
+  | spec_from_descriptor_6 : object_loc -> out -> ext_expr
+
+                       
+                  
+  (** Extented expressions for eval *)
+
+  | spec_entering_eval_code : bool -> funcbody -> ext_expr -> ext_expr
+  | spec_entering_eval_code_1 : funcbody -> ext_expr -> bool -> ext_expr
+  | spec_entering_eval_code_2 : out -> ext_expr -> ext_expr
+
+  | spec_call_global_eval : bool -> list value -> ext_expr
+  | spec_call_global_eval_1 : bool -> value -> ext_expr
+  | spec_call_global_eval_2 : prog -> ext_expr
+  | spec_call_global_eval_3 : out -> ext_expr
+
+  (** Extended expressions for function calls *)
+
+  | spec_entering_func_code : object_loc -> value -> list value -> ext_expr -> ext_expr
+  | spec_entering_func_code_1 : object_loc -> list value -> funcbody -> value -> strictness_flag -> ext_expr -> ext_expr
+  | spec_entering_func_code_2 : object_loc -> list value -> funcbody -> out -> ext_expr -> ext_expr
+  | spec_entering_func_code_3 : object_loc -> list value -> strictness_flag -> funcbody -> value -> ext_expr -> ext_expr
+  | spec_entering_func_code_4 : out -> ext_expr -> ext_expr
+
+  | spec_binding_inst_formal_params : list value -> env_loc -> list string -> strictness_flag -> ext_expr
+  | spec_binding_inst_formal_params_1 : list value -> env_loc -> string -> list string -> strictness_flag -> value -> out -> ext_expr
+  | spec_binding_inst_formal_params_2 : list value -> env_loc -> string -> list string -> strictness_flag -> value -> out -> ext_expr
+  | spec_binding_inst_formal_params_3 : list value -> env_loc -> string -> list string -> strictness_flag -> value -> ext_expr
+  | spec_binding_inst_formal_params_4 : list value -> env_loc -> list string -> strictness_flag -> out -> ext_expr
+  | spec_binding_inst_function_decls :  list value -> env_loc -> list funcdecl -> strictness_flag -> bool -> ext_expr
+  | spec_binding_inst_function_decls_1 : list value -> env_loc -> funcdecl -> list funcdecl -> strictness_flag -> bool -> out -> ext_expr
+  | spec_binding_inst_function_decls_2 : list value -> env_loc -> funcdecl -> list funcdecl -> strictness_flag -> object_loc -> bool -> out -> ext_expr
+  | spec_binding_inst_function_decls_3 : list value -> funcdecl -> list funcdecl -> strictness_flag -> object_loc -> bool -> specret full_descriptor -> ext_expr
+  | spec_binding_inst_function_decls_3a : list value -> funcdecl -> list funcdecl -> strictness_flag -> object_loc -> bool -> full_descriptor -> ext_expr
+  | spec_binding_inst_function_decls_4 : list value -> env_loc -> funcdecl -> list funcdecl -> strictness_flag -> object_loc -> bool -> out -> ext_expr
+  | spec_binding_inst_function_decls_5 : list value -> env_loc -> funcdecl -> list funcdecl -> strictness_flag -> object_loc -> bool -> ext_expr
+  | spec_binding_inst_function_decls_6 : list value -> env_loc -> list funcdecl -> strictness_flag -> bool -> out -> ext_expr
+  | spec_binding_inst_arg_obj :   object_loc -> prog -> list string -> list value -> env_loc -> ext_expr
+  | spec_binding_inst_arg_obj_1 : prog -> env_loc -> strictness_flag -> out -> ext_expr
+  | spec_binding_inst_arg_obj_2 : prog -> env_loc -> object_loc -> out -> ext_expr
+  | spec_binding_inst_var_decls : env_loc -> list string -> bool -> strictness_flag -> ext_expr
+  | spec_binding_inst_var_decls_1 : env_loc -> string -> list string -> bool -> strictness_flag -> out -> ext_expr
+  | spec_binding_inst_var_decls_2 : env_loc -> list string -> bool -> strictness_flag -> out -> ext_expr
+  | spec_binding_inst : codetype -> option object_loc -> prog -> list value -> ext_expr
+  | spec_binding_inst_1 : codetype -> option object_loc -> prog -> list value -> env_loc -> ext_expr
+  | spec_binding_inst_2 : codetype -> object_loc -> prog -> list string -> list value -> env_loc -> out -> ext_expr
+  | spec_binding_inst_3 : codetype -> option object_loc -> prog -> list string -> list value -> env_loc -> ext_expr
+  | spec_binding_inst_4 : codetype -> option object_loc -> prog -> list string -> list value -> bool -> env_loc -> out -> ext_expr
+  | spec_binding_inst_5 : codetype -> option object_loc -> prog -> list string -> list value -> bool -> env_loc -> ext_expr
+  | spec_binding_inst_6 : codetype -> option object_loc -> prog -> list string -> list value -> bool -> env_loc -> out -> ext_expr
+  | spec_binding_inst_7 : prog -> bool -> env_loc -> out -> ext_expr
+  | spec_binding_inst_8 : prog -> bool -> env_loc -> ext_expr
+  
+  | spec_make_arg_getter : string -> lexical_env -> ext_expr
+  | spec_make_arg_setter : string -> lexical_env -> ext_expr
+  
+  | spec_args_obj_get_1 : value -> object_loc -> prop_name -> object_loc -> (specret full_descriptor) -> ext_expr
+  
+  
+  | spec_args_obj_define_own_prop_1 : object_loc -> prop_name -> descriptor -> bool -> object_loc -> specret full_descriptor -> ext_expr
+  | spec_args_obj_define_own_prop_2 : object_loc -> prop_name -> descriptor -> bool -> object_loc -> full_descriptor -> out -> ext_expr
+  | spec_args_obj_define_own_prop_3 : object_loc -> prop_name -> descriptor -> bool -> object_loc -> out -> ext_expr
+  | spec_args_obj_define_own_prop_4 : object_loc -> prop_name -> descriptor -> bool -> object_loc -> ext_expr
+  | spec_args_obj_define_own_prop_5 : out -> ext_expr
+  | spec_args_obj_define_own_prop_6 : ext_expr
+  
+  | spec_args_obj_delete_1 : object_loc -> prop_name -> bool -> object_loc -> specret full_descriptor -> ext_expr
+  | spec_args_obj_delete_2 : object_loc -> prop_name -> bool -> object_loc -> full_descriptor -> out -> ext_expr
+  | spec_args_obj_delete_3 : out -> ext_expr
+  | spec_args_obj_delete_4 : bool -> ext_expr
+  
+  | spec_arguments_object_map : object_loc -> list string -> list value -> lexical_env -> strictness_flag -> ext_expr
+  | spec_arguments_object_map_1 : object_loc -> list string -> list value -> lexical_env -> strictness_flag -> out -> ext_expr
+  | spec_arguments_object_map_2 : object_loc -> list string -> list value -> lexical_env -> strictness_flag -> object_loc -> list string -> int -> ext_expr
+  | spec_arguments_object_map_3 : object_loc -> list string -> list value -> lexical_env -> strictness_flag -> object_loc -> list string -> int -> out -> ext_expr
+  | spec_arguments_object_map_4 : object_loc -> list string -> list value -> lexical_env -> strictness_flag -> object_loc -> list string -> int -> string -> ext_expr
+  | spec_arguments_object_map_5 : object_loc -> list string -> list value -> lexical_env -> strictness_flag -> object_loc -> list string -> int -> string -> out -> ext_expr
+  | spec_arguments_object_map_6 : object_loc -> list string -> list value -> lexical_env -> strictness_flag -> object_loc -> list string -> int -> object_loc -> out -> ext_expr
+  | spec_arguments_object_map_7 : object_loc -> list string -> list value -> lexical_env -> strictness_flag -> object_loc -> list string -> int -> out -> ext_expr
+  | spec_arguments_object_map_8 : object_loc -> object_loc -> list string -> ext_expr
+
+  | spec_create_arguments_object : object_loc -> list string -> list value -> lexical_env -> strictness_flag -> ext_expr
+  | spec_create_arguments_object_1 : object_loc -> list string -> list value -> lexical_env -> strictness_flag -> object_loc -> out -> ext_expr
+  | spec_create_arguments_object_2 : object_loc -> strictness_flag -> object_loc -> out -> ext_expr
+  | spec_create_arguments_object_3 : object_loc -> value -> attributes -> out -> ext_expr
+  | spec_create_arguments_object_4 : object_loc -> out -> ext_expr
+
+  (* Functions *)
+
+  | spec_object_has_instance : object_loc -> value -> ext_expr
+  | spec_object_has_instance_1 : builtin_has_instance -> object_loc -> value -> ext_expr
+  | spec_function_has_instance_1 : object_loc -> out -> ext_expr
+  | spec_function_has_instance_2 : object_loc -> object_loc -> ext_expr
+  | spec_function_has_instance_3 : object_loc -> value -> ext_expr
+
+  | spec_function_has_instance_after_bind_1 : object_loc -> value -> ext_expr
+  | spec_function_has_instance_after_bind_2 : object_loc -> value  -> ext_expr
+
+  | spec_function_get_1 : object_loc -> prop_name -> out -> ext_expr
+
+  (* Function.prototype.apply *)
+
+  | spec_function_proto_apply   : object_loc -> value -> value -> ext_expr
+  | spec_function_proto_apply_1 : object_loc -> value -> object_loc -> out -> ext_expr   
+  | spec_function_proto_apply_2 : object_loc -> value -> object_loc -> specret int -> ext_expr
+  | spec_function_proto_apply_3 : object_loc -> value -> specret (list value) -> ext_expr 
+
+  (* Function.prototype.bind *)
+
+  | spec_function_proto_bind_1 : object_loc -> value -> list value -> ext_expr
+  | spec_function_proto_bind_2 : object_loc -> value -> list value -> ext_expr
+  | spec_function_proto_bind_3 : object_loc -> specret int -> ext_expr
+  | spec_function_proto_bind_4 : object_loc -> int -> ext_expr
+  | spec_function_proto_bind_5 : object_loc -> ext_expr
+  | spec_function_proto_bind_6 : object_loc -> out -> ext_expr
+  | spec_function_proto_bind_7 : object_loc -> out -> ext_expr
+
+  (* Throwing of errors *)
+
+  | spec_error : native_error -> ext_expr 
+  | spec_error_1 : out -> ext_expr
+  | spec_error_or_cst : bool -> native_error -> value -> ext_expr
+  | spec_error_or_void : bool -> native_error -> ext_expr
+
+  (* LATER: these are currently unused *)
+  | spec_init_throw_type_error : ext_expr
+  | spec_init_throw_type_error_1 : out -> ext_expr
+
+  | spec_build_error : value -> value -> ext_expr
+  | spec_build_error_1 : object_loc -> value -> ext_expr
+  | spec_build_error_2 : object_loc -> out -> ext_expr
+
+  (* Object creation and calling continuation with object address *)
+
+  | spec_new_object : (object_loc -> ext_expr) -> ext_expr
+  | spec_new_object_1 : out -> (object_loc -> ext_expr) -> ext_expr
+
+  | spec_prim_new_object : prim -> ext_expr
+
+  (* Auxiliary reduction for creating function object steps 16 - 18 *)
+  | spec_creating_function_object_proto : object_loc -> ext_expr
+  | spec_creating_function_object_proto_1 : object_loc -> out -> ext_expr
+  | spec_creating_function_object_proto_2 : object_loc -> object_loc -> out -> ext_expr
+
+  | spec_creating_function_object : list string -> funcbody -> lexical_env -> strictness_flag -> ext_expr
+  | spec_creating_function_object_1 : strictness_flag -> object_loc -> out -> ext_expr
+  | spec_creating_function_object_2 : strictness_flag -> object_loc -> out -> ext_expr
+  | spec_creating_function_object_3 : object_loc -> out -> ext_expr
+  | spec_creating_function_object_4 : object_loc -> out -> ext_expr
+
+  (* Function creation in give execution context*)
+  | spec_create_new_function_in :  execution_ctx -> list string -> funcbody -> ext_expr
+
+  (* TODO: Check if object_loc or value could be None *)
+  (* TODO: get rid of this: | spec_call : builtin -> option object_loc -> option value -> list value -> ext_expr *)
+  | spec_call : object_loc -> value -> list value -> ext_expr (* object with the call method, this value, arguments *)
+  | spec_call_1 : call -> object_loc -> value -> list value -> ext_expr
+
+  | spec_call_prealloc : prealloc -> value -> list value -> ext_expr
+
+  | spec_call_default : object_loc -> value -> list value -> ext_expr
+  | spec_call_default_1 : object_loc -> ext_expr
+  | spec_call_default_2 : option funcbody -> ext_expr
+  | spec_call_default_3 : out -> ext_expr
+ 
+  | spec_construct : object_loc -> list value -> ext_expr
+  | spec_construct_1 : construct -> object_loc -> list value -> ext_expr
+
+  | spec_construct_prealloc : prealloc -> list value -> ext_expr
+
+  | spec_construct_default : object_loc -> list value -> ext_expr
+  | spec_construct_default_1 : object_loc -> list value -> out -> ext_expr
+  | spec_construct_default_2 : object_loc -> out -> ext_expr
+
+  | spec_construct_1_after_bind : object_loc -> list value -> object_loc -> ext_expr
+
+  (** Extended expressions for calling global object builtin functions *)
+  (* LATER: rename all the spec_call into spec_builtin *)
+
+  | spec_call_global_is_nan_1 : out -> ext_expr
+  | spec_call_global_is_finite_1 : out -> ext_expr
+
+  | spec_call_object_call_1 : value -> list value -> ext_expr
+  | spec_call_object_new_1 : value -> ext_expr
+  | spec_call_object_get_proto_of_1 : value -> ext_expr
+  | spec_call_object_is_extensible_1 : value -> ext_expr
+
+  | spec_call_object_create_1 : value -> value -> ext_expr
+  | spec_call_object_create_2 : out -> value -> value -> ext_expr
+  | spec_call_object_create_3 : object_loc -> value -> ext_expr
+
+  | spec_call_object_define_props_1 : value -> value -> ext_expr
+  | spec_call_object_define_props_2 : out -> object_loc -> ext_expr
+  | spec_call_object_define_props_3 : object_loc -> object_loc -> list prop_name -> list (prop_name * attributes) -> ext_expr
+  | spec_call_object_define_props_4 : out -> object_loc -> object_loc -> prop_name -> list prop_name -> list (prop_name * attributes) -> ext_expr
+  | spec_call_object_define_props_5 : object_loc -> object_loc -> prop_name -> list prop_name -> list (prop_name * attributes) -> specret attributes -> ext_expr
+  | spec_call_object_define_props_6 : object_loc -> list (prop_name * attributes) -> ext_expr
+  | spec_call_object_define_props_7 : out -> object_loc -> list (prop_name * attributes) -> ext_expr
+
+  | spec_call_object_seal_1 : value -> ext_expr
+  | spec_call_object_seal_2 : object_loc -> list prop_name -> ext_expr
+  | spec_call_object_seal_3 : object_loc -> prop_name -> list prop_name -> specret full_descriptor -> ext_expr
+  | spec_call_object_seal_4 : object_loc -> list prop_name -> out -> ext_expr
+
+  | spec_call_object_is_sealed_1 : value -> ext_expr
+  | spec_call_object_is_sealed_2 : object_loc -> list prop_name -> ext_expr
+  | spec_call_object_is_sealed_3 : object_loc -> list prop_name -> specret full_descriptor -> ext_expr
+
+  | spec_call_object_freeze_1 : value -> ext_expr
+  | spec_call_object_freeze_2 : object_loc -> list prop_name -> ext_expr
+  | spec_call_object_freeze_3 : object_loc -> prop_name -> list prop_name -> specret full_descriptor -> ext_expr
+  | spec_call_object_freeze_4 : object_loc -> prop_name -> list prop_name -> full_descriptor -> ext_expr
+  | spec_call_object_freeze_5 : object_loc -> list prop_name -> out -> ext_expr
+
+  | spec_call_object_is_frozen_1 : value -> ext_expr
+  | spec_call_object_is_frozen_2 : object_loc -> list prop_name -> ext_expr
+  | spec_call_object_is_frozen_3 : object_loc -> list prop_name -> specret full_descriptor -> ext_expr
+  | spec_call_object_is_frozen_4 : object_loc -> list prop_name -> full_descriptor -> ext_expr
+  | spec_call_object_is_frozen_5 : object_loc -> list prop_name -> full_descriptor -> ext_expr
+
+
+  | spec_call_object_prevent_extensions_1 : value -> ext_expr
+
+  | spec_call_object_define_prop_1 : value -> value -> value -> ext_expr
+  | spec_call_object_define_prop_2 : object_loc -> out -> value -> ext_expr
+  | spec_call_object_define_prop_3 : object_loc -> string -> specret descriptor -> ext_expr
+  | spec_call_object_define_prop_4 : object_loc -> out -> ext_expr
+
+  | spec_call_object_get_own_prop_descriptor_1: value -> value -> ext_expr
+  | spec_call_object_get_own_prop_descriptor_2: object_loc -> out -> ext_expr
+
+
+  | spec_call_object_proto_to_string_1 : value -> ext_expr
+  | spec_call_object_proto_to_string_2 : out -> ext_expr
+
+  | spec_call_object_proto_has_own_prop_1 : out -> value -> ext_expr
+  | spec_call_object_proto_has_own_prop_2 : out -> prop_name -> ext_expr
+  | spec_call_object_proto_has_own_prop_3 : specret full_descriptor -> ext_expr
+
+  | spec_call_object_proto_is_prototype_of_2_1 : value -> value -> ext_expr
+  | spec_call_object_proto_is_prototype_of_2_2 : out -> object_loc -> ext_expr
+  | spec_call_object_proto_is_prototype_of_2_3 : object_loc -> object_loc -> ext_expr
+  | spec_call_object_proto_is_prototype_of_2_4 : object_loc -> value -> ext_expr
+
+  | spec_call_object_proto_prop_is_enumerable_1 : value -> value -> ext_expr
+  | spec_call_object_proto_prop_is_enumerable_2 : value -> out -> ext_expr
+  | spec_call_object_proto_prop_is_enumerable_3 : out -> string -> ext_expr
+  | spec_call_object_proto_prop_is_enumerable_4 : specret full_descriptor -> ext_expr
+
+  | spec_call_array_new_1 : list value -> ext_expr
+  | spec_call_array_new_2 : object_loc -> list value -> ext_expr
+  | spec_call_array_new_3 : object_loc -> list value -> int -> ext_expr
+
+  | spec_call_array_new_single_1 : value -> ext_expr
+  | spec_call_array_new_single_2 : object_loc -> value -> ext_expr
+  | spec_call_array_new_single_3 : object_loc -> number -> specret int -> ext_expr
+  | spec_call_array_new_single_4 : object_loc -> int -> ext_expr
+
+  | spec_call_array_is_array_1 : value -> ext_expr
+  | spec_call_array_is_array_2_3 : class_name -> ext_expr
+
+  | spec_call_array_proto_to_string : out -> ext_expr
+  | spec_call_array_proto_to_string_1 : object_loc -> out -> ext_expr
+
+  | spec_call_array_proto_join   : out -> list value -> ext_expr 
+  | spec_call_array_proto_join_1 : object_loc -> out -> list value -> ext_expr 
+  | spec_call_array_proto_join_2 : object_loc -> specret int -> list value -> ext_expr
+  | spec_call_array_proto_join_3 : object_loc -> int -> value -> ext_expr
+  | spec_call_array_proto_join_4 : object_loc -> int -> out -> ext_expr
+  | spec_call_array_proto_join_5 : object_loc -> int -> string -> specret string -> ext_expr
+
+  | spec_call_array_proto_join_elements : object_loc -> int -> int -> string -> string -> ext_expr
+  | spec_call_array_proto_join_elements_1 : object_loc -> int -> int -> string -> string -> ext_expr
+  | spec_call_array_proto_join_elements_2 : object_loc -> int -> int -> string -> string -> specret string -> ext_expr
+
+  | spec_call_array_proto_pop_1 : out -> ext_expr
+  | spec_call_array_proto_pop_2 : object_loc -> out -> ext_expr
+  | spec_call_array_proto_pop_3 : object_loc -> specret int -> ext_expr
+  | spec_call_array_proto_pop_3_empty_1 : object_loc -> ext_expr
+  | spec_call_array_proto_pop_3_empty_2 : out -> ext_expr
+  | spec_call_array_proto_pop_3_nonempty_1 : object_loc -> int -> ext_expr
+  | spec_call_array_proto_pop_3_nonempty_2 : object_loc -> out -> ext_expr
+  | spec_call_array_proto_pop_3_nonempty_3 : object_loc -> value -> out -> ext_expr
+  | spec_call_array_proto_pop_3_nonempty_4 : object_loc -> value -> value -> out -> ext_expr
+  | spec_call_array_proto_pop_3_nonempty_5 : value -> out -> ext_expr
+
+  | spec_call_array_proto_push_1 : out -> list value -> ext_expr
+  | spec_call_array_proto_push_2 : object_loc -> list value -> out -> ext_expr
+  | spec_call_array_proto_push_3 : object_loc -> list value -> specret int -> ext_expr
+  | spec_call_array_proto_push_4 : object_loc -> list value -> int -> ext_expr
+  | spec_call_array_proto_push_4_nonempty_1 : object_loc -> list value -> int -> value -> ext_expr
+  | spec_call_array_proto_push_4_nonempty_2 : object_loc -> list value -> int -> value -> out -> ext_expr
+  | spec_call_array_proto_push_4_nonempty_3 : object_loc -> list value -> int -> value -> out -> ext_expr
+  | spec_call_array_proto_push_5 : object_loc -> value -> ext_expr
+  | spec_call_array_proto_push_6 : value -> out -> ext_expr
+
+  | spec_call_string_non_empty : out -> ext_expr 
+
+  | spec_construct_string_1 : value -> ext_expr
+  | spec_construct_string_2 : out -> ext_expr
+
+  | spec_construct_bool_1 : out -> ext_expr
+  | spec_call_bool_proto_to_string_1 : out -> ext_expr
+  | spec_call_bool_proto_value_of_1 : value -> ext_expr
+  | spec_call_bool_proto_value_of_2 : value -> ext_expr
+
+  | spec_call_number_proto_to_string_1 : value -> list value -> ext_expr
+  | spec_call_number_proto_to_string_2 : value -> out -> ext_expr
+  | spec_construct_number_1 : out -> ext_expr
+  | spec_call_number_proto_value_of_1 : value -> ext_expr
+
+  | spec_call_error_proto_to_string_1 : value -> ext_expr
+  | spec_call_error_proto_to_string_2 : object_loc -> out -> ext_expr
+  | spec_call_error_proto_to_string_3 : object_loc -> out -> ext_expr
+  | spec_call_error_proto_to_string_4 : object_loc -> string -> out -> ext_expr
+  | spec_call_error_proto_to_string_5 : object_loc -> string -> out -> ext_expr
+  | spec_call_error_proto_to_string_6 : object_loc -> string -> out -> ext_expr
+
+
+  (** Special state for returning an outcome *)
+
+  | spec_returns : out -> ext_expr
+
+(** Grammar of extended statements *)
+
+with ext_stat :=
+
+  (** Extended expressions include statements *)
+
+  | stat_basic : stat -> ext_stat
+
+  (** Extended statements associated with primitive statements *)
+  | stat_expr_1: (specret value) -> ext_stat
+
+  | stat_block_1 : out -> stat -> ext_stat
+  | stat_block_2 : resvalue -> out -> ext_stat
+
+  | stat_label_1 : label -> out -> ext_stat
+
+  | stat_var_decl_1 : out -> list (string * option expr) -> ext_stat
+  | stat_var_decl_item : (string * option expr) -> ext_stat
+  | stat_var_decl_item_1 : string -> specret ref -> expr -> ext_stat
+  | stat_var_decl_item_2 : string -> ref -> (specret value) -> ext_stat
+  | stat_var_decl_item_3 : string -> out -> ext_stat
+
+  | stat_if_1 : specret value -> stat -> option stat -> ext_stat
+
+  | stat_while_1 : label_set -> expr -> stat -> resvalue -> ext_stat
+  | stat_while_2 : label_set -> expr -> stat -> resvalue -> specret value -> ext_stat
+  | stat_while_3 : label_set -> expr -> stat -> resvalue -> out -> ext_stat
+  | stat_while_4 : label_set -> expr -> stat -> resvalue -> res -> ext_stat
+  | stat_while_5 : label_set -> expr -> stat -> resvalue -> res -> ext_stat
+  | stat_while_6 : label_set -> expr -> stat -> resvalue -> res -> ext_stat
+
+
+  | stat_do_while_1 : label_set -> stat -> expr -> resvalue -> ext_stat
+  | stat_do_while_2 : label_set -> stat -> expr -> resvalue -> out -> ext_stat
+  | stat_do_while_3 : label_set -> stat -> expr -> resvalue -> res -> ext_stat
+  | stat_do_while_4 : label_set -> stat -> expr -> resvalue -> res -> ext_stat
+  | stat_do_while_5 : label_set -> stat -> expr -> resvalue -> res -> ext_stat
+  | stat_do_while_6 : label_set -> stat -> expr -> resvalue -> ext_stat
+  | stat_do_while_7 : label_set -> stat -> expr -> resvalue -> specret value -> ext_stat
+
+  | stat_for_1 : label_set -> specret value -> option expr -> option expr -> stat -> ext_stat
+  | stat_for_2 : label_set -> resvalue -> option expr -> option expr -> stat -> ext_stat
+  | stat_for_3 : label_set -> resvalue -> expr -> specret value -> option expr -> stat -> ext_stat
+  | stat_for_4 : label_set -> resvalue -> option expr -> option expr -> stat -> ext_stat
+  | stat_for_5 : label_set -> resvalue -> option expr -> out -> option expr -> stat -> ext_stat
+  | stat_for_6 : label_set -> resvalue -> option expr -> option expr -> stat -> res -> ext_stat
+  | stat_for_7 : label_set -> resvalue -> option expr -> option expr -> stat -> res -> ext_stat
+  | stat_for_8 : label_set -> resvalue -> option expr -> option expr -> stat -> ext_stat
+  | stat_for_9 : label_set -> resvalue -> option expr -> expr -> specret value -> stat -> ext_stat
+
+  | stat_for_var_1 : out -> label_set -> option expr -> option expr -> stat -> ext_stat
+
+
+(* LATER: define prop_names for [set prop_name] *)
+(* LATER
+  | stat_for_in_1 : expr -> stat -> out -> ext_stat
+  | stat_for_in_2 : expr -> stat -> out -> ext_stat
+  | stat_for_in_3 : expr -> stat -> out -> ext_stat
+  | stat_for_in_4 : expr -> stat -> object_loc -> option res -> option out -> set prop_name -> set prop_name -> ext_stat 
+  | stat_for_in_5 : expr -> stat -> object_loc -> option res -> option out -> set prop_name -> set prop_name -> prop_name -> ext_stat
+  | stat_for_in_6 : expr -> stat -> object_loc -> option res -> option out -> set prop_name -> set prop_name -> prop_name -> ext_stat
+  | stat_for_in_7 : expr -> stat -> object_loc -> option res -> option out -> set prop_name -> set prop_name -> out -> ext_stat
+  | stat_for_in_8 : expr -> stat -> object_loc -> option res -> option out -> set prop_name -> set prop_name -> out -> ext_stat
+  | stat_for_in_9 : expr -> stat -> object_loc -> option res -> option out -> set prop_name -> set prop_name -> res -> ext_stat
+*)
+
+  (* Extended statements for 'switch' *)
+                                                                           
+  | stat_switch_1: (specret value) -> label_set -> switchbody -> ext_stat
+  | stat_switch_2: out -> label_set -> ext_stat
+  | stat_switch_nodefault_1: value -> resvalue -> list switchclause -> ext_stat
+  | stat_switch_nodefault_2: (specret value) -> value -> resvalue -> list stat -> list switchclause -> ext_stat
+  | stat_switch_nodefault_3: bool -> value -> resvalue -> list stat -> list switchclause -> ext_stat
+  | stat_switch_nodefault_4: out -> list switchclause -> ext_stat
+  | stat_switch_nodefault_5: resvalue -> list switchclause -> ext_stat
+  | stat_switch_nodefault_6: resvalue -> out -> list switchclause -> ext_stat
+
+  | stat_switch_default_1: value -> resvalue -> list switchclause -> list stat -> list switchclause -> ext_stat
+  | stat_switch_default_A_1: bool -> value -> resvalue -> list switchclause -> list stat -> list switchclause -> ext_stat
+  | stat_switch_default_A_2: (specret value) -> value -> resvalue -> list stat -> list switchclause -> list stat -> list switchclause -> ext_stat
+  | stat_switch_default_A_3: bool -> value -> resvalue -> list stat -> list switchclause -> list stat -> list switchclause -> ext_stat
+  | stat_switch_default_A_4: resvalue -> value -> list stat -> list switchclause -> list stat -> list switchclause -> ext_stat
+  | stat_switch_default_A_5: resvalue -> out -> value -> list switchclause -> list stat -> list switchclause -> ext_stat
+
+  | stat_switch_default_B_1: value -> resvalue -> list stat -> list switchclause -> ext_stat
+  | stat_switch_default_B_2: (specret value) -> value -> resvalue -> list stat -> list stat -> list switchclause -> ext_stat
+  | stat_switch_default_B_3: bool -> value -> resvalue -> list stat -> list stat -> list switchclause -> ext_stat
+  | stat_switch_default_B_4: out -> list stat -> list switchclause -> ext_stat
+
+  | stat_switch_default_5: value -> resvalue -> list stat -> list switchclause -> ext_stat
+  | stat_switch_default_6: out -> list switchclause -> ext_stat
+  | stat_switch_default_7: resvalue -> list switchclause -> ext_stat
+  | stat_switch_default_8: resvalue -> out -> list switchclause -> ext_stat
+
+  | stat_with_1 : stat -> specret value -> ext_stat (* The expression have been executed. *)
+
+  | stat_throw_1 : (specret value) -> ext_stat (* The expression have been executed. *)
+
+  | stat_return_1 : (specret value) -> ext_stat (* The expression have been executed. *)
+
+  | stat_try_1 : out -> option (string*stat) -> option stat -> ext_stat (* The try block has been executed. *)
+  | stat_try_2 : out -> lexical_env -> stat -> option stat -> ext_stat (* The catch block is actived and will be executed. *)
+  | stat_try_3 : out -> option stat -> ext_stat (* The try catch block has been executed:  there only stay an optional finally. *)
+  | stat_try_4 : res -> option stat -> ext_stat (* The try catch block has been executed:  there only stay an optional finally. *)
+  | stat_try_5 : res -> out -> ext_stat (* The finally has been executed. *)
+
+(** Grammar of extended programs *)
+
+with ext_prog :=
+
+  | prog_basic : prog -> ext_prog
+  | javascript_1 : out -> prog -> ext_prog
+  | prog_1 : out -> element -> ext_prog
+  | prog_2 : resvalue -> out -> ext_prog
+
+
+(** Grammar of extended forms for specification functions *)
+
+with ext_spec :=
+  | spec_to_int32 : value -> ext_spec
+  | spec_to_int32_1 : out -> ext_spec
+  | spec_to_uint32 : value -> ext_spec
+  | spec_to_uint32_1 : out -> ext_spec
+
+  | spec_expr_get_value_conv : (value -> ext_expr) -> expr -> ext_spec
+  | spec_expr_get_value_conv_1 : (value -> ext_expr) -> (specret value) -> ext_spec
+  | spec_expr_get_value_conv_2 : out -> ext_spec
+
+  | spec_convert_twice : ext_expr -> ext_expr -> ext_spec
+  | spec_convert_twice_1 : out -> ext_expr -> ext_spec
+  | spec_convert_twice_2 : value -> out -> ext_spec
+
+  (** Extended expressions for lists of expressions *)
+  | spec_list_expr : list expr -> ext_spec
+  | spec_list_expr_1 : list value -> list expr -> ext_spec
+  | spec_list_expr_2 : list value -> (specret value) -> list expr -> ext_spec 
+
+  | spec_to_descriptor : value -> ext_spec
+  | spec_to_descriptor_1a : object_loc -> descriptor -> ext_spec
+  | spec_to_descriptor_1b : out -> object_loc -> descriptor -> ext_spec
+  | spec_to_descriptor_1c : out -> object_loc -> descriptor -> ext_spec
+  | spec_to_descriptor_2a : object_loc -> descriptor -> ext_spec                            
+  | spec_to_descriptor_2b : out -> object_loc -> descriptor -> ext_spec
+  | spec_to_descriptor_2c : out -> object_loc -> descriptor -> ext_spec
+  | spec_to_descriptor_3a : object_loc -> descriptor -> ext_spec                            
+  | spec_to_descriptor_3b : out -> object_loc -> descriptor -> ext_spec
+  | spec_to_descriptor_3c : out -> object_loc -> descriptor -> ext_spec
+  | spec_to_descriptor_4a : object_loc -> descriptor -> ext_spec                            
+  | spec_to_descriptor_4b : out -> object_loc -> descriptor -> ext_spec
+  | spec_to_descriptor_4c : out -> object_loc -> descriptor -> ext_spec
+  | spec_to_descriptor_5a : object_loc -> descriptor -> ext_spec                            
+  | spec_to_descriptor_5b : out -> object_loc -> descriptor -> ext_spec
+  | spec_to_descriptor_5c : out -> object_loc -> descriptor -> ext_spec
+  | spec_to_descriptor_6a : object_loc -> descriptor -> ext_spec                            
+  | spec_to_descriptor_6b : out -> object_loc -> descriptor -> ext_spec
+  | spec_to_descriptor_6c : out -> object_loc -> descriptor -> ext_spec
+  | spec_to_descriptor_7 : object_loc -> descriptor -> ext_spec    
+
+  | spec_object_get_own_prop : object_loc -> prop_name -> ext_spec
+  | spec_object_get_own_prop_1 : builtin_get_own_prop -> object_loc -> prop_name -> ext_spec
+  | spec_object_get_own_prop_2 : object_loc -> prop_name -> option attributes -> ext_spec
+
+  | spec_object_get_prop : object_loc -> prop_name -> ext_spec
+  | spec_object_get_prop_1 : builtin_get_prop -> object_loc -> prop_name -> ext_spec
+  | spec_object_get_prop_2 : object_loc -> prop_name -> specret full_descriptor -> ext_spec
+  | spec_object_get_prop_3 : object_loc -> prop_name -> value -> ext_spec
+
+  | spec_get_value : resvalue -> ext_spec
+  | spec_get_value_ref_b_1 : out -> ext_spec
+  | spec_get_value_ref_c_1 : out -> ext_spec
+
+  (** Shorthand for calling [red_expr] then [ref_get_value] *)
+
+  | spec_expr_get_value : expr -> ext_spec
+  | spec_expr_get_value_1 : out -> ext_spec
+
+  (** Extended expressions for operations on lexical environments *)
+
+  | spec_lexical_env_get_identifier_ref : lexical_env -> prop_name -> bool -> ext_spec
+  | spec_lexical_env_get_identifier_ref_1 : env_loc -> lexical_env -> prop_name -> bool -> ext_spec
+  | spec_lexical_env_get_identifier_ref_2 : env_loc -> lexical_env -> prop_name -> bool -> out -> ext_spec
+
+  (** Errors in the grammar of spec *) (* LATER: merge *)
+  | spec_error_spec : native_error -> ext_spec
+  | spec_error_spec_1 : out -> ext_spec
+
+  (* .. *)
+  | spec_args_obj_get_own_prop_1 : object_loc -> prop_name -> (specret full_descriptor) -> ext_spec
+  | spec_args_obj_get_own_prop_2 : object_loc -> prop_name -> object_loc -> full_descriptor -> (specret full_descriptor) -> ext_spec
+  | spec_args_obj_get_own_prop_3 : full_descriptor -> out -> ext_spec
+  | spec_args_obj_get_own_prop_4 : full_descriptor -> ext_spec
+
+  | spec_string_get_own_prop_1 : object_loc -> prop_name -> (specret full_descriptor) -> ext_spec
+  | spec_string_get_own_prop_2 : object_loc -> prop_name -> (specret int) -> ext_spec
+  | spec_string_get_own_prop_3 : object_loc -> prop_name -> out -> ext_spec
+  | spec_string_get_own_prop_4 : prop_name -> string -> ext_spec
+  | spec_string_get_own_prop_5 : string -> (specret int) -> ext_spec
+  | spec_string_get_own_prop_6 : string -> int -> int -> ext_spec
+
+  (* Argumenst for Function.prototype.apply *)
+
+  | spec_function_proto_apply_get_args   : object_loc -> int -> int -> ext_spec
+  | spec_function_proto_apply_get_args_1 : object_loc -> int -> int -> out -> ext_spec
+  | spec_function_proto_apply_get_args_2 : object_loc -> int -> int -> out -> ext_spec
+  | spec_function_proto_apply_get_args_3 : value -> specret (list value) -> ext_spec 
+
+  (* Length for Function.prototype.bind *)
+
+  | spec_function_proto_bind_length   : object_loc -> list value -> ext_spec
+  | spec_function_proto_bind_length_1 : object_loc -> list value -> ext_spec
+  | spec_function_proto_bind_length_2 : list value -> out -> ext_spec
+  | spec_function_proto_bind_length_3 : specret int -> list value -> ext_spec
+
+  (* Conversion for Array.prototype.join *)
+
+  | spec_call_array_proto_join_vtsfj : object_loc -> int -> ext_spec
+  | spec_call_array_proto_join_vtsfj_1 : object_loc -> out -> ext_spec
+  | spec_call_array_proto_join_vtsfj_2 : object_loc -> out -> ext_spec
+  | spec_call_array_proto_join_vtsfj_3 : out -> ext_spec
+.
+
+(** Coercions *)
+
+Coercion expr_basic : expr >-> ext_expr.
+Coercion stat_basic : stat >-> ext_stat.
+Coercion prog_basic : prog >-> ext_prog.
+
+
+(** Shorthand for calling toPrimitive without prefered type *)
+
+Definition spec_to_primitive_auto v :=
+  spec_to_primitive v None.
+
+
+(**************************************************************)
+(** ** Extracting outcome from an extended expression. *)
+
+(** Auxiliary definition for extracting [out] of [specret] *)
+
+Definition out_of_specret T (y:specret T) :=
+  match y with
+  | specret_out o => Some o
+  | specret_val _ _ => None
+  end.
+
+(** The [out_of_ext_*] family of definitions is used by
+    the generic abort rule, which propagates exceptions,
+    and divergence, break and continues. *)
+
+Definition out_of_ext_expr (e : ext_expr) : option out :=
+  match e with
+  | expr_basic _ => None
+
+  | expr_identifier_1 y => out_of_specret y   
+  | expr_object_0 o _ => Some o
+  | expr_object_1 _ _ => None
+  | expr_object_2 _ _ _ _ => None
+  | expr_object_3_val _ _ y _ => out_of_specret y
+  | expr_object_3_get _ _ o _ => Some o
+  | expr_object_3_set _ _ o _ => Some o
+  | expr_object_4 _ _ _ _ => None
+  | expr_object_5 _ _ o => Some o
+
+
+
+
+  (* _ARRAYS_ : support for array intermediate forms - CHECK!*)
+  | expr_array_0 o _ => Some o
+  | expr_array_1 _ _ => None
+  | expr_array_2 _ _ _ => None
+  | expr_array_3 _ _ _ => None
+  | expr_array_3_1 _ y _ _ => out_of_specret y
+  | expr_array_3_2 _ _ o _ _ => Some o
+  | expr_array_3_3 _ _ y _ _ => out_of_specret y
+  | expr_array_3_4 _ _ o _ => Some o
+  | expr_array_3_5 _ o _ => Some o
+  
+
+  | expr_array_add_length   _ _ o => Some o
+  | expr_array_add_length_0 _ _ => None
+  | expr_array_add_length_1 _ _ o => Some o 
+  | expr_array_add_length_2 _ y _ => out_of_specret y
+  | expr_array_add_length_3 _ y => out_of_specret y
+  | expr_array_add_length_4 _ o => Some o
+
+
+
+
+
+  | expr_function_1 _ _ _ _ _ o => Some o
+  | expr_function_2 _ _ o => Some o
+  | expr_function_3 _ o => Some o
+
+  | expr_access_1 y _ => out_of_specret y
+  | expr_access_2 _ y => out_of_specret y
+  | expr_access_3 _ o _ => Some o
+  | expr_access_4 _ o => Some o
+
+  | expr_new_1 y _ => out_of_specret y
+  | expr_new_2 _ y => out_of_specret y  
+
+  | expr_call_1 o _ _ => Some o
+  | expr_call_2 _ _ _ y => out_of_specret y
+  | expr_call_3 _ _ _ y => out_of_specret y  
+  | expr_call_4 _ _ _ _ => None
+  | expr_call_5 _ _ _ o => Some o
+
+  | spec_eval _ _ _ => None
+
+  | expr_unary_op_1 _ y => out_of_specret y
+  | expr_unary_op_2 _ _ => None
+  | expr_delete_1 o => Some o
+  | expr_delete_2 _ => None
+  | expr_delete_3 _ o => Some o
+  | expr_delete_4 _ _ => None
+  | expr_typeof_1 o => Some o
+  | expr_typeof_2 y => out_of_specret y
+  | expr_prepost_1 _ o => Some o
+(*  | expr_prepost_2 _ _ o => Some o *)
+
+  | expr_prepost_2 _ _ y => out_of_specret y
+
+  | expr_prepost_3 _ _ o => Some o
+  | expr_prepost_4 _ o => Some o
+  | expr_unary_op_neg_1 o => Some o
+  | expr_unary_op_bitwise_not_1 y => out_of_specret y
+  | expr_unary_op_not_1 o => Some o
+  | expr_conditional_1 y _ _ => out_of_specret y
+  | expr_conditional_1' o _ _ => None
+  | expr_conditional_2 y => out_of_specret y
+
+  | expr_binary_op_1 _ y _ => out_of_specret y
+  | expr_binary_op_2 _ _ y => out_of_specret y
+  | expr_binary_op_3 _ _ _ => None
+  | expr_binary_op_add_1 y => out_of_specret y
+  | expr_binary_op_add_string_1 y => out_of_specret y
+  | expr_puremath_op_1 _ y => out_of_specret y
+  | expr_shift_op_1 _ y _ => out_of_specret y
+  | expr_shift_op_2 _ _ y => out_of_specret y
+  | expr_inequality_op_1 _ _ _ _ => None
+  | expr_inequality_op_2 _ _ y => out_of_specret y
+  | expr_binary_op_in_1 _ o => Some o
+  | expr_binary_op_disequal_1 o => Some o
+  | spec_equal _ _ => None
+  | spec_equal_1 _ _ _ _ => None
+  | spec_equal_2 _ => None
+  | spec_equal_3 _ _ _ => None
+  | spec_equal_4 _ o => Some o
+  | expr_bitwise_op_1 _ y _ => out_of_specret y
+  | expr_bitwise_op_2 _ _ y => out_of_specret y
+  | expr_lazy_op_1 _ y _ => out_of_specret y
+  | expr_lazy_op_2 _ _ o _ => Some o
+  | expr_lazy_op_2_1 y => out_of_specret y
+
+  | expr_assign_1 o _ _ => Some o
+  | expr_assign_2 _ y _ _ => out_of_specret y
+  | expr_assign_3 _ _ _ y => out_of_specret y
+  | expr_assign_3' _ o => Some o
+  | expr_assign_4 _ y => out_of_specret y
+  | expr_assign_5 _ o => Some o
+
+  | spec_to_primitive _ _ => None
+  | spec_to_boolean _ => None
+  | spec_to_number _ => None
+  | spec_to_number_1 o => Some o
+  | spec_to_integer _ => None
+  | spec_to_integer_1 o => Some o
+  | spec_to_string _ => None
+  | spec_to_string_1 o => Some o
+  | spec_to_object _ => None
+
+  | spec_check_object_coercible _ => None
+
+  | spec_eq _ _ => None
+  | spec_eq0 _ _ => None
+  | spec_eq1 _ _ => None
+  | spec_eq2 _ _ _ => None
+
+  | spec_object_get _ _ => None
+  | spec_object_get_1 _ _ _ _ => None
+  | spec_object_get_2 _ y => out_of_specret y
+  | spec_object_get_3 _ _ => None
+
+  | spec_object_can_put _ _ => None
+  | spec_object_can_put_1 _ _ _ => None
+  | spec_object_can_put_2 _ _ y => out_of_specret y
+  | spec_object_can_put_4 _ _ _ => None
+  | spec_object_can_put_5 _ y => out_of_specret y
+  | spec_object_can_put_6 _ _ => None
+
+  | spec_object_put _ _ _ _ => None
+  | spec_object_put_1 _ _ _ _ _ _ => None
+  | spec_object_put_2 _ _ _ _ _ o => Some o
+  | spec_object_put_3 _ _ _ _ _ y => out_of_specret y
+  | spec_object_put_4 _ _ _ _ _ y => out_of_specret y
+  | spec_object_put_5 o => Some o
+
+  | spec_object_has_prop _ _ => None
+  | spec_object_has_prop_1 _ _ _ => None
+  | spec_object_has_prop_2 y => out_of_specret y
+
+  | spec_object_delete _ _ _ => None
+  | spec_object_delete_1 _ _ _ _ => None
+  | spec_object_delete_2 _ _ _ y => out_of_specret y
+  | spec_object_delete_3 _ _ _ _ => None
+
+  | spec_object_default_value _ _ => None
+  | spec_object_default_value_1 _ _ _ => None
+  | spec_object_default_value_2 _ _ _ => None
+  | spec_object_default_value_3 _ _ => None
+  | spec_object_default_value_4 => None
+  | spec_object_default_value_sub_1 _ _ _ => None
+  | spec_object_default_value_sub_2 _ o _ => Some o
+  | spec_object_default_value_sub_3 o _ => Some o
+
+  | spec_object_define_own_prop _ _ _ _ => None
+  | spec_object_define_own_prop_1 _ _ _ _ _ => None
+  | spec_object_define_own_prop_2 _ _ _ _ y => out_of_specret y
+  | spec_object_define_own_prop_3 _ _ _ _ _ _ => None
+  | spec_object_define_own_prop_4 _ _ _ _ _ => None
+  | spec_object_define_own_prop_5 _ _ _ _ _ => None
+  | spec_object_define_own_prop_6a _ _ _ _ _ => None
+  | spec_object_define_own_prop_6b _ _ _ _ _ => None
+  | spec_object_define_own_prop_6c _ _ _ _ _ => None
+  | spec_object_define_own_prop_reject _ => None
+  | spec_object_define_own_prop_write _ _ _ _ _ => None
+
+
+
+  (* ARRAYS *)
+  | spec_object_define_own_prop_array_2 _ _ _ _ y => out_of_specret y
+  | spec_object_define_own_prop_array_2_1 _ _ _ _ _ _ => None
+  | spec_object_define_own_prop_array_branch_3_4 _ _ _ _ _ y => out_of_specret y
+  | spec_object_define_own_prop_array_branch_4_5 _ _ _ _ _ _ => None
+  | spec_object_define_own_prop_array_branch_4_5_a _ _ y _ _ _ _ => out_of_specret y
+  | spec_object_define_own_prop_array_branch_4_5_b _ _ _ o _ _ _ _ => Some o
+  | spec_object_define_own_prop_array_4a _ _ _ _ _ _ => None
+  | spec_object_define_own_prop_array_4b _ _ y _ _ _ _ => out_of_specret y
+  | spec_object_define_own_prop_array_4c _ _ _ _ _ _ o => Some o
+  | spec_object_define_own_prop_array_5 _ _ _ _ => None
+  | spec_object_define_own_prop_array_3 _ _ _ _ _ => None
+  | spec_object_define_own_prop_array_3c _ _ y _ _ _ _ => out_of_specret y
+  | spec_object_define_own_prop_array_3d_e _ o _ _ _ _ _ => Some o
+  | spec_object_define_own_prop_array_3f_g _ _ _ _ _ _ => None
+  | spec_object_define_own_prop_array_3h_i _ _ _ _ _ _ => None
+  | spec_object_define_own_prop_array_3j _ _ _ _ _ _ _ => None
+  | spec_object_define_own_prop_array_3k_l _ o _ _ _ _ _ _ => Some o
+  | spec_object_define_own_prop_array_3l _ _ _ _ _ _ => None
+  | spec_object_define_own_prop_array_3l_ii _ _ _ _ _ _ => None
+  | spec_object_define_own_prop_array_3l_ii_1 _ _ _ _ _ _ o => Some o
+  | spec_object_define_own_prop_array_3l_ii_2 _ _ _ _ _ _ o => Some o
+  | spec_object_define_own_prop_array_3l_iii_1 _ _ _ _ _ => None
+  | spec_object_define_own_prop_array_3l_iii_2 _ _ _ _ => None
+  | spec_object_define_own_prop_array_3l_iii_3 _ _ _ => None
+  | spec_object_define_own_prop_array_3l_iii_4 _ _ o => Some o
+  | spec_object_define_own_prop_array_3m_n _ _ => None
+
+  | spec_prim_value_get _ _ => None
+  | spec_prim_value_get_1 _ _ o => Some o
+
+  | spec_prim_value_put _ _ _ _ => None
+  | spec_prim_value_put_1 _ _ _ _ o => Some o
+
+  | spec_put_value _ _ => None
+
+
+  | spec_env_record_has_binding _ _ => None
+  | spec_env_record_has_binding_1 _ _ _ => None
+  | spec_env_record_get_binding_value _ _ _ => None
+  | spec_env_record_get_binding_value_1 _ _ _ _ => None
+  | spec_env_record_get_binding_value_2 _ _ _ o => Some o
+
+  | spec_env_record_create_immutable_binding _ _ => None
+  | spec_env_record_initialize_immutable_binding _ _ _ => None
+  | spec_env_record_create_mutable_binding _ _ _ => None
+  | spec_env_record_create_mutable_binding_1 _ _ _ _ => None
+  | spec_env_record_create_mutable_binding_2 _ _ _ _ o => Some o
+  | spec_env_record_create_mutable_binding_3 o => Some o
+  | spec_env_record_set_mutable_binding _ _ _ _ => None
+  | spec_env_record_set_mutable_binding_1 _ _ _ _ _ => None
+  | spec_env_record_delete_binding _ _ => None
+  | spec_env_record_delete_binding_1 _ _ _ => None
+
+  | spec_env_record_create_set_mutable_binding _ _ _ _ _ => None
+  | spec_env_record_create_set_mutable_binding_1 o _ _ _ _ => Some o
+
+  | spec_env_record_implicit_this_value _ => None
+  | spec_env_record_implicit_this_value_1 _ _ => None
+
+  | spec_from_descriptor y => out_of_specret y
+  | spec_from_descriptor_1 _ o => Some o
+  | spec_from_descriptor_2 _ _ o => Some o
+  | spec_from_descriptor_3 _ _ o => Some o
+  | spec_from_descriptor_4 _ _ o => Some o
+  | spec_from_descriptor_5 _ _ o => Some o
+  | spec_from_descriptor_6 _ o => Some o
+
+
+  | spec_entering_eval_code _ _ _ => None
+  | spec_entering_eval_code_1 _ _ _ => None
+  | spec_entering_eval_code_2 o _ => Some o
+
+  | spec_call_global_eval _ _ => None
+  | spec_call_global_eval_1 _ _ => None
+  | spec_call_global_eval_2 _ => None
+  | spec_call_global_eval_3 o => Some o
+
+  | spec_entering_func_code _ _ _ _ => None
+  | spec_entering_func_code_1 _ _ _ _ _ _ => None
+  | spec_entering_func_code_2 _ _ _ o _ => Some o
+  | spec_entering_func_code_3 _ _ _ _ _ _ => None
+  | spec_entering_func_code_4 o _ => Some o
+
+  | spec_binding_inst_formal_params _ _ _ _ => None
+  | spec_binding_inst_formal_params_1 _ _ _ _ _ _ o => Some o
+  | spec_binding_inst_formal_params_2 _ _ _ _ _ _ o => Some o
+  | spec_binding_inst_formal_params_3 _ _ _ _ _ _ => None
+  | spec_binding_inst_formal_params_4 _ _ _ _ o => Some o
+  | spec_binding_inst_function_decls _ _ _ _ _ => None
+  | spec_binding_inst_function_decls_1 _ _ _ _ _ _ o => Some o
+  | spec_binding_inst_function_decls_2 _ _ _ _ _ _ _ o => Some o
+  | spec_binding_inst_function_decls_3 _ _ _ _ _ _ y => out_of_specret y
+  | spec_binding_inst_function_decls_3a _ _ _ _ _ _ _ => None
+  | spec_binding_inst_function_decls_4 _ _ _ _ _ _ _ o => Some o
+  | spec_binding_inst_function_decls_5 _ _ _ _ _ _ _ => None
+  | spec_binding_inst_function_decls_6 _ _ _ _ _ o => Some o
+  | spec_binding_inst_arg_obj   object_loc _ _ _ _ => None
+  | spec_binding_inst_arg_obj_1 _ _ _ o => Some o
+  | spec_binding_inst_arg_obj_2 _ _ _ o => Some o
+  | spec_binding_inst_var_decls _ _ _ _ => None
+  | spec_binding_inst_var_decls_1 _ _ _ _ _ o => Some o
+  | spec_binding_inst_var_decls_2 _ _ _ _ o => Some o
+  | spec_binding_inst _ _ _ _ => None
+  | spec_binding_inst_1 _ _ _ _ _ => None
+  | spec_binding_inst_2 _ _ _ _ _ _ o => Some o
+  | spec_binding_inst_3 _ _ _ _ _ _ => None
+  | spec_binding_inst_4 _ _ _ _ _ _ _ o => Some o
+  | spec_binding_inst_5 _ _ _ _ _ _ _ => None
+  | spec_binding_inst_6 _ _ _ _ _ _ _ o => Some o
+  | spec_binding_inst_7 _ _ _ o => Some o
+  | spec_binding_inst_8 _ _ _ => None
+  
+  | spec_make_arg_getter _ _ => None
+  | spec_make_arg_setter _ _ => None
+  
+  | spec_args_obj_get_1 _ _ _ _ y => out_of_specret y
+  
+  
+  | spec_args_obj_define_own_prop_1 _ _ _ _ _ y => out_of_specret y
+  | spec_args_obj_define_own_prop_2 _ _ _ _ _ _ o => Some o
+  | spec_args_obj_define_own_prop_3 _ _ _ _ _ o => Some o
+  | spec_args_obj_define_own_prop_4 _ _ _ _ _ => None
+  | spec_args_obj_define_own_prop_5 o => Some o
+  | spec_args_obj_define_own_prop_6 => None
+  
+  | spec_args_obj_delete_1 _ _ _ _ y => out_of_specret y
+  | spec_args_obj_delete_2 _ _ _ _ _ o => Some o
+  | spec_args_obj_delete_3 o => Some o
+  | spec_args_obj_delete_4 _ => None
+  
+  | spec_arguments_object_map _ _ _ _ _ => None
+  | spec_arguments_object_map_1 _ _ _ _ _ o => Some o
+  | spec_arguments_object_map_2 _ _ _ _ _ _ _ _ => None
+  | spec_arguments_object_map_3 _ _ _ _ _ _ _ _ o => Some o
+  | spec_arguments_object_map_4 _ _ _ _ _ _ _ _ _ => None
+  | spec_arguments_object_map_5 _ _ _ _ _ _ _ _ _ o => Some o
+  | spec_arguments_object_map_6 _ _ _ _ _ _ _ _ _ o => Some o
+  | spec_arguments_object_map_7 _ _ _ _ _ _ _ _ o => Some o
+  | spec_arguments_object_map_8 _ _ _  => None
+
+
+  | spec_create_arguments_object _ _ _ _ _ => None
+  | spec_create_arguments_object_1 _ _ _ _ _ _ o => Some o
+  | spec_create_arguments_object_2 _ _ _ o => Some o
+  | spec_create_arguments_object_3 _ _ _ o => Some o
+  | spec_create_arguments_object_4 _ o => Some o
+
+  | spec_object_has_instance _ _ => None
+  | spec_object_has_instance_1 _ _ _ => None
+  | spec_function_has_instance_1 _ o => Some o
+  | spec_function_has_instance_2 _ _ => None
+  | spec_function_has_instance_3 _ _ => None
+  | spec_function_has_instance_after_bind_1 _ _ => None
+  | spec_function_has_instance_after_bind_2 _ _ => None 
+
+  | spec_function_get_1 _ _ o => Some o
+
+  | spec_error _ => None
+  | spec_error_1 o => Some o 
+  | spec_error_or_cst _ _ _ => None
+  | spec_error_or_void _ _ => None
+
+  | spec_init_throw_type_error => None
+  | spec_init_throw_type_error_1 o => Some o
+
+  | spec_build_error _ _ => None
+  | spec_build_error_1 _ _ => None
+  | spec_build_error_2 _ o => Some o
+
+  | spec_new_object _ => None
+  | spec_new_object_1 o _ => Some o
+
+  | spec_prim_new_object _ => None
+
+  | spec_creating_function_object_proto _ => None
+  | spec_creating_function_object_proto_1 _ o => Some o
+  | spec_creating_function_object_proto_2 _ _ o => Some o
+
+  | spec_creating_function_object _ _ _ _ => None
+  | spec_creating_function_object_1 _ _ o => Some o
+  | spec_creating_function_object_2 _ _ o => Some o
+  | spec_creating_function_object_3 _ o => Some o
+  | spec_creating_function_object_4 _ o => Some o
+
+  | spec_function_proto_apply _ _ _ => None
+  | spec_function_proto_apply_1 _ _ _ o => Some o  
+  | spec_function_proto_apply_2 _ _ _ y => out_of_specret y
+  | spec_function_proto_apply_3 _ _ y => out_of_specret y
+
+  | spec_function_proto_bind_1 _ _ _ => None 
+  | spec_function_proto_bind_2 _ _ _ => None 
+  | spec_function_proto_bind_3 _ y => out_of_specret y 
+  | spec_function_proto_bind_4 _ _ => None 
+  | spec_function_proto_bind_5 _ => None
+  | spec_function_proto_bind_6 _ o => Some o 
+  | spec_function_proto_bind_7 _ o => Some o
+
+  | spec_create_new_function_in  execution_ctx _ _ => None
+
+  | spec_call _ _ _ => None
+  | spec_call_1 _ _ _ _ => None
+
+  | spec_call_prealloc _ _ _ => None
+
+  | spec_call_default _ _ _ => None
+  | spec_call_default_1 _ => None
+  | spec_call_default_2 _ => None
+  | spec_call_default_3 o => Some o
+
+  | spec_construct _ _ => None
+  | spec_construct_1 _ _ _ => None
+
+  | spec_construct_prealloc _ _ => None
+
+  | spec_construct_default _ _ => None
+  | spec_construct_default_1 _ _ o => Some o
+  | spec_construct_default_2 _ o => Some o
+
+  | spec_construct_1_after_bind _ _ _ => None
+
+  | spec_construct_bool_1 o => Some o
+
+  | spec_construct_number_1 o => Some o
+
+  | spec_call_global_is_nan_1 o => Some o
+  | spec_call_global_is_finite_1 o => Some o
+
+  | spec_call_object_call_1 _ _ => None
+  | spec_call_object_new_1 _ => None
+  | spec_call_object_get_proto_of_1 _ => None
+  | spec_call_object_is_extensible_1 _ => None
+
+  | spec_call_object_define_props_1 _ _ => None
+  | spec_call_object_define_props_2 o _ => Some o
+  | spec_call_object_define_props_3 _ _ _ _ => None
+  | spec_call_object_define_props_4 o _ _ _ _ _ => Some o
+  | spec_call_object_define_props_5 _ _ _ _ _ y => out_of_specret y
+  | spec_call_object_define_props_6 _ _ => None
+  | spec_call_object_define_props_7 o _ _ => Some o
+
+  | spec_call_object_create_1 _ _ => None
+  | spec_call_object_create_2 o _ _ => Some o
+  | spec_call_object_create_3 _ _ => None
+
+  | spec_call_object_seal_1 _ => None
+  | spec_call_object_seal_2 _ _ => None
+  | spec_call_object_seal_3 _ _ _ y => out_of_specret y
+  | spec_call_object_seal_4 _ _ o => Some o
+
+  | spec_call_object_is_sealed_1 _ => None
+  | spec_call_object_is_sealed_2 _ _ => None
+  | spec_call_object_is_sealed_3 _ _ y => out_of_specret y
+
+  | spec_call_object_freeze_1 _ => None
+  | spec_call_object_freeze_2 _ _ => None
+  | spec_call_object_freeze_3 _ _ _ y => out_of_specret y
+  | spec_call_object_freeze_4 _ _ _ _ => None
+  | spec_call_object_freeze_5 _ _ o => Some o
+
+  | spec_call_object_is_frozen_1 _ => None
+  | spec_call_object_is_frozen_2 _ _ => None
+  | spec_call_object_is_frozen_3 _ _ y => out_of_specret y
+  | spec_call_object_is_frozen_4 _ _ _ => None
+  | spec_call_object_is_frozen_5 _ _ _ => None
+
+
+  | spec_call_object_prevent_extensions_1 _ => None
+
+  | spec_call_object_define_prop_1 _ _ _ => None
+  | spec_call_object_define_prop_2 _ o _ => Some o
+  | spec_call_object_define_prop_3 _ _ y => out_of_specret y
+  | spec_call_object_define_prop_4 _ o => Some o
+
+  | spec_call_object_get_own_prop_descriptor_1 _ _ => None
+  | spec_call_object_get_own_prop_descriptor_2 _ o => Some o
+
+  | spec_call_object_proto_to_string_1 _ => None
+  | spec_call_object_proto_to_string_2 o => Some o
+
+  | spec_call_object_proto_has_own_prop_1 o _ => Some o
+  | spec_call_object_proto_has_own_prop_2 o _ => Some o
+  | spec_call_object_proto_has_own_prop_3 y => out_of_specret y
+
+  | spec_call_object_proto_is_prototype_of_2_1 _ _ => None
+  | spec_call_object_proto_is_prototype_of_2_2 o _ => Some o
+  | spec_call_object_proto_is_prototype_of_2_3 _ _ => None
+  | spec_call_object_proto_is_prototype_of_2_4 _ _ => None
+
+  | spec_call_object_proto_prop_is_enumerable_1 _ _ => None
+  | spec_call_object_proto_prop_is_enumerable_2 _ o => Some o
+  | spec_call_object_proto_prop_is_enumerable_3 o _ => Some o
+  | spec_call_object_proto_prop_is_enumerable_4 y => out_of_specret y
+
+  | spec_call_array_new_1 _ => None
+  | spec_call_array_new_2 _ _ => None
+  | spec_call_array_new_3 _ _ _ => None
+
+  | spec_call_array_new_single_1 _ => None
+  | spec_call_array_new_single_2 _ _ => None
+  | spec_call_array_new_single_3 _ _ y => out_of_specret y
+  | spec_call_array_new_single_4 _ _ => None
+  
+  | spec_call_array_is_array_1 _ => None
+  | spec_call_array_is_array_2_3 _ => None
+
+  | spec_call_array_proto_join   o _ => Some o 
+  | spec_call_array_proto_join_1 _ o _ => Some o 
+  | spec_call_array_proto_join_2 _ y _ => out_of_specret y
+  | spec_call_array_proto_join_3 _ _ _ => None
+  | spec_call_array_proto_join_4 _ _ o => Some o
+  | spec_call_array_proto_join_5 _ _ _ y => out_of_specret y
+
+  | spec_call_array_proto_join_elements _ _ _ _ _ => None
+  | spec_call_array_proto_join_elements_1 _ _ _ _ _ => None
+  | spec_call_array_proto_join_elements_2 _ _ _ _ _ y => out_of_specret y
+
+  | spec_call_array_proto_to_string o => Some o
+  | spec_call_array_proto_to_string_1 _ o => Some o
+
+  | spec_call_array_proto_pop_1 o => Some o
+  | spec_call_array_proto_pop_2 _ o => Some o
+  | spec_call_array_proto_pop_3 _ y  => out_of_specret y
+  | spec_call_array_proto_pop_3_empty_1 _ => None
+  | spec_call_array_proto_pop_3_empty_2 o => Some o
+  | spec_call_array_proto_pop_3_nonempty_1 _ _ => None
+  | spec_call_array_proto_pop_3_nonempty_2 _ o => Some o
+  | spec_call_array_proto_pop_3_nonempty_3 _ _ o => Some o
+  | spec_call_array_proto_pop_3_nonempty_4 _ _ _ o => Some o
+  | spec_call_array_proto_pop_3_nonempty_5 _ o => Some o
+
+  | spec_call_array_proto_push_1 o _ => Some o
+  | spec_call_array_proto_push_2 _ _ o => Some o
+  | spec_call_array_proto_push_3 _ _ y => out_of_specret y
+  | spec_call_array_proto_push_4 _ _ _ => None
+  | spec_call_array_proto_push_4_nonempty_1 _ _ _ _ => None
+  | spec_call_array_proto_push_4_nonempty_2 _ _ _ _ o => Some o
+  | spec_call_array_proto_push_4_nonempty_3 _ _ _ _ o => Some o
+  | spec_call_array_proto_push_5 _ _ => None
+  | spec_call_array_proto_push_6 _ o => Some o
+
+  | spec_call_string_non_empty o => Some o 
+
+  | spec_construct_string_1 _ => None
+  | spec_construct_string_2 o => Some o
+
+  | spec_call_bool_proto_to_string_1 o => Some o
+  | spec_call_bool_proto_value_of_1 _ => None
+  | spec_call_bool_proto_value_of_2 _ => None
+
+  | spec_call_number_proto_to_string_1 _ _ => None
+  | spec_call_number_proto_to_string_2 _ o => Some o
+  | spec_call_number_proto_value_of_1 _ => None
+
+  | spec_call_error_proto_to_string_1 _ => None
+  | spec_call_error_proto_to_string_2 _ o => Some o
+  | spec_call_error_proto_to_string_3 _ o => Some o
+  | spec_call_error_proto_to_string_4 _ _ o => Some o
+  | spec_call_error_proto_to_string_5 _ _ o => Some o
+  | spec_call_error_proto_to_string_6 _ _ o => Some o
+
+  | spec_returns o => Some o
+  end.
+
+Definition out_of_ext_stat (p : ext_stat) : option out :=
+  match p with
+  | stat_expr_1 (specret_out o) => Some o
+  | stat_expr_1 (specret_val _ _) => None
+  | stat_basic _ => None
+
+  | stat_block_1 o _ => Some o
+  | stat_block_2 _ o => Some o
+
+  | stat_label_1 _ o => Some o
+
+  | stat_var_decl_1 o _ => Some o
+  | stat_var_decl_item _ => None
+  | stat_var_decl_item_1 _ y _ => out_of_specret y
+  | stat_var_decl_item_2 _ _ y => out_of_specret y
+  | stat_var_decl_item_3 _ o => Some o
+
+  | stat_if_1 y _ _ => out_of_specret y
+
+  | stat_while_1 _ _ _ _ => None
+  | stat_while_2 _ _ _ _ y => out_of_specret y
+  | stat_while_3 _ _ _ _ o => Some o
+  | stat_while_4 _ _ _ _ _ => None
+  | stat_while_5 _ _ _ _ _ => None
+  | stat_while_6 _ _ _ _ _ => None
+
+  | stat_do_while_1 _ _ _ _ => None
+  | stat_do_while_2 _ _ _ _ o => Some o
+  | stat_do_while_3 _ _ _ _ _ => None
+  | stat_do_while_4 _ _ _ _ _ => None
+  | stat_do_while_5 _ _ _ _ _ => None
+  | stat_do_while_6 _ _ _ _ => None
+  | stat_do_while_7 _ _ _ _ y => out_of_specret y
+
+  | stat_for_1 _ y _ _ _ => out_of_specret y
+  | stat_for_2 _ _ _ _ _ => None
+  | stat_for_3 _ _ _ y _ _ => out_of_specret y
+  | stat_for_4 _ _ _ _ _ => None
+  | stat_for_5 _ _ _ o _ _ => Some o
+  | stat_for_6 _ _ _ _ _ _ => None
+  | stat_for_7 _ _ _ _ _ _ => None
+  | stat_for_8 _ _ _ _ _ => None
+  | stat_for_9 _ _ _ _ y _ => out_of_specret y
+  | stat_for_var_1 o _ _ _ _ => Some o
+
+  | stat_with_1 _ y => out_of_specret y
+
+  | stat_throw_1 y => out_of_specret y
+
+  | stat_return_1 y => out_of_specret y
+
+  | stat_try_1 o _ _ => Some o
+  | stat_try_2 o _ _ _ => Some o
+  | stat_try_3 o _ => Some o
+  | stat_try_4 _ _ => None
+  | stat_try_5 _ o => Some o
+
+  | stat_switch_1 y _ _ => out_of_specret y
+  | stat_switch_2 o _ => Some o
+  | stat_switch_nodefault_1 _ _ _=> None
+  | stat_switch_nodefault_2 y _ _ _ _  => out_of_specret y
+  | stat_switch_nodefault_3 _ _ _ _ _ => None
+  | stat_switch_nodefault_4 o _ => Some o
+  | stat_switch_nodefault_5 _ _ => None
+  | stat_switch_nodefault_6 _ o _ => Some o
+
+  | stat_switch_default_1 _ _ _ _ _ => None
+  | stat_switch_default_A_1 _ _ _ _ _ _ => None 
+  | stat_switch_default_A_2 y _ _ _ _ _ _ => out_of_specret y
+  | stat_switch_default_A_3 _ _ _ _ _ _ _  => None
+  | stat_switch_default_A_4 _ _ _ _ _ _ => None
+  | stat_switch_default_A_5 _ o _ _ _ _ => Some o
+  | stat_switch_default_B_1 _ _ _ _ => None
+  | stat_switch_default_B_2 y _ _ _ _ _ => out_of_specret y
+  | stat_switch_default_B_3 _ _ _ _ _ _ => None
+  | stat_switch_default_B_4 o _ _ => Some o
+
+  | stat_switch_default_5 _ _ _ _ => None
+  | stat_switch_default_6 o _ => Some o 
+  | stat_switch_default_7 _ _  => None
+  | stat_switch_default_8 _ o _ => Some o
+
+  end.
+
+Definition out_of_ext_prog (p : ext_prog) : option out :=
+  match p with
+  | prog_basic _ => None
+  | javascript_1 o _ => Some o
+  | prog_1 o _ => Some o
+  | prog_2 _ o => Some o
+
+  end.
+
+Definition out_of_ext_spec (es : ext_spec) : option out :=
+  match es with
+  | spec_to_int32 _ => None
+  | spec_to_int32_1 o => Some o
+  | spec_to_uint32 _ => None
+  | spec_to_uint32_1 o => Some o
+  | spec_expr_get_value_conv _ _ => None
+  | spec_expr_get_value_conv_1 _ y => out_of_specret y
+  | spec_expr_get_value_conv_2 o => Some o
+  | spec_convert_twice _ _ => None
+  | spec_convert_twice_1 o _ => Some o
+  | spec_convert_twice_2 _ o => Some o
+  | spec_list_expr _ => None
+  | spec_list_expr_1 _ _ => None
+  | spec_list_expr_2 _ y _ => out_of_specret y
+  | spec_to_descriptor _ => None
+  | spec_to_descriptor_1a _ _ => None
+  | spec_to_descriptor_1b o _ _ => Some o
+  | spec_to_descriptor_1c o _ _ => Some o
+  | spec_to_descriptor_2a _ _ => None
+  | spec_to_descriptor_2b o _ _ => Some o
+  | spec_to_descriptor_2c o _ _ => Some o
+  | spec_to_descriptor_3a _ _ => None
+  | spec_to_descriptor_3b o _ _ => Some o
+  | spec_to_descriptor_3c o _ _ => Some o
+  | spec_to_descriptor_4a _ _ => None
+  | spec_to_descriptor_4b o _ _ => Some o
+  | spec_to_descriptor_4c o _ _ => Some o
+  | spec_to_descriptor_5a _ _ => None
+  | spec_to_descriptor_5b o _ _ => Some o
+  | spec_to_descriptor_5c o _ _ => Some o
+  | spec_to_descriptor_6a _ _ => None
+  | spec_to_descriptor_6b o _ _=> Some o
+  | spec_to_descriptor_6c o _ _ => Some o
+  | spec_to_descriptor_7 _ _ => None
+  | spec_object_get_own_prop _ _ => None
+  | spec_object_get_own_prop_1 _ _ _ => None
+  | spec_object_get_own_prop_2 _ _ _ => None
+  | spec_object_get_prop _ _ => None
+  | spec_object_get_prop_1 _ _ _ => None
+  | spec_object_get_prop_2 _ _ y => out_of_specret y
+  | spec_object_get_prop_3 _ _ _ => None
+  | spec_get_value _ => None
+  | spec_get_value_ref_b_1 o => Some o
+  | spec_get_value_ref_c_1 o => Some o
+  | spec_expr_get_value _ => None
+  | spec_expr_get_value_1 o => Some o
+  | spec_lexical_env_get_identifier_ref _ _ _ => None
+  | spec_lexical_env_get_identifier_ref_1 _ _ _ _ => None
+  | spec_lexical_env_get_identifier_ref_2 _ _ _ _ o => Some o
+  | spec_error_spec _ => None
+  | spec_error_spec_1 o => Some o
+  | spec_args_obj_get_own_prop_1 _ _ y => out_of_specret y
+  | spec_args_obj_get_own_prop_2 _ _ _ _ y => out_of_specret y
+  | spec_args_obj_get_own_prop_3 _ o => Some o
+  | spec_args_obj_get_own_prop_4 _ => None
+  | spec_string_get_own_prop_1 _ _ y => out_of_specret y
+  | spec_string_get_own_prop_2 _ _ y => out_of_specret y
+  | spec_string_get_own_prop_3 _ _ o => Some o
+  | spec_string_get_own_prop_4 _ _ => None
+  | spec_string_get_own_prop_5 _ y => out_of_specret y
+  | spec_string_get_own_prop_6 _ _ _ => None
+  | spec_function_proto_apply_get_args _ _ _ => None
+  | spec_function_proto_apply_get_args_1 _ _ _ o => Some o 
+  | spec_function_proto_apply_get_args_2 _ _ _ o => Some o 
+  | spec_function_proto_apply_get_args_3 _ y => out_of_specret y
+  | spec_function_proto_bind_length _ _ => None
+  | spec_function_proto_bind_length_1 _ _ => None
+  | spec_function_proto_bind_length_2 _ o => Some o
+  | spec_function_proto_bind_length_3 y _ => out_of_specret y
+  | spec_call_array_proto_join_vtsfj _ _ => None
+  | spec_call_array_proto_join_vtsfj_1 _ o => Some o 
+  | spec_call_array_proto_join_vtsfj_2 _ o => Some o 
+  | spec_call_array_proto_join_vtsfj_3 o => Some o 
+  end.
+
+
+(**************************************************************)
+(** ** Rules for propagating aborting expressions *)
+
+(** Definition of a result of type normal *)
+
+Definition res_is_normal R :=
+  res_type R = restype_normal.
+
+(** Definition of aborting outcomes: diverging outcomes,
+    and terminating outcomes that are not of type "normal". *)
+
+Inductive abort : out -> Prop :=
+  | abort_div :
+      abort out_div
+  | abort_not_normal : forall S R,
+      abrupt_res R ->
+      abort (out_ter S R).
+
+(** Definition of the behaviors caught by an exception handler,
+    and thus not propagated by the generic abort rule *)
+
+Inductive abort_intercepted_prog : ext_prog -> Prop :=
+  | abort_intercepted_prog_block_2 : forall S R rv,
+      abort_intercepted_prog (prog_2 rv (out_ter S R)).
+
+Inductive abort_intercepted_stat : ext_stat -> Prop :=
+
+  | abort_intercepted_stat_block_2 : forall S R rv,
+      abort_intercepted_stat (stat_block_2 rv (out_ter S R))
+  | abort_intercepted_stat_label_1 : forall lab rv S R,
+      R = res_intro restype_break rv lab ->
+      abort_intercepted_stat (stat_label_1 lab (out_ter S R))
+  | abort_intercepted_do_while_2 : forall labs e1 t2 rv S R,
+      res_label_in R labs ->
+      (res_type R = restype_continue \/ res_type R = restype_break) ->
+      abort_intercepted_stat (stat_do_while_2 labs t2 e1 rv (out_ter S R))
+  | abort_intercepted_while_3 : forall labs e1 t2 rv S R,
+      res_label_in R labs ->
+      (res_type R = restype_continue \/ res_type R = restype_break) ->
+      abort_intercepted_stat (stat_while_3 labs e1 t2 rv (out_ter S R))
+  | abort_intercepted_stat_try_1 : forall S R cb fo,
+      res_type R = restype_throw ->
+      abort_intercepted_stat (stat_try_1 (out_ter S R) (Some cb) fo)
+  | abort_intercepted_stat_try_3 : forall S R fo,
+      abort_intercepted_stat (stat_try_3 (out_ter S R) fo)
+  | abort_intercepted_stat_switch_2 : forall S R labs,
+      res_type R = restype_break ->
+      res_label_in R labs ->  
+      abort_intercepted_stat (stat_switch_2 (out_ter S R) labs)
+  | abort_intercepted_stat_switch_nodefault_6 : forall S rv R scs,
+      abrupt_res R ->
+      res_type R <> restype_throw -> 
+      abort_intercepted_stat (stat_switch_nodefault_6 rv (out_ter S R) scs)
+  | abort_intercepted_stat_switch_default_8 : forall S rv R scs,
+      abrupt_res R ->
+      res_type R <> restype_throw ->
+      abort_intercepted_stat (stat_switch_default_8 rv (out_ter S R) scs)
+  | abort_intercepted_stat_switch_default_A_5 : forall S rv R vi scs ts1 scs2,
+      abrupt_res R ->
+      res_type R <> restype_throw ->
+      abort_intercepted_stat (stat_switch_default_A_5 rv (out_ter S R) vi scs ts1 scs2)
+   | abort_intercepted_stat_for_6 : forall S0 S C labs rv R eo2 eo3 t,
+      abort_intercepted_stat (stat_for_6 labs rv eo2 eo3 t R)
+   | abort_intercepted_stat_for_7 : forall S0 S C labs rv R eo2 eo3 t,
+      abort_intercepted_stat (stat_for_7 labs rv eo2 eo3 t R)
+.
+
+Inductive abort_intercepted_expr : ext_expr -> Prop :=
+  | abort_intercepted_expr_call_default_2 : forall S R,
+      res_type R = restype_return ->
+      abort_intercepted_expr (spec_call_default_3 (out_ter S R))
+  | abort_intercepted_expr_call_global_eval_3 : forall S R,
+      res_type R = restype_throw ->
+      abort_intercepted_expr (spec_call_global_eval_3 (out_ter S R)).
+
+Inductive abort_intercepted_spec : ext_spec -> Prop :=
+  .
+
+(**************************************************************)
+(** ** Auxiliary definition used in identifier resolution *)
+
+(** [spec_identifier_resolution C x] returns the extended expression
+    which needs to be evaluated in order to perform the lookup
+    of name [x] in the execution context [C]. Typically, a
+    reduction rule that performs such a lookup would have a
+    premise of the form [red_expr S C (identifier_resolution C x) o1]. *)
+
+Definition spec_identifier_resolution C x :=
+  let lex := execution_ctx_lexical_env C in
+  let strict := execution_ctx_strict C in
+  spec_lexical_env_get_identifier_ref lex x strict.
+
+
+(**************************************************************)
+(** ** Instantiation of arguments in function calls *)
+
+Inductive arguments_from : list value -> list value -> Prop :=
+ | arguments_from_nil : forall Vs,
+      arguments_from Vs nil
+ | arguments_from_undef : forall Vs: list value,
+      arguments_from nil Vs ->
+      arguments_from nil (undef::Vs)
+ | arguments_from_cons : forall Vs1 Vs2 v,
+      arguments_from Vs1 Vs2 ->
+      arguments_from (v::Vs1) (v::Vs2).
+
+Inductive arguments_first_and_rest : list value -> (value * list value) -> Prop :=
+ | arguments_f_a_r_from_nil  : arguments_first_and_rest nil (undef, nil)
+ | arguments_f_a_r_from_cons : forall v lv, 
+     arguments_first_and_rest (v :: lv) (v, lv).
+
+Hint Constructors arguments_first_and_rest.
+
+(**************************************************************)
+(** ** Rules for delete_events. *)
+
+(** [search_proto_chain S l x] returns the location l' of the first object 
+    in the prototype chain of l which contains property x. *)
+
+Inductive search_proto_chain : state -> object_loc -> prop_name -> option object_loc -> Prop :=
+  | search_proto_chain_found : forall S l x,
+                                 object_has_property S l x ->
+                                 search_proto_chain S l x (Some l)
+  | search_proto_chain_not_found : forall S l x,
+                                     not (object_has_property S l x) ->
+                                     object_proto S l prim_null ->
+                                     search_proto_chain S l x None
+  | search_proto_chain_inductive : forall S l x v l' res,
+                                     not (object_has_property S l x) ->
+                                     object_proto S l (value_object l') ->
+                                     search_proto_chain S l' x res ->
+                                     search_proto_chain S l x res.
+
+
+(** [make_delete_event S l x ev] constructs a delete_event "ev" which
+records the deletion of the property (l,x) in the state S. *)
+
+Inductive make_delete_event : state -> object_loc -> prop_name -> event -> Prop :=
+  | make_delete_event_intro : forall S l x res ev,
+                                search_proto_chain S l x res ->
+                                ev = delete_event l x res ->
+                                make_delete_event S l x ev.
+
+(**************************************************************)
+(** ** Auxiliary definitions for the semantics of for-in. *)
+
+(* LATER *)
+
+
+(**************************************************************)
+(** ** Implementation Defined Object *)
+
+(** As stated in Section 2 of the ECMAScript specification, an
+  implementation can provide additionnal properties not described in
+  the specification. **)
+
+(** As we are only describing the core of JavaScrip here, this
+  inductive shall be empty.  But one can found in the other branches
+  of this developpment some examples of non-empty instantiation of
+  this predicate. **)
+
+Inductive implementation_prealloc : prealloc -> Prop :=
+  .
+
+
+(**************************************************************)
+(** Shorthand **)
+
+Definition vret : state -> value -> specret value := ret (T:=value).
+Definition dret : state -> full_descriptor -> specret full_descriptor := ret (T:=full_descriptor).
+
diff --git a/samples/Coq/Main.v b/samples/Coq/Main.v
new file mode 100644
index 00000000..71d67bc1
--- /dev/null
+++ b/samples/Coq/Main.v
@@ -0,0 +1,42 @@
+Require Import FunctionNinjas.All.
+Require Import ListString.All.
+Require Import Computation.
+
+Import C.Notations.
+
+Definition error (message : LString.t) : C.t :=
+  do_call! Command.ShowError message in
+  ret.
+
+Definition main : C.t :=
+  call! card_is_valid := Command.AskCard in
+  if card_is_valid then
+    call! pin := Command.AskPIN in
+    match pin with
+    | None => error @@ LString.s "No PIN given."
+    | Some pin =>
+      call! pin_is_valid := Command.CheckPIN pin in
+      if pin_is_valid then
+        call! ask_amount := Command.AskAmount in
+        match ask_amount with
+        | None => error @@ LString.s "No amount given."
+        | Some amount =>
+          call! amount_is_valid := Command.CheckAmount amount in
+          if amount_is_valid then
+            call! card_is_given := Command.GiveCard in
+            if card_is_given then
+              call! amount_is_given := Command.GiveAmount amount in
+              if amount_is_given then
+                ret
+              else
+                error @@ LString.s "Cannot give you the amount. Please contact your bank."
+            else
+              error @@ LString.s "Cannot give you back the card. Please contact your bank."
+          else
+            error @@ LString.s "Invalid amount."
+        end
+      else
+        error @@ LString.s "Invalid PIN."
+    end
+  else
+    error @@ LString.s "Invalid card.".
diff --git a/samples/Coq/Spec.v b/samples/Coq/Spec.v
new file mode 100644
index 00000000..3013e00c
--- /dev/null
+++ b/samples/Coq/Spec.v
@@ -0,0 +1,62 @@
+(** Specifications. *)
+Require Import Coq.Lists.List.
+Require Import Coq.Strings.Ascii.
+Require Import FunctionNinjas.All.
+Require Import ListString.All.
+Require Import Computation.
+
+Import ListNotations.
+Local Open Scope char.
+
+(** A run is an execution of the program with explicit answers for the
+    system calls. *)
+Module Run.
+  (** We define a run by induction on the structure of a computation. *)
+  Inductive t : C.t -> Type :=
+  | Ret : t C.Ret
+  | Call : forall (command : Command.t) (answer : Command.answer command)
+    {handler : Command.answer command -> C.t}, t (handler answer) ->
+    t (C.Call command handler).
+
+  (** The trace of a run. *)
+  Fixpoint trace {x : C.t} (run : t x)
+    : list {command : Command.t & Command.answer command} :=
+    match run with
+    | Ret => []
+    | Call command answer _ run => existT _ command answer :: trace run
+    end.
+End Run.
+
+Module Temporal.
+  Module All.
+    Inductive t (P : Command.t -> Prop) : C.t -> Prop :=
+    | Ret : t P C.Ret
+    | Call : forall (c : Command.t) (h : Command.answer c -> C.t),
+      P c -> (forall a, t P (h a)) ->
+      t P (C.Call c h).
+  End All.
+
+  Module One.
+    Inductive t (P : Command.t -> Prop) : C.t -> Prop :=
+    | CallThis : forall (c : Command.t) (h : Command.answer c -> C.t),
+      P c ->
+      t P (C.Call c h)
+    | CallOther : forall (c : Command.t) (h : Command.answer c -> C.t),
+      (forall a, t P (h a)) ->
+      t P (C.Call c h).
+  End One.
+
+  Module Then.
+    Inductive t (P1 P2 : Command.t -> Prop) : C.t -> Prop :=
+    | Ret : t P1 P2 C.Ret
+    | Call : forall (c : Command.t) (h : Command.answer c -> C.t),
+      (forall a, t P1 P2 (h a)) ->
+      t P1 P2 (C.Call c h)
+    | CallThen : forall (c : Command.t) (h : Command.answer c -> C.t),
+      P1 c -> (forall a, One.t P2 (h a)) ->
+      t P1 P2 (C.Call c h).
+  End Then.
+End Temporal.
+
+Module CardBeforeMoney.
+End CardBeforeMoney.