From ae11043bc3b0e9b2529be9038f44ee6b5c070aa4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Wed, 4 Dec 2019 15:19:10 +0100
Subject: [PATCH 01/56] [Michocoq] Remove contract literals

---
 src/michocoq/semantics.v |  4 +---
 src/michocoq/syntax.v    |  2 --
 src/michocoq/typer.v     | 21 ---------------------
 src/michocoq/untyper.v   | 18 ------------------
 4 files changed, 1 insertion(+), 44 deletions(-)

diff --git a/src/michocoq/semantics.v b/src/michocoq/semantics.v
index 4aa6db7e..e7b84031 100644
--- a/src/michocoq/semantics.v
+++ b/src/michocoq/semantics.v
@@ -223,7 +223,6 @@ Module Semantics(ST : SelfType)(C:ContractContext)(E:Env ST C).
     | Key_hash_constant x => Mk_key_hash x
     | Mutez_constant (Mk_mutez x) => x
     | Address_constant x => x
-    | @Contract_constant a x H => exist _ x H
     | Unit => tt
     | True_ => true
     | False_ => false
@@ -309,8 +308,7 @@ Module Semantics(ST : SelfType)(C:ContractContext)(E:Env ST C).
                                     (comparable_data_to_concrete_data _ k)
                                     (data_to_concrete_data b H v))
                              l)
-    | contract _, H, exist _ x Hx =>
-      Contract_constant x Hx
+    | contract _, H, _ => match H with end
     | operation, H, _ => match H with end
     | big_map _ _, H, _ => match H with end
     | pair a b, H, (x, y) =>
diff --git a/src/michocoq/syntax.v b/src/michocoq/syntax.v
index 63ae2fca..ded5e62d 100644
--- a/src/michocoq/syntax.v
+++ b/src/michocoq/syntax.v
@@ -437,8 +437,6 @@ concrete_data : type -> Set :=
 | Key_hash_constant : String.string -> concrete_data key_hash
 | Mutez_constant : mutez_constant -> concrete_data mutez
 | Address_constant : address_constant -> concrete_data address
-| Contract_constant {a} : forall cst : contract_constant,
-    C.get_contract_type cst = Some a -> concrete_data (contract a)
 | Unit : concrete_data unit
 | True_ : concrete_data bool
 | False_ : concrete_data bool
diff --git a/src/michocoq/typer.v b/src/michocoq/typer.v
index 011f4688..7f43014c 100644
--- a/src/michocoq/typer.v
+++ b/src/michocoq/typer.v
@@ -49,12 +49,6 @@ Module Typer(C : ContractContext).
   Definition instruction_cast_domain {self_type tff} A A' B (i : instruction self_type tff A B)
     : M (instruction self_type tff A' B) := instruction_cast A A' B B i.
 
-  Definition contract_cast (c : contract_constant) (a b : type)
-             (H : C.get_contract_type c = Some b)
-             (He : a = b)
-    : syntax.concrete_data (contract a) :=
-    syntax.Contract_constant c (eq_trans H (f_equal Some (eq_sym He))).
-
   Inductive typer_result {self_type} A : Set :=
   | Inferred_type B : instruction self_type false A B -> typer_result A
   | Any_type : (forall B, instruction self_type true A B) -> typer_result A.
@@ -190,18 +184,6 @@ Module Typer(C : ContractContext).
       reflexivity.
   Qed.
 
-  Definition type_contract_data_aux c a tyopt :=
-    match tyopt return C.get_contract_type c = tyopt -> error.M (syntax.concrete_data (contract a)) with
-    | Some b =>
-      match type_dec a b with
-      | left He => fun H => Return (contract_cast c a b H He)
-      | right _ => fun _ => Failed _ (Typing _ ("ill-typed contract"%string, c, a, b))
-      end
-    | None => fun _ => Failed _ (Typing _ ("contract not found"%string, c))
-    end.
-
-  Definition type_contract_data c a := type_contract_data_aux c a _ eq_refl.
-
   Fixpoint type_data (d : concrete_data) {struct d}
     : forall ty, M (syntax.concrete_data ty) :=
     match d with
@@ -225,9 +207,6 @@ Module Typer(C : ContractContext).
         | signature => Return (syntax.Signature_constant s)
         | key => Return (syntax.Key_constant s)
         | Comparable_type key_hash => Return (syntax.Key_hash_constant s)
-        | contract a =>
-          let c := Mk_contract s in
-          type_contract_data c a
         | Comparable_type address => Return (syntax.Address_constant (syntax.Mk_address s))
         | chain_id => Return (syntax.Chain_id_constant (syntax.Mk_chain_id s))
         | _ => Failed _ (Typing _ (d, ty))
diff --git a/src/michocoq/untyper.v b/src/michocoq/untyper.v
index c9bf187b..f3cae0b0 100644
--- a/src/michocoq/untyper.v
+++ b/src/michocoq/untyper.v
@@ -26,7 +26,6 @@ Module Untyper(C : ContractContext).
     | syntax.Signature_constant s => String_constant s
     | syntax.Key_constant s => String_constant s
     | syntax.Key_hash_constant s => String_constant s
-    | syntax.Contract_constant (Mk_contract c) _ => String_constant c
     | syntax.Address_constant (Mk_address c) => String_constant c
     | syntax.Unit => Unit
     | syntax.True_ => True_
@@ -474,23 +473,6 @@ Module Untyper(C : ContractContext).
         destruct a.
         simpl.
         reflexivity.
-      + simpl.
-        destruct cst.
-        simpl.
-        unfold type_contract_data.
-        cut (forall tyopt H, type_contract_data_aux (Mk_contract s) a tyopt H =
-                             Return (Contract_constant (Mk_contract s) e)).
-        * intro H. apply H.
-        * intros tyopt H.
-          destruct tyopt.
-          -- simpl.
-             destruct (type_dec a t).
-             ++ unfold contract_cast.
-                repeat f_equal.
-                apply Eqdep_dec.eq_proofs_unicity.
-                intros; repeat decide equality.
-             ++ congruence.
-          -- congruence.
       + simpl.
         trans_refl (
           let! x := typer.type_data (untype_data d1) a in
-- 
GitLab


From fdfa10d12965ca75814132cfb874c319667e1f5b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Wed, 4 Dec 2019 21:50:34 +0100
Subject: [PATCH 02/56] [Michocoq] Remove superfluous functors

---
 src/contracts_coq/boomerang.v        | 14 ++----
 src/contracts_coq/deposit.v          | 15 +++---
 src/contracts_coq/generic_multisig.v | 38 ++++++++-------
 src/contracts_coq/manager.v          | 14 +++---
 src/contracts_coq/multisig.v         | 34 +++++++-------
 src/contracts_coq/return_to_sender.v | 14 ++----
 src/contracts_coq/vote.v             | 16 +++----
 src/michocoq/macros.v                |  6 ---
 src/michocoq/main.v                  |  6 +--
 src/michocoq/semantics.v             | 21 ++-------
 src/michocoq/syntax.v                |  8 ----
 src/michocoq/typer.v                 | 69 +++++++++++++---------------
 src/michocoq/untyper.v               | 43 +++++++----------
 13 files changed, 118 insertions(+), 180 deletions(-)

diff --git a/src/contracts_coq/boomerang.v b/src/contracts_coq/boomerang.v
index 347f7c2d..89cc9bea 100644
--- a/src/contracts_coq/boomerang.v
+++ b/src/contracts_coq/boomerang.v
@@ -31,14 +31,10 @@ Require List.
 Definition parameter_ty := unit.
 Definition storage_ty := unit.
 
-Module ST : (SelfType with Definition self_type := parameter_ty).
-  Definition self_type := parameter_ty.
-End ST.
+Module boomerang(C:ContractContext).
+Module semantics := Semantics C. Import semantics.
 
-Module boomerang(C:ContractContext)(E:Env ST C).
-Module semantics := Semantics ST C E. Import semantics.
-
-Definition boomerang : full_contract _ ST.self_type storage_ty :=
+Definition boomerang : full_contract _ parameter_ty storage_ty :=
   (
     CDR ;;
     NIL operation ;;
@@ -80,7 +76,7 @@ Proof.
 Qed.
 
 Lemma boomerang_correct :
-  forall (ops : data (list operation)) (fuel : Datatypes.nat),
+  forall env (ops : data (list operation)) (fuel : Datatypes.nat),
   fuel >= 42 ->
   eval env boomerang fuel ((tt, tt), tt) = Return ((ops, tt), tt)
   <->
@@ -89,7 +85,7 @@ Lemma boomerang_correct :
     exists ctr, contract_ env unit (source env) = Some ctr /\
            ops = ((transfer_tokens env unit tt (amount env) ctr) :: nil)%list).
 Proof.
-  intros ops fuel Hfuel.
+  intros env ops fuel Hfuel.
   rewrite return_precond.
   unfold eval.
   rewrite eval_precond_correct.
diff --git a/src/contracts_coq/deposit.v b/src/contracts_coq/deposit.v
index ece69e73..ddec81a9 100644
--- a/src/contracts_coq/deposit.v
+++ b/src/contracts_coq/deposit.v
@@ -32,15 +32,11 @@ Require List.
 Definition parameter_ty := (or unit mutez).
 Definition storage_ty := address.
 
-Module ST : (SelfType with Definition self_type := parameter_ty).
-  Definition self_type := parameter_ty.
-End ST.
+Module deposit(C:ContractContext).
 
-Module deposit(C:ContractContext)(E:Env ST C).
+Module semantics := Semantics C. Import semantics.
 
-Module semantics := Semantics ST C E. Import semantics.
-
-Definition deposit : full_contract _ ST.self_type storage_ty :=
+Definition deposit : full_contract _ parameter_ty storage_ty :=
   ( DUP;; CAR;; DIP1 CDR;;
     IF_LEFT
       ( DROP1;; NIL operation )
@@ -52,7 +48,8 @@ Definition deposit : full_contract _ ST.self_type storage_ty :=
     PAIR ).
 
 Lemma deposit_correct :
-  forall (input : data (or unit mutez)) storage_in
+  forall (env : @proto_env (Some parameter_ty))
+         (input : data (or unit mutez)) storage_in
          (ops : data (list operation)) storage_out
          (fuel : Datatypes.nat),
   fuel >= 42 ->
@@ -67,7 +64,7 @@ Lemma deposit_correct :
                   ops = cons (transfer_tokens env unit tt am c) nil)
    end).
 Proof.
-  intros input storage_in ops storage_out fuel Hfuel.
+  intros env input storage_in ops storage_out fuel Hfuel.
   rewrite return_precond.
   unfold eval.
   rewrite eval_precond_correct.
diff --git a/src/contracts_coq/generic_multisig.v b/src/contracts_coq/generic_multisig.v
index d58308f3..544e1069 100644
--- a/src/contracts_coq/generic_multisig.v
+++ b/src/contracts_coq/generic_multisig.v
@@ -38,19 +38,15 @@ Definition parameter_ty :=
                   (pair nat (list key))))
          (list (option signature)))).
 
-Module ST : (SelfType with Definition self_type := parameter_ty).
-  Definition self_type := parameter_ty.
-End ST.
-
-Module generic_multisig(C:ContractContext)(E:Env ST C).
+Module generic_multisig(C:ContractContext).
 
 Definition storage_ty := pair nat (pair nat (list key)).
 
-Module semantics := Semantics ST C E. Import semantics.
+Module semantics := Semantics C. Import semantics.
 
-Definition ADD_nat {S} : instruction (Some ST.self_type) _ (nat ::: nat ::: S) (nat ::: S) := ADD.
+Definition ADD_nat {S} : instruction (Some parameter_ty) _ (nat ::: nat ::: S) (nat ::: S) := ADD.
 
-Definition multisig : full_contract _ ST.self_type storage_ty :=
+Definition multisig : full_contract _ parameter_ty storage_ty :=
   (
     UNPAIR ;;
     IF_LEFT
@@ -129,6 +125,7 @@ Definition action_ty := or (lambda unit (list operation)) (pair nat (list key)).
 Definition pack_ty := pair (pair chain_id address) (pair nat action_ty).
 
 Definition multisig_spec
+           (env : @proto_env (Some parameter_ty))
            (parameter : data parameter_ty)
            (stored_counter : N)
            (threshold : N)
@@ -154,9 +151,8 @@ Definition multisig_spec
       (fun k sig =>
          check_signature
            env k sig
-           (pack env pack_ty
-                 ((chain_id_ env, address_ env ST.self_type (self env)),
-                  (counter, action)))) /\
+           (pack env pack_ty (chain_id_ env, address_ env parameter_ty (self env),
+                              (counter, action)))) /\
     (count_signatures sigs >= threshold)%N /\
     new_stored_counter = (1 + stored_counter)%N /\
     match action with
@@ -175,7 +171,7 @@ Definition multisig_spec
     end
   end.
 
-Definition multisig_head {A} (then_ : instruction (Some ST.self_type) Datatypes.false (nat ::: list key ::: list (option signature) ::: bytes ::: action_ty ::: storage_ty ::: nil) A) :
+Definition multisig_head {A} (then_ : instruction (Some parameter_ty) Datatypes.false (nat ::: list key ::: list (option signature) ::: bytes ::: action_ty ::: storage_ty ::: nil) A) :
   instruction _ _ (pair (pair nat action_ty) (list (option signature)) ::: pair nat (pair nat (list key)) ::: nil) A
 :=
     PUSH mutez (0 ~mutez);; AMOUNT;; ASSERT_CMPEQ;;
@@ -194,6 +190,7 @@ Definition multisig_head {A} (then_ : instruction (Some ST.self_type) Datatypes.
 
 Definition multisig_head_spec
            A
+           (env : @proto_env (Some parameter_ty))
            (counter : N)
            (action : data action_ty)
            (sigs : Datatypes.list (Datatypes.option (data signature)))
@@ -219,8 +216,7 @@ Definition multisig_head_spec
         (keys,
          (sigs,
           (pack env pack_ty
-                ((chain_id_ env, address_ env ST.self_type (self env)),
-                 (counter, action)),
+                (chain_id_ env, address_ env parameter_ty (self env), (counter, action)),
            (action, (storage, tt)))))).
 
 Ltac fold_eval_precond :=
@@ -228,6 +224,7 @@ Ltac fold_eval_precond :=
 
 Lemma multisig_head_correct
       A
+      (env : @proto_env (Some parameter_ty))
       (counter : N)
       (action : data action_ty)
       (sigs : Datatypes.list (Datatypes.option (data signature)))
@@ -246,7 +243,7 @@ Lemma multisig_head_correct
     12 <= fuel ->
     (semantics.eval_precond (12 + fuel) env (multisig_head then_) psi (params, (storage, tt)))
         <->
-        multisig_head_spec A counter action sigs stored_counter threshold keys fuel then_ psi.
+        multisig_head_spec A env counter action sigs stored_counter threshold keys fuel then_ psi.
 Proof.
   intros params storage fuel Hfuel.
   unfold multisig_head.
@@ -289,7 +286,7 @@ Definition multisig_iter_body :
          SWAP
     ).
 
-Lemma multisig_iter_body_correct k n sigs packed
+Lemma multisig_iter_body_correct env k n sigs packed
       (st : stack (action_ty ::: storage_ty ::: nil)) fuel psi :
     17 <= fuel ->
     semantics.eval_precond fuel env multisig_iter_body psi (k, (n, (sigs, (packed, st))))
@@ -324,7 +321,7 @@ Definition multisig_iter :
   :=
   ITER multisig_iter_body.
 
-Lemma multisig_iter_correct keys n sigs packed
+Lemma multisig_iter_correct env keys n sigs packed
       (st : stack (action_ty ::: storage_ty ::: nil)) fuel psi :
     length keys * 17 + 1 <= fuel ->
     semantics.eval_precond fuel env multisig_iter psi (keys, (n, (sigs, (packed, st)))) <->
@@ -440,7 +437,7 @@ Proof.
 Qed.
 
 Definition multisig_tail :
-  instruction (Some ST.self_type) _
+  instruction (Some parameter_ty) _
     (nat ::: nat ::: list (option signature) ::: bytes ::: action_ty :::
          storage_ty ::: nil)
     (pair (list operation) storage_ty ::: nil) :=
@@ -470,7 +467,7 @@ Proof.
 Qed.
 
 Lemma multisig_tail_correct
-      threshold n sigs packed action counter (keys : data (list key)) psi fuel :
+      env threshold n sigs packed action counter (keys : data (list key)) psi fuel :
   3 <= fuel ->
   precond (semantics.eval env multisig_tail (10 + fuel) (threshold, (n, (sigs, (packed, (action, ((counter, (threshold, keys)), tt))))))) psi <->
   sigs = nil /\
@@ -524,6 +521,7 @@ Proof.
 Qed.
 
 Lemma multisig_correct
+      (env : @proto_env (Some parameter_ty))
       (params : data parameter_ty)
       (stored_counter : N)
       (threshold : N)
@@ -537,7 +535,7 @@ Lemma multisig_correct
   let new_storage : data storage_ty := (new_stored_counter, (new_threshold, new_keys)) in
   17 * length keys + 14 <= fuel ->
   eval env multisig (23 + fuel) ((params, storage), tt) = Return ((returned_operations, new_storage), tt) <->
-  multisig_spec params stored_counter threshold keys new_stored_counter new_threshold new_keys returned_operations fuel.
+  multisig_spec env params stored_counter threshold keys new_stored_counter new_threshold new_keys returned_operations fuel.
 Proof.
   intros storage new_storage Hfuel.
   rewrite return_precond.
diff --git a/src/contracts_coq/manager.v b/src/contracts_coq/manager.v
index 6991ff87..7ba6c9a3 100644
--- a/src/contracts_coq/manager.v
+++ b/src/contracts_coq/manager.v
@@ -34,15 +34,11 @@ Require Import Lia.
 Definition parameter_ty := or (lambda unit (list operation)) unit.
 Definition storage_ty := key_hash.
 
-Module ST : (SelfType with Definition self_type := parameter_ty).
-  Definition self_type := parameter_ty.
-End ST.
+Module manager(C:ContractContext).
 
-Module manager(C:ContractContext)(E:Env ST C).
+Module semantics := Semantics C. Import semantics.
 
-Module semantics := Semantics ST C E. Import semantics.
-
-Definition manager : full_contract _ ST.self_type storage_ty :=
+Definition manager : full_contract _ parameter_ty storage_ty :=
   (UNPAIR ;;
    IF_LEFT
    ( (* 'do' entrypoint *)
@@ -70,6 +66,7 @@ Definition manager : full_contract _ ST.self_type storage_ty :=
   ).
 
 Definition manager_spec
+           (env : @proto_env (Some parameter_ty))
            (storage : data storage_ty)
            (param : data parameter_ty)
            (new_storage : data storage_ty)
@@ -137,6 +134,7 @@ Proof.
 Qed.
 
 Lemma manager_correct
+      (env : @proto_env (Some parameter_ty))
       (storage : data storage_ty)
       (param : data parameter_ty)
       (new_storage : data storage_ty)
@@ -144,7 +142,7 @@ Lemma manager_correct
       (fuel : Datatypes.nat) :
   fuel >= 42 ->
   eval env manager (13 + fuel) ((param, storage), tt) = Return ((returned_operations, new_storage), tt)
-  <-> manager_spec storage param new_storage returned_operations fuel.
+  <-> manager_spec env storage param new_storage returned_operations fuel.
 Proof.
   intro Hfuel.
   remember (13 + fuel) as fuel2.
diff --git a/src/contracts_coq/multisig.v b/src/contracts_coq/multisig.v
index f946f13e..9b4efcbf 100644
--- a/src/contracts_coq/multisig.v
+++ b/src/contracts_coq/multisig.v
@@ -38,19 +38,15 @@ Definition parameter_ty := (pair
 
 Definition storage_ty := pair nat (pair nat (list key)).
 
-Module ST : (SelfType with Definition self_type := parameter_ty).
-  Definition self_type := parameter_ty.
-End ST.
+Module multisig(C:ContractContext).
 
-Module multisig(C:ContractContext)(E:Env ST C).
+Module semantics := Semantics C. Import semantics.
 
-Module semantics := Semantics ST C E. Import semantics.
-
-Definition ADD_nat {S} : instruction (Some ST.self_type) _ (nat ::: nat ::: S) (nat ::: S) := ADD.
+Definition ADD_nat {S} : instruction (Some parameter_ty) _ (nat ::: nat ::: S) (nat ::: S) := ADD.
 
 Definition pack_ty := pair (pair chain_id address) (pair nat action_ty).
 
-Definition multisig : full_contract _ ST.self_type storage_ty :=
+Definition multisig : full_contract _ parameter_ty storage_ty :=
   (
     UNPAIR ;; SWAP ;; DUP ;; DIP1 SWAP ;;
     DIP1
@@ -122,6 +118,7 @@ Fixpoint count_signatures (sigs : Datatypes.list (Datatypes.option (data signatu
 
 
 Definition multisig_spec
+           (env : @proto_env (Some parameter_ty))
            (counter : N)
            (action : data action_ty)
            (sigs : Datatypes.list (Datatypes.option (data signature)))
@@ -143,7 +140,7 @@ Definition multisig_spec
       (fun k sig =>
          check_signature
            env k sig
-           (pack env pack_ty ((chain_id_ env, address_ env ST.self_type (self env)),
+           (pack env pack_ty ((chain_id_ env, address_ env parameter_ty (self env)),
                              (counter, action)))) /\
     (count_signatures first_sigs >= threshold)%N /\
     new_stored_counter = (1 + stored_counter)%N /\
@@ -162,7 +159,7 @@ Definition multisig_spec
       returned_operations = nil
     end.
 
-Definition multisig_head (then_ : instruction (Some ST.self_type) Datatypes.false (nat ::: list key ::: list (option signature) ::: bytes ::: action_ty ::: storage_ty ::: nil) (pair (list operation) storage_ty ::: nil)) :
+Definition multisig_head (then_ : instruction (Some parameter_ty) Datatypes.false (nat ::: list key ::: list (option signature) ::: bytes ::: action_ty ::: storage_ty ::: nil) (pair (list operation) storage_ty ::: nil)) :
   instruction _ _
               (pair parameter_ty storage_ty ::: nil)
               (pair (list operation) storage_ty ::: nil)
@@ -182,6 +179,7 @@ Definition multisig_head (then_ : instruction (Some ST.self_type) Datatypes.fals
     DIP1 SWAP ;; UNPAIR ;; then_.
 
 Definition multisig_head_spec
+           (env : @proto_env (Some parameter_ty))
            (counter : N)
            (action : data action_ty)
            (sigs : Datatypes.list (Datatypes.option (data signature)))
@@ -206,17 +204,18 @@ Definition multisig_head_spec
         (keys,
          (sigs,
           (pack env pack_ty
-                ((chain_id_ env, address_ env ST.self_type (self env)), (counter, action)),
+                ((chain_id_ env, address_ env parameter_ty (self env)), (counter, action)),
            (action, (storage, tt))))))) psi.
 
 Lemma fold_eval_precond fuel :
   eval_precond_body (@semantics.eval_precond fuel) =
-  @semantics.eval_precond (S fuel) (Some ST.self_type).
+  @semantics.eval_precond (S fuel) (Some parameter_ty).
 Proof.
   reflexivity.
 Qed.
 
 Lemma multisig_head_correct
+      (env : @proto_env (Some parameter_ty))
       (counter : N)
       (action : data action_ty)
       (sigs : Datatypes.list (Datatypes.option (data signature)))
@@ -234,7 +233,7 @@ Lemma multisig_head_correct
   forall fuel, 11 <= fuel ->
     (precond (eval env (multisig_head then_) (10 + fuel) ((params, storage), tt)) psi)
         <->
-    multisig_head_spec counter action sigs stored_counter threshold keys
+    multisig_head_spec env counter action sigs stored_counter threshold keys
                        fuel then_ psi.
 Proof.
   intros params storage fuel Hfuel.
@@ -272,7 +271,7 @@ Definition multisig_iter_body :
        ) ;;
        SWAP).
 
-Lemma multisig_iter_body_correct k n sigs packed
+Lemma multisig_iter_body_correct env k n sigs packed
       (st : stack (action_ty ::: storage_ty ::: nil)) fuel psi :
     14 <= fuel ->
     precond (eval env multisig_iter_body fuel (k, (n, (sigs, (packed, st))))) psi
@@ -311,7 +310,7 @@ Definition multisig_iter :
 (* Executing on stack (keys, n, sigs, packed, st) returns (nb_valid_sigs + n, nb_excess_sigs, packed, st) *)
 (* Invariant: all_keys = verified_keys @ remaining *)
 
-Lemma multisig_iter_correct keys n sigs packed
+Lemma multisig_iter_correct env keys n sigs packed
       (st : stack (action_ty ::: storage_ty ::: nil)) fuel psi :
     length keys * 14 + 1 <= fuel ->
     precond (eval env multisig_iter fuel (keys, (n, (sigs, (packed, st))))) psi <->
@@ -452,7 +451,7 @@ Proof.
 Qed.
 
 Lemma multisig_tail_correct
-      threshold n sigs packed action counter keys psi fuel :
+      env threshold n sigs packed action counter keys psi fuel :
     13 <= fuel ->
     precond (eval env multisig_tail fuel (threshold, (n, (sigs, (packed, (action, ((counter, (threshold, keys)), tt))))))) psi <->
     ((threshold <= n)%N /\
@@ -484,6 +483,7 @@ Proof.
 Qed.
 
 Lemma multisig_correct
+      (env : @proto_env (Some parameter_ty))
       (counter : N)
       (action : data action_ty)
       (sigs : Datatypes.list (Datatypes.option (data signature)))
@@ -500,7 +500,7 @@ Lemma multisig_correct
   let new_storage : data storage_ty := (new_stored_counter, (new_threshold, new_keys)) in
   14 * length keys + 37 <= fuel ->
   eval env multisig fuel ((params, storage), tt) = Return ((returned_operations, new_storage), tt) <->
-  multisig_spec counter action sigs stored_counter threshold keys new_stored_counter new_threshold new_keys returned_operations.
+  multisig_spec env counter action sigs stored_counter threshold keys new_stored_counter new_threshold new_keys returned_operations.
 Proof.
   intros params storage new_storage Hfuel.
   rewrite return_precond.
diff --git a/src/contracts_coq/return_to_sender.v b/src/contracts_coq/return_to_sender.v
index 1041de8e..1d9311fb 100644
--- a/src/contracts_coq/return_to_sender.v
+++ b/src/contracts_coq/return_to_sender.v
@@ -31,15 +31,11 @@ Require List.
 Definition parameter_ty := unit.
 Definition storage_ty := unit.
 
-Module ST : (SelfType with Definition self_type := parameter_ty).
-  Definition self_type := parameter_ty.
-End ST.
+Module return_to_sender(C:ContractContext).
 
-Module return_to_sender(C:ContractContext)(E:Env ST C).
+Module semantics := Semantics C. Import semantics.
 
-Module semantics := Semantics ST C E. Import semantics.
-
-Definition return_to_sender : full_contract _ ST.self_type storage_ty :=
+Definition return_to_sender : full_contract _ parameter_ty storage_ty :=
   (
     CDR ;;
     NIL operation ;;
@@ -81,7 +77,7 @@ Proof.
 Qed.
 
 Lemma return_to_sender_correct :
-  forall (ops : data (list operation)) (fuel : Datatypes.nat),
+  forall env (ops : data (list operation)) (fuel : Datatypes.nat),
   fuel >= 42 ->
   eval env return_to_sender fuel ((tt, tt), tt) = Return ((ops, tt), tt)
   <->
@@ -90,7 +86,7 @@ Lemma return_to_sender_correct :
     exists ctr, contract_ env unit (source env) = Some ctr /\
            ops = ((transfer_tokens env unit tt (amount env) ctr) :: nil)%list).
 Proof.
-  intros ops fuel Hfuel.
+  intros env ops fuel Hfuel.
   rewrite return_precond.
   unfold eval.
   rewrite eval_precond_correct.
diff --git a/src/contracts_coq/vote.v b/src/contracts_coq/vote.v
index b6197194..e2500f09 100644
--- a/src/contracts_coq/vote.v
+++ b/src/contracts_coq/vote.v
@@ -29,16 +29,10 @@ Require map.
 
 Definition parameter_ty : type := string.
 Definition storage_ty := map string int.
+Module vote(C:ContractContext).
+Module semantics := Semantics C. Import semantics.
 
-Module ST : (SelfType with Definition self_type := parameter_ty).
-  Definition self_type := parameter_ty.
-End ST.
-
-Module vote(C:ContractContext)(E:Env ST C).
-
-Module semantics := Semantics ST C E. Import semantics.
-
-Definition vote : full_contract _ ST.self_type storage_ty :=
+Definition vote : full_contract _ parameter_ty storage_ty :=
   (
     AMOUNT ;;
     PUSH mutez (5000000 ~mutez);;
@@ -53,6 +47,7 @@ Definition vote : full_contract _ ST.self_type storage_ty :=
     NIL operation;; PAIR ).
 
 Definition vote_spec
+           (env : @proto_env (Some parameter_ty))
            (storage: data storage_ty)
            (param : data parameter_ty)
            (new_storage : data storage_ty)
@@ -84,6 +79,7 @@ Proof.
 Defined.
 
 Theorem vote_correct
+      (env : @proto_env (Some parameter_ty))
       (storage : data storage_ty)
       (param : data parameter_ty)
       (new_storage : data storage_ty)
@@ -91,7 +87,7 @@ Theorem vote_correct
       (fuel : Datatypes.nat) :
   fuel >= 42 ->
   eval env vote fuel ((param, storage), tt) = Return ((returned_operations, new_storage), tt)
-  <-> vote_spec storage param new_storage returned_operations.
+  <-> vote_spec env storage param new_storage returned_operations.
 Proof.
   intro Hfuel. unfold ">=" in Hfuel.
   unfold eval.
diff --git a/src/michocoq/macros.v b/src/michocoq/macros.v
index 5e3b0e46..edf78b1c 100644
--- a/src/michocoq/macros.v
+++ b/src/michocoq/macros.v
@@ -22,11 +22,6 @@
 Require Import syntax syntax_type.
 Require Import comparable.
 
-Module Macros(C : ContractContext).
-
-Module syntax := Syntax C.
-Export syntax.
-
 Section macros.
   Context {self_type : Datatypes.option type}.
 
@@ -167,4 +162,3 @@ Definition MAP_CDR {a b1 b2 S} (code : instruction self_type Datatypes.false (b1
 Definition UNPAPAIR {a b c S} : instruction self_type Datatypes.false (pair a (pair b c) :: S) (a ::: b ::: c ::: S) := UNPAIR ;; DIP1 UNPAIR.
 Definition PAPAIR {a b c S} : instruction self_type Datatypes.false (a ::: b ::: c ::: S) (pair a (pair b c) :: S) := DIP1 PAIR;; PAIR.
 End macros.
-End Macros.
diff --git a/src/michocoq/main.v b/src/michocoq/main.v
index a9560812..152e5935 100644
--- a/src/michocoq/main.v
+++ b/src/michocoq/main.v
@@ -1,16 +1,12 @@
 Require Import String ZArith.
 Require micheline_lexer micheline_parser.
 Require micheline2michelson typer.
-Require syntax.
+Require Import syntax.
 Require Import syntax_type.
 Require dummy_contract_context.
 Require error_pp.
 Import error.Notations.
 
-Module syntax := syntax.Syntax(dummy_contract_context).
-Module typer := typer.Typer(dummy_contract_context).
-Import typer syntax.
-
 Section Main.
   Variable input : String.string.
   Variable fuel : Datatypes.nat.
diff --git a/src/michocoq/semantics.v b/src/michocoq/semantics.v
index e7b84031..85fdd707 100644
--- a/src/michocoq/semantics.v
+++ b/src/michocoq/semantics.v
@@ -30,13 +30,13 @@ Require NPeano.
 Require Import comparable error.
 Import error.Notations.
 
-Module Type SelfType.
-  Parameter self_type : type.
-End SelfType.
+Module Type ContractContext.
+  Parameter get_contract_type : contract_constant -> Datatypes.option type.
+End ContractContext.
 
-Module EnvDef(C : ContractContext).
+Module Semantics(C : ContractContext).
   Export C.
-  Module macros := Macros(C). Export macros.
+
   Fixpoint data (a : type) {struct a} : Set :=
     match a with
     | Comparable_type b => comparable_data b
@@ -121,17 +121,6 @@ Module EnvDef(C : ContractContext).
                  (check_signature e)
                  (chain_id_ e).
 
-End EnvDef.
-
-Module Type Env(ST : SelfType)(C:ContractContext).
-  Include EnvDef C.
-  Parameter env : @proto_env (Some ST.self_type).
-End Env.
-
-Module Semantics(ST : SelfType)(C:ContractContext)(E:Env ST C).
-
-  Export E.
-
   Fixpoint stack (t : stack_type) : Set :=
     match t with
     | nil => Datatypes.unit
diff --git a/src/michocoq/syntax.v b/src/michocoq/syntax.v
index ded5e62d..ca69afe8 100644
--- a/src/michocoq/syntax.v
+++ b/src/michocoq/syntax.v
@@ -281,12 +281,6 @@ Inductive operation_constant : Set := Mk_operation : str -> operation_constant.
 Inductive mutez_constant : Set := Mk_mutez : tez.mutez -> mutez_constant.
 Inductive chain_id_constant : Set := Mk_chain_id : str -> chain_id_constant.
 
-Module Type ContractContext.
-  Parameter get_contract_type : contract_constant -> Datatypes.option type.
-End ContractContext.
-
-Module Syntax(C : ContractContext).
-
 Inductive elt_pair (a b : Set) : Set :=
 | Elt : a -> b -> elt_pair a b.
 
@@ -641,5 +635,3 @@ Proof.
     specialize (stacktype_dug_aux_proof_irrelevant (l1+++l2) n (length_app_cons_dug n l1 l2 H0)) as Hpi.
     rewrite <- Hpi. rewrite IHl1. reflexivity.
 Qed.
-
-End Syntax.
diff --git a/src/michocoq/typer.v b/src/michocoq/typer.v
index 7f43014c..c7e4f42d 100644
--- a/src/michocoq/typer.v
+++ b/src/michocoq/typer.v
@@ -1,5 +1,6 @@
 Require Import ZArith List Nat String.
-Require Import syntax semantics.
+Require syntax semantics.
+Require Import syntax_type.
 Require Import untyped_syntax error.
 Import error.Notations.
 
@@ -11,11 +12,6 @@ Proof.
   - apply Bool.andb_prop_intro.
 Qed.
 
-Module Typer(C : ContractContext).
-
-  Module syntax := Syntax C.
-  Import syntax. Import untyped_syntax.
-
   Definition instruction := syntax.instruction.
 
   Definition safe_instruction_cast {self_type tff} A A' B B' :
@@ -119,14 +115,14 @@ Module Typer(C : ContractContext).
                               IF_instr B true true (i1 B) (i2 B)))
     end.
 
-  Definition take_one (S : stack_type) : M (type * stack_type) :=
+  Definition take_one (S : syntax.stack_type) : M (type * syntax.stack_type) :=
     match S with
     | nil => Failed _ (Typing _ "take_one"%string)
     | cons a l => Return (a, l)
     end.
 
-  Fixpoint take_n (A : stack_type) n : M ({B | List.length B = n} * stack_type) :=
-    match n as n return M ({B | List.length B = n} * stack_type) with
+  Fixpoint take_n (A : syntax.stack_type) n : M ({B | List.length B = n} * syntax.stack_type) :=
+    match n as n return M ({B | List.length B = n} * syntax.stack_type) with
     | 0 => Return (exist (fun B => List.length B = 0) nil eq_refl, A)
     | S n =>
       let! (a, A) := take_one A in
@@ -153,13 +149,13 @@ Module Typer(C : ContractContext).
         repeat decide equality.
   Qed.
 
-  Definition type_check_dig {self_type} n (S:stack_type) : M (typer_result (self_type := self_type) S) :=
+  Definition type_check_dig {self_type} n (S:syntax.stack_type) : M (typer_result (self_type := self_type) S) :=
     let! (exist _ S1 H1, tS2) := take_n S n in
     let! (t, S2) := take_one tS2 in
     let! i := instruction_cast_domain (S1 +++ t ::: S2) S _ (syntax.DIG n H1) in
     Return (Inferred_type S (t ::: S1 +++ S2) i).
 
-  Definition type_check_dug {self_type} n (S:stack_type) : M (typer_result (self_type := self_type) S) :=
+  Definition type_check_dug {self_type} n (S:syntax.stack_type) : M (typer_result (self_type := self_type) S) :=
     let! (t, S12) := take_one S in
     let! (exist _ S1 H1, S2) := take_n S12 n in
     let! i := instruction_cast_domain (t ::: S1 +++ S2) S _ (syntax.DUG n H1) in
@@ -196,7 +192,7 @@ Module Typer(C : ContractContext).
           else Failed _ (Typing _ ("Negative value cannot be typed in nat"%string, d))
         | Comparable_type mutez =>
           let! m := tez.of_Z z in
-          Return (syntax.Mutez_constant (Mk_mutez m))
+          Return (syntax.Mutez_constant (syntax.Mk_mutez m))
         | Comparable_type timestamp => Return (syntax.Timestamp_constant z)
         | _ => Failed _ (Typing _ (d, ty))
         end
@@ -487,27 +483,27 @@ Module Typer(C : ContractContext).
       let! i := instruction_cast_domain A' A (int ::: B) (syntax.COMPARE (a := a)) in
       Return (Inferred_type _ _ i)
     | CONCAT, Comparable_type string :: Comparable_type string :: B =>
-      Return (Inferred_type _ _ (@syntax.CONCAT _ _ stringlike_string _))
+      Return (Inferred_type _ _ (@syntax.CONCAT _ _ syntax.stringlike_string _))
     | CONCAT, Comparable_type bytes :: Comparable_type bytes :: B =>
-      Return (Inferred_type _ _ (@syntax.CONCAT _ _ stringlike_bytes _))
+      Return (Inferred_type _ _ (@syntax.CONCAT _ _ syntax.stringlike_bytes _))
     | CONCAT, list (Comparable_type string) :: B =>
-      Return (Inferred_type _ _ (@syntax.CONCAT_list _ _ stringlike_string _))
+      Return (Inferred_type _ _ (@syntax.CONCAT_list _ _ syntax.stringlike_string _))
     | CONCAT, list (Comparable_type bytes) :: B =>
-      Return (Inferred_type _ _ (@syntax.CONCAT_list _ _ stringlike_bytes _))
+      Return (Inferred_type _ _ (@syntax.CONCAT_list _ _ syntax.stringlike_bytes _))
     | SIZE, set a :: A =>
-      Return (Inferred_type _ _ (@syntax.SIZE _ _ (size_set a) _))
+      Return (Inferred_type _ _ (@syntax.SIZE _ _ (syntax.size_set a) _))
     | SIZE, cons (list a) A =>
-      Return (Inferred_type _ _ (@syntax.SIZE _ _ (size_list a) _))
+      Return (Inferred_type _ _ (@syntax.SIZE _ _ (syntax.size_list a) _))
     | SIZE, cons (map a b) A =>
-      Return (Inferred_type _ _ (@syntax.SIZE _ _ (size_map a b) _))
+      Return (Inferred_type _ _ (@syntax.SIZE _ _ (syntax.size_map a b) _))
     | SIZE, Comparable_type string :: A =>
-      Return (Inferred_type _ _ (@syntax.SIZE _ _ size_string _))
+      Return (Inferred_type _ _ (@syntax.SIZE _ _ syntax.size_string _))
     | SIZE, Comparable_type bytes :: A =>
-      Return (Inferred_type _ _ (@syntax.SIZE _ _ size_bytes _))
+      Return (Inferred_type _ _ (@syntax.SIZE _ _ syntax.size_bytes _))
     | SLICE, Comparable_type nat :: Comparable_type nat :: Comparable_type string :: A =>
-      Return (Inferred_type _ _ (@syntax.SLICE _ _ stringlike_string _))
+      Return (Inferred_type _ _ (@syntax.SLICE _ _ syntax.stringlike_string _))
     | SLICE, Comparable_type nat :: Comparable_type nat :: Comparable_type bytes :: A =>
-      Return (Inferred_type _ _ (@syntax.SLICE _ _ stringlike_bytes _))
+      Return (Inferred_type _ _ (@syntax.SLICE _ _ syntax.stringlike_bytes _))
     | PAIR, a :: b :: A =>
       Return (Inferred_type _ _ syntax.PAIR)
     | CAR, pair a b :: A =>
@@ -520,47 +516,47 @@ Module Typer(C : ContractContext).
       let A := elt' :: set elt :: B in
       let A' := elt ::: set elt :: B in
       let! i := instruction_cast_domain
-        A' A _ (@syntax.MEM _ _ _ (mem_set elt) _) in
+        A' A _ (@syntax.MEM _ _ _ (syntax.mem_set elt) _) in
       Return (Inferred_type _ _ i)
     | MEM, kty' :: map kty vty :: B =>
       let A := kty' :: map kty vty :: B in
       let A' := kty ::: map kty vty :: B in
       let! i := instruction_cast_domain
-        A' A _ (@syntax.MEM _ _ _ (mem_map kty vty) _) in
+        A' A _ (@syntax.MEM _ _ _ (syntax.mem_map kty vty) _) in
       Return (Inferred_type _ _ i)
     | MEM, kty' :: big_map kty vty :: B =>
       let A := kty' :: big_map kty vty :: B in
       let A' := kty ::: big_map kty vty :: B in
       let! i := instruction_cast_domain
-        A' A _ (@syntax.MEM _ _ _ (mem_bigmap kty vty) _) in
+        A' A _ (@syntax.MEM _ _ _ (syntax.mem_bigmap kty vty) _) in
       Return (Inferred_type _ _ i)
     | UPDATE, elt' :: Comparable_type bool :: set elt :: B =>
       let A := elt' ::: bool ::: set elt :: B in
       let A' := elt ::: bool ::: set elt :: B in
       let! i := instruction_cast_domain
-        A' A _ (@syntax.UPDATE _ _ _ _ (update_set elt) _) in
+        A' A _ (@syntax.UPDATE _ _ _ _ (syntax.update_set elt) _) in
       Return (Inferred_type _ _ i)
     | UPDATE, kty' :: option vty' :: map kty vty :: B =>
       let A := kty' ::: option vty' ::: map kty vty :: B in
       let A' := kty ::: option vty ::: map kty vty :: B in
       let! i := instruction_cast_domain
-        A' A _ (@syntax.UPDATE _ _ _ _ (update_map kty vty) _) in
+        A' A _ (@syntax.UPDATE _ _ _ _ (syntax.update_map kty vty) _) in
       Return (Inferred_type _ _ i)
     | UPDATE, kty' :: option vty' :: big_map kty vty :: B =>
       let A := kty' ::: option vty' ::: big_map kty vty :: B in
       let A' := kty ::: option vty ::: big_map kty vty :: B in
       let! i := instruction_cast_domain
-        A' A _ (@syntax.UPDATE _ _ _ _ (update_bigmap kty vty) _) in
+        A' A _ (@syntax.UPDATE _ _ _ _ (syntax.update_bigmap kty vty) _) in
       Return (Inferred_type _ _ i)
     | ITER i, list a :: A =>
       let! i := type_check_instruction_no_tail_fail type_instruction i (a :: A) A in
-      Return (Inferred_type _ _ (syntax.ITER i))
+      Return (Inferred_type _ _ (syntax.ITER (i := syntax.iter_list _) i))
     | ITER i, set a :: A =>
       let! i := type_check_instruction_no_tail_fail type_instruction i (a ::: A) A in
-      Return (Inferred_type _ _ (syntax.ITER i))
+      Return (Inferred_type _ _ (syntax.ITER (i := syntax.iter_set _)i))
     | ITER i, map kty vty :: A =>
       let! i := type_check_instruction_no_tail_fail type_instruction i (pair kty vty :: A) A in
-      Return (Inferred_type _ _ (syntax.ITER i))
+      Return (Inferred_type _ _ (syntax.ITER (i := syntax.iter_map _ _) i))
     | EMPTY_MAP kty vty, A =>
       Return (Inferred_type _ _ (syntax.EMPTY_MAP kty vty))
     | EMPTY_BIG_MAP kty vty, A =>
@@ -569,20 +565,20 @@ Module Typer(C : ContractContext).
       let A := kty' :: map kty vty :: B in
       let A' := kty ::: map kty vty :: B in
       let! i := instruction_cast_domain
-        A' A _ (@syntax.GET _ _ _ (get_map kty vty) _) in
+        A' A _ (@syntax.GET _ _ _ (syntax.get_map kty vty) _) in
       Return (Inferred_type _ _ i)
     | GET, kty' :: big_map kty vty :: B =>
       let A := kty' :: big_map kty vty :: B in
       let A' := kty ::: big_map kty vty :: B in
       let! i := instruction_cast_domain
-        A' A _ (@syntax.GET _ _ _ (get_bigmap kty vty) _) in
+        A' A _ (@syntax.GET _ _ _ (syntax.get_bigmap kty vty) _) in
       Return (Inferred_type _ _ i)
     | MAP i, list a :: A =>
       let! r := type_instruction_no_tail_fail type_instruction i (a :: A) in
       match r with
       | existT _ (b :: A') i =>
         let! i := instruction_cast_range (a :: A) (b :: A') (b :: A) i in
-        Return (Inferred_type _ _ (syntax.MAP i))
+        Return (Inferred_type _ _ (syntax.MAP (i := syntax.map_list _ _) i))
       | _ => Failed _ (Typing _ tt)
       end
     | MAP i, map kty vty :: A =>
@@ -590,7 +586,7 @@ Module Typer(C : ContractContext).
       match r with
       | existT _ (b :: A') i =>
         let! i := instruction_cast_range (pair kty vty :: A) (b :: A') (b :: A) i in
-        Return (Inferred_type _ _ (syntax.MAP i))
+        Return (Inferred_type _ _ (syntax.MAP (i := syntax.map_map _ _ _) i))
       | _ => Failed _ (Typing _ tt)
       end
     | SOME, a :: A => Return (Inferred_type _ _ syntax.SOME)
@@ -670,4 +666,3 @@ Module Typer(C : ContractContext).
       Return (Inferred_type _ _ syntax.CHAIN_ID)
     | _, _ => Failed _ (Typing _ (i, A))
     end.
-End Typer.
diff --git a/src/michocoq/untyper.v b/src/michocoq/untyper.v
index f3cae0b0..21bedfd6 100644
--- a/src/michocoq/untyper.v
+++ b/src/michocoq/untyper.v
@@ -1,20 +1,13 @@
 Require Import ZArith List.
 Require Import syntax.
+Require Import typer.
 Require Import untyped_syntax error.
-Require typer.
 Require Eqdep_dec.
 Import error.Notations.
 
 (* Not really needed but eases reading of proof states. *)
 Require Import String.
 
-Module Untyper(C : ContractContext).
-
-  Module syntax := Syntax C.
-  Module typer := typer.Typer C.
-  Import typer. Import syntax. Import untyped_syntax.
-
-
   Fixpoint untype_data {a} (d : syntax.concrete_data a) : concrete_data :=
     match d with
     | syntax.Int_constant z => Int_constant z
@@ -591,7 +584,7 @@ Module Untyper(C : ContractContext).
         rewrite untype_type_instruction_no_tail_fail.
         * simpl.
           rewrite untype_type_instruction.
-          destruct tff0; reflexivity.
+          destruct tff; reflexivity.
         * auto.
       + simpl.
         trans_refl
@@ -603,13 +596,13 @@ Module Untyper(C : ContractContext).
         rewrite untype_type_branches; auto.
       + trans_refl (
           let! i := typer.type_check_instruction_no_tail_fail
-            typer.type_instruction (untype_instruction i0) A (bool ::: A) in
+            typer.type_instruction (untype_instruction i) A (bool ::: A) in
           Return (@typer.Inferred_type self_type _ _ (syntax.LOOP i))
         ).
         rewrite untype_type_check_instruction_no_tail_fail; auto.
       + trans_refl (
           let! i := typer.type_check_instruction_no_tail_fail
-            typer.type_instruction (untype_instruction i0) _ (or a b ::: A) in
+            typer.type_instruction (untype_instruction i) _ (or a b ::: A) in
           Return (@typer.Inferred_type self_type _ _ (syntax.LOOP_LEFT i))
         ).
         rewrite untype_type_check_instruction_no_tail_fail; auto.
@@ -626,7 +619,7 @@ Module Untyper(C : ContractContext).
                       let! i := instruction_cast_domain A A _ (@syntax.APPLY self_type _ _ _ _ (IT_eq_rev _ i)) in
                       Return (Inferred_type _ _ i)
                     else fun _ => Failed _ (Typing _ "APPLY"%string)) i1
-                   = Return (Inferred_type A _ (@syntax.APPLY _ _ _ _ _ i0))).
+                   = Return (Inferred_type A _ (@syntax.APPLY _ _ _ _ _ i))).
         * intros b0 i1.
           destruct b0.
           -- rewrite instruction_cast_domain_same.
@@ -634,8 +627,8 @@ Module Untyper(C : ContractContext).
              repeat f_equal.
              apply Is_true_UIP.
           -- exfalso.
-             rewrite i1 in i0.
-             exact i0.
+             rewrite i1 in i.
+             exact i.
         * apply H.
       + trans_refl (
           let! d := typer.type_data (untype_data x) a in
@@ -646,7 +639,7 @@ Module Untyper(C : ContractContext).
       + trans_refl (
           let! existT _ tff i :=
             typer.type_check_instruction
-              typer.type_instruction (untype_instruction i0) (a :: nil) (b :: nil) in
+              typer.type_instruction (untype_instruction i) (a :: nil) (b :: nil) in
           Return (@typer.Inferred_type self_type _ (lambda a b ::: A) (syntax.LAMBDA a b i))
         ).
         rewrite untype_type_check_instruction; auto.
@@ -668,11 +661,11 @@ Module Untyper(C : ContractContext).
         * rewrite instruction_cast_domain_same.
           simpl.
           reflexivity.
-      + destruct i0 as [v]; destruct v; reflexivity.
-      + destruct i0 as [v]; destruct v; reflexivity.
-      + destruct i0 as [v]; destruct v; reflexivity.
-      + destruct i0 as [v]; destruct v; reflexivity.
-      + destruct i0 as [v]; destruct v.
+      + destruct i as [v]; destruct v; reflexivity.
+      + destruct i as [v]; destruct v; reflexivity.
+      + destruct i as [v]; destruct v; reflexivity.
+      + destruct i as [v]; destruct v; reflexivity.
+      + destruct i as [v]; destruct v.
         * unfold untype_type_spec; simpl.
           rewrite instruction_cast_domain_same.
           reflexivity.
@@ -682,7 +675,7 @@ Module Untyper(C : ContractContext).
         * unfold untype_type_spec; simpl.
           rewrite instruction_cast_domain_same.
           reflexivity.
-      + destruct i0 as [v]; destruct v.
+      + destruct i as [v]; destruct v.
         * unfold untype_type_spec; simpl.
           rewrite instruction_cast_domain_same.
           reflexivity.
@@ -692,21 +685,21 @@ Module Untyper(C : ContractContext).
         * unfold untype_type_spec; simpl.
           rewrite instruction_cast_domain_same.
           reflexivity.
-      + destruct i0 as [c v]; destruct v.
+      + destruct i as [c v]; destruct v.
         * unfold untype_type_spec; simpl.
           rewrite untype_type_check_instruction_no_tail_fail; auto.
         * unfold untype_type_spec; simpl.
           rewrite untype_type_check_instruction_no_tail_fail; auto.
         * unfold untype_type_spec; simpl.
           rewrite untype_type_check_instruction_no_tail_fail; auto.
-      + destruct i0 as [c v]; destruct v.
+      + destruct i as [c v]; destruct v.
         * unfold untype_type_spec; simpl.
           rewrite instruction_cast_domain_same.
           reflexivity.
         * unfold untype_type_spec; simpl.
           rewrite instruction_cast_domain_same.
           reflexivity.
-      + destruct i0 as [a c v]; destruct v.
+      + destruct i as [a c v]; destruct v.
         * unfold untype_type_spec; simpl.
           rewrite untype_type_instruction_no_tail_fail.
           -- simpl.
@@ -782,5 +775,3 @@ Module Untyper(C : ContractContext).
         rewrite instruction_cast_domain_same.
         reflexivity.
   Qed.
-
-End Untyper.
-- 
GitLab


From 80978eefa89344564a82cb149febc51951146ae3 Mon Sep 17 00:00:00 2001
From: Guillaume Claret <dev@clarus.me>
Date: Sat, 16 Nov 2019 14:28:16 +0100
Subject: [PATCH 03/56] [of_ocaml] Add imported syntax definition from the
 OCaml code

---
 src/michocoq/of_ocaml/script_typed_ir_ml.v | 776 +++++++++++++++++++++
 1 file changed, 776 insertions(+)
 create mode 100644 src/michocoq/of_ocaml/script_typed_ir_ml.v

diff --git a/src/michocoq/of_ocaml/script_typed_ir_ml.v b/src/michocoq/of_ocaml/script_typed_ir_ml.v
new file mode 100644
index 00000000..da9046a7
--- /dev/null
+++ b/src/michocoq/of_ocaml/script_typed_ir_ml.v
@@ -0,0 +1,776 @@
+Require Import Coq.Strings.String.
+Require Import ZArith.
+
+Local Open Scope type_scope.
+
+Module Tezos_protocol_environment_alpha.
+  Module Environment.
+    Module Chain_id.
+      Parameter t : Type.
+    End Chain_id.
+
+    Module MBytes.
+      Parameter t : Type.
+    End MBytes.
+
+    Module Z.
+      Parameter t : Type.
+    End Z.
+  End Environment.
+End Tezos_protocol_environment_alpha.
+
+Module Tezos_raw_protocol_alpha.
+  Module Alpha_context.
+    Module Contract.
+      Parameter big_map_diff : Type.
+      Parameter t : Type.
+    End Contract.
+
+    Module Script.
+      Parameter location : Type.
+      Parameter node : Type.
+    End Script.
+
+    Module Script_int.
+      Parameter n : Type.
+      Parameter num : Type -> Type.
+      Parameter z : Type.
+    End Script_int.
+
+    Module Script_timestamp.
+      Parameter t : Type.
+    End Script_timestamp.
+
+    Module Tez.
+      Parameter t : Type.
+    End Tez.
+
+    Parameter packed_internal_operation : Type.
+    Parameter public_key : Type.
+    Parameter public_key_hash : Type.
+    Parameter signature : Type.
+  End Alpha_context.
+End Tezos_raw_protocol_alpha.
+
+Parameter var_annot : Type.
+
+Parameter type_annot : Type.
+
+Parameter field_annot : Type.
+
+Definition address :=
+  Tezos_raw_protocol_alpha.Alpha_context.Contract.t * string.
+
+Definition pair (a b : Type) := a * b.
+
+Inductive union (a b : Type) : Type :=
+| L : a -> union a b
+| R : b -> union a b.
+
+Arguments L {_ _}.
+Arguments R {_ _}.
+
+Inductive comb : Type :=
+| Comb : comb.
+
+Inductive leaf : Type :=
+| Leaf : leaf.
+
+Inductive comparable_struct : forall (_ _ : Type), Type :=
+| Int_key : forall {A : Type}, (option type_annot) ->
+  comparable_struct
+    (Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) A
+| Nat_key : forall {A : Type}, (option type_annot) ->
+  comparable_struct
+    (Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) A
+| String_key : forall {A : Type}, (option type_annot) ->
+  comparable_struct string A
+| Bytes_key : forall {A : Type}, (option type_annot) ->
+  comparable_struct Tezos_protocol_environment_alpha.Environment.MBytes.t A
+| Mutez_key : forall {A : Type}, (option type_annot) ->
+  comparable_struct Tezos_raw_protocol_alpha.Alpha_context.Tez.t A
+| Bool_key : forall {A : Type}, (option type_annot) -> comparable_struct bool A
+| Key_hash_key : forall {A : Type}, (option type_annot) ->
+  comparable_struct Tezos_raw_protocol_alpha.Alpha_context.public_key_hash A
+| Timestamp_key : forall {A : Type}, (option type_annot) ->
+  comparable_struct Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t A
+| Address_key : forall {A : Type}, (option type_annot) ->
+  comparable_struct address A
+| Pair_key : forall {C a b : Type},
+  ((comparable_struct a leaf) * (option field_annot)) ->
+  ((comparable_struct b C) * (option field_annot)) -> (option type_annot) ->
+  comparable_struct (pair a b) comb.
+
+Definition comparable_ty (a : Type) := comparable_struct a comb.
+
+(*Module Boxed_set.
+  Record signature {elt OPS_t : Type} := {
+    elt := elt;
+    elt_ty : comparable_ty elt;
+    OPS : S.SET.signature elt OPS_t;
+    boxed : OPS.(Tezos_protocol_environment_alpha.Environment.SET.S.t);
+    size : Z;
+  }.
+  Arguments signature : clear implicits.
+End Boxed_set.
+
+Definition set (elt : Type) := {OPS_t : _ & Boxed_set.signature elt OPS_t}.*)
+
+Parameter set : Type -> Type.
+
+(*Module Boxed_map.
+  Record signature {key value OPS_t : Type} := {
+    key := key;
+    value := value;
+    key_ty : comparable_ty key;
+    OPS : S.MAP.signature key OPS_t;
+    boxed : (OPS.(Tezos_protocol_environment_alpha.Environment.MAP.S.t) value)
+      * Z;
+  }.
+  Arguments signature : clear implicits.
+End Boxed_map.
+
+Definition map (key value : Type) :=
+  {OPS_t : _ & Boxed_map.signature key value OPS_t}.*)
+
+Parameter map : Type -> Type -> Type.
+
+Definition operation :=
+  Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation *
+    (option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff).
+
+Reserved Notation "'script".
+Reserved Notation "'end_of_stack".
+Reserved Notation "'typed_contract".
+Reserved Notation "'big_map".
+Reserved Notation "'descr".
+
+Record descr_skeleton {loc bef aft instr : Type} := {
+  loc : loc;
+  bef : bef;
+  aft : aft;
+  instr_ : instr }.
+Arguments descr_skeleton : clear implicits.
+
+Record big_map_skeleton {id diff key_type value_type : Type} := {
+  id : id;
+  diff : diff;
+  key_type : key_type;
+  value_type : value_type }.
+Arguments big_map_skeleton : clear implicits.
+
+Record script_skeleton {code arg_type storage storage_type root_name : Type} :=
+  {
+  code : code;
+  arg_type : arg_type;
+  storage : storage;
+  storage_type : storage_type;
+  root_name : root_name }.
+Arguments script_skeleton : clear implicits.
+
+
+(*Inductive lambda : forall (arg ret : Type), Type :=
+| Lam : forall (arg ret : Type), ('descr (arg * 'end_of_stack) (ret * 'end_of_stack)) ->
+Tezos_raw_protocol_alpha.Alpha_context.Script.node -> lambda arg ret*)
+
+Parameter lambda : forall (arg ret : Type), Type.
+
+Inductive Ty : forall (ty : Type), Type :=
+| Unit_t : (option type_annot) -> Ty unit
+| Int_t : (option type_annot) ->
+  Ty
+    (Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z)
+| Nat_t : (option type_annot) ->
+  Ty
+    (Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n)
+| Signature_t : (option type_annot) ->
+  Ty Tezos_raw_protocol_alpha.Alpha_context.signature
+| String_t : (option type_annot) -> Ty string
+| Bytes_t : (option type_annot) ->
+  Ty Tezos_protocol_environment_alpha.Environment.MBytes.t
+| Mutez_t : (option type_annot) ->
+  Ty Tezos_raw_protocol_alpha.Alpha_context.Tez.t
+| Key_hash_t : (option type_annot) ->
+  Ty Tezos_raw_protocol_alpha.Alpha_context.public_key_hash
+| Key_t : (option type_annot) ->
+  Ty Tezos_raw_protocol_alpha.Alpha_context.public_key
+| Timestamp_t : (option type_annot) ->
+  Ty Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t
+| Address_t : (option type_annot) -> Ty address
+| Bool_t : (option type_annot) -> Ty bool
+| Pair_t : forall {a b : Type},
+  ((Ty a) * (option field_annot) * (option var_annot)) ->
+  ((Ty b) * (option field_annot) * (option var_annot)) -> (option type_annot) ->
+  bool -> Ty (pair a b)
+| Union_t : forall {a b : Type}, ((Ty a) * (option field_annot)) ->
+  ((Ty b) * (option field_annot)) -> (option type_annot) -> bool ->
+  Ty (union a b)
+| Lambda_t : forall {arg ret : Type}, (Ty arg) -> (Ty ret) ->
+  (option type_annot) -> Ty (lambda arg ret)
+| Option_t : forall {v : Type}, (Ty v) -> (option type_annot) -> bool ->
+  Ty (option v)
+| List_t : forall {v : Type}, (Ty v) -> (option type_annot) -> bool ->
+  Ty (list v)
+| Set_t : forall {v : Type}, (comparable_ty v) -> (option type_annot) ->
+  Ty (set v)
+| Map_t : forall {k v : Type}, (comparable_ty k) -> (Ty v) ->
+  (option type_annot) -> bool -> Ty (map k v)
+(*| Big_map_t : forall {k v : Type}, (comparable_ty k) -> (Ty v) ->
+  (option type_annot) -> Ty ('big_map k v)*)
+(*| Contract_t : forall {arg : Type}, (Ty arg) -> (option type_annot) ->
+  Ty ('typed_contract arg)*)
+| Operation_t : (option type_annot) -> Ty operation
+| Chain_id_t : (option type_annot) ->
+  Ty Tezos_protocol_environment_alpha.Environment.Chain_id.t
+
+with stack_ty : forall (ty : Type), Type :=
+| Item_t : forall {rest ty : Type}, (Ty ty) -> (stack_ty rest) ->
+  (option var_annot) -> stack_ty (ty * rest)
+| Empty_t : stack_ty 'end_of_stack
+
+with instr : forall (bef aft : Type), Type :=
+| Drop : forall {A rest : Type}, instr (A * rest) rest
+| Dup : forall {rest top : Type}, instr (top * rest) (top * (top * rest))
+| Swap : forall {rest tip top : Type},
+  instr (tip * (top * rest)) (top * (tip * rest))
+| Const : forall {rest ty : Type}, ty -> instr rest (ty * rest)
+| Cons_pair : forall {car cdr rest : Type},
+  instr (car * (cdr * rest)) ((pair car cdr) * rest)
+| Car : forall {B car rest : Type}, instr ((pair car B) * rest) (car * rest)
+| Cdr : forall {A cdr rest : Type}, instr ((pair A cdr) * rest) (cdr * rest)
+| Cons_some : forall {rest v : Type}, instr (v * rest) ((option v) * rest)
+| Cons_none : forall {a rest : Type}, (Ty a) -> instr rest ((option a) * rest)
+| If_none : forall {a aft bef : Type}, ('descr bef aft) ->
+  ('descr (a * bef) aft) -> instr ((option a) * bef) aft
+| Left : forall {l r rest : Type}, instr (l * rest) ((union l r) * rest)
+| Right : forall {l r rest : Type}, instr (r * rest) ((union l r) * rest)
+| If_left : forall {aft bef l r : Type}, ('descr (l * bef) aft) ->
+  ('descr (r * bef) aft) -> instr ((union l r) * bef) aft
+| Cons_list : forall {a rest : Type},
+  instr (a * ((list a) * rest)) ((list a) * rest)
+| Nil : forall {a rest : Type}, instr rest ((list a) * rest)
+| If_cons : forall {a aft bef : Type}, ('descr (a * ((list a) * bef)) aft) ->
+  ('descr bef aft) -> instr ((list a) * bef) aft
+| List_map : forall {a b rest : Type}, ('descr (a * rest) (b * rest)) ->
+  instr ((list a) * rest) ((list b) * rest)
+| List_iter : forall {a rest : Type}, ('descr (a * rest) rest) ->
+  instr ((list a) * rest) rest
+| List_size : forall {a rest : Type},
+  instr ((list a) * rest)
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+| Empty_set : forall {a rest : Type}, (comparable_ty a) ->
+  instr rest ((set a) * rest)
+| Set_iter : forall {a rest : Type}, ('descr (a * rest) rest) ->
+  instr ((set a) * rest) rest
+| Set_mem : forall {elt rest : Type},
+  instr (elt * ((set elt) * rest)) (bool * rest)
+| Set_update : forall {elt rest : Type},
+  instr (elt * (bool * ((set elt) * rest))) ((set elt) * rest)
+| Set_size : forall {a rest : Type},
+  instr ((set a) * rest)
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+| Empty_map : forall {a rest v : Type}, (comparable_ty a) -> (Ty v) ->
+  instr rest ((map a v) * rest)
+| Map_map : forall {a r rest v : Type}, ('descr ((a * v) * rest) (r * rest)) ->
+  instr ((map a v) * rest) ((map a r) * rest)
+| Map_iter : forall {a rest v : Type}, ('descr ((a * v) * rest) rest) ->
+  instr ((map a v) * rest) rest
+| Map_mem : forall {a rest v : Type},
+  instr (a * ((map a v) * rest)) (bool * rest)
+| Map_get : forall {a rest v : Type},
+  instr (a * ((map a v) * rest)) ((option v) * rest)
+| Map_update : forall {a rest v : Type},
+  instr (a * ((option v) * ((map a v) * rest))) ((map a v) * rest)
+| Map_size : forall {a b rest : Type},
+  instr ((map a b) * rest)
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+(*| Empty_big_map : forall {a rest v : Type}, (comparable_ty a) -> (Ty v) ->
+  instr rest (('big_map a v) * rest)
+| Big_map_mem : forall {a rest v : Type},
+  instr (a * (('big_map a v) * rest)) (bool * rest)
+| Big_map_get : forall {a rest v : Type},
+  instr (a * (('big_map a v) * rest)) ((option v) * rest)
+| Big_map_update : forall {key rest value : Type},
+  instr (key * ((option value) * (('big_map key value) * rest)))
+    (('big_map key value) * rest)*)
+| Concat_string : forall {rest : Type},
+  instr ((list string) * rest) (string * rest)
+| Concat_string_pair : forall {rest : Type},
+  instr (string * (string * rest)) (string * rest)
+| Slice_string : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * (string * rest)))
+    ((option string) * rest)
+| String_size : forall {rest : Type},
+  instr (string * rest)
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+| Concat_bytes : forall {rest : Type},
+  instr ((list Tezos_protocol_environment_alpha.Environment.MBytes.t) * rest)
+    (Tezos_protocol_environment_alpha.Environment.MBytes.t * rest)
+| Concat_bytes_pair : forall {rest : Type},
+  instr
+    (Tezos_protocol_environment_alpha.Environment.MBytes.t *
+      (Tezos_protocol_environment_alpha.Environment.MBytes.t * rest))
+    (Tezos_protocol_environment_alpha.Environment.MBytes.t * rest)
+| Slice_bytes : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) *
+        (Tezos_protocol_environment_alpha.Environment.MBytes.t * rest)))
+    ((option Tezos_protocol_environment_alpha.Environment.MBytes.t) * rest)
+| Bytes_size : forall {rest : Type},
+  instr (Tezos_protocol_environment_alpha.Environment.MBytes.t * rest)
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+| Add_seconds_to_timestamp : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) *
+      (Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t * rest))
+    (Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t * rest)
+| Add_timestamp_to_seconds : forall {rest : Type},
+  instr
+    (Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest))
+    (Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t * rest)
+| Sub_timestamp_seconds : forall {rest : Type},
+  instr
+    (Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest))
+    (Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t * rest)
+| Diff_timestamps : forall {rest : Type},
+  instr
+    (Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t *
+      (Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t * rest))
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+| Add_tez : forall {rest : Type},
+  instr
+    (Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
+      (Tezos_raw_protocol_alpha.Alpha_context.Tez.t * rest))
+    (Tezos_raw_protocol_alpha.Alpha_context.Tez.t * rest)
+| Sub_tez : forall {rest : Type},
+  instr
+    (Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
+      (Tezos_raw_protocol_alpha.Alpha_context.Tez.t * rest))
+    (Tezos_raw_protocol_alpha.Alpha_context.Tez.t * rest)
+| Mul_teznat : forall {rest : Type},
+  instr
+    (Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest))
+    (Tezos_raw_protocol_alpha.Alpha_context.Tez.t * rest)
+| Mul_nattez : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) *
+      (Tezos_raw_protocol_alpha.Alpha_context.Tez.t * rest))
+    (Tezos_raw_protocol_alpha.Alpha_context.Tez.t * rest)
+| Ediv_teznat : forall {rest : Type},
+  instr
+    (Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest))
+    ((option
+      (pair Tezos_raw_protocol_alpha.Alpha_context.Tez.t
+        Tezos_raw_protocol_alpha.Alpha_context.Tez.t)) * rest)
+| Ediv_tez : forall {rest : Type},
+  instr
+    (Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
+      (Tezos_raw_protocol_alpha.Alpha_context.Tez.t * rest))
+    ((option
+      (pair
+        (Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+          Tezos_raw_protocol_alpha.Alpha_context.Script_int.n)
+        Tezos_raw_protocol_alpha.Alpha_context.Tez.t)) * rest)
+| Or : forall {rest : Type}, instr (bool * (bool * rest)) (bool * rest)
+| And : forall {rest : Type}, instr (bool * (bool * rest)) (bool * rest)
+| Xor : forall {rest : Type}, instr (bool * (bool * rest)) (bool * rest)
+| Not : forall {rest : Type}, instr (bool * rest) (bool * rest)
+| Is_nat : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+    ((option
+      (Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n)) * rest)
+| Neg_nat : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+| Neg_int : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+| Abs_int : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+| Int_nat : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+| Add_intint : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest))
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+| Add_intnat : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest))
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+| Add_natint : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest))
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+| Add_natnat : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest))
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+| Sub_int : forall {rest s t : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num s) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num t) * rest))
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+| Mul_intint : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest))
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+| Mul_intnat : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest))
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+| Mul_natint : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest))
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+| Mul_natnat : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest))
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+| Ediv_intint : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest))
+    ((option
+      (pair
+        (Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+          Tezos_raw_protocol_alpha.Alpha_context.Script_int.z)
+        (Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+          Tezos_raw_protocol_alpha.Alpha_context.Script_int.n))) * rest)
+| Ediv_intnat : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest))
+    ((option
+      (pair
+        (Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+          Tezos_raw_protocol_alpha.Alpha_context.Script_int.z)
+        (Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+          Tezos_raw_protocol_alpha.Alpha_context.Script_int.n))) * rest)
+| Ediv_natint : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest))
+    ((option
+      (pair
+        (Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+          Tezos_raw_protocol_alpha.Alpha_context.Script_int.z)
+        (Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+          Tezos_raw_protocol_alpha.Alpha_context.Script_int.n))) * rest)
+| Ediv_natnat : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest))
+    ((option
+      (pair
+        (Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+          Tezos_raw_protocol_alpha.Alpha_context.Script_int.n)
+        (Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+          Tezos_raw_protocol_alpha.Alpha_context.Script_int.n))) * rest)
+| Lsl_nat : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest))
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+| Lsr_nat : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest))
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+| Or_nat : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest))
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+| And_nat : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest))
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+| And_int_nat : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest))
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+| Xor_nat : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) *
+      ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest))
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+| Not_nat : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+| Not_int : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+| Seq : forall {aft bef trans : Type}, ('descr bef trans) -> ('descr trans aft)
+  -> instr bef aft
+| If : forall {aft bef : Type}, ('descr bef aft) -> ('descr bef aft) ->
+  instr (bool * bef) aft
+| Loop : forall {rest : Type}, ('descr rest (bool * rest)) ->
+  instr (bool * rest) rest
+| Loop_left : forall {a b rest : Type}, ('descr (a * rest) ((union a b) * rest))
+  -> instr ((union a b) * rest) (b * rest)
+| Dip : forall {aft bef top : Type}, ('descr bef aft) ->
+  instr (top * bef) (top * aft)
+| Exec : forall {arg rest ret : Type},
+  instr (arg * ((lambda arg ret) * rest)) (ret * rest)
+| Apply : forall {arg remaining rest ret : Type}, (Ty arg) ->
+  instr (arg * ((lambda (arg * remaining) ret) * rest))
+    ((lambda remaining ret) * rest)
+| Lambda : forall {arg rest ret : Type}, (lambda arg ret) ->
+  instr rest ((lambda arg ret) * rest)
+| Failwith : forall {a aft rest : Type}, (Ty a) -> instr (a * rest) aft
+| Nop : forall {rest : Type}, instr rest rest
+| Compare : forall {a rest : Type}, (comparable_ty a) ->
+  instr (a * (a * rest))
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest)
+| Eq : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest) (bool * rest)
+| Neq : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest) (bool * rest)
+| Lt : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest) (bool * rest)
+| Gt : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest) (bool * rest)
+| Le : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest) (bool * rest)
+| Ge : forall {rest : Type},
+  instr
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.z) * rest) (bool * rest)
+(*| Address : forall {A rest : Type},
+  instr (('typed_contract A) * rest) (address * rest)*)
+(*| Contract : forall {p rest : Type}, (Ty p) -> string ->
+  instr (address * rest) ((option ('typed_contract p)) * rest)*)
+(*| Transfer_tokens : forall {arg rest : Type},
+  instr
+    (arg *
+      (Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
+        (('typed_contract arg) * rest))) (operation * rest)*)
+| Create_account : forall {rest : Type},
+  instr
+    (Tezos_raw_protocol_alpha.Alpha_context.public_key_hash *
+      ((option Tezos_raw_protocol_alpha.Alpha_context.public_key_hash) *
+        (bool * (Tezos_raw_protocol_alpha.Alpha_context.Tez.t * rest))))
+    (operation * (address * rest))
+(*| Implicit_account : forall {rest : Type},
+  instr (Tezos_raw_protocol_alpha.Alpha_context.public_key_hash * rest)
+    (('typed_contract unit) * rest)*)
+| Create_contract : forall {g p rest : Type}, (Ty g) -> (Ty p) ->
+  (lambda (p * g) ((list operation) * g)) -> (option string) ->
+  instr
+    (Tezos_raw_protocol_alpha.Alpha_context.public_key_hash *
+      ((option Tezos_raw_protocol_alpha.Alpha_context.public_key_hash) *
+        (bool *
+          (bool * (Tezos_raw_protocol_alpha.Alpha_context.Tez.t * (g * rest))))))
+    (operation * (address * rest))
+| Create_contract_2 : forall {g p rest : Type}, (Ty g) -> (Ty p) ->
+  (lambda (p * g) ((list operation) * g)) -> (option string) ->
+  instr
+    ((option Tezos_raw_protocol_alpha.Alpha_context.public_key_hash) *
+      (Tezos_raw_protocol_alpha.Alpha_context.Tez.t * (g * rest)))
+    (operation * (address * rest))
+| Set_delegate : forall {rest : Type},
+  instr ((option Tezos_raw_protocol_alpha.Alpha_context.public_key_hash) * rest)
+    (operation * rest)
+| Now : forall {rest : Type},
+  instr rest (Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t * rest)
+| Balance : forall {rest : Type},
+  instr rest (Tezos_raw_protocol_alpha.Alpha_context.Tez.t * rest)
+| Check_signature : forall {rest : Type},
+  instr
+    (Tezos_raw_protocol_alpha.Alpha_context.public_key *
+      (Tezos_raw_protocol_alpha.Alpha_context.signature *
+        (Tezos_protocol_environment_alpha.Environment.MBytes.t * rest)))
+    (bool * rest)
+| Hash_key : forall {rest : Type},
+  instr (Tezos_raw_protocol_alpha.Alpha_context.public_key * rest)
+    (Tezos_raw_protocol_alpha.Alpha_context.public_key_hash * rest)
+| Pack : forall {a rest : Type}, (Ty a) ->
+  instr (a * rest)
+    (Tezos_protocol_environment_alpha.Environment.MBytes.t * rest)
+| Unpack : forall {a rest : Type}, (Ty a) ->
+  instr (Tezos_protocol_environment_alpha.Environment.MBytes.t * rest)
+    ((option a) * rest)
+| Blake2b : forall {rest : Type},
+  instr (Tezos_protocol_environment_alpha.Environment.MBytes.t * rest)
+    (Tezos_protocol_environment_alpha.Environment.MBytes.t * rest)
+| Sha256 : forall {rest : Type},
+  instr (Tezos_protocol_environment_alpha.Environment.MBytes.t * rest)
+    (Tezos_protocol_environment_alpha.Environment.MBytes.t * rest)
+| Sha512 : forall {rest : Type},
+  instr (Tezos_protocol_environment_alpha.Environment.MBytes.t * rest)
+    (Tezos_protocol_environment_alpha.Environment.MBytes.t * rest)
+| Steps_to_quota : forall {rest : Type},
+  instr rest
+    ((Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.n) * rest)
+| Source : forall {rest : Type}, instr rest (address * rest)
+| Sender : forall {rest : Type}, instr rest (address * rest)
+(*| Self : forall {p rest : Type}, (Ty p) -> string ->
+  instr rest (('typed_contract p) * rest)*)
+| Amount : forall {rest : Type},
+  instr rest (Tezos_raw_protocol_alpha.Alpha_context.Tez.t * rest)
+| Dig : forall {aft bef rest x : Type}, Z ->
+  (stack_prefix_preservation_witness (x * rest) rest bef aft) ->
+  instr bef (x * aft)
+| Dug : forall {aft bef rest x : Type}, Z ->
+  (stack_prefix_preservation_witness rest (x * rest) bef aft) ->
+  instr (x * bef) aft
+| Dipn : forall {aft bef faft fbef : Type}, Z ->
+  (stack_prefix_preservation_witness fbef faft bef aft) -> ('descr fbef faft) ->
+  instr bef aft
+| Dropn : forall {C bef rest : Type}, Z ->
+  (stack_prefix_preservation_witness rest rest bef C) -> instr bef rest
+| ChainId : forall {rest : Type},
+  instr rest
+    (Tezos_protocol_environment_alpha.Environment.Chain_id.t * rest)
+
+with stack_prefix_preservation_witness : forall
+  (bef aft bef_suffix aft_suffix : Type), Type :=
+| Prefix : forall {aft bef faft fbef x : Type},
+  (stack_prefix_preservation_witness fbef faft bef aft) ->
+  stack_prefix_preservation_witness fbef faft (x * bef) (x * aft)
+| Rest : forall {aft bef : Type},
+  stack_prefix_preservation_witness bef aft bef aft
+
+where "'script" := (fun (arg storage : Type) =>
+  script_skeleton (lambda (pair arg storage) (pair (list operation) storage))
+    (Ty arg) storage (Ty storage) (option string))
+and "'end_of_stack" := (unit)
+and "'typed_contract" := (fun (arg : Type) => (Ty arg) * address)
+and "'big_map" := (fun (key value : Type) =>
+  big_map_skeleton (option Tezos_protocol_environment_alpha.Environment.Z.t)
+    (map key (option value)) (Ty key) (Ty value))
+and "'descr" := (fun (bef aft : Type) =>
+  descr_skeleton Tezos_raw_protocol_alpha.Alpha_context.Script.location
+    (stack_ty bef) (stack_ty aft) (instr bef aft)).
+
+Definition script := 'script.
+Definition end_of_stack := 'end_of_stack.
+Definition typed_contract := 'typed_contract.
+Definition big_map := 'big_map.
+Definition descr := 'descr.
+
+Inductive ex_big_map : Type :=
+| Ex_bm : forall {key value : Type}, (big_map key value) -> ex_big_map.
-- 
GitLab


From e432e0315ae24fd49a1d629b629b72decbe9d0ad Mon Sep 17 00:00:00 2001
From: Guillaume Claret <dev@clarus.me>
Date: Sat, 16 Nov 2019 14:29:15 +0100
Subject: [PATCH 04/56] [of_ocaml] Add one side of the equivalence with the Coq
 AST

---
 src/michocoq/of_ocaml/syntax_type_equiv.v | 125 ++++++++++++++++++++++
 1 file changed, 125 insertions(+)
 create mode 100644 src/michocoq/of_ocaml/syntax_type_equiv.v

diff --git a/src/michocoq/of_ocaml/syntax_type_equiv.v b/src/michocoq/of_ocaml/syntax_type_equiv.v
new file mode 100644
index 00000000..ae61bcd2
--- /dev/null
+++ b/src/michocoq/of_ocaml/syntax_type_equiv.v
@@ -0,0 +1,125 @@
+Require of_ocaml.script_typed_ir_ml syntax_type.
+
+Fixpoint typ_ocaml_to_coq {ty : Type} (typ : script_typed_ir_ml.Ty ty)
+  : syntax_type.type :=
+  match typ with
+  | script_typed_ir_ml.Unit_t _ => syntax_type.unit
+  | script_typed_ir_ml.Int_t _ => syntax_type.Comparable_type syntax_type.int
+  | script_typed_ir_ml.Nat_t _ => syntax_type.Comparable_type syntax_type.nat
+  | script_typed_ir_ml.Signature_t _ => syntax_type.signature
+  | script_typed_ir_ml.String_t _ => syntax_type.Comparable_type syntax_type.string
+  | script_typed_ir_ml.Bytes_t _ => syntax_type.Comparable_type syntax_type.bytes
+  | script_typed_ir_ml.Mutez_t _ => syntax_type.Comparable_type syntax_type.mutez
+  | script_typed_ir_ml.Key_hash_t _ => syntax_type.Comparable_type syntax_type.key_hash
+  | script_typed_ir_ml.Key_t _ => syntax_type.key
+  | script_typed_ir_ml.Timestamp_t _ => syntax_type.Comparable_type syntax_type.timestamp
+  | script_typed_ir_ml.Address_t _ => syntax_type.Comparable_type syntax_type.address
+  | script_typed_ir_ml.Bool_t _ => syntax_type.Comparable_type syntax_type.bool
+  | script_typed_ir_ml.Pair_t (typ_a, _, _) (typ_b, _, _) _ _ =>
+    syntax_type.pair (typ_ocaml_to_coq typ_a) (typ_ocaml_to_coq typ_b)
+  | script_typed_ir_ml.Union_t (typ_a, _) (typ_b, _) _ _ =>
+    syntax_type.or (typ_ocaml_to_coq typ_a) (typ_ocaml_to_coq typ_b)
+  | script_typed_ir_ml.Lambda_t typ_arg typ_ret _ =>
+    syntax_type.lambda (typ_ocaml_to_coq typ_arg) (typ_ocaml_to_coq typ_ret)
+  | script_typed_ir_ml.Option_t typ _ _ => syntax_type.option (typ_ocaml_to_coq typ)
+  | script_typed_ir_ml.List_t typ _ _ => syntax_type.list (typ_ocaml_to_coq typ)
+  | script_typed_ir_ml.Operation_t _ => syntax_type.operation
+  | script_typed_ir_ml.Chain_id_t _ => syntax_type.chain_id
+  | _ => syntax_type.unit
+  end.
+
+Fixpoint typ_coq_to_ocaml (typ : syntax_type.type)
+  : option {ty : Type & script_typed_ir_ml.Ty ty} :=
+  match typ with
+  | syntax_type.Comparable_type comparable_typ =>
+    Some (
+      match comparable_typ with
+      | syntax_type.string => existT _ _ (script_typed_ir_ml.String_t None)
+      | syntax_type.nat => existT _ _ (script_typed_ir_ml.Nat_t None)
+      | syntax_type.int => existT _ _ (script_typed_ir_ml.Int_t None)
+      | syntax_type.bytes => existT _ _ (script_typed_ir_ml.Bytes_t None)
+      | syntax_type.bool => existT _ _ (script_typed_ir_ml.Bool_t None)
+      | syntax_type.mutez => existT _ _ (script_typed_ir_ml.Mutez_t None)
+      | syntax_type.address => existT _ _ (script_typed_ir_ml.Address_t None)
+      | syntax_type.key_hash => existT _ _ (script_typed_ir_ml.Key_hash_t None)
+      | syntax_type.timestamp => existT _ _ (script_typed_ir_ml.Timestamp_t None)
+      end
+    )
+  | syntax_type.key => Some (existT _ _ (script_typed_ir_ml.Key_t None))
+  | syntax_type.unit => Some (existT _ _ (script_typed_ir_ml.Unit_t None))
+  | syntax_type.signature => Some (existT _ _ (script_typed_ir_ml.Signature_t None))
+  | syntax_type.option typ =>
+    match typ_coq_to_ocaml typ with
+    | Some (existT _ _ typ) => Some (existT _ _ (script_typed_ir_ml.Option_t typ None false))
+    | _ => None
+    end
+  | syntax_type.list typ =>
+    match typ_coq_to_ocaml typ with
+    | Some (existT _ _ typ) => Some (existT _ _ (script_typed_ir_ml.List_t typ None false))
+    | _ => None
+    end
+  | syntax_type.operation => Some (existT _ _ (script_typed_ir_ml.Operation_t None))
+  | syntax_type.pair typ_a typ_b =>
+    match (typ_coq_to_ocaml typ_a, typ_coq_to_ocaml typ_b) with
+    | (Some (existT _ _ typ_a), Some (existT _ _ typ_b)) =>
+      Some (existT _ _ (script_typed_ir_ml.Pair_t
+        (typ_a, None, None)
+        (typ_b, None, None)
+        None
+        false
+      ))
+    | _ => None
+    end
+  | syntax_type.or typ_a typ_b =>
+    match (typ_coq_to_ocaml typ_a, typ_coq_to_ocaml typ_b) with
+    | (Some (existT _ _ typ_a), Some (existT _ _ typ_b)) =>
+      Some (existT _ _ (script_typed_ir_ml.Union_t
+        (typ_a, None)
+        (typ_b, None)
+        None
+        false
+      ))
+    | _ => None
+    end
+  | syntax_type.lambda typ_arg typ_ret =>
+    match (typ_coq_to_ocaml typ_arg, typ_coq_to_ocaml typ_ret) with
+    | (Some (existT _ _ typ_arg), Some (existT _ _ typ_ret)) =>
+      Some (existT _ _ (script_typed_ir_ml.Lambda_t typ_arg typ_ret None))
+    | _ => None
+    end
+  | syntax_type.chain_id => Some (existT _ _ (script_typed_ir_ml.Chain_id_t None))
+  | _ => None
+  end.
+
+Fixpoint coq_to_ocaml_to_coq_eq (typ : syntax_type.type)
+  : match typ_coq_to_ocaml typ with
+    | Some (existT _ _ typ') => typ_ocaml_to_coq typ' = typ
+    | _ => True
+    end.
+  destruct typ; simpl;
+    try reflexivity;
+    (* One recursive call *)
+    try (
+      case_eq (typ_coq_to_ocaml typ); trivial;
+      intros s Heq;
+      set (Heq' := coq_to_ocaml_to_coq_eq typ);
+      rewrite Heq in Heq';
+      destruct s; simpl;
+      now rewrite Heq'
+    );
+    (* two recusive calls *)
+    try (
+      case_eq (typ_coq_to_ocaml typ1); trivial;
+      destruct s as [ty1' typ1'];
+      intro Heq1;
+      set (Heq1' := coq_to_ocaml_to_coq_eq typ1);
+      rewrite Heq1 in Heq1';
+      case_eq (typ_coq_to_ocaml typ2); trivial;
+      destruct s as [ty2' typ2'];
+      intro Heq2;
+      set (Heq2' := coq_to_ocaml_to_coq_eq typ2);
+      rewrite Heq2 in Heq2';
+      now simpl; rewrite Heq1'; rewrite Heq2'
+    ).
+  destruct s; simpl; reflexivity.
+Qed.
-- 
GitLab


From bbb0057169479837119fbce1e3ffd48e913be572 Mon Sep 17 00:00:00 2001
From: Guillaume Claret <dev@clarus.me>
Date: Sat, 16 Nov 2019 17:28:49 +0100
Subject: [PATCH 05/56] [of_ocaml] Extend one side on the equivalence of the
 types with comparable types

---
 src/michocoq/of_ocaml/syntax_type_equiv.v | 367 +++++++++++++++-------
 1 file changed, 248 insertions(+), 119 deletions(-)

diff --git a/src/michocoq/of_ocaml/syntax_type_equiv.v b/src/michocoq/of_ocaml/syntax_type_equiv.v
index ae61bcd2..3af34d91 100644
--- a/src/michocoq/of_ocaml/syntax_type_equiv.v
+++ b/src/michocoq/of_ocaml/syntax_type_equiv.v
@@ -1,125 +1,254 @@
 Require of_ocaml.script_typed_ir_ml syntax_type.
 
-Fixpoint typ_ocaml_to_coq {ty : Type} (typ : script_typed_ir_ml.Ty ty)
-  : syntax_type.type :=
-  match typ with
-  | script_typed_ir_ml.Unit_t _ => syntax_type.unit
-  | script_typed_ir_ml.Int_t _ => syntax_type.Comparable_type syntax_type.int
-  | script_typed_ir_ml.Nat_t _ => syntax_type.Comparable_type syntax_type.nat
-  | script_typed_ir_ml.Signature_t _ => syntax_type.signature
-  | script_typed_ir_ml.String_t _ => syntax_type.Comparable_type syntax_type.string
-  | script_typed_ir_ml.Bytes_t _ => syntax_type.Comparable_type syntax_type.bytes
-  | script_typed_ir_ml.Mutez_t _ => syntax_type.Comparable_type syntax_type.mutez
-  | script_typed_ir_ml.Key_hash_t _ => syntax_type.Comparable_type syntax_type.key_hash
-  | script_typed_ir_ml.Key_t _ => syntax_type.key
-  | script_typed_ir_ml.Timestamp_t _ => syntax_type.Comparable_type syntax_type.timestamp
-  | script_typed_ir_ml.Address_t _ => syntax_type.Comparable_type syntax_type.address
-  | script_typed_ir_ml.Bool_t _ => syntax_type.Comparable_type syntax_type.bool
-  | script_typed_ir_ml.Pair_t (typ_a, _, _) (typ_b, _, _) _ _ =>
-    syntax_type.pair (typ_ocaml_to_coq typ_a) (typ_ocaml_to_coq typ_b)
-  | script_typed_ir_ml.Union_t (typ_a, _) (typ_b, _) _ _ =>
-    syntax_type.or (typ_ocaml_to_coq typ_a) (typ_ocaml_to_coq typ_b)
-  | script_typed_ir_ml.Lambda_t typ_arg typ_ret _ =>
-    syntax_type.lambda (typ_ocaml_to_coq typ_arg) (typ_ocaml_to_coq typ_ret)
-  | script_typed_ir_ml.Option_t typ _ _ => syntax_type.option (typ_ocaml_to_coq typ)
-  | script_typed_ir_ml.List_t typ _ _ => syntax_type.list (typ_ocaml_to_coq typ)
-  | script_typed_ir_ml.Operation_t _ => syntax_type.operation
-  | script_typed_ir_ml.Chain_id_t _ => syntax_type.chain_id
-  | _ => syntax_type.unit
-  end.
+Module comparable.
+  Import script_typed_ir_ml syntax_type.
 
-Fixpoint typ_coq_to_ocaml (typ : syntax_type.type)
-  : option {ty : Type & script_typed_ir_ml.Ty ty} :=
-  match typ with
-  | syntax_type.Comparable_type comparable_typ =>
-    Some (
-      match comparable_typ with
-      | syntax_type.string => existT _ _ (script_typed_ir_ml.String_t None)
-      | syntax_type.nat => existT _ _ (script_typed_ir_ml.Nat_t None)
-      | syntax_type.int => existT _ _ (script_typed_ir_ml.Int_t None)
-      | syntax_type.bytes => existT _ _ (script_typed_ir_ml.Bytes_t None)
-      | syntax_type.bool => existT _ _ (script_typed_ir_ml.Bool_t None)
-      | syntax_type.mutez => existT _ _ (script_typed_ir_ml.Mutez_t None)
-      | syntax_type.address => existT _ _ (script_typed_ir_ml.Address_t None)
-      | syntax_type.key_hash => existT _ _ (script_typed_ir_ml.Key_hash_t None)
-      | syntax_type.timestamp => existT _ _ (script_typed_ir_ml.Timestamp_t None)
-      end
-    )
-  | syntax_type.key => Some (existT _ _ (script_typed_ir_ml.Key_t None))
-  | syntax_type.unit => Some (existT _ _ (script_typed_ir_ml.Unit_t None))
-  | syntax_type.signature => Some (existT _ _ (script_typed_ir_ml.Signature_t None))
-  | syntax_type.option typ =>
-    match typ_coq_to_ocaml typ with
-    | Some (existT _ _ typ) => Some (existT _ _ (script_typed_ir_ml.Option_t typ None false))
-    | _ => None
-    end
-  | syntax_type.list typ =>
-    match typ_coq_to_ocaml typ with
-    | Some (existT _ _ typ) => Some (existT _ _ (script_typed_ir_ml.List_t typ None false))
-    | _ => None
-    end
-  | syntax_type.operation => Some (existT _ _ (script_typed_ir_ml.Operation_t None))
-  | syntax_type.pair typ_a typ_b =>
-    match (typ_coq_to_ocaml typ_a, typ_coq_to_ocaml typ_b) with
-    | (Some (existT _ _ typ_a), Some (existT _ _ typ_b)) =>
-      Some (existT _ _ (script_typed_ir_ml.Pair_t
-        (typ_a, None, None)
-        (typ_b, None, None)
-        None
-        false
-      ))
-    | _ => None
-    end
-  | syntax_type.or typ_a typ_b =>
-    match (typ_coq_to_ocaml typ_a, typ_coq_to_ocaml typ_b) with
-    | (Some (existT _ _ typ_a), Some (existT _ _ typ_b)) =>
-      Some (existT _ _ (script_typed_ir_ml.Union_t
-        (typ_a, None)
-        (typ_b, None)
+  Definition ocaml_leaf_to_coq {A Kind : Type}
+    (comparable : script_typed_ir_ml.comparable_struct A Kind)
+    : syntax_type.simple_comparable_type :=
+    match comparable with
+    | Int_key _ => int
+    | Nat_key _ => nat
+    | String_key _ => string
+    | Bytes_key _ => bytes
+    | Mutez_key _ => mutez
+    | Bool_key _ => bool
+    | Key_hash_key _ => key_hash
+    | Timestamp_key _ => timestamp
+    | Address_key _ => address
+    (* This case should not be used with GADTs *)
+    | Pair_key _ _ _ => bool
+    end.
+
+  Fixpoint ocaml_to_coq {A Kind : Type}
+    (comparable : script_typed_ir_ml.comparable_struct A Kind)
+    : syntax_type.comparable_type :=
+    match comparable with
+    | Pair_key (comparable_a, _) (comparable_b, _) _ =>
+      Cpair
+        (ocaml_leaf_to_coq comparable_a)
+        (ocaml_to_coq comparable_b)
+    | _ => Comparable_type_simple (ocaml_leaf_to_coq comparable)
+    end.
+
+  Definition coq_simple_to_ocaml_typ
+    (comparable : syntax_type.simple_comparable_type)
+    : Type :=
+    match comparable with
+    | string => String.string
+    | nat =>
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n
+    | int =>
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.z
+    | bytes =>
+      Tezos_protocol_environment_alpha.Environment.MBytes.t
+    | bool => Datatypes.bool
+    | mutez => Tezos_raw_protocol_alpha.Alpha_context.Tez.t
+    | address => script_typed_ir_ml.address
+    | key_hash => Tezos_raw_protocol_alpha.Alpha_context.public_key_hash
+    | timestamp => Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t
+    end.
+
+  Definition coq_simple_to_ocaml
+    (Kind : Type)
+    (comparable : syntax_type.simple_comparable_type)
+    : script_typed_ir_ml.comparable_struct
+      (coq_simple_to_ocaml_typ comparable)
+      Kind
+    :=
+    match comparable with
+    | string => String_key None
+    | nat => Nat_key None
+    | int => Int_key None
+    | bytes => Bytes_key None
+    | bool => Bool_key None
+    | mutez => Mutez_key None
+    | address => Address_key None
+    | key_hash => Key_hash_key None
+    | timestamp => Timestamp_key None
+    end.
+
+  Fixpoint coq_to_ocaml_typ
+    (comparable : syntax_type.comparable_type)
+    : Type :=
+    match comparable with
+    | Comparable_type_simple comparable => coq_simple_to_ocaml_typ comparable
+    | Cpair comparable_a comparable_b =>
+      coq_simple_to_ocaml_typ comparable_a * coq_to_ocaml_typ comparable_b
+    end.
+
+  Definition coq_to_ocaml_kind (comparable : syntax_type.comparable_type) : Type :=
+    match comparable with
+    | Comparable_type_simple _ => leaf
+    | Cpair _ _ => comb
+    end.
+
+  Fixpoint coq_to_ocaml (comparable : syntax_type.comparable_type)
+    : script_typed_ir_ml.comparable_ty (coq_to_ocaml_typ comparable) :=
+    match comparable with
+    | Comparable_type_simple comparable =>
+      coq_simple_to_ocaml comb comparable
+    | Cpair comparable_a comparable_b =>
+      Pair_key
+        (coq_simple_to_ocaml leaf comparable_a, None)
+        (coq_to_ocaml comparable_b, None)
         None
-        false
-      ))
-    | _ => None
-    end
-  | syntax_type.lambda typ_arg typ_ret =>
-    match (typ_coq_to_ocaml typ_arg, typ_coq_to_ocaml typ_ret) with
-    | (Some (existT _ _ typ_arg), Some (existT _ _ typ_ret)) =>
-      Some (existT _ _ (script_typed_ir_ml.Lambda_t typ_arg typ_ret None))
-    | _ => None
-    end
-  | syntax_type.chain_id => Some (existT _ _ (script_typed_ir_ml.Chain_id_t None))
-  | _ => None
-  end.
+    end.
+
+  Fixpoint coq_simple_to_ocaml_to_coq_eq {Kind : Type}
+    (comparable : syntax_type.simple_comparable_type)
+    : ocaml_leaf_to_coq (coq_simple_to_ocaml Kind comparable) = comparable.
+    destruct comparable; reflexivity.
+  Qed.
+
+  Fixpoint coq_to_ocaml_to_coq_eq (comparable : syntax_type.comparable_type)
+    : ocaml_to_coq (coq_to_ocaml comparable) = comparable.
+    destruct comparable as [simple | simple comparable]; simpl.
+    - destruct simple; reflexivity.
+    - rewrite coq_simple_to_ocaml_to_coq_eq.
+      rewrite coq_to_ocaml_to_coq_eq.
+      reflexivity.
+  Qed.
+End comparable.
+
+Module typ.
+  Import script_typed_ir_ml syntax_type.
+
+  Fixpoint ocaml_to_coq {ty : Type} (typ : script_typed_ir_ml.Ty ty)
+    : syntax_type.type :=
+    match typ with
+    | Unit_t _ => unit
+    | Int_t _ => Comparable_type int
+    | Nat_t _ => Comparable_type nat
+    | Signature_t _ => signature
+    | String_t _ => Comparable_type string
+    | Bytes_t _ => Comparable_type bytes
+    | Mutez_t _ => Comparable_type mutez
+    | Key_hash_t _ => Comparable_type key_hash
+    | Key_t _ => key
+    | Timestamp_t _ => Comparable_type timestamp
+    | Address_t _ => Comparable_type address
+    | Bool_t _ => Comparable_type bool
+    | Pair_t (typ_a, _, _) (typ_b, _, _) _ _ =>
+      pair (ocaml_to_coq typ_a) (ocaml_to_coq typ_b)
+    | Union_t (typ_a, _) (typ_b, _) _ _ =>
+      or (ocaml_to_coq typ_a) (ocaml_to_coq typ_b)
+    | Lambda_t typ_arg typ_ret _ =>
+      lambda (ocaml_to_coq typ_arg) (ocaml_to_coq typ_ret)
+    | Option_t typ _ _ => option (ocaml_to_coq typ)
+    | List_t typ _ _ => list (ocaml_to_coq typ)
+    | Set_t typ_key _ => set (comparable.ocaml_to_coq typ_key)
+    | Map_t typ_key typ _ _ =>
+      map (comparable.ocaml_to_coq typ_key) (ocaml_to_coq typ)
+    | Operation_t _ => operation
+    | Chain_id_t _ => chain_id
+    end.
 
-Fixpoint coq_to_ocaml_to_coq_eq (typ : syntax_type.type)
-  : match typ_coq_to_ocaml typ with
-    | Some (existT _ _ typ') => typ_ocaml_to_coq typ' = typ
-    | _ => True
+  Fixpoint coq_to_ocaml (typ : syntax_type.type)
+    : Datatypes.option {ty : Type & script_typed_ir_ml.Ty ty} :=
+    match typ with
+    | Comparable_type comparable_typ =>
+      Some (
+        match comparable_typ with
+        | string => existT _ _ (String_t None)
+        | nat => existT _ _ (Nat_t None)
+        | int => existT _ _ (Int_t None)
+        | bytes => existT _ _ (Bytes_t None)
+        | bool => existT _ _ (Bool_t None)
+        | mutez => existT _ _ (Mutez_t None)
+        | address => existT _ _ (Address_t None)
+        | key_hash => existT _ _ (Key_hash_t None)
+        | timestamp => existT _ _ (Timestamp_t None)
+        end
+      )
+    | key => Some (existT _ _ (Key_t None))
+    | unit => Some (existT _ _ (Unit_t None))
+    | signature => Some (existT _ _ (Signature_t None))
+    | option typ =>
+      match coq_to_ocaml typ with
+      | Some (existT _ _ typ) => Some (existT _ _ (Option_t typ None false))
+      | _ => None
+      end
+    | list typ =>
+      match coq_to_ocaml typ with
+      | Some (existT _ _ typ) => Some (existT _ _ (List_t typ None false))
+      | _ => None
+      end
+    | set typ_key =>
+      Some (existT _ _ (Set_t (comparable.coq_to_ocaml typ_key) None))
+    | operation => Some (existT _ _ (Operation_t None))
+    | pair typ_a typ_b =>
+      match (coq_to_ocaml typ_a, coq_to_ocaml typ_b) with
+      | (Some (existT _ _ typ_a), Some (existT _ _ typ_b)) =>
+        Some (existT _ _ (Pair_t
+          (typ_a, None, None)
+          (typ_b, None, None)
+          None
+          false
+        ))
+      | _ => None
+      end
+    | or typ_a typ_b =>
+      match (coq_to_ocaml typ_a, coq_to_ocaml typ_b) with
+      | (Some (existT _ _ typ_a), Some (existT _ _ typ_b)) =>
+        Some (existT _ _ (Union_t
+          (typ_a, None)
+          (typ_b, None)
+          None
+          false
+        ))
+      | _ => None
+      end
+    | lambda typ_arg typ_ret =>
+      match (coq_to_ocaml typ_arg, coq_to_ocaml typ_ret) with
+      | (Some (existT _ _ typ_arg), Some (existT _ _ typ_ret)) =>
+        Some (existT _ _ (Lambda_t typ_arg typ_ret None))
+      | _ => None
+      end
+    | map typ_key typ =>
+      match coq_to_ocaml typ with
+      | Some (existT _ _ typ) =>
+        Some (existT _ _ (Map_t (comparable.coq_to_ocaml typ_key) typ None false))
+      | _ => None
+      end
+    | chain_id => Some (existT _ _ (Chain_id_t None))
+    | _ => None
     end.
-  destruct typ; simpl;
-    try reflexivity;
-    (* One recursive call *)
-    try (
-      case_eq (typ_coq_to_ocaml typ); trivial;
-      intros s Heq;
-      set (Heq' := coq_to_ocaml_to_coq_eq typ);
-      rewrite Heq in Heq';
-      destruct s; simpl;
-      now rewrite Heq'
-    );
-    (* two recusive calls *)
-    try (
-      case_eq (typ_coq_to_ocaml typ1); trivial;
-      destruct s as [ty1' typ1'];
-      intro Heq1;
-      set (Heq1' := coq_to_ocaml_to_coq_eq typ1);
-      rewrite Heq1 in Heq1';
-      case_eq (typ_coq_to_ocaml typ2); trivial;
-      destruct s as [ty2' typ2'];
-      intro Heq2;
-      set (Heq2' := coq_to_ocaml_to_coq_eq typ2);
-      rewrite Heq2 in Heq2';
-      now simpl; rewrite Heq1'; rewrite Heq2'
-    ).
-  destruct s; simpl; reflexivity.
-Qed.
+
+  Fixpoint coq_to_ocaml_to_coq_eq (typ : syntax_type.type)
+    : match coq_to_ocaml typ with
+      | Some (existT _ _ typ') => ocaml_to_coq typ' = typ
+      | _ => True
+      end.
+    destruct typ; simpl;
+      try reflexivity;
+      (* One recursive call *)
+      try (
+        case_eq (coq_to_ocaml typ); trivial;
+        intros s Heq;
+        set (Heq' := coq_to_ocaml_to_coq_eq typ);
+        rewrite Heq in Heq';
+        destruct s; simpl;
+        rewrite Heq'; trivial
+      );
+      (* Two recusive calls *)
+      try (
+        case_eq (coq_to_ocaml typ1); trivial;
+        destruct s as [ty1' typ1'];
+        intro Heq1;
+        set (Heq1' := coq_to_ocaml_to_coq_eq typ1);
+        rewrite Heq1 in Heq1';
+        case_eq (coq_to_ocaml typ2); trivial;
+        destruct s as [ty2' typ2'];
+        intro Heq2;
+        set (Heq2' := coq_to_ocaml_to_coq_eq typ2);
+        rewrite Heq2 in Heq2';
+        simpl; rewrite Heq1'; rewrite Heq2'; trivial
+      ).
+    - destruct s; simpl; reflexivity.
+    - now rewrite comparable.coq_to_ocaml_to_coq_eq.
+    - now rewrite comparable.coq_to_ocaml_to_coq_eq.
+  Qed.
+End typ.
-- 
GitLab


From e94f138da30fa592fec9044c3b0c437ae493c06b Mon Sep 17 00:00:00 2001
From: Guillaume Claret <dev@clarus.me>
Date: Mon, 2 Dec 2019 15:54:09 +0100
Subject: [PATCH 06/56] [of_ocaml] Explicit definition of coq_to_ocaml_typ

---
 src/michocoq/of_ocaml/script_typed_ir_ml.v |   3 +-
 src/michocoq/of_ocaml/syntax_type_equiv.v  | 103 +++++++++++++--------
 2 files changed, 67 insertions(+), 39 deletions(-)

diff --git a/src/michocoq/of_ocaml/script_typed_ir_ml.v b/src/michocoq/of_ocaml/script_typed_ir_ml.v
index da9046a7..bb166630 100644
--- a/src/michocoq/of_ocaml/script_typed_ir_ml.v
+++ b/src/michocoq/of_ocaml/script_typed_ir_ml.v
@@ -170,14 +170,13 @@ Record script_skeleton {code arg_type storage storage_type root_name : Type} :=
   root_name : root_name }.
 Arguments script_skeleton : clear implicits.
 
-
 (*Inductive lambda : forall (arg ret : Type), Type :=
 | Lam : forall (arg ret : Type), ('descr (arg * 'end_of_stack) (ret * 'end_of_stack)) ->
 Tezos_raw_protocol_alpha.Alpha_context.Script.node -> lambda arg ret*)
 
 Parameter lambda : forall (arg ret : Type), Type.
 
-Inductive Ty : forall (ty : Type), Type :=
+Polymorphic Inductive Ty : forall (ty : Type), Type :=
 | Unit_t : (option type_annot) -> Ty unit
 | Int_t : (option type_annot) ->
   Ty
diff --git a/src/michocoq/of_ocaml/syntax_type_equiv.v b/src/michocoq/of_ocaml/syntax_type_equiv.v
index 3af34d91..dce46af5 100644
--- a/src/michocoq/of_ocaml/syntax_type_equiv.v
+++ b/src/michocoq/of_ocaml/syntax_type_equiv.v
@@ -146,80 +146,112 @@ Module typ.
     | Chain_id_t _ => chain_id
     end.
 
+  Fixpoint coq_to_ocaml_typ (typ : syntax_type.type) : Type :=
+    match typ with
+    | Comparable_type comparable_typ =>
+      comparable.coq_simple_to_ocaml_typ comparable_typ
+    | key => Tezos_raw_protocol_alpha.Alpha_context.public_key
+    | unit => Datatypes.unit
+    | signature => Tezos_raw_protocol_alpha.Alpha_context.signature
+    | option typ => Datatypes.option (coq_to_ocaml_typ typ)
+    | list typ => Datatypes.list (coq_to_ocaml_typ typ)
+    | set comparable_typ =>
+      script_typed_ir_ml.set (comparable.coq_to_ocaml_typ comparable_typ)
+    | contract typ => typed_contract (coq_to_ocaml_typ typ)
+    | operation => script_typed_ir_ml.operation
+    | pair typ_a typ_b => coq_to_ocaml_typ typ_a * coq_to_ocaml_typ typ_b
+    | or typ_a typ_b => union (coq_to_ocaml_typ typ_a) (coq_to_ocaml_typ typ_b)
+    | lambda typ_arg typ_res =>
+      script_typed_ir_ml.lambda
+        (coq_to_ocaml_typ typ_arg)
+        (coq_to_ocaml_typ typ_res)
+    | map comparable_typ typ =>
+      script_typed_ir_ml.map
+        (comparable.coq_to_ocaml_typ comparable_typ)
+        (coq_to_ocaml_typ typ)
+    | big_map comparable_typ typ =>
+      script_typed_ir_ml.big_map
+        (comparable.coq_to_ocaml_typ comparable_typ)
+        (coq_to_ocaml_typ typ)
+    | chain_id => Tezos_protocol_environment_alpha.Environment.Chain_id.t
+    end.
+
   Fixpoint coq_to_ocaml (typ : syntax_type.type)
-    : Datatypes.option {ty : Type & script_typed_ir_ml.Ty ty} :=
+    : Datatypes.option (script_typed_ir_ml.Ty (coq_to_ocaml_typ typ)) :=
     match typ with
     | Comparable_type comparable_typ =>
       Some (
-        match comparable_typ with
-        | string => existT _ _ (String_t None)
-        | nat => existT _ _ (Nat_t None)
-        | int => existT _ _ (Int_t None)
-        | bytes => existT _ _ (Bytes_t None)
-        | bool => existT _ _ (Bool_t None)
-        | mutez => existT _ _ (Mutez_t None)
-        | address => existT _ _ (Address_t None)
-        | key_hash => existT _ _ (Key_hash_t None)
-        | timestamp => existT _ _ (Timestamp_t None)
+        match comparable_typ return
+          script_typed_ir_ml.Ty (comparable.coq_simple_to_ocaml_typ comparable_typ)
+        with
+        | string => String_t None
+        | nat => Nat_t None
+        | int => Int_t None
+        | bytes => Bytes_t None
+        | bool => Bool_t None
+        | mutez => Mutez_t None
+        | address => Address_t None
+        | key_hash => Key_hash_t None
+        | timestamp => Timestamp_t None
         end
       )
-    | key => Some (existT _ _ (Key_t None))
-    | unit => Some (existT _ _ (Unit_t None))
-    | signature => Some (existT _ _ (Signature_t None))
+    | key => Some (Key_t None)
+    | unit => Some (Unit_t None)
+    | signature => Some (Signature_t None)
     | option typ =>
       match coq_to_ocaml typ with
-      | Some (existT _ _ typ) => Some (existT _ _ (Option_t typ None false))
+      | Some typ => Some (Option_t typ None false)
       | _ => None
       end
     | list typ =>
       match coq_to_ocaml typ with
-      | Some (existT _ _ typ) => Some (existT _ _ (List_t typ None false))
+      | Some typ => Some (List_t typ None false)
       | _ => None
       end
     | set typ_key =>
-      Some (existT _ _ (Set_t (comparable.coq_to_ocaml typ_key) None))
-    | operation => Some (existT _ _ (Operation_t None))
+      Some (Set_t (comparable.coq_to_ocaml typ_key) None)
+    | operation => Some (Operation_t None)
     | pair typ_a typ_b =>
       match (coq_to_ocaml typ_a, coq_to_ocaml typ_b) with
-      | (Some (existT _ _ typ_a), Some (existT _ _ typ_b)) =>
-        Some (existT _ _ (Pair_t
+      | (Some typ_a, Some typ_b) =>
+        Some (Pair_t
           (typ_a, None, None)
           (typ_b, None, None)
           None
           false
-        ))
+        )
       | _ => None
       end
     | or typ_a typ_b =>
       match (coq_to_ocaml typ_a, coq_to_ocaml typ_b) with
-      | (Some (existT _ _ typ_a), Some (existT _ _ typ_b)) =>
-        Some (existT _ _ (Union_t
+      | (Some typ_a, Some typ_b) =>
+        Some (Union_t
           (typ_a, None)
           (typ_b, None)
           None
           false
-        ))
+        )
       | _ => None
       end
     | lambda typ_arg typ_ret =>
       match (coq_to_ocaml typ_arg, coq_to_ocaml typ_ret) with
-      | (Some (existT _ _ typ_arg), Some (existT _ _ typ_ret)) =>
-        Some (existT _ _ (Lambda_t typ_arg typ_ret None))
+      | (Some typ_arg, Some typ_ret) =>
+        Some (Lambda_t typ_arg typ_ret None)
       | _ => None
       end
     | map typ_key typ =>
       match coq_to_ocaml typ with
-      | Some (existT _ _ typ) =>
-        Some (existT _ _ (Map_t (comparable.coq_to_ocaml typ_key) typ None false))
+      | Some typ =>
+        Some (Map_t (comparable.coq_to_ocaml typ_key) typ None false)
       | _ => None
       end
-    | chain_id => Some (existT _ _ (Chain_id_t None))
+    | chain_id => Some (Chain_id_t None)
     | _ => None
     end.
 
   Fixpoint coq_to_ocaml_to_coq_eq (typ : syntax_type.type)
     : match coq_to_ocaml typ with
-      | Some (existT _ _ typ') => ocaml_to_coq typ' = typ
+      | Some typ' => ocaml_to_coq typ' = typ
       | _ => True
       end.
     destruct typ; simpl;
@@ -229,20 +261,17 @@ Module typ.
         case_eq (coq_to_ocaml typ); trivial;
         intros s Heq;
         set (Heq' := coq_to_ocaml_to_coq_eq typ);
-        rewrite Heq in Heq';
-        destruct s; simpl;
+        rewrite Heq in Heq'; simpl;
         rewrite Heq'; trivial
       );
       (* Two recusive calls *)
       try (
         case_eq (coq_to_ocaml typ1); trivial;
-        destruct s as [ty1' typ1'];
-        intro Heq1;
+        intros ty1' Heq1;
+        case_eq (coq_to_ocaml typ2); trivial;
+        intros ty2' Heq2;
         set (Heq1' := coq_to_ocaml_to_coq_eq typ1);
         rewrite Heq1 in Heq1';
-        case_eq (coq_to_ocaml typ2); trivial;
-        destruct s as [ty2' typ2'];
-        intro Heq2;
         set (Heq2' := coq_to_ocaml_to_coq_eq typ2);
         rewrite Heq2 in Heq2';
         simpl; rewrite Heq1'; rewrite Heq2'; trivial
-- 
GitLab


From 41fed528c56dc344de54402365c0d04e4a01392f Mon Sep 17 00:00:00 2001
From: Guillaume Claret <dev@clarus.me>
Date: Tue, 3 Dec 2019 16:35:40 +0100
Subject: [PATCH 07/56] [of_ocaml] Bijection for the comparable types

---
 src/michocoq/of_ocaml/script_typed_ir_ml.v |   3 +
 src/michocoq/of_ocaml/syntax_type_equiv.v  | 394 +++++++++++++++------
 2 files changed, 290 insertions(+), 107 deletions(-)

diff --git a/src/michocoq/of_ocaml/script_typed_ir_ml.v b/src/michocoq/of_ocaml/script_typed_ir_ml.v
index bb166630..dbfda8c9 100644
--- a/src/michocoq/of_ocaml/script_typed_ir_ml.v
+++ b/src/michocoq/of_ocaml/script_typed_ir_ml.v
@@ -33,8 +33,11 @@ Module Tezos_raw_protocol_alpha.
 
     Module Script_int.
       Parameter n : Type.
+      Parameter n_sample : n.
       Parameter num : Type -> Type.
+      Parameter num_make : forall {A : Type}, A -> num A.
       Parameter z : Type.
+      Parameter z_sample : z.
     End Script_int.
 
     Module Script_timestamp.
diff --git a/src/michocoq/of_ocaml/syntax_type_equiv.v b/src/michocoq/of_ocaml/syntax_type_equiv.v
index dce46af5..aaf4a5fa 100644
--- a/src/michocoq/of_ocaml/syntax_type_equiv.v
+++ b/src/michocoq/of_ocaml/syntax_type_equiv.v
@@ -1,34 +1,77 @@
+Require Import Coq.Lists.List.
 Require of_ocaml.script_typed_ir_ml syntax_type.
 
+Import ListNotations.
+
+Module Option.
+  Definition bind {A B : Type}
+    (x : Datatypes.option A) (f : A -> Datatypes.option B)
+    : Datatypes.option B :=
+    match x with
+    | Some x => f x
+    | None => None
+    end.
+
+  (** Notation for the bind with a typed answer. *)
+  Notation "'let?' x : A ':=' X 'in' Y" :=
+    (bind X (fun (x : A) => Y))
+    (at level 200, x pattern, X at level 100, A at level 200, Y at level 200).
+
+  (** Notation for the bind. *)
+  Notation "'let?' x ':=' X 'in' Y" :=
+    (bind X (fun x => Y))
+    (at level 200, x pattern, X at level 100, Y at level 200).
+
+  Definition true_or_None (A : Datatypes.option Prop) : Prop :=
+    match A with
+    | Some A => A
+    | None => True
+    end.
+
+  Lemma true_or_None_case_eq
+    {T : Type} {e1 : Datatypes.option T} {e2 : T -> Prop}
+    (A : true_or_None (let? x := e1 in Some (e2 x)))
+    {x : T}
+    (H : e1 = Some x)
+    : e2 x.
+    rewrite H in A; simpl in A.
+    exact A.
+  Qed.
+End Option.
+
+Import Option.
+
 Module comparable.
   Import script_typed_ir_ml syntax_type.
 
   Definition ocaml_leaf_to_coq {A Kind : Type}
     (comparable : script_typed_ir_ml.comparable_struct A Kind)
-    : syntax_type.simple_comparable_type :=
+    : Datatypes.option syntax_type.simple_comparable_type :=
     match comparable with
-    | Int_key _ => int
-    | Nat_key _ => nat
-    | String_key _ => string
-    | Bytes_key _ => bytes
-    | Mutez_key _ => mutez
-    | Bool_key _ => bool
-    | Key_hash_key _ => key_hash
-    | Timestamp_key _ => timestamp
-    | Address_key _ => address
+    | Int_key _ => Some int
+    | Nat_key _ => Some nat
+    | String_key _ => Some string
+    | Bytes_key _ => Some bytes
+    | Mutez_key _ => Some mutez
+    | Bool_key _ => Some bool
+    | Key_hash_key _ => Some key_hash
+    | Timestamp_key _ => Some timestamp
+    | Address_key _ => Some address
     (* This case should not be used with GADTs *)
-    | Pair_key _ _ _ => bool
+    | Pair_key _ _ _ => None
     end.
 
   Fixpoint ocaml_to_coq {A Kind : Type}
     (comparable : script_typed_ir_ml.comparable_struct A Kind)
-    : syntax_type.comparable_type :=
+    : Datatypes.option syntax_type.comparable_type :=
     match comparable with
     | Pair_key (comparable_a, _) (comparable_b, _) _ =>
-      Cpair
-        (ocaml_leaf_to_coq comparable_a)
-        (ocaml_to_coq comparable_b)
-    | _ => Comparable_type_simple (ocaml_leaf_to_coq comparable)
+      let? comparable_a' := ocaml_leaf_to_coq comparable_a in
+      let? comparable_b' := ocaml_to_coq comparable_b in
+      Some (Cpair comparable_a' comparable_b')
+    | _ =>
+      let? comparable' := ocaml_leaf_to_coq comparable in
+      Some (Comparable_type_simple comparable')
     end.
 
   Definition coq_simple_to_ocaml_typ
@@ -79,12 +122,6 @@ Module comparable.
       coq_simple_to_ocaml_typ comparable_a * coq_to_ocaml_typ comparable_b
     end.
 
-  Definition coq_to_ocaml_kind (comparable : syntax_type.comparable_type) : Type :=
-    match comparable with
-    | Comparable_type_simple _ => leaf
-    | Cpair _ _ => comb
-    end.
-
   Fixpoint coq_to_ocaml (comparable : syntax_type.comparable_type)
     : script_typed_ir_ml.comparable_ty (coq_to_ocaml_typ comparable) :=
     match comparable with
@@ -99,51 +136,170 @@ Module comparable.
 
   Fixpoint coq_simple_to_ocaml_to_coq_eq {Kind : Type}
     (comparable : syntax_type.simple_comparable_type)
-    : ocaml_leaf_to_coq (coq_simple_to_ocaml Kind comparable) = comparable.
+    : ocaml_leaf_to_coq (coq_simple_to_ocaml Kind comparable) = Some comparable.
     destruct comparable; reflexivity.
   Qed.
 
   Fixpoint coq_to_ocaml_to_coq_eq (comparable : syntax_type.comparable_type)
-    : ocaml_to_coq (coq_to_ocaml comparable) = comparable.
+    : ocaml_to_coq (coq_to_ocaml comparable) = Some comparable.
     destruct comparable as [simple | simple comparable]; simpl.
     - destruct simple; reflexivity.
     - rewrite coq_simple_to_ocaml_to_coq_eq.
       rewrite coq_to_ocaml_to_coq_eq.
       reflexivity.
   Qed.
+
+  Definition ocaml_leaf_to_coq_to_ocaml_typ_eq {A : Type}
+    (comparable : comparable_struct A leaf)
+    : true_or_None (
+        let? comparable' := ocaml_leaf_to_coq comparable in
+        Some (coq_simple_to_ocaml_typ comparable' = A)
+      ).
+    destruct comparable; simpl; reflexivity.
+  Qed.
+
+  Fixpoint ocaml_to_coq_to_ocaml_typ_eq {A Kind : Type}
+    (comparable : script_typed_ir_ml.comparable_struct A Kind)
+    : true_or_None (
+        let? comparable' := ocaml_to_coq comparable in
+        Some (coq_to_ocaml_typ comparable' = A)
+      ).
+    destruct comparable; simpl; try reflexivity.
+    destruct p; destruct p0; simpl.
+    case_eq (ocaml_leaf_to_coq c); simpl; trivial.
+    intros s Hs.
+    case_eq (ocaml_to_coq c0); simpl; trivial.
+    intros c1 Hc1.
+    rewrite (true_or_None_case_eq (ocaml_leaf_to_coq_to_ocaml_typ_eq c) Hs).
+    rewrite (true_or_None_case_eq (ocaml_to_coq_to_ocaml_typ_eq _ _ c0) Hc1).
+    reflexivity.
+  Qed.
+
+  Module eq.
+    Import script_typed_ir_ml.
+
+    Inductive t :
+      forall {A B : Type} (Kind_A Kind_B : Type),
+        script_typed_ir_ml.comparable_struct A Kind_A ->
+        script_typed_ir_ml.comparable_struct B Kind_B ->
+        Prop :=
+    | Int :
+      forall Kind_A Kind_B annot_a annot_b,
+      t Kind_A Kind_B (Int_key annot_a) (Int_key annot_b)
+    | Nat :
+      forall Kind_A Kind_B annot_a annot_b,
+      t Kind_A Kind_B (Nat_key annot_a) (Nat_key annot_b)
+    | String_key :
+      forall Kind_A Kind_B annot_a annot_b,
+      t Kind_A Kind_B (String_key annot_a) (String_key annot_b)
+    | Bytes_key :
+      forall Kind_A Kind_B annot_a annot_b,
+      t Kind_A Kind_B (Bytes_key annot_a) (Bytes_key annot_b)
+    | Mutez_key :
+      forall Kind_A Kind_B annot_a annot_b,
+      t Kind_A Kind_B (Mutez_key annot_a) (Mutez_key annot_b)
+    | Bool_key :
+      forall Kind_A Kind_B annot_a annot_b,
+      t Kind_A Kind_B (Bool_key annot_a) (Bool_key annot_b)
+    | Key_hash_key :
+      forall Kind_A Kind_B annot_a annot_b,
+      t Kind_A Kind_B (Key_hash_key annot_a) (Key_hash_key annot_b)
+    | Timestamp_key :
+      forall Kind_A Kind_B annot_a annot_b,
+      t Kind_A Kind_B (Timestamp_key annot_a) (Timestamp_key annot_b)
+    | Address_key :
+      forall Kind_A Kind_B annot_a annot_b,
+      t Kind_A Kind_B (Address_key annot_a) (Address_key annot_b)
+    | Pair :
+      forall {A_A A_B B_A B_B : Type},
+      forall Kind_A Kind_B,
+      forall annot_a_a annot_a_b annot_a annot_b_a annot_b_b annot_b,
+      forall
+        (comparable_a_a : script_typed_ir_ml.comparable_struct A_A leaf)
+        (comparable_a_b : script_typed_ir_ml.comparable_struct A_B Kind_A)
+        (comparable_b_a : script_typed_ir_ml.comparable_struct B_A leaf)
+        (comparable_b_b : script_typed_ir_ml.comparable_struct B_B Kind_B),
+      t leaf leaf comparable_a_a comparable_b_a ->
+      t Kind_A Kind_B comparable_a_b comparable_b_b ->
+      t
+        comb comb
+        (Pair_key (comparable_a_a, annot_a_a) (comparable_a_b, annot_a_b) annot_a)
+        (Pair_key (comparable_b_a, annot_b_a) (comparable_b_b, annot_b_b) annot_b).
+    Arguments t {_ _ _ _} _ _.
+  End eq.
+
+  Definition ocaml_leaf_to_coq_to_ocaml_eq {A Kind : Type}
+    (comparable : script_typed_ir_ml.comparable_struct A Kind)
+    : true_or_None (
+        let? comparable' := ocaml_leaf_to_coq comparable in
+        Some (eq.t (coq_simple_to_ocaml Kind comparable') comparable)
+      ).
+    destruct comparable; simpl; constructor.
+  Qed.
+
+  Fixpoint ocaml_to_coq_to_ocaml_eq {A Kind : Type}
+    (comparable : script_typed_ir_ml.comparable_struct A Kind)
+    : true_or_None (
+        let? comparable' := ocaml_to_coq comparable in
+        Some (eq.t (coq_to_ocaml comparable') comparable)
+      ).
+    destruct comparable; simpl; try constructor.
+    destruct p; destruct p0; simpl.
+    case_eq (ocaml_leaf_to_coq c); simpl; trivial.
+    intros s Hs.
+    case_eq (ocaml_to_coq c0); simpl; trivial.
+    intros c1 Hc1.
+    constructor.
+    - apply (true_or_None_case_eq (ocaml_leaf_to_coq_to_ocaml_eq c) Hs).
+    - apply (true_or_None_case_eq (ocaml_to_coq_to_ocaml_eq _ _ c0) Hc1).
+  Qed.
 End comparable.
 
 Module typ.
   Import script_typed_ir_ml syntax_type.
 
   Fixpoint ocaml_to_coq {ty : Type} (typ : script_typed_ir_ml.Ty ty)
-    : syntax_type.type :=
+    : Datatypes.option syntax_type.type :=
     match typ with
-    | Unit_t _ => unit
-    | Int_t _ => Comparable_type int
-    | Nat_t _ => Comparable_type nat
-    | Signature_t _ => signature
-    | String_t _ => Comparable_type string
-    | Bytes_t _ => Comparable_type bytes
-    | Mutez_t _ => Comparable_type mutez
-    | Key_hash_t _ => Comparable_type key_hash
-    | Key_t _ => key
-    | Timestamp_t _ => Comparable_type timestamp
-    | Address_t _ => Comparable_type address
-    | Bool_t _ => Comparable_type bool
+    | Unit_t _ => Some (unit)
+    | Int_t _ => Some (Comparable_type int)
+    | Nat_t _ => Some (Comparable_type nat)
+    | Signature_t _ => Some (signature)
+    | String_t _ => Some (Comparable_type string)
+    | Bytes_t _ => Some (Comparable_type bytes)
+    | Mutez_t _ => Some (Comparable_type mutez)
+    | Key_hash_t _ => Some (Comparable_type key_hash)
+    | Key_t _ => Some (key)
+    | Timestamp_t _ => Some (Comparable_type timestamp)
+    | Address_t _ => Some (Comparable_type address)
+    | Bool_t _ => Some (Comparable_type bool)
     | Pair_t (typ_a, _, _) (typ_b, _, _) _ _ =>
-      pair (ocaml_to_coq typ_a) (ocaml_to_coq typ_b)
+      let? typ_a' := ocaml_to_coq typ_a in
+      let? typ_b' := ocaml_to_coq typ_b in
+      Some (pair typ_a' typ_b')
     | Union_t (typ_a, _) (typ_b, _) _ _ =>
-      or (ocaml_to_coq typ_a) (ocaml_to_coq typ_b)
+      let? typ_a' := ocaml_to_coq typ_a in
+      let? typ_b' := ocaml_to_coq typ_b in
+      Some (or typ_a' typ_b')
     | Lambda_t typ_arg typ_ret _ =>
-      lambda (ocaml_to_coq typ_arg) (ocaml_to_coq typ_ret)
-    | Option_t typ _ _ => option (ocaml_to_coq typ)
-    | List_t typ _ _ => list (ocaml_to_coq typ)
-    | Set_t typ_key _ => set (comparable.ocaml_to_coq typ_key)
+      let? typ_arg' := ocaml_to_coq typ_arg in
+      let? typ_ret' := ocaml_to_coq typ_ret in
+      Some (lambda typ_arg' typ_ret')
+    | Option_t typ _ _ =>
+      let? typ' := ocaml_to_coq typ in
+      Some (option typ')
+    | List_t typ _ _ =>
+      let? typ' := ocaml_to_coq typ in
+      Some (list typ')
+    | Set_t typ_key _ =>
+      let? typ_key' := comparable.ocaml_to_coq typ_key in
+      Some (set typ_key')
     | Map_t typ_key typ _ _ =>
-      map (comparable.ocaml_to_coq typ_key) (ocaml_to_coq typ)
-    | Operation_t _ => operation
-    | Chain_id_t _ => chain_id
+      let? typ_key' := comparable.ocaml_to_coq typ_key in
+      let? typ' := ocaml_to_coq typ in
+      Some (map typ_key' typ')
+    | Operation_t _ => Some operation
+    | Chain_id_t _ => Some chain_id
     end.
 
   Fixpoint coq_to_ocaml_typ (typ : syntax_type.type) : Type :=
@@ -176,6 +332,16 @@ Module typ.
     | chain_id => Tezos_protocol_environment_alpha.Environment.Chain_id.t
     end.
 
+  Fixpoint coq_comparable_to_ocaml_typ_eq
+    (comparable : syntax_type.comparable_type)
+    : comparable.coq_to_ocaml_typ comparable =
+      coq_to_ocaml_typ (syntax_type.comparable_type_to_type comparable).
+    destruct comparable; simpl.
+    - reflexivity.
+    - rewrite coq_comparable_to_ocaml_typ_eq.
+      reflexivity.
+  Qed.
+
   Fixpoint coq_to_ocaml (typ : syntax_type.type)
     : Datatypes.option (script_typed_ir_ml.Ty (coq_to_ocaml_typ typ)) :=
     match typ with
@@ -199,85 +365,99 @@ Module typ.
     | unit => Some (Unit_t None)
     | signature => Some (Signature_t None)
     | option typ =>
-      match coq_to_ocaml typ with
-      | Some typ => Some (Option_t typ None false)
-      | _ => None
-      end
+      let? typ' := coq_to_ocaml typ in
+      Some (Option_t typ' None false)
     | list typ =>
-      match coq_to_ocaml typ with
-      | Some typ => Some (List_t typ None false)
-      | _ => None
-      end
+      let? typ' := coq_to_ocaml typ in
+      Some (List_t typ' None false)
     | set typ_key =>
-      Some (Set_t (comparable.coq_to_ocaml typ_key) None)
+      let typ_key' := comparable.coq_to_ocaml typ_key in
+      Some (Set_t typ_key' None)
     | operation => Some (Operation_t None)
     | pair typ_a typ_b =>
-      match (coq_to_ocaml typ_a, coq_to_ocaml typ_b) with
-      | (Some typ_a, Some typ_b) =>
-        Some (Pair_t
-          (typ_a, None, None)
-          (typ_b, None, None)
-          None
-          false
-        )
-      | _ => None
-      end
+      let? typ_a' := coq_to_ocaml typ_a in
+      let? typ_b' := coq_to_ocaml typ_b in
+      Some (Pair_t
+        (typ_a', None, None)
+        (typ_b', None, None)
+        None
+        false
+      )
     | or typ_a typ_b =>
-      match (coq_to_ocaml typ_a, coq_to_ocaml typ_b) with
-      | (Some typ_a, Some typ_b) =>
-        Some (Union_t
-          (typ_a, None)
-          (typ_b, None)
-          None
-          false
-        )
-      | _ => None
-      end
+      let? typ_a' := coq_to_ocaml typ_a in
+      let? typ_b' := coq_to_ocaml typ_b in
+      Some (Union_t
+        (typ_a', None)
+        (typ_b', None)
+        None
+        false
+      )
     | lambda typ_arg typ_ret =>
-      match (coq_to_ocaml typ_arg, coq_to_ocaml typ_ret) with
-      | (Some typ_arg, Some typ_ret) =>
-        Some (Lambda_t typ_arg typ_ret None)
-      | _ => None
-      end
+      let? typ_arg' := coq_to_ocaml typ_arg in
+      let? typ_ret' := coq_to_ocaml typ_ret in
+      Some (Lambda_t typ_arg' typ_ret' None)
     | map typ_key typ =>
-      match coq_to_ocaml typ with
-      | Some typ =>
-        Some (Map_t (comparable.coq_to_ocaml typ_key) typ None false)
-      | _ => None
-      end
+      let typ_key' := comparable.coq_to_ocaml typ_key in
+      let? typ' := coq_to_ocaml typ in
+      Some (Map_t typ_key' typ' None false)
     | chain_id => Some (Chain_id_t None)
     | _ => None
     end.
 
+  Ltac case_eq_rewrite_in_H e e' He H:=
+    case_eq e; simpl; trivial;
+    intros e' He;
+    rewrite He in H; simpl in H;
+    clear He.
+
   Fixpoint coq_to_ocaml_to_coq_eq (typ : syntax_type.type)
-    : match coq_to_ocaml typ with
-      | Some typ' => ocaml_to_coq typ' = typ
-      | _ => True
-      end.
+    : true_or_None (
+        let? typ' := coq_to_ocaml typ in
+        let? typ'' := ocaml_to_coq typ' in
+        Some (typ'' = typ)
+      ).
     destruct typ; simpl;
       try reflexivity;
-      (* One recursive call *)
+      (* one recursive case *)
       try (
-        case_eq (coq_to_ocaml typ); trivial;
-        intros s Heq;
-        set (Heq' := coq_to_ocaml_to_coq_eq typ);
-        rewrite Heq in Heq'; simpl;
-        rewrite Heq'; trivial
+        assert (H_ind := coq_to_ocaml_to_coq_eq typ);
+        case_eq_rewrite_in_H (coq_to_ocaml typ) typ' Htyp H_ind;
+        case_eq_rewrite_in_H (ocaml_to_coq typ') typ'' Htyp' H_ind;
+        congruence
       );
-      (* Two recusive calls *)
+      (* two recursive cases *)
       try (
-        case_eq (coq_to_ocaml typ1); trivial;
-        intros ty1' Heq1;
-        case_eq (coq_to_ocaml typ2); trivial;
-        intros ty2' Heq2;
-        set (Heq1' := coq_to_ocaml_to_coq_eq typ1);
-        rewrite Heq1 in Heq1';
-        set (Heq2' := coq_to_ocaml_to_coq_eq typ2);
-        rewrite Heq2 in Heq2';
-        simpl; rewrite Heq1'; rewrite Heq2'; trivial
+        assert (H_ind_typ1 := coq_to_ocaml_to_coq_eq typ1);
+        assert (H_ind_typ2 := coq_to_ocaml_to_coq_eq typ2);
+        case_eq_rewrite_in_H (coq_to_ocaml typ1) typ1' Htyp1 H_ind_typ1;
+        case_eq_rewrite_in_H (coq_to_ocaml typ2) typ2' Htyp2 H_ind_typ2;
+        case_eq_rewrite_in_H (ocaml_to_coq typ1') typ1'' Htyp1' H_ind_typ1;
+        case_eq_rewrite_in_H (ocaml_to_coq typ2') typ2'' Htyp2' H_ind_typ2;
+        congruence
       ).
     - destruct s; simpl; reflexivity.
-    - now rewrite comparable.coq_to_ocaml_to_coq_eq.
-    - now rewrite comparable.coq_to_ocaml_to_coq_eq.
+    - rewrite comparable.coq_to_ocaml_to_coq_eq; simpl.
+      reflexivity.
+    - assert (H_ind_typ := coq_to_ocaml_to_coq_eq typ).
+      case_eq_rewrite_in_H (coq_to_ocaml typ) typ' Htyp H_ind_typ.
+      rewrite comparable.coq_to_ocaml_to_coq_eq; simpl.
+      case_eq_rewrite_in_H (ocaml_to_coq typ') typ'' Htyp' H_ind_typ.
+      congruence.
   Qed.
+
+  Fixpoint coq_to_ocaml_typs (typs : Datatypes.list syntax_type.type) : Type :=
+    match typs with
+    | [] => Datatypes.unit
+    | typ :: typs => coq_to_ocaml_typ typ * coq_to_ocaml_typs typs
+    end.
+
+  Fixpoint coq_to_ocamls (typs : Datatypes.list syntax_type.type)
+    : Datatypes.option (script_typed_ir_ml.stack_ty (coq_to_ocaml_typs typs)) :=
+    match typs with
+    | [] => Some Empty_t
+    | typ :: typs =>
+      let? typ' := coq_to_ocaml typ in
+      let? typs' := coq_to_ocamls typs in
+      Some (Item_t typ' typs' None)
+    end.
 End typ.
-- 
GitLab


From a35ea8cab65a69910f127864d7550e9dbd96800a Mon Sep 17 00:00:00 2001
From: Guillaume Claret <dev@clarus.me>
Date: Fri, 6 Dec 2019 19:04:18 +0100
Subject: [PATCH 08/56] [of_ocaml] Beginning of injection of the syntax of
 Mi-Cho-Coq to OCaml

---
 src/michocoq/of_ocaml/script_typed_ir_ml.v |   8 +
 src/michocoq/of_ocaml/syntax_equiv.v       | 249 +++++++++++++++++++++
 src/michocoq/of_ocaml/syntax_type_equiv.v  |  14 ++
 3 files changed, 271 insertions(+)
 create mode 100644 src/michocoq/of_ocaml/syntax_equiv.v

diff --git a/src/michocoq/of_ocaml/script_typed_ir_ml.v b/src/michocoq/of_ocaml/script_typed_ir_ml.v
index dbfda8c9..712fad35 100644
--- a/src/michocoq/of_ocaml/script_typed_ir_ml.v
+++ b/src/michocoq/of_ocaml/script_typed_ir_ml.v
@@ -1,3 +1,11 @@
+(** File imported from the Tezos protocol Babylon in the file
+  ` proto_alpha/lib_protocol/script_typed_ir.ml`. We did the following changes:
+  * add dependencies as axioms at the beginning of the file;
+  * comment what is not supported:
+    * cases generating positivity checking errors;
+    * set and map first-class modules.
+    In particular we do not support instructions related to lambdas.
+*)
 Require Import Coq.Strings.String.
 Require Import ZArith.
 
diff --git a/src/michocoq/of_ocaml/syntax_equiv.v b/src/michocoq/of_ocaml/syntax_equiv.v
new file mode 100644
index 00000000..769a1e6e
--- /dev/null
+++ b/src/michocoq/of_ocaml/syntax_equiv.v
@@ -0,0 +1,249 @@
+(** Comparison of the OCaml and MiChoCoq syntax. *)
+Require of_ocaml.script_typed_ir_ml.
+Require of_ocaml.syntax_type_equiv.
+Require syntax.
+Require syntax_type.
+
+Import of_ocaml.syntax_type_equiv.Option.
+Import syntax syntax_type of_ocaml.script_typed_ir_ml.
+
+Parameter default_location
+  : Tezos_raw_protocol_alpha.Alpha_context.Script.location.
+
+Definition comparable_coq_to_ocaml
+  (comparable : syntax_type.comparable_type)
+  : script_typed_ir_ml.comparable_ty
+    (syntax_type_equiv.typ.coq_to_ocaml_typ
+      (comparable_type_to_type comparable)
+    ).
+  rewrite <- syntax_type_equiv.typ.coq_comparable_to_ocaml_typ_eq.
+  apply syntax_type_equiv.comparable.coq_to_ocaml.
+Defined.
+
+(** We define a partial injection from the MiChoCoq syntax to the OCaml AST. *)
+Definition to_coq_concrete_data
+  {type : syntax_type.type}
+  (concrete_data : syntax.concrete_data type)
+  : Datatypes.option (of_ocaml.syntax_type_equiv.typ.coq_to_ocaml_typ type) :=
+  match concrete_data with
+  | Int_constant _ =>
+    Some (
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num_make
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.z_sample
+    )
+  | Nat_constant _ =>
+    Some (
+      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num_make
+        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n_sample
+    )
+  | _ => None
+  end.
+
+Fixpoint of_coq
+  {self_type : Datatypes.option syntax_type.type}
+  {tail_fail_flag : Datatypes.bool}
+  {A B : Datatypes.list syntax_type.type}
+  (instruction : syntax.instruction self_type tail_fail_flag A B)
+  : Datatypes.option (
+    of_ocaml.script_typed_ir_ml.instr
+      (of_ocaml.syntax_type_equiv.typ.coq_to_ocaml_typs A)
+      (of_ocaml.syntax_type_equiv.typ.coq_to_ocaml_typs B)
+    ) :=
+  match instruction with
+  | NOOP => Some Nop
+  | @FAILWITH _ _ _ a =>
+    let? ty_a := of_ocaml.syntax_type_equiv.typ.coq_to_ocaml a in
+    Some (Failwith ty_a)
+  | @SEQ _ A B C _ instruction_a instruction_b =>
+    let? bef := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls A in
+    let? trans := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls B in
+    let? aft := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls C in
+    let? instruction_a' := of_coq instruction_a in
+    let? instruction_b' := of_coq instruction_b in
+    Some (Seq
+      {|
+        loc := default_location;
+        bef := bef;
+        aft := trans;
+        instr_ := instruction_a';
+      |}
+      {|
+        loc := default_location;
+        bef := trans;
+        aft := aft;
+        instr_ := instruction_b';
+      |}
+    )
+  | @IF_ _ A B _ _ instruction_a instruction_b =>
+    let? bef := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls A in
+    let? aft := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls B in
+    let? instruction_a' := of_coq instruction_a in
+    let? instruction_b' := of_coq instruction_b in
+    Some (If
+      {|
+        loc := default_location;
+        bef := bef;
+        aft := aft;
+        instr_ := instruction_a';
+      |}
+      {|
+        loc := default_location;
+        bef := bef;
+        aft := aft;
+        instr_ := instruction_a';
+      |}
+    )
+  | @LOOP _ A instruction =>
+    let? rest := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls A in
+    let? instruction' := of_coq instruction in
+    Some (Loop
+      {|
+        loc := default_location;
+        bef := rest;
+        aft := Item_t (Bool_t None) rest None;
+        instr_ := instruction';
+      |}
+    )
+  | @LOOP_LEFT _ a b A instruction =>
+    let? bef := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls (a :: A) in
+    let? aft := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls (or a b :: A) in
+    let? instruction' := of_coq instruction in
+    Some (Loop_left
+      {|
+        loc := default_location;
+        bef := bef;
+        aft := aft;
+        instr_ := instruction';
+      |}
+    )
+  | EXEC => None
+  | APPLY => None
+  | DUP => Some Dup
+  | SWAP => Some Swap
+  | PUSH _ x =>
+    let? x' := to_coq_concrete_data x in
+    Some (Const x')
+  (** FIXME: the `UNIT` instruction is not in the OCaml AST. It should be
+      added rather than removed during type-checking.
+  *)
+  | UNIT => None
+  | LAMBDA _ _ _ => None
+  | EQ => Some Eq
+  | NEQ => Some Neq
+  | LT => Some Lt
+  | GT => Some Gt
+  | LE => Some Le
+  | GE => Some Ge
+  | @OR _ _ s _ =>
+    let 'syntax.Mk_bitwise _ variant := s in
+    match variant with
+    | syntax.Bitwise_variant_bool => Some Or
+    | syntax.Bitwise_variant_nat => Some Or_nat
+    end
+  | @AND _ _ s _ =>
+    let 'syntax.Mk_bitwise _ variant := s in
+    match variant with
+    | syntax.Bitwise_variant_bool => Some And
+    | syntax.Bitwise_variant_nat => Some And_nat
+    end
+  | @XOR _ _ s _ =>
+    let 'syntax.Mk_bitwise _ variant := s in
+    match variant with
+    | syntax.Bitwise_variant_bool => Some Xor
+    | syntax.Bitwise_variant_nat => Some Xor_nat
+    end
+  | @NOT _ _ s _ =>
+    let 'syntax.Mk_not _ _ variant := s in
+    match variant with
+    | syntax.Not_variant_bool => Some Not
+    | syntax.Not_variant_nat => Some Not_nat
+    | syntax.Not_variant_int => Some Not_int
+    end
+  | @NEG _ _ s _ =>
+    let 'syntax.Mk_neg _ variant := s in
+    match variant with
+    | syntax.Neg_variant_nat => Some Neg_nat
+    | syntax.Neg_variant_int => Some Neg_int
+    end
+  | ABS => Some Abs_int
+  | ISNAT => Some Is_nat
+  | INT => Some Int_nat
+  | @ADD _ _ _ s _ =>
+    let 'syntax.Mk_add _ _ _ variant := s in
+    match variant with
+    | syntax.Add_variant_nat_nat => Some Add_natnat
+    | syntax.Add_variant_nat_int => Some Add_natint
+    | syntax.Add_variant_int_nat => Some Add_intnat
+    | syntax.Add_variant_int_int => Some Add_intint
+    | syntax.Add_variant_timestamp_int => Some Add_timestamp_to_seconds
+    | syntax.Add_variant_int_timestamp => Some Add_seconds_to_timestamp
+    | syntax.Add_variant_tez_tez => Some Add_tez
+    end
+  | @SUB _ _ _ s _ =>
+    let 'syntax.Mk_sub _ _ _ variant := s in
+    match variant with
+    | syntax.Sub_variant_nat_nat => Some Sub_int
+    | syntax.Sub_variant_nat_int => Some Sub_int
+    | syntax.Sub_variant_int_nat => Some Sub_int
+    | syntax.Sub_variant_int_int => Some Sub_int
+    | syntax.Sub_variant_timestamp_int => Some Sub_timestamp_seconds
+    | syntax.Sub_variant_timestamp_timestamp => Some Diff_timestamps
+    | syntax.Sub_variant_tez_tez => Some Sub_tez
+    end
+  | @MUL _ _ _ s _ =>
+    let 'syntax.Mk_mul _ _ _ variant := s in
+    match variant with
+    | syntax.Mul_variant_nat_nat => Some Mul_natnat
+    | syntax.Mul_variant_nat_int => Some Mul_natint
+    | syntax.Mul_variant_int_nat => Some Mul_intnat
+    | syntax.Mul_variant_int_int => Some Mul_intint
+    | syntax.Mul_variant_tez_nat => Some Mul_teznat
+    | syntax.Mul_variant_nat_tez => Some Mul_nattez
+    end
+  | @EDIV _ _ _ s _ =>
+    let 'syntax.Mk_ediv _ _ _ _ variant := s in
+    match variant with
+    | syntax.Ediv_variant_nat_nat => Some Ediv_natnat
+    | syntax.Ediv_variant_nat_int => Some Ediv_natint
+    | syntax.Ediv_variant_int_nat => Some Ediv_intnat
+    | syntax.Ediv_variant_int_int => Some Ediv_intint
+    | syntax.Ediv_variant_tez_nat => Some Ediv_teznat
+    | syntax.Ediv_variant_tez_tez => Some Ediv_tez
+    end
+  | LSL => Some Lsl_nat
+  | LSR => Some Lsr_nat
+  | @COMPARE _ a _ => Some (Compare (comparable_coq_to_ocaml a))
+  | @CONCAT _ _ i _ =>
+    let 'syntax.Mk_stringlike _ variant := i in
+    match variant with
+    | syntax.Stringlike_variant_string => Some Concat_string_pair
+    | syntax.Stringlike_variant_bytes => Some Concat_bytes_pair
+    end
+  | @CONCAT_list _ _ i _ =>
+    let 'syntax.Mk_stringlike _ variant := i in
+    match variant with
+    | syntax.Stringlike_variant_string => Some Concat_string
+    | syntax.Stringlike_variant_bytes => Some Concat_bytes
+    end
+  | @SIZE _ _ i _ =>
+    let 'syntax.Mk_size _ variant := i in
+    match variant with
+    | syntax.Size_variant_set _ => Some Set_size
+    | syntax.Size_variant_map _ _ => Some Map_size
+    | syntax.Size_variant_list _ => Some List_size
+    | syntax.Size_variant_string => Some String_size
+    | syntax.Size_variant_bytes => Some Bytes_size
+    end
+  | @SLICE _ _ i _ =>
+    let 'syntax.Mk_stringlike _ variant := i in
+    match variant with
+    | syntax.Stringlike_variant_string => Some Slice_string
+    | syntax.Stringlike_variant_bytes => Some Slice_bytes
+    end
+  | PAIR => Some Cons_pair
+  | CAR => Some Car
+  | CDR => Some Cdr
+  | EMPTY_SET elt =>
+    Some (Empty_set (syntax_type_equiv.comparable.coq_to_ocaml elt))
+  | _ => None
+  end.
diff --git a/src/michocoq/of_ocaml/syntax_type_equiv.v b/src/michocoq/of_ocaml/syntax_type_equiv.v
index aaf4a5fa..fc1e345c 100644
--- a/src/michocoq/of_ocaml/syntax_type_equiv.v
+++ b/src/michocoq/of_ocaml/syntax_type_equiv.v
@@ -1,8 +1,10 @@
+(** Comparison of the OCaml and MiChoCoq types. *)
 Require Import Coq.Lists.List.
 Require of_ocaml.script_typed_ir_ml syntax_type.
 
 Import ListNotations.
 
+(** Utilities and notations to manipulate the option type. *)
 Module Option.
   Definition bind {A B : Type}
     (x : Datatypes.option A) (f : A -> Datatypes.option B)
@@ -41,6 +43,14 @@ End Option.
 
 Import Option.
 
+(** Bijection between OCaml and MiChoCoq comparable types. This bijection is
+    not a true bijection for the following reasons:
+    * some cases from OCaml are not imported by coq-of-ocaml;
+    * most of the annotations are missing in MiChoCoq;
+    * we define the equality on OCaml terms with an inductive, as this equality
+      is heterogeneous and we did not achieve to use the heterogeneous equality
+      of the Coq standard library with success.
+*)
 Module comparable.
   Import script_typed_ir_ml syntax_type.
 
@@ -255,6 +265,10 @@ Module comparable.
   Qed.
 End comparable.
 
+(** Injection from MiChoCoq types to OCaml types. We should be able to show that
+    this injection is actually a bijection. This bijection would be partial, for
+    the same reasons as for the comparable types.
+*)
 Module typ.
   Import script_typed_ir_ml syntax_type.
 
-- 
GitLab


From 94071da950da90b3cbd8cb1573aceba17771cb12 Mon Sep 17 00:00:00 2001
From: Guillaume Claret <dev@clarus.me>
Date: Fri, 6 Dec 2019 19:59:32 +0100
Subject: [PATCH 09/56] [of_ocaml] Add a README for the of_ocaml folder

---
 src/michocoq/of_ocaml/README.org | 12 ++++++++++++
 1 file changed, 12 insertions(+)
 create mode 100644 src/michocoq/of_ocaml/README.org

diff --git a/src/michocoq/of_ocaml/README.org b/src/michocoq/of_ocaml/README.org
new file mode 100644
index 00000000..f88d0e60
--- /dev/null
+++ b/src/michocoq/of_ocaml/README.org
@@ -0,0 +1,12 @@
+#+Title: Comparison to the Tezos implementation
+
+This folder contains proofs comparing the Mi-Cho-Coq formalization to the Tezos
+implementation. We use [[https://github.com/clarus/coq-of-ocaml][coq-of-ocaml]]
+to convert large chunks of the Tezos OCaml code to Coq. We amend this imported
+code by hand and then make some proofs.
+
+* What do we compare
+
+- comparable types (bijection);
+- types (injection);
+- syntax (partial injection).
-- 
GitLab


From c578ebadaf8c3d3c737d6edb8aadf69ef71651b7 Mon Sep 17 00:00:00 2001
From: Guillaume Claret <dev@clarus.me>
Date: Thu, 27 Feb 2020 18:45:18 +0100
Subject: [PATCH 10/56] [build] Add support for Coq 8.11

---
 .gitignore          | 3 +++
 .gitlab-ci.yml      | 3 +++
 coq-mi-cho-coq.opam | 6 +-----
 3 files changed, 7 insertions(+), 5 deletions(-)

diff --git a/.gitignore b/.gitignore
index 9d8d63c3..07a45784 100644
--- a/.gitignore
+++ b/.gitignore
@@ -6,10 +6,13 @@
 *.aux
 *.glob
 *.vo
+*.vok
+*.vos
 *.lia.cache
 # Generated by configure and coq_makefile
 _CoqProject
 Makefile
+.Makefile.d
 .coqdeps.d
 
 # OCaml
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index b5bbdd4f..aeb80f59 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -26,3 +26,6 @@ coq:8.9:
 
 coq:8.10:
   extends: .build
+
+coq:8.11:
+  extends: .build
diff --git a/coq-mi-cho-coq.opam b/coq-mi-cho-coq.opam
index 265b4ee3..93005091 100644
--- a/coq-mi-cho-coq.opam
+++ b/coq-mi-cho-coq.opam
@@ -18,16 +18,12 @@ install: [
   make "install"
 ]
 depends: [
-  "ocamlbuild"
   "coq-menhirlib" {>= "20190626"}
   "coq-ott" {>= "0.29"}
   "coq" {>= "8.8"}
-  "coq-ott"
-  "ott"
   "menhir"
-  "coq-menhirlib" {>= "20190626"}
-  "zarith"
   "ocaml" {>= "4.07.1"}
+  "ocamlbuild"
   "ott" {build & >= "0.29"}
   "zarith"
 ]
-- 
GitLab


From 1c4fb621ea004d3cba62cf50f6f7d7837b37a6fa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Tue, 16 Jul 2019 10:57:17 +0200
Subject: [PATCH 11/56] [Michocoq] Formalize %-annotations and entrypoints

Annotations are still ignored at lexing time but the semantically
meaningful ones are supported in the untyped syntax.
---
 src/contracts_coq/boomerang.v             |  67 +++++-------
 src/contracts_coq/deposit.v               |  29 ++++--
 src/contracts_coq/generic_multisig.v      |  61 ++++++-----
 src/contracts_coq/manager.v               |   8 +-
 src/contracts_coq/multisig.v              |  41 ++++----
 src/contracts_coq/return_to_sender.v      |  67 +++++-------
 src/contracts_coq/vote.v                  |   6 +-
 src/michocoq/macros.v                     |   8 +-
 src/michocoq/main.v                       |   7 +-
 src/michocoq/micheline2michelson.v        |  10 +-
 src/michocoq/michelson2micheline.v        |  31 ++++--
 src/michocoq/of_ocaml/syntax_equiv.v      |   6 +-
 src/michocoq/of_ocaml/syntax_type_equiv.v |  19 +++-
 src/michocoq/semantics.v                  |  62 ++++++-----
 src/michocoq/syntax.v                     | 120 +++++++++++++++++-----
 src/michocoq/syntax_type.v                |  44 +++++---
 src/michocoq/typer.v                      |  33 +++---
 src/michocoq/untyped_syntax.v             |   6 +-
 src/michocoq/untyper.v                    |  42 +++++---
 src/michocoq/util.v                       |  16 +++
 20 files changed, 410 insertions(+), 273 deletions(-)

diff --git a/src/contracts_coq/boomerang.v b/src/contracts_coq/boomerang.v
index 89cc9bea..753e054c 100644
--- a/src/contracts_coq/boomerang.v
+++ b/src/contracts_coq/boomerang.v
@@ -34,7 +34,7 @@ Definition storage_ty := unit.
 Module boomerang(C:ContractContext).
 Module semantics := Semantics C. Import semantics.
 
-Definition boomerang : full_contract _ parameter_ty storage_ty :=
+Definition boomerang : full_contract _ parameter_ty None storage_ty :=
   (
     CDR ;;
     NIL operation ;;
@@ -43,7 +43,7 @@ Definition boomerang : full_contract _ parameter_ty storage_ty :=
        IFCMPEQ NOOP
          (
            SOURCE ;;
-           CONTRACT unit ;;
+           CONTRACT None unit ;;
            ASSERT_SOME ;;
            AMOUNT ;;
            UNIT ;;
@@ -82,7 +82,7 @@ Lemma boomerang_correct :
   <->
   (amount env = (0 ~Mutez) /\ ops = nil) \/
   (amount env <> (0 ~Mutez) /\
-    exists ctr, contract_ env unit (source env) = Some ctr /\
+    exists ctr, contract_ env None unit (source env) = Some ctr /\
            ops = ((transfer_tokens env unit tt (amount env) ctr) :: nil)%list).
 Proof.
   intros env ops fuel Hfuel.
@@ -90,43 +90,30 @@ Proof.
   unfold eval.
   rewrite eval_precond_correct.
   unfold ">=" in Hfuel.
-  do 8 (more_fuel ; simpl).
-  fold (simple_compare mutez).
-  fold (compare mutez).
-  case_eq ((comparison_to_int (compare mutez (0 ~Mutez) (amount env)) =? 0)%Z).
-  - (* true *)
-    intro Heq.
-    rewrite eqb_eq in Heq.
-    do 1 (more_fuel ; simpl).
-    split.
-    + intro Hops.
-      injection Hops.
-      intro; subst ops.
-      intuition.
-    + intros [(Hl, Hops)|(Hr, _)].
-      * simpl.
-        subst; reflexivity.
-      * symmetry in Heq.
-        contradiction.
-  - intro Hneq.
-    rewrite eqb_neq in Hneq.
-    do 7 (more_fuel ; simpl).
-    destruct (contract_ env unit (source env)).
-    + (* Some *)
-      split.
-      * intro H ; right; split.
-        -- congruence.
-        -- eexists ; intuition ; injection H.
-           symmetry; assumption.
-      * intros [(Habs, _)| (_, (ctr, (He, Hops)))].
-        -- congruence.
-        -- injection He; intro; subst d; subst ops; reflexivity.
-    + (* None *)
-      simpl. split.
-      * intro H; inversion H.
-      * intros [(Habs, _)|(ctr, (He, (Hops, _)))].
-        -- congruence.
-        -- discriminate.
+  repeat (more_fuel ; simpl).
+  rewrite destruct_if.
+  apply or_both; apply and_both_0.
+  - rewrite (eqb_eq mutez).
+    intuition.
+  - intuition congruence.
+  - rewrite bool_not_false.
+    rewrite (eqb_eq mutez).
+    intuition.
+  - pose (c := contract_ env None unit (source env)).
+    pose (transfer := transfer_tokens env unit tt (amount env)).
+    change (match c with Some b => ((transfer b :: nil)%list, tt, tt) = (ops, tt, tt) | None => False end <-> (exists ctr, c = Some ctr /\ ops = (transfer ctr :: nil)%list)).
+    destruct c.
+    + split.
+      * intro H.
+        exists d.
+        intuition congruence.
+      * intros (c, (Hc, Hops)).
+        injection Hc; clear Hc.
+        intro; subst.
+        reflexivity.
+    + split; [contradiction|].
+      intros (c, (Habs, _)).
+      discriminate.
 Qed.
 
 End boomerang.
diff --git a/src/contracts_coq/deposit.v b/src/contracts_coq/deposit.v
index ddec81a9..a32cbcfb 100644
--- a/src/contracts_coq/deposit.v
+++ b/src/contracts_coq/deposit.v
@@ -29,27 +29,27 @@ Import error.
 Require List.
 
 
-Definition parameter_ty := (or unit mutez).
+Definition parameter_ty := (or unit None mutez None).
 Definition storage_ty := address.
 
 Module deposit(C:ContractContext).
 
 Module semantics := Semantics C. Import semantics.
 
-Definition deposit : full_contract _ parameter_ty storage_ty :=
+Definition deposit : full_contract _ parameter_ty None storage_ty :=
   ( DUP;; CAR;; DIP1 CDR;;
     IF_LEFT
       ( DROP1;; NIL operation )
       ( DIP1 ( DUP;;
                DUP;; SENDER;; COMPARE;; EQ;; IF NOOP FAILWITH;;
-               CONTRACT unit;; IF_NONE FAILWITH NOOP);;
+               CONTRACT None unit;; IF_NONE FAILWITH NOOP);;
         PUSH unit Unit;; TRANSFER_TOKENS;;
         NIL operation;; SWAP;; CONS);;
     PAIR ).
 
 Lemma deposit_correct :
-  forall (env : @proto_env (Some parameter_ty))
-         (input : data (or unit mutez)) storage_in
+  forall (env : @proto_env (Some (parameter_ty, None)))
+         (input : data (or unit None mutez None)) storage_in
          (ops : data (list operation)) storage_out
          (fuel : Datatypes.nat),
   fuel >= 42 ->
@@ -60,7 +60,7 @@ Lemma deposit_correct :
    | inl tt => ops = nil
    | inr am => (storage_in = sender env /\
                 exists c : data (contract unit),
-                  contract_ env unit storage_in = Some c /\
+                  contract_ env None unit storage_in = Some c /\
                   ops = cons (transfer_tokens env unit tt am c) nil)
    end).
 Proof.
@@ -76,7 +76,15 @@ Proof.
   - do 11 (more_fuel ; simpl).
     rewrite if_false_is_and.
     rewrite (eqb_eq address).
-    destruct (contract_ env unit storage_in).
+    remember (contract_ env None unit storage_in) as d.
+    match goal with
+      |- (_ /\ match ?x with | Some b => _ | None => _ end <-> _) =>
+      remember x as d2
+    end.
+    assert (d = d2) as Hdd2 by (subst; reflexivity).
+    rewrite <- Hdd2.
+    subst d2; clear Hdd2.
+    destruct d.
     + split.
       * intros (Hsend, Hops).
         subst storage_in.
@@ -84,7 +92,12 @@ Proof.
         do 2 (split; [reflexivity|]).
         exists d; split; reflexivity.
       * intros (Hstorage, (Hsend, (c, (Hcd, Hops)))).
-        intuition congruence.
+        split; [symmetry; assumption|].
+        subst ops.
+        f_equal.
+        injection Hcd.
+        intro; subst.
+        reflexivity.
     + split.
       * intuition.
       * intros (_, (_, (c, (Habs, _)))).
diff --git a/src/contracts_coq/generic_multisig.v b/src/contracts_coq/generic_multisig.v
index 544e1069..25b2a35f 100644
--- a/src/contracts_coq/generic_multisig.v
+++ b/src/contracts_coq/generic_multisig.v
@@ -29,14 +29,22 @@ Require Import Lia.
 Import error.
 Require List.
 
+Module annots.
+  Import String.
+  Definition main : string := "%main".
+  Definition operation : string := "%operation".
+  Definition change_keys : string := "%change_keys".
+End annots.
+
 Definition parameter_ty :=
-  (or unit
+  (or unit (Some default_entrypoint.default)
       (pair
          (pair nat
                (or
-                  (lambda unit (list operation))
-                  (pair nat (list key))))
-         (list (option signature)))).
+                  (lambda unit (list operation)) (Some annots.operation)
+                  (pair nat (list key)) (Some annots.change_keys)))
+         (list (option signature)))
+  (Some annots.main)).
 
 Module generic_multisig(C:ContractContext).
 
@@ -44,9 +52,9 @@ Definition storage_ty := pair nat (pair nat (list key)).
 
 Module semantics := Semantics C. Import semantics.
 
-Definition ADD_nat {S} : instruction (Some parameter_ty) _ (nat ::: nat ::: S) (nat ::: S) := ADD.
+Definition ADD_nat {S} : instruction (Some (parameter_ty, None)) _ (nat ::: nat ::: S) (nat ::: S) := ADD.
 
-Definition multisig : full_contract _ parameter_ty storage_ty :=
+Definition multisig : full_contract _ parameter_ty None storage_ty :=
   (
     UNPAIR ;;
     IF_LEFT
@@ -56,7 +64,9 @@ Definition multisig : full_contract _ parameter_ty storage_ty :=
         DIP1
           (
             UNPAIR ;;
-            DUP ;; SELF ;; ADDRESS ;; CHAIN_ID ;; PAIR ;; PAIR ;; PACK ;;
+            DUP ;; SELF (self_type := parameter_ty) (self_annot := None) None I ;;
+            ADDRESS ;; CHAIN_ID ;; PAIR ;; PAIR ;;
+            PACK ;;
             DIP1 ( UNPAIR ;; DIP1 SWAP ) ;; SWAP
           ) ;;
 
@@ -121,11 +131,14 @@ Fixpoint count_signatures (sigs : Datatypes.list (Datatypes.option (data signatu
   | cons (Some _) sigs => (count_signatures sigs + 1)%N
   end.
 
-Definition action_ty := or (lambda unit (list operation)) (pair nat (list key)).
+Definition action_ty :=
+  (or
+     (lambda unit (list operation)) (Some annots.operation)
+     (pair nat (list key)) (Some annots.change_keys)).
 Definition pack_ty := pair (pair chain_id address) (pair nat action_ty).
 
 Definition multisig_spec
-           (env : @proto_env (Some parameter_ty))
+           (env : @proto_env (Some (parameter_ty, None)))
            (parameter : data parameter_ty)
            (stored_counter : N)
            (threshold : N)
@@ -151,7 +164,7 @@ Definition multisig_spec
       (fun k sig =>
          check_signature
            env k sig
-           (pack env pack_ty (chain_id_ env, address_ env parameter_ty (self env),
+           (pack env pack_ty (chain_id_ env, address_ env unit (self env None I),
                               (counter, action)))) /\
     (count_signatures sigs >= threshold)%N /\
     new_stored_counter = (1 + stored_counter)%N /\
@@ -171,7 +184,7 @@ Definition multisig_spec
     end
   end.
 
-Definition multisig_head {A} (then_ : instruction (Some parameter_ty) Datatypes.false (nat ::: list key ::: list (option signature) ::: bytes ::: action_ty ::: storage_ty ::: nil) A) :
+Definition multisig_head {A} (then_ : instruction (Some (parameter_ty, None)) Datatypes.false (nat ::: list key ::: list (option signature) ::: bytes ::: action_ty ::: storage_ty ::: nil) A) :
   instruction _ _ (pair (pair nat action_ty) (list (option signature)) ::: pair nat (pair nat (list key)) ::: nil) A
 :=
     PUSH mutez (0 ~mutez);; AMOUNT;; ASSERT_CMPEQ;;
@@ -179,7 +192,9 @@ Definition multisig_head {A} (then_ : instruction (Some parameter_ty) Datatypes.
     DIP1
       (
         UNPAIR ;;
-        DUP ;; SELF ;; ADDRESS ;; CHAIN_ID ;; PAIR ;; PAIR ;; PACK ;;
+        DUP ;; SELF (self_type := parameter_ty) (self_annot := None) None I ;;
+        ADDRESS ;; CHAIN_ID ;; PAIR ;; PAIR ;;
+        PACK ;;
         DIP1 ( UNPAIR ;; DIP1 SWAP ) ;; SWAP
       ) ;;
 
@@ -190,7 +205,7 @@ Definition multisig_head {A} (then_ : instruction (Some parameter_ty) Datatypes.
 
 Definition multisig_head_spec
            A
-           (env : @proto_env (Some parameter_ty))
+           (env : @proto_env (Some (parameter_ty, None)))
            (counter : N)
            (action : data action_ty)
            (sigs : Datatypes.list (Datatypes.option (data signature)))
@@ -216,7 +231,7 @@ Definition multisig_head_spec
         (keys,
          (sigs,
           (pack env pack_ty
-                (chain_id_ env, address_ env parameter_ty (self env), (counter, action)),
+                (chain_id_ env, address_ env unit (self env None I), (counter, action)),
            (action, (storage, tt)))))).
 
 Ltac fold_eval_precond :=
@@ -224,7 +239,7 @@ Ltac fold_eval_precond :=
 
 Lemma multisig_head_correct
       A
-      (env : @proto_env (Some parameter_ty))
+      (env : @proto_env (Some (parameter_ty, None)))
       (counter : N)
       (action : data action_ty)
       (sigs : Datatypes.list (Datatypes.option (data signature)))
@@ -304,11 +319,9 @@ Proof.
   simpl.
   destruct sigs as [|[sig|] sigs].
   - reflexivity.
-  - case (check_signature env k sig packed).
-    + tauto.
-    + split.
-      * intro H; inversion H.
-      * intros (H, _); discriminate.
+  - rewrite if_false_is_and.
+    apply and_both.
+    reflexivity.
   - reflexivity.
 Qed.
 
@@ -437,7 +450,7 @@ Proof.
 Qed.
 
 Definition multisig_tail :
-  instruction (Some parameter_ty) _
+  instruction (Some (parameter_ty, None)) _
     (nat ::: nat ::: list (option signature) ::: bytes ::: action_ty :::
          storage_ty ::: nil)
     (pair (list operation) storage_ty ::: nil) :=
@@ -501,9 +514,7 @@ Proof.
       * do 2 fold_eval_precond.
         rewrite <- eval_precond_correct.
         change (2 + fuel) with (S (S fuel)).
-        case (semantics.eval _ lam (S (S fuel)) (tt, tt)).
-        -- intro; split; intro H; inversion H.
-        -- intro s; reflexivity.
+        reflexivity.
       * reflexivity.
     + intro Hle.
       apply (leb_gt nat) in Hle.
@@ -521,7 +532,7 @@ Proof.
 Qed.
 
 Lemma multisig_correct
-      (env : @proto_env (Some parameter_ty))
+      (env : @proto_env (Some (parameter_ty, None)))
       (params : data parameter_ty)
       (stored_counter : N)
       (threshold : N)
diff --git a/src/contracts_coq/manager.v b/src/contracts_coq/manager.v
index 7ba6c9a3..3426e8ed 100644
--- a/src/contracts_coq/manager.v
+++ b/src/contracts_coq/manager.v
@@ -31,14 +31,14 @@ Import error.
 Require List.
 Require Import Lia.
 
-Definition parameter_ty := or (lambda unit (list operation)) unit.
+Definition parameter_ty := or (lambda unit (list operation)) (Some "%do"%string) unit (Some "%default"%string).
 Definition storage_ty := key_hash.
 
 Module manager(C:ContractContext).
 
 Module semantics := Semantics C. Import semantics.
 
-Definition manager : full_contract _ parameter_ty storage_ty :=
+Definition manager : full_contract _ parameter_ty None storage_ty :=
   (UNPAIR ;;
    IF_LEFT
    ( (* 'do' entrypoint *)
@@ -66,7 +66,7 @@ Definition manager : full_contract _ parameter_ty storage_ty :=
   ).
 
 Definition manager_spec
-           (env : @proto_env (Some parameter_ty))
+           (env : @proto_env (Some (parameter_ty, None)))
            (storage : data storage_ty)
            (param : data parameter_ty)
            (new_storage : data storage_ty)
@@ -134,7 +134,7 @@ Proof.
 Qed.
 
 Lemma manager_correct
-      (env : @proto_env (Some parameter_ty))
+      (env : @proto_env (Some (parameter_ty, None)))
       (storage : data storage_ty)
       (param : data parameter_ty)
       (new_storage : data storage_ty)
diff --git a/src/contracts_coq/multisig.v b/src/contracts_coq/multisig.v
index 9b4efcbf..624d4911 100644
--- a/src/contracts_coq/multisig.v
+++ b/src/contracts_coq/multisig.v
@@ -19,6 +19,7 @@
 (* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
 (* DEALINGS IN THE SOFTWARE. *)
 
+Require String.
 Require Import Michocoq.macros.
 Import syntax.
 Import comparable.
@@ -28,7 +29,13 @@ Require Import util.
 Import error.
 Require List.
 
-Definition action_ty := or (pair mutez (contract unit)) (or (option key_hash) (pair nat (list key))).
+Module annots.
+  Import String.
+  Definition delegate : string := "%delegate".
+  Definition change_keys : string := "%change_keys".
+End annots.
+
+Definition action_ty := or (pair mutez (contract unit)) None (or (option key_hash) (Some annots.delegate) (pair nat (list key)) (Some annots.change_keys)) None.
 
 Definition parameter_ty := (pair
              (pair
@@ -42,17 +49,17 @@ Module multisig(C:ContractContext).
 
 Module semantics := Semantics C. Import semantics.
 
-Definition ADD_nat {S} : instruction (Some parameter_ty) _ (nat ::: nat ::: S) (nat ::: S) := ADD.
+Definition ADD_nat {S} : instruction (Some (parameter_ty, None)) _ (nat ::: nat ::: S) (nat ::: S) := ADD.
 
 Definition pack_ty := pair (pair chain_id address) (pair nat action_ty).
 
-Definition multisig : full_contract _ parameter_ty storage_ty :=
+Definition multisig : full_contract _ parameter_ty None storage_ty :=
   (
     UNPAIR ;; SWAP ;; DUP ;; DIP1 SWAP ;;
     DIP1
       (
         UNPAIR ;;
-        DUP ;; SELF ;; ADDRESS ;; CHAIN_ID ;; PAIR ;; PAIR ;;
+        DUP ;; SELF (self_type := parameter_ty) (self_annot := None) None I ;; ADDRESS ;; CHAIN_ID ;; PAIR ;; PAIR ;;
         PACK ;;
         DIP1 ( UNPAIR ;; DIP1 SWAP ) ;; SWAP
       ) ;;
@@ -118,7 +125,7 @@ Fixpoint count_signatures (sigs : Datatypes.list (Datatypes.option (data signatu
 
 
 Definition multisig_spec
-           (env : @proto_env (Some parameter_ty))
+           (env : @proto_env (Some (parameter_ty, None)))
            (counter : N)
            (action : data action_ty)
            (sigs : Datatypes.list (Datatypes.option (data signature)))
@@ -140,7 +147,7 @@ Definition multisig_spec
       (fun k sig =>
          check_signature
            env k sig
-           (pack env pack_ty ((chain_id_ env, address_ env parameter_ty (self env)),
+           (pack env pack_ty ((chain_id_ env, address_ env parameter_ty (self env None I)),
                              (counter, action)))) /\
     (count_signatures first_sigs >= threshold)%N /\
     new_stored_counter = (1 + stored_counter)%N /\
@@ -159,7 +166,7 @@ Definition multisig_spec
       returned_operations = nil
     end.
 
-Definition multisig_head (then_ : instruction (Some parameter_ty) Datatypes.false (nat ::: list key ::: list (option signature) ::: bytes ::: action_ty ::: storage_ty ::: nil) (pair (list operation) storage_ty ::: nil)) :
+Definition multisig_head (then_ : instruction (Some (parameter_ty, None)) Datatypes.false (nat ::: list key ::: list (option signature) ::: bytes ::: action_ty ::: storage_ty ::: nil) (pair (list operation) storage_ty ::: nil)) :
   instruction _ _
               (pair parameter_ty storage_ty ::: nil)
               (pair (list operation) storage_ty ::: nil)
@@ -168,7 +175,7 @@ Definition multisig_head (then_ : instruction (Some parameter_ty) Datatypes.fals
     DIP1
       (
         UNPAIR ;;
-        DUP ;; SELF ;; ADDRESS ;; CHAIN_ID ;; PAIR ;; PAIR ;;
+        DUP ;; SELF (self_type := parameter_ty) (self_annot := None) None I ;; ADDRESS ;; CHAIN_ID ;; PAIR ;; PAIR ;;
         PACK ;;
         DIP1 ( UNPAIR ;; DIP1 SWAP ) ;; SWAP
       ) ;;
@@ -179,7 +186,7 @@ Definition multisig_head (then_ : instruction (Some parameter_ty) Datatypes.fals
     DIP1 SWAP ;; UNPAIR ;; then_.
 
 Definition multisig_head_spec
-           (env : @proto_env (Some parameter_ty))
+           (env : @proto_env (Some (parameter_ty, None)))
            (counter : N)
            (action : data action_ty)
            (sigs : Datatypes.list (Datatypes.option (data signature)))
@@ -204,18 +211,18 @@ Definition multisig_head_spec
         (keys,
          (sigs,
           (pack env pack_ty
-                ((chain_id_ env, address_ env parameter_ty (self env)), (counter, action)),
+                ((chain_id_ env, address_ env parameter_ty (self env None I)), (counter, action)),
            (action, (storage, tt))))))) psi.
 
 Lemma fold_eval_precond fuel :
   eval_precond_body (@semantics.eval_precond fuel) =
-  @semantics.eval_precond (S fuel) (Some parameter_ty).
+  @semantics.eval_precond (S fuel) (Some (parameter_ty, None)).
 Proof.
   reflexivity.
 Qed.
 
 Lemma multisig_head_correct
-      (env : @proto_env (Some parameter_ty))
+      (env : @proto_env (Some (parameter_ty, None)))
       (counter : N)
       (action : data action_ty)
       (sigs : Datatypes.list (Datatypes.option (data signature)))
@@ -290,11 +297,9 @@ Proof.
   simpl.
   destruct sigs as [|[sig|] sigs].
   - reflexivity.
-  - case (check_signature env k sig packed).
-    + tauto.
-    + split.
-      * intro H; inversion H.
-      * intros (H, _); discriminate.
+  - rewrite if_false_is_and.
+    apply and_both.
+    reflexivity.
   - reflexivity.
 Qed.
 
@@ -483,7 +488,7 @@ Proof.
 Qed.
 
 Lemma multisig_correct
-      (env : @proto_env (Some parameter_ty))
+      (env : @proto_env (Some (parameter_ty, None)))
       (counter : N)
       (action : data action_ty)
       (sigs : Datatypes.list (Datatypes.option (data signature)))
diff --git a/src/contracts_coq/return_to_sender.v b/src/contracts_coq/return_to_sender.v
index 1d9311fb..4b99dbad 100644
--- a/src/contracts_coq/return_to_sender.v
+++ b/src/contracts_coq/return_to_sender.v
@@ -35,7 +35,7 @@ Module return_to_sender(C:ContractContext).
 
 Module semantics := Semantics C. Import semantics.
 
-Definition return_to_sender : full_contract _ parameter_ty storage_ty :=
+Definition return_to_sender : full_contract _ parameter_ty None storage_ty :=
   (
     CDR ;;
     NIL operation ;;
@@ -44,7 +44,7 @@ Definition return_to_sender : full_contract _ parameter_ty storage_ty :=
        IFCMPEQ NOOP
          (
            SOURCE ;;
-           CONTRACT unit ;;
+           CONTRACT None unit ;;
            ASSERT_SOME ;;
            AMOUNT ;;
            UNIT ;;
@@ -83,7 +83,7 @@ Lemma return_to_sender_correct :
   <->
   (amount env = (0 ~Mutez) /\ ops = nil) \/
   (amount env <> (0 ~Mutez) /\
-    exists ctr, contract_ env unit (source env) = Some ctr /\
+    exists ctr, contract_ env None unit (source env) = Some ctr /\
            ops = ((transfer_tokens env unit tt (amount env) ctr) :: nil)%list).
 Proof.
   intros env ops fuel Hfuel.
@@ -91,43 +91,30 @@ Proof.
   unfold eval.
   rewrite eval_precond_correct.
   unfold ">=" in Hfuel.
-  do 8 (more_fuel ; simpl).
-  fold (simple_compare mutez).
-  fold (compare mutez).
-  case_eq ((comparison_to_int (compare mutez (0 ~Mutez) (amount env)) =? 0)%Z).
-  - (* true *)
-    intro Heq.
-    rewrite eqb_eq in Heq.
-    do 1 (more_fuel ; simpl).
-    split.
-    + intro Hops.
-      injection Hops.
-      intro; subst ops.
-      intuition.
-    + intros [(Hl, Hops)|(Hr, _)].
-      * simpl.
-        subst; reflexivity.
-      * symmetry in Heq.
-        contradiction.
-  - intro Hneq.
-    rewrite eqb_neq in Hneq.
-    do 7 (more_fuel ; simpl).
-    destruct (contract_ env unit (source env)).
-    + (* Some *)
-      split.
-      * intro H ; right; split.
-        -- congruence.
-        -- eexists ; intuition ; injection H.
-           symmetry; assumption.
-      * intros [(Habs, _)| (_, (ctr, (He, Hops)))].
-        -- congruence.
-        -- injection He; intro; subst d; subst ops; reflexivity.
-    + (* None *)
-      simpl. split.
-      * intro H; inversion H.
-      * intros [(Habs, _)|(ctr, (He, (Hops, _)))].
-        -- congruence.
-        -- discriminate.
+  repeat (more_fuel ; simpl).
+  rewrite destruct_if.
+  apply or_both; apply and_both_0.
+  - rewrite (eqb_eq mutez).
+    intuition.
+  - intuition congruence.
+  - rewrite bool_not_false.
+    rewrite (eqb_eq mutez).
+    intuition.
+  - pose (c := contract_ env None unit (source env)).
+    pose (transfer := transfer_tokens env unit tt (amount env)).
+    change (match c with Some b => ((transfer b :: nil)%list, tt, tt) = (ops, tt, tt) | None => False end <-> (exists ctr, c = Some ctr /\ ops = (transfer ctr :: nil)%list)).
+    destruct c.
+    + split.
+      * intro H.
+        exists d.
+        intuition congruence.
+      * intros (c, (Hc, Hops)).
+        injection Hc; clear Hc.
+        intro; subst.
+        reflexivity.
+    + split; [contradiction|].
+      intros (c, (Habs, _)).
+      discriminate.
 Qed.
 
 End return_to_sender.
diff --git a/src/contracts_coq/vote.v b/src/contracts_coq/vote.v
index e2500f09..5fc4549d 100644
--- a/src/contracts_coq/vote.v
+++ b/src/contracts_coq/vote.v
@@ -32,7 +32,7 @@ Definition storage_ty := map string int.
 Module vote(C:ContractContext).
 Module semantics := Semantics C. Import semantics.
 
-Definition vote : full_contract _ parameter_ty storage_ty :=
+Definition vote : full_contract _ parameter_ty None storage_ty :=
   (
     AMOUNT ;;
     PUSH mutez (5000000 ~mutez);;
@@ -47,7 +47,7 @@ Definition vote : full_contract _ parameter_ty storage_ty :=
     NIL operation;; PAIR ).
 
 Definition vote_spec
-           (env : @proto_env (Some parameter_ty))
+           (env : @proto_env (Some (parameter_ty, None)))
            (storage: data storage_ty)
            (param : data parameter_ty)
            (new_storage : data storage_ty)
@@ -79,7 +79,7 @@ Proof.
 Defined.
 
 Theorem vote_correct
-      (env : @proto_env (Some parameter_ty))
+      (env : @proto_env (Some (parameter_ty, None)))
       (storage : data storage_ty)
       (param : data parameter_ty)
       (new_storage : data storage_ty)
diff --git a/src/michocoq/macros.v b/src/michocoq/macros.v
index edf78b1c..30db2544 100644
--- a/src/michocoq/macros.v
+++ b/src/michocoq/macros.v
@@ -23,7 +23,7 @@ Require Import syntax syntax_type.
 Require Import comparable.
 
 Section macros.
-  Context {self_type : Datatypes.option type}.
+  Context {self_type : self_info}.
 
 Definition CMPop (a : comparable_type) S (op : instruction self_type Datatypes.false (int ::: S) (bool ::: S))
            : instruction self_type Datatypes.false (a ::: a ::: S) (bool ::: S) := COMPARE ;; op.
@@ -90,9 +90,9 @@ Definition ASSERT_NONE {a S} : instruction self_type Datatypes.false (option a :
 Definition ASSERT_SOME {a S} : instruction self_type Datatypes.false (option a ::: S) (a ::: S) :=
   IF_NONE FAIL NOOP.
 
-Definition ASSERT_LEFT {a b S} : instruction self_type Datatypes.false (or a b ::: S) (a ::: S) :=
+Definition ASSERT_LEFT {a b an bn S} : instruction self_type Datatypes.false (or a an b bn ::: S) (a ::: S) :=
   IF_LEFT NOOP FAIL.
-Definition ASSERT_RIGHT {a b S} : instruction self_type Datatypes.false (or a b ::: S) (b ::: S) :=
+Definition ASSERT_RIGHT {a b an bn S} : instruction self_type Datatypes.false (or a an b bn ::: S) (b ::: S) :=
   IF_LEFT FAIL NOOP.
 
 Definition DROP1 {a SA} : instruction self_type Datatypes.false (a ::: SA) SA :=
@@ -141,7 +141,7 @@ Definition CDDR {a b c S} : instruction self_type Datatypes.false (pair a (pair
 Definition IF_SOME {a SA SB tffa tffb} (bt : instruction self_type tffa _ _) (bf : instruction self_type tffb _ _) : instruction self_type _ (option a ::: SA) SB :=
   IF_NONE bf bt.
 
-Definition IF_RIGHT {a b SA SB tffa tffb} (bt : instruction self_type tffa _ _) (bf : instruction self_type tffb _ _) : instruction self_type _ (or a b ::: SA) SB :=
+Definition IF_RIGHT {a an b bn SA SB tffa tffb} (bt : instruction self_type tffa _ _) (bf : instruction self_type tffb _ _) : instruction self_type _ (or a an b bn ::: SA) SB :=
   IF_LEFT bf bt.
 
 Definition SET_CAR {a b S} : instruction self_type Datatypes.false (pair a b ::: a ::: S) (pair a b ::: S) :=
diff --git a/src/michocoq/main.v b/src/michocoq/main.v
index 152e5935..23bef48a 100644
--- a/src/michocoq/main.v
+++ b/src/michocoq/main.v
@@ -48,9 +48,10 @@ Definition contract_file_M : error.M syntax.contract_file :=
     typer.type_check_instruction typer.type_instruction i _ _ in
   error.Return
     {| contract_file_parameter := self_type;
-      contract_file_storage := storage_type;
-      contract_tff := tff;
-      contract_file_code := code; |}.
+       contract_file_annotation := None;
+       contract_file_storage := storage_type;
+       contract_tff := tff;
+       contract_file_code := code; |}.
 
 Definition is_lexed := error_pp.m_pp lexed_M.
 
diff --git a/src/michocoq/micheline2michelson.v b/src/michocoq/micheline2michelson.v
index a0db094c..77e9556f 100644
--- a/src/michocoq/micheline2michelson.v
+++ b/src/michocoq/micheline2michelson.v
@@ -62,7 +62,7 @@ Fixpoint micheline2michelson_type (bem : loc_micheline) : M type :=
        | Mk_loc_micheline (_, PRIM (_, "or") (a :: b :: nil)) =>
         let! a := micheline2michelson_type a in
         let! b := micheline2michelson_type b in
-        Return (or a b)
+        Return (or a None b None)
        | Mk_loc_micheline (_, PRIM (_, "lambda") (a :: b :: nil)) =>
         let! a := micheline2michelson_type a in
         let! b := micheline2michelson_type b in
@@ -437,10 +437,10 @@ Fixpoint micheline2michelson_instruction (m : loc_micheline) : M instruction :=
   | Mk_loc_micheline (_, PRIM (_, "ADDRESS") nil) => Return ADDRESS
   | Mk_loc_micheline (_, PRIM (_, "CONTRACT") (ty :: nil)) =>
     let! ty := micheline2michelson_type ty in
-    Return (CONTRACT ty)
+    Return (CONTRACT None ty)
   | Mk_loc_micheline (_, PRIM (_, "SOURCE") nil) => Return SOURCE
   | Mk_loc_micheline (_, PRIM (_, "SENDER") nil) => Return SENDER
-  | Mk_loc_micheline (_, PRIM (_, "SELF") nil) => Return SELF
+  | Mk_loc_micheline (_, PRIM (_, "SELF") nil) => Return (SELF None)
   | Mk_loc_micheline (_, PRIM (_, "AMOUNT") nil) => Return AMOUNT
   | Mk_loc_micheline (_, PRIM (_, "IMPLICIT_ACCOUNT") nil) => Return IMPLICIT_ACCOUNT
   | Mk_loc_micheline (_, PRIM (_, "NOW") nil) => Return NOW
@@ -489,7 +489,7 @@ Fixpoint micheline2michelson_instruction (m : loc_micheline) : M instruction :=
     let! i := micheline2michelson_instruction i in
     let! sty := micheline2michelson_type storage_ty in
     let! pty := micheline2michelson_type params_ty in
-    Return (CREATE_CONTRACT sty pty i)
+    Return (CREATE_CONTRACT sty pty None i)
   | Mk_loc_micheline
       (_, PRIM (_, "CREATE_CONTRACT")
                (Mk_loc_micheline
@@ -501,7 +501,7 @@ Fixpoint micheline2michelson_instruction (m : loc_micheline) : M instruction :=
     let! i := micheline2michelson_instruction i in
     let! sty := micheline2michelson_type storage_ty in
     let! pty := micheline2michelson_type params_ty in
-    Return (CREATE_CONTRACT sty pty i)
+    Return (CREATE_CONTRACT sty pty None i)
   | Mk_loc_micheline (_, PRIM (_, "EMPTY_SET") (cty :: nil)) =>
     let! cty := micheline2michelson_ctype cty in
     Return (EMPTY_SET cty)
diff --git a/src/michocoq/michelson2micheline.v b/src/michocoq/michelson2micheline.v
index cb001fc4..812e4f0c 100644
--- a/src/michocoq/michelson2micheline.v
+++ b/src/michocoq/michelson2micheline.v
@@ -37,6 +37,15 @@ Fixpoint michelson2micheline_ctype (ct: comparable_type) : loc_micheline :=
                [michelson2micheline_sctype sct; michelson2micheline_ctype ct]
   end.
 
+Definition michelson2micheline_atype michelson2micheline_type (t : type) (an : annot_o) : loc_micheline :=
+  match an, michelson2micheline_type t with
+  | None, m => m
+  | Some an, Mk_loc_micheline (loca, locb, (PRIM (loc1, loc2, p) l)) =>
+    Mk_loc_micheline (loca, locb, (PRIM (loc1, loc2, p) (dummy_prim an nil :: l)))
+  | Some an, m => (* Cannot happen *)
+    dummy_prim "strange_annotated_type" nil
+  end.
+
 Fixpoint michelson2micheline_type (t : type) : loc_micheline :=
   match t with
   | Comparable_type ct => michelson2micheline_sctype ct
@@ -50,8 +59,8 @@ Fixpoint michelson2micheline_type (t : type) : loc_micheline :=
   | contract t' => dummy_prim "contract" [michelson2micheline_type t']
   | pair t1 t2 =>
     dummy_prim "pair" [michelson2micheline_type t1; michelson2micheline_type t2]
-  | or t1 t2 =>
-    dummy_prim "or" [michelson2micheline_type t1; michelson2micheline_type t2]
+  | or t1 n1 t2 n2 =>
+    dummy_prim "or" [michelson2micheline_atype michelson2micheline_type t1 n1; michelson2micheline_atype michelson2micheline_type t2 n2]
   | lambda t1 t2 =>
     dummy_prim "lambda" [michelson2micheline_type t1; michelson2micheline_type t2]
   | map ct1 t2 =>
@@ -145,20 +154,24 @@ Fixpoint michelson2micheline_ins (i : instruction) : loc_micheline :=
   | EMPTY_BIG_MAP ct t => dummy_prim "EMPTY_BIG_MAP"
                                      [michelson2micheline_ctype ct;
                                         michelson2micheline_type t]
-  | MEM => dummy_prim "MEM" nil
-  | UPDATE => dummy_prim "UPDATE" nil
-  | CREATE_CONTRACT t1 t2 i => dummy_prim "CREATE_CONTRACT"
+  | MEM => dummy_prim "MEM" []
+  | UPDATE => dummy_prim "UPDATE" []
+  | CREATE_CONTRACT t1 t2 an i => dummy_prim "CREATE_CONTRACT"
                                           [michelson2micheline_type t1;
-                                             michelson2micheline_type t2;
-                                             dummy_seq (michelson2micheline_ins i)]
+                                             michelson2micheline_atype
+                                               michelson2micheline_type t2 an;
+                                             michelson2micheline_ins i]
   | TRANSFER_TOKENS => dummy_prim "TRANSFER_TOKENS" []
   | SET_DELEGATE => dummy_prim "SET_DELEGATE" []
   | BALANCE => dummy_prim "BALANCE" []
   | ADDRESS => dummy_prim "ADDRESS" []
-  | CONTRACT t => dummy_prim "CONTRACT" [michelson2micheline_type t]
+  | CONTRACT None t => dummy_prim "CONTRACT" [michelson2micheline_type t]
+  | CONTRACT (Some an) t =>
+    dummy_prim "CONTRACT" [dummy_prim an []; michelson2micheline_type t]
   | SOURCE => dummy_prim "SOURCE" []
   | SENDER => dummy_prim "SENDER" []
-  | SELF => dummy_prim "SELF" []
+  | SELF None => dummy_prim "SELF" []
+  | SELF (Some an) => dummy_prim "SELF" [dummy_prim an []]
   | AMOUNT => dummy_prim "AMOUNT" []
   | IMPLICIT_ACCOUNT => dummy_prim "IMPLICIT_ACCOUNT" []
   | NOW => dummy_prim "NOW" []
diff --git a/src/michocoq/of_ocaml/syntax_equiv.v b/src/michocoq/of_ocaml/syntax_equiv.v
index 769a1e6e..8f5abb9d 100644
--- a/src/michocoq/of_ocaml/syntax_equiv.v
+++ b/src/michocoq/of_ocaml/syntax_equiv.v
@@ -40,7 +40,7 @@ Definition to_coq_concrete_data
   end.
 
 Fixpoint of_coq
-  {self_type : Datatypes.option syntax_type.type}
+  {self_type : syntax.self_info}
   {tail_fail_flag : Datatypes.bool}
   {A B : Datatypes.list syntax_type.type}
   (instruction : syntax.instruction self_type tail_fail_flag A B)
@@ -104,9 +104,9 @@ Fixpoint of_coq
         instr_ := instruction';
       |}
     )
-  | @LOOP_LEFT _ a b A instruction =>
+  | @LOOP_LEFT _ a b an bn A instruction =>
     let? bef := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls (a :: A) in
-    let? aft := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls (or a b :: A) in
+    let? aft := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls (or a an b bn :: A) in
     let? instruction' := of_coq instruction in
     Some (Loop_left
       {|
diff --git a/src/michocoq/of_ocaml/syntax_type_equiv.v b/src/michocoq/of_ocaml/syntax_type_equiv.v
index fc1e345c..a69cc57f 100644
--- a/src/michocoq/of_ocaml/syntax_type_equiv.v
+++ b/src/michocoq/of_ocaml/syntax_type_equiv.v
@@ -291,10 +291,10 @@ Module typ.
       let? typ_a' := ocaml_to_coq typ_a in
       let? typ_b' := ocaml_to_coq typ_b in
       Some (pair typ_a' typ_b')
-    | Union_t (typ_a, _) (typ_b, _) _ _ =>
+    | Union_t (typ_a, _) (typ_b, _) _ _ => (* Annotations ignored unfortunately *)
       let? typ_a' := ocaml_to_coq typ_a in
       let? typ_b' := ocaml_to_coq typ_b in
-      Some (or typ_a' typ_b')
+      Some (or typ_a' None typ_b' None)
     | Lambda_t typ_arg typ_ret _ =>
       let? typ_arg' := ocaml_to_coq typ_arg in
       let? typ_ret' := ocaml_to_coq typ_ret in
@@ -330,7 +330,7 @@ Module typ.
     | contract typ => typed_contract (coq_to_ocaml_typ typ)
     | operation => script_typed_ir_ml.operation
     | pair typ_a typ_b => coq_to_ocaml_typ typ_a * coq_to_ocaml_typ typ_b
-    | or typ_a typ_b => union (coq_to_ocaml_typ typ_a) (coq_to_ocaml_typ typ_b)
+    | or typ_a _ typ_b _ => union (coq_to_ocaml_typ typ_a) (coq_to_ocaml_typ typ_b)
     | lambda typ_arg typ_res =>
       script_typed_ir_ml.lambda
         (coq_to_ocaml_typ typ_arg)
@@ -397,7 +397,7 @@ Module typ.
         None
         false
       )
-    | or typ_a typ_b =>
+    | or typ_a None typ_b None =>
       let? typ_a' := coq_to_ocaml typ_a in
       let? typ_b' := coq_to_ocaml typ_b in
       Some (Union_t
@@ -405,7 +405,8 @@ Module typ.
         (typ_b', None)
         None
         false
-      )
+           )
+    | or _ _ _ _ => None
     | lambda typ_arg typ_ret =>
       let? typ_arg' := coq_to_ocaml typ_arg in
       let? typ_ret' := coq_to_ocaml typ_ret in
@@ -452,6 +453,14 @@ Module typ.
     - destruct s; simpl; reflexivity.
     - rewrite comparable.coq_to_ocaml_to_coq_eq; simpl.
       reflexivity.
+    - destruct a; destruct a0; try reflexivity.
+      assert (H_ind_typ1 := coq_to_ocaml_to_coq_eq typ1);
+        assert (H_ind_typ2 := coq_to_ocaml_to_coq_eq typ2);
+        case_eq_rewrite_in_H (coq_to_ocaml typ1) typ1' Htyp1 H_ind_typ1;
+        case_eq_rewrite_in_H (coq_to_ocaml typ2) typ2' Htyp2 H_ind_typ2;
+        case_eq_rewrite_in_H (ocaml_to_coq typ1') typ1'' Htyp1' H_ind_typ1;
+        case_eq_rewrite_in_H (ocaml_to_coq typ2') typ2'' Htyp2' H_ind_typ2;
+        congruence.
     - assert (H_ind_typ := coq_to_ocaml_to_coq_eq typ).
       case_eq_rewrite_in_H (coq_to_ocaml typ) typ' Htyp H_ind_typ.
       rewrite comparable.coq_to_ocaml_to_coq_eq; simpl.
diff --git a/src/michocoq/semantics.v b/src/michocoq/semantics.v
index 85fdd707..4b511b15 100644
--- a/src/michocoq/semantics.v
+++ b/src/michocoq/semantics.v
@@ -45,7 +45,7 @@ Module Semantics(C : ContractContext).
     | key => key_constant
     | unit => Datatypes.unit
     | pair a b => data a * data b
-    | or a b => sum (data a) (data b)
+    | or a _ b _ => sum (data a) (data b)
     | option a => Datatypes.option (data a)
     | list a => Datatypes.list (data a)
     | set a => set.set (comparable_data a) (compare a)
@@ -58,13 +58,13 @@ Module Semantics(C : ContractContext).
     | chain_id => chain_id_constant
     end.
 
-  Record proto_env {self_ty : Datatypes.option type} : Set :=
+  Record proto_env {self_ty : self_info} : Type :=
     mk_proto_env
       {
-        create_contract : forall g p tff,
+        create_contract : forall g p annot tff,
           Datatypes.option (comparable_data key_hash) ->
           tez.mutez ->
-          syntax.instruction (Some p) tff
+          syntax.instruction (Some (p, annot)) tff
                              (pair p g ::: nil)
                              (pair (list operation) g ::: nil) ->
           data g -> data (pair operation address);
@@ -75,13 +75,17 @@ Module Semantics(C : ContractContext).
                        data operation;
         balance : tez.mutez;
         address_ : forall p, data (contract p) -> data address;
-        contract_ : forall p, data address -> data (option (contract p));
+        contract_ : Datatypes.option annotation -> forall p, data address ->
+                              data (option (contract p));
         source : data address;
         sender : data address;
-        self : match self_ty with
-               | None => Datatypes.unit
-               | Some self_ty => data (contract self_ty)
-               end;
+        self :
+            match self_ty with
+            | None => Datatypes.unit
+            | Some (ty, self_annot) =>
+              forall annot_opt H,
+                data (contract (get_opt (get_entrypoint_opt annot_opt ty self_annot) H))
+            end;
         amount : tez.mutez;
         implicit_account :
           comparable_data key_hash -> data (contract unit);
@@ -97,7 +101,9 @@ Module Semantics(C : ContractContext).
         chain_id_ : data chain_id
       }.
 
-  Definition no_self {self_type} (e : proto_env (self_ty := self_type)) :
+  Definition no_self
+             {self_type}
+             (e : proto_env (self_ty := self_type)) :
     proto_env (self_ty := None) :=
     mk_proto_env None
                  (create_contract e)
@@ -137,7 +143,7 @@ Module Semantics(C : ContractContext).
       stack t = s <-> stack_ind t s.
   Proof.
     intros t.
-    induction t; intros s; simpl.
+    induction t as [|a t]; intros s; simpl.
     - split; intros; subst.
       + constructor.
       + inversion H; reflexivity.
@@ -151,7 +157,7 @@ Module Semantics(C : ContractContext).
 
   Definition stack_app {l1} {l2} (S1 : stack l1) (S2 : stack l2) : stack (l1+++l2).
   Proof.
-    induction l1; simpl.
+    induction l1 as [|a l1]; simpl.
     - assumption.
     - inversion S1. split; auto.
   Defined.
@@ -216,8 +222,8 @@ Module Semantics(C : ContractContext).
     | True_ => true
     | False_ => false
     | Pair a b => (concrete_data_to_data _ a, concrete_data_to_data _ b)
-    | Left a => inl (concrete_data_to_data _ a)
-    | Right b => inr (concrete_data_to_data _ b)
+    | Left a _ _ => inl (concrete_data_to_data _ a)
+    | Right b _ _ => inr (concrete_data_to_data _ b)
     | Some_ a => Some (concrete_data_to_data _ a)
     | None_ => None
     | Concrete_list l => List.map (concrete_data_to_data _) l
@@ -303,10 +309,10 @@ Module Semantics(C : ContractContext).
     | pair a b, H, (x, y) =>
       Pair (data_to_concrete_data a (Is_true_and_left _ _ H) x)
            (data_to_concrete_data b (Is_true_and_right _ _ H) y)
-    | or a b, H, inl x =>
-      Left (data_to_concrete_data a (Is_true_and_left _ _ H) x)
-    | or a b, H, inr x =>
-      Right (data_to_concrete_data b (Is_true_and_right _ _ H) x)
+    | or a an b bn, H, inl x =>
+      Left (data_to_concrete_data a (Is_true_and_left _ _ H) x) an bn
+    | or a an b bn, H, inr x =>
+      Right (data_to_concrete_data b (Is_true_and_right _ _ H) x) an bn
     | lambda a b, _, existT _ tff f => Instruction tff f
     | chain_id, _, x => Chain_id_constant x
     end.
@@ -541,7 +547,7 @@ Module Semantics(C : ContractContext).
   amount of gas that is actually required to run the contract because
   in the SEQ case, both instructions are run with gas n *)
 
-  Fixpoint eval {param_ty : Datatypes.option type} {tff0} (env : @proto_env param_ty) {A : stack_type} {B : stack_type}
+  Fixpoint eval {param_ty : self_info} {tff0} (env : @proto_env param_ty) {A : stack_type} {B : stack_type}
            (i : instruction param_ty tff0 A B) (fuel : Datatypes.nat) (SA : stack A) {struct fuel} : M (stack B) :=
     match fuel with
     | O => Failed _ Out_of_fuel
@@ -681,18 +687,18 @@ Module Semantics(C : ContractContext).
         | cons a b => eval env bt n (a, (b, SA))
         | nil => eval env bf n SA
         end
-      | CREATE_CONTRACT _ _ f, (a, (b, (c, SA))), env =>
-        let (oper, addr) := create_contract env _ _ _ a b f c in
+      | CREATE_CONTRACT g p an f, (a, (b, (c, SA))), env =>
+        let (oper, addr) := create_contract env g p an _ a b f c in
         Return (oper, (addr, SA))
       | TRANSFER_TOKENS, (a, (b, (c, SA))), env =>
         Return (transfer_tokens env _ a b c, SA)
       | SET_DELEGATE, (x, SA), env => Return (set_delegate env x, SA)
       | BALANCE, SA, env => Return (balance env, SA)
       | ADDRESS, (x, SA), env => Return (address_ env _ x, SA)
-      | CONTRACT _, (x, SA), env => Return (contract_ env _ x, SA)
+      | CONTRACT ao p, (x, SA), env => Return (contract_ env ao p x, SA)
       | SOURCE, SA, env => Return (source env, SA)
       | SENDER, SA, env => Return (sender env, SA)
-      | SELF, SA, env => Return (self env, SA)
+      | SELF ao H, SA, env => Return (self env ao H, SA)
       | AMOUNT, SA, env => Return (amount env, SA)
       | IMPLICIT_ACCOUNT, (x, SA), env => Return (implicit_account env x, SA)
       | NOW, SA, env => Return (now env, SA)
@@ -954,8 +960,8 @@ Module Semantics(C : ContractContext).
       | cons a b => eval_precond_n env bt psi (a, (b, SA))
       | nil => eval_precond_n env bf psi SA
       end
-    | CREATE_CONTRACT _ _ f, env, psi, (a, (b, (c, SA))) =>
-      let (oper, addr) := create_contract env _ _ _ a b f c in
+    | CREATE_CONTRACT g p an f, env, psi, (a, (b, (c, SA))) =>
+      let (oper, addr) := create_contract env g p an _ a b f c in
       psi (oper, (addr, SA))
     | TRANSFER_TOKENS, env, psi, (a, (b, (c, SA))) =>
       psi (transfer_tokens env _ a b c, SA)
@@ -963,10 +969,10 @@ Module Semantics(C : ContractContext).
       psi (set_delegate env x, SA)
     | BALANCE, env, psi, SA => psi (balance env, SA)
     | ADDRESS, env, psi, (x, SA) => psi (address_ env _ x, SA)
-    | CONTRACT _, env, psi, (x, SA) => psi (contract_ env _ x, SA)
+    | CONTRACT ao p, env, psi, (x, SA) => psi (contract_ env ao p x, SA)
     | SOURCE, env, psi, SA => psi (source env, SA)
     | SENDER, env, psi, SA => psi (sender env, SA)
-    | SELF, env, psi, SA => psi (self env, SA)
+    | SELF ao H, env, psi, SA => psi (self env ao H, SA)
     | AMOUNT, env, psi, SA => psi (amount env, SA)
     | IMPLICIT_ACCOUNT, env, psi, (x, SA) => psi (implicit_account env x, SA)
     | NOW, env, psi, SA => psi (now env, SA)
@@ -1098,7 +1104,7 @@ Module Semantics(C : ContractContext).
     - reflexivity.
     - destruct st as ([|], st); apply IHn.
     - destruct st as (a, (b, (c, SA))).
-      destruct (create_contract env g p _ a b i c).
+      destruct (create_contract env g p an _ a b i c).
       reflexivity.
     - destruct st as (a, (b, (c, SA))).
       reflexivity.
diff --git a/src/michocoq/syntax.v b/src/michocoq/syntax.v
index ca69afe8..be09c5d4 100644
--- a/src/michocoq/syntax.v
+++ b/src/michocoq/syntax.v
@@ -214,8 +214,10 @@ Canonical Structure mem_bigmap key val : mem_struct key (big_map key val) :=
 (* UPDATE *)
 Inductive update_variant : comparable_type -> type -> type -> Set :=
 | Update_variant_set a : update_variant a bool (set a)
-| Update_variant_map key val : update_variant key (option val) (map key val)
-| Update_variant_bigmap key val : update_variant key (option val) (big_map key val).
+| Update_variant_map key val :
+    update_variant key (option val) (map key val)
+| Update_variant_bigmap key val :
+    update_variant key (option val) (big_map key val).
 Structure update_struct key val collection :=
   Mk_update { update_variant_field : update_variant key val collection }.
 Canonical Structure update_set a : update_struct a bool (set a) :=
@@ -228,16 +230,18 @@ Canonical Structure update_bigmap key val :=
 (* ITER *)
 Inductive iter_variant : type -> type -> Set :=
 | Iter_variant_set (a : comparable_type) : iter_variant a (set a)
-| Iter_variant_map (key : comparable_type) val : iter_variant (pair key val) (map key val)
+| Iter_variant_map (key : comparable_type) val :
+    iter_variant (pair key val) (map key val)
 | Iter_variant_list a : iter_variant a (list a).
 Structure iter_struct collection :=
   Mk_iter { iter_elt_type : type;
             iter_variant_field : iter_variant iter_elt_type collection }.
-Canonical Structure iter_set a : iter_struct (set a) :=
+Canonical Structure iter_set (a : comparable_type) : iter_struct (set a) :=
   {| iter_variant_field := Iter_variant_set a |}.
-Canonical Structure iter_map key val : iter_struct (map key val) :=
+Canonical Structure iter_map (key : comparable_type) val :
+  iter_struct (map key val) :=
   {| iter_variant_field := Iter_variant_map key val |}.
-Canonical Structure iter_list a : iter_struct (list a) :=
+Canonical Structure iter_list (a : type) : iter_struct (list a) :=
   {| iter_variant_field := Iter_variant_list a |}.
 
 (* GET *)
@@ -247,9 +251,9 @@ Inductive get_variant : comparable_type -> type -> type -> Set :=
 Structure get_struct key collection :=
   Mk_get { get_val_type : type;
            get_variant_field : get_variant key get_val_type collection }.
-Canonical Structure get_map key val : get_struct key (map key val) :=
+Canonical Structure get_map key (val : type) : get_struct key (map key val) :=
   {| get_variant_field := Get_variant_map key val |}.
-Canonical Structure get_bigmap key val : get_struct key (big_map key val) :=
+Canonical Structure get_bigmap key (val : type) : get_struct key (big_map key val) :=
   {| get_variant_field := Get_variant_bigmap key val |}.
 
 (* MAP *)
@@ -262,9 +266,10 @@ Structure map_struct collection b :=
   Mk_map { map_in_type : type; map_out_collection_type : type;
            map_variant_field :
              map_variant map_in_type b collection map_out_collection_type }.
-Canonical Structure map_map key val b : map_struct (map key val) b :=
+Canonical Structure map_map (key : comparable_type) val b :
+  map_struct (map key val) b :=
   {| map_variant_field := Map_variant_map key val b |}.
-Canonical Structure map_list a b : map_struct (list a) b :=
+Canonical Structure map_list (a : type) b : map_struct (list a) b :=
   {| map_variant_field := Map_variant_list a b |}.
 
 End Overloading.
@@ -284,9 +289,67 @@ Inductive chain_id_constant : Set := Mk_chain_id : str -> chain_id_constant.
 Inductive elt_pair (a b : Set) : Set :=
 | Elt : a -> b -> elt_pair a b.
 
+Definition stack_type := Datatypes.list type.
+
+Definition opt_bind {A B : Set} (m : Datatypes.option A) (f : A -> Datatypes.option B) : Datatypes.option B :=
+  match m with
+  | Some a => f a
+  | None => None
+  end.
+
+Definition opt_merge {A : Set} (m1 m2 : Datatypes.option A) : Datatypes.option A :=
+  match m1 with
+  | Some a1 => Some a1
+  | None => m2
+  end.
+
+Definition get_entrypoint_root (e : annotation) (a : type) (an : annot_o) :
+  Datatypes.option type :=
+  opt_bind an (fun e' =>
+                 match String.string_dec e e' with
+                 | left _ => Some a
+                 | right _ => None
+                 end).
+
+Fixpoint get_entrypoint (e : annotation) (a : type) (an : annot_o) : Datatypes.option type :=
+  opt_merge (get_entrypoint_root e a an)
+            (match a with
+             | or a annot_a b annot_b =>
+               opt_merge (get_entrypoint e a annot_a) (get_entrypoint e b annot_b)
+             | _ => None
+             end).
+
+Definition get_entrypoint_opt (e : annot_o) (a : type) (an : annot_o) :
+  Datatypes.option type :=
+  match e with
+  | None =>
+    opt_merge (get_entrypoint default_entrypoint.default a an)
+              (Some a)
+  | Some e => get_entrypoint e a an
+  end.
+
+Definition isSome {A : Set} (m : Datatypes.option A) : Prop :=
+  match m with
+  | None => False
+  | Some _ => True
+  end.
+
+Definition isSome_maybe {A : Set} error (o : Datatypes.option A) : error.M (isSome o) :=
+  match o return error.M (isSome o) with
+  | Some _ => error.Return I
+  | None => error.Failed _ error
+  end.
+
+Definition get_opt {A : Set} (m : Datatypes.option A) (H : isSome m) : A :=
+  match m, H with
+  | Some a, I => a
+  | None, H => match H with end
+  end.
+
+Definition self_info := Datatypes.option (type * annot_o)%type.
 
 Inductive instruction :
-  forall (self_type : Datatypes.option type) (tail_fail_flag : Datatypes.bool) (A B : Datatypes.list type), Set :=
+  forall (self_i : self_info) (tail_fail_flag : Datatypes.bool) (A B : Datatypes.list type), Set :=
 | NOOP {self_type A} : instruction self_type Datatypes.false A A    (* Undocumented *)
 | FAILWITH {self_type A B a} : instruction self_type Datatypes.true (a ::: A) B
 | SEQ {self_type A B C tff} : instruction self_type Datatypes.false A B -> instruction self_type tff B C -> instruction self_type tff A C
@@ -298,8 +361,8 @@ Inductive instruction :
 part of the notation "'IF' c1 'then' c2 'else' c3" so we cannot call
 this constructor "IF" but we can make a notation for it. *)
 | LOOP {self_type A} : instruction self_type Datatypes.false A (bool ::: A) -> instruction self_type Datatypes.false (bool ::: A) A
-| LOOP_LEFT {self_type a b A} : instruction self_type Datatypes.false (a :: A) (or a b :: A) ->
-                      instruction self_type Datatypes.false (or a b :: A) (b :: A)
+| LOOP_LEFT {self_type a b an bn A} : instruction self_type Datatypes.false (a :: A) (or a an b bn :: A) ->
+                      instruction self_type Datatypes.false (or a an b bn :: A) (b :: A)
 | EXEC {self_type a b C} : instruction self_type Datatypes.false (a ::: lambda a b ::: C) (b :: C)
 | APPLY {self_type a b c D} {_ : Bool.Is_true (is_packable a)} :
     instruction self_type Datatypes.false (a ::: lambda (pair a b) c ::: D) (lambda b c ::: D)
@@ -365,20 +428,20 @@ this constructor "IF" but we can make a notation for it. *)
 | IF_NONE {self_type a A B tffa tffb} :
     instruction self_type tffa A B -> instruction self_type tffb (a :: A) B ->
     instruction self_type (tffa && tffb) (option a :: A) B
-| LEFT {self_type a} (b : type) {S} : instruction self_type Datatypes.false (a :: S) (or a b :: S)
-| RIGHT (a : type) {self_type b S} : instruction self_type Datatypes.false (b :: S) (or a b :: S)
-| IF_LEFT {self_type a b A B tffa tffb} :
+| LEFT {self_type a} (b : type) {S} : instruction self_type Datatypes.false (a :: S) (or a None b None :: S)
+| RIGHT (a : type) {self_type b S} : instruction self_type Datatypes.false (b :: S) (or a None b None :: S)
+| IF_LEFT {self_type a an b bn A B tffa tffb} :
     instruction self_type tffa (a :: A) B ->
     instruction self_type tffb (b :: A) B ->
-    instruction self_type (tffa && tffb) (or a b :: A) B
+    instruction self_type (tffa && tffb) (or a an b bn :: A) B
 | CONS {self_type a S} : instruction self_type Datatypes.false (a ::: list a ::: S) (list a :: S)
 | NIL (a : type) {self_type S} : instruction self_type Datatypes.false S (list a :: S)
 | IF_CONS {self_type a A B tffa tffb} :
     instruction self_type tffa (a ::: list a ::: A) B ->
     instruction self_type tffb A B ->
     instruction self_type (tffa && tffb) (list a :: A) B
-| CREATE_CONTRACT {self_type S tff} (g p : type) :
-    instruction (Some p) tff (pair p g :: nil) (pair (list operation) g :: nil) ->
+| CREATE_CONTRACT {self_type S tff} (g p : type) (an : annot_o) :
+    instruction (Some (p, an)) tff (pair p g :: nil) (pair (list operation) g :: nil) ->
     instruction self_type Datatypes.false
                 (option key_hash ::: mutez ::: g ::: S)
                 (operation ::: address ::: S)
@@ -388,11 +451,12 @@ this constructor "IF" but we can make a notation for it. *)
     instruction self_type Datatypes.false (option key_hash ::: S) (operation ::: S)
 | BALANCE {self_type S} : instruction self_type Datatypes.false S (mutez ::: S)
 | ADDRESS {self_type p S} : instruction self_type Datatypes.false (contract p ::: S) (address ::: S)
-| CONTRACT {self_type S} p : instruction self_type Datatypes.false (address ::: S) (option (contract p) ::: S)
+| CONTRACT {self_type S} (annot_opt : Datatypes.option annotation) p : instruction self_type Datatypes.false (address ::: S) (option (contract p) ::: S)
 (* Mistake in the doc: the return type must be an option *)
 | SOURCE {self_type S} : instruction self_type Datatypes.false S (address ::: S)
 | SENDER {self_type S} : instruction self_type Datatypes.false S (address ::: S)
-| SELF {self_type S} : instruction (Some self_type) Datatypes.false S (contract self_type :: S)
+| SELF {self_type self_annot S} (annot_opt : annot_o) (H : isSome (get_entrypoint_opt annot_opt self_type self_annot)) :
+    instruction (Some (self_type, self_annot)) Datatypes.false S (contract (get_opt _ H) :: S)
 (* p should be the current parameter type *)
 | AMOUNT {self_type S} : instruction self_type Datatypes.false S (mutez ::: S)
 | IMPLICIT_ACCOUNT {self_type S} : instruction self_type Datatypes.false (key_hash ::: S) (contract unit :: S)
@@ -418,7 +482,6 @@ this constructor "IF" but we can make a notation for it. *)
     length A = n ->
     instruction self_type Datatypes.false (A +++ B) B
 | CHAIN_ID {self_type S} : instruction self_type Datatypes.false S (chain_id ::: S)
-
 with
 concrete_data : type -> Set :=
 | Int_constant : Z -> concrete_data int
@@ -435,8 +498,8 @@ concrete_data : type -> Set :=
 | True_ : concrete_data bool
 | False_ : concrete_data bool
 | Pair {a b : type} : concrete_data a -> concrete_data b -> concrete_data (pair a b)
-| Left {a b : type} : concrete_data a -> concrete_data (or a b)
-| Right {a b : type} : concrete_data b -> concrete_data (or a b)
+| Left {a b : type} (x : concrete_data a) an bn : concrete_data (or a an b bn)
+| Right {a b : type} (x : concrete_data b) an bn : concrete_data (or a an b bn)
 | Some_ {a : type} : concrete_data a -> concrete_data (option a)
 | None_ {a : type} : concrete_data (option a)
 | Concrete_list {a} : Datatypes.list (concrete_data a) -> concrete_data (list a)
@@ -445,7 +508,7 @@ concrete_data : type -> Set :=
 | Concrete_map {a : comparable_type} {b} :
     Datatypes.list (elt_pair (concrete_data a) (concrete_data b)) ->
     concrete_data (map a b)
-| Instruction {a b} tff : instruction None tff (a ::: nil) (b ::: nil) ->
+| Instruction {a b} tff : instruction (None) tff (a ::: nil) (b ::: nil) ->
                           concrete_data (lambda a b)
 | Chain_id_constant : chain_id_constant -> concrete_data chain_id.
 (* TODO: add the no-ops CAST and RENAME *)
@@ -454,8 +517,8 @@ Coercion int_constant := Int_constant.
 Coercion nat_constant := Nat_constant.
 Coercion string_constant := String_constant.
 
-Definition full_contract tff param storage :=
-  instruction (Some param) tff
+Definition full_contract tff param annot storage :=
+  instruction (Some (param, annot)) tff
     ((pair param storage) ::: nil)
     ((pair (list operation) storage) ::: nil).
 
@@ -463,17 +526,18 @@ Record contract_file : Set :=
   Mk_contract_file
     {
       contract_file_parameter : type;
+      contract_file_annotation : annot_o;
       contract_file_storage : type;
       contract_tff : Datatypes.bool;
       contract_file_code :
         full_contract
           contract_tff
           contract_file_parameter
+          contract_file_annotation
           contract_file_storage;
     }.
 
 Notation "'IF'" := (IF_).
-Definition stack_type := Datatypes.list type.
 
 Notation "A ;; B" := (SEQ A B) (at level 100, right associativity).
 
diff --git a/src/michocoq/syntax_type.v b/src/michocoq/syntax_type.v
index b2e73e8a..4ea51252 100644
--- a/src/michocoq/syntax_type.v
+++ b/src/michocoq/syntax_type.v
@@ -1,3 +1,15 @@
+Require String.
+
+Definition annotation := String.string.
+Definition annot_o := Datatypes.option annotation.
+
+Module default_entrypoint.
+  Import String.
+
+  Definition default : annotation := "%default"%string.
+
+End default_entrypoint.
+
 Inductive simple_comparable_type : Set :=
 | string
 | nat
@@ -19,21 +31,21 @@ Proof.
 Defined.
 
 Inductive type : Set :=
-| Comparable_type : simple_comparable_type -> type
-| key : type
-| unit : type
-| signature : type
-| option : type -> type
-| list : type -> type
-| set : comparable_type -> type
-| contract : type -> type
-| operation : type
-| pair : type -> type -> type
-| or : type -> type -> type
-| lambda : type -> type -> type
-| map : comparable_type -> type -> type
-| big_map : comparable_type -> type -> type
-| chain_id : type.
+| Comparable_type (_ : simple_comparable_type)
+| key
+| unit
+| signature
+| option (a : type)
+| list (a : type)
+| set (a : comparable_type)
+| contract (a : type)
+| operation
+| pair (a : type) (b : type)
+| or (a : type) (_ : annot_o) (b : type) (_ : annot_o)
+| lambda (a b : type)
+| map (k : comparable_type) (v : type)
+| big_map (k : comparable_type) (v : type)
+| chain_id.
 
 Fixpoint comparable_type_to_type (c : comparable_type) : type :=
   match c with
@@ -53,7 +65,7 @@ Fixpoint is_packable (a : type) : Datatypes.bool :=
   | option ty
   | list ty
   | map _ ty => is_packable ty
-  | pair a b | or a b => is_packable a && is_packable b
+  | pair a b | or a _ b _ => is_packable a && is_packable b
   end.
 
 Lemma type_dec (a b : type) : {a = b} + {a <> b}.
diff --git a/src/michocoq/typer.v b/src/michocoq/typer.v
index c7e4f42d..004798bd 100644
--- a/src/michocoq/typer.v
+++ b/src/michocoq/typer.v
@@ -29,7 +29,7 @@ Qed.
         expected_input : Datatypes.list type;
         expected_output : Datatypes.list type;
         tff : Datatypes.bool;
-        self_type_ : Datatypes.option type;
+        self_type_ : syntax.self_info;
         i : instruction self_type_ tff input output;
       }.
 
@@ -243,17 +243,17 @@ Qed.
     | Left x =>
       fun ty =>
         match ty with
-        | or a b =>
+        | or a an b bn =>
           let! x := type_data x a in
-          Return (syntax.Left x)
+          Return (syntax.Left x an bn)
         | _ => Failed _ (Typing _ (d, ty))
         end
     | Right y =>
       fun ty =>
         match ty with
-        | or a b =>
+        | or a an b bn =>
           let! y := type_data y b in
-          Return (syntax.Right y)
+          Return (syntax.Right y an bn)
         | _ => Failed _ (Typing _ (d, ty))
         end
     | Some_ x =>
@@ -342,7 +342,7 @@ Qed.
       type_branches type_instruction i1 i2 _ _ _ (fun B tffa tffb => syntax.IF_)
     | IF_NONE i1 i2, option a :: A =>
       type_branches type_instruction i1 i2 _ _ _ (fun B tffa tffb => syntax.IF_NONE)
-    | IF_LEFT i1 i2, or a b :: A =>
+    | IF_LEFT i1 i2, or a an b bn :: A =>
       type_branches type_instruction i1 i2 _ _ _ (fun B tffa tffb => syntax.IF_LEFT)
     | IF_CONS i1 i2, list a :: A =>
       type_branches type_instruction i1 i2 _ _ _ (fun B tffa tffb => syntax.IF_CONS)
@@ -350,9 +350,9 @@ Qed.
       let! i := type_check_instruction_no_tail_fail
         type_instruction i A (bool ::: A) in
       Return (Inferred_type _ _ (syntax.LOOP i))
-    | LOOP_LEFT i, or a b :: A =>
+    | LOOP_LEFT i, or a an b bn :: A =>
       let! i := type_check_instruction_no_tail_fail
-        type_instruction i (a :: A) (or a b :: A) in
+        type_instruction i (a :: A) (or a an b bn :: A) in
       Return (Inferred_type _ _ (syntax.LOOP_LEFT i))
     | EXEC, a :: lambda a' b :: B =>
       let A := a :: lambda a' b :: B in
@@ -599,15 +599,15 @@ Qed.
       let! i := instruction_cast_domain A' A _ (syntax.CONS) in
       Return (Inferred_type _ _ i)
     | NIL a, A => Return (Inferred_type _ _ (syntax.NIL a))
-    | CREATE_CONTRACT g p i,
+    | CREATE_CONTRACT g p an i,
       option (Comparable_type key_hash) :: Comparable_type mutez :: g2 :: B =>
       let A :=
           option key_hash ::: mutez ::: g2 :: B in
       let A' :=
           option key_hash ::: mutez ::: g ::: B in
       let! existT _ tff i :=
-        type_check_instruction (self_type := Some p) type_instruction i (pair p g :: nil) (pair (list operation) g :: nil) in
-      let! i := instruction_cast_domain A' A _ (syntax.CREATE_CONTRACT g p i) in
+        type_check_instruction (self_type := (Some (p, an))) type_instruction i (pair p g :: nil) (pair (list operation) g :: nil) in
+      let! i := instruction_cast_domain A' A _ (syntax.CREATE_CONTRACT g p an i) in
       Return (Inferred_type _ _ i)
     | TRANSFER_TOKENS, p1 :: Comparable_type mutez :: contract p2 :: B =>
       let A := p1 ::: mutez ::: contract p2 ::: B in
@@ -620,15 +620,18 @@ Qed.
       Return (Inferred_type _ _ syntax.BALANCE)
     | ADDRESS, contract _ :: A =>
       Return (Inferred_type _ _ syntax.ADDRESS)
-    | CONTRACT ty, Comparable_type address :: A =>
-      Return (Inferred_type _ _ (syntax.CONTRACT ty))
+    | CONTRACT an ty, Comparable_type address :: A =>
+      Return (Inferred_type _ _ (syntax.CONTRACT an ty))
     | SOURCE, A =>
       Return (Inferred_type _ _ syntax.SOURCE)
     | SENDER, A =>
       Return (Inferred_type _ _ syntax.SENDER)
-    | SELF, A =>
+    | SELF an, A =>
       match self_type with
-      | Some sty => Return (Inferred_type _ _ syntax.SELF)
+      | Some (sty, san) =>
+        let error := Typing _ "No such self entrypoint"%string in
+        let! H := syntax.isSome_maybe error (syntax.get_entrypoint_opt an sty san) in
+        Return (Inferred_type _ _ (syntax.SELF an H))
       | None => Failed _ (Typing _ "SELF is not allowed inside lambdas"%string)
       end
     | AMOUNT, A =>
diff --git a/src/michocoq/untyped_syntax.v b/src/michocoq/untyped_syntax.v
index 49d6de6c..d4673b07 100644
--- a/src/michocoq/untyped_syntax.v
+++ b/src/michocoq/untyped_syntax.v
@@ -61,15 +61,15 @@ Inductive instruction : Set :=
 | CONS : instruction
 | NIL : type -> instruction
 | IF_CONS : instruction -> instruction -> instruction
-| CREATE_CONTRACT : type -> type -> instruction -> instruction
+| CREATE_CONTRACT : type -> type -> annot_o -> instruction -> instruction
 | TRANSFER_TOKENS : instruction
 | SET_DELEGATE : instruction
 | BALANCE : instruction
 | ADDRESS : instruction
-| CONTRACT : type -> instruction
+| CONTRACT : annot_o -> type -> instruction
 | SOURCE : instruction
 | SENDER : instruction
-| SELF : instruction
+| SELF : annot_o -> instruction
 | AMOUNT : instruction
 | IMPLICIT_ACCOUNT : instruction
 | NOW : instruction
diff --git a/src/michocoq/untyper.v b/src/michocoq/untyper.v
index 21bedfd6..7c4017f4 100644
--- a/src/michocoq/untyper.v
+++ b/src/michocoq/untyper.v
@@ -24,8 +24,8 @@ Require Import String.
     | syntax.True_ => True_
     | syntax.False_ => False_
     | syntax.Pair x y => Pair (untype_data x) (untype_data y)
-    | syntax.Left x => Left (untype_data x)
-    | syntax.Right y => Right (untype_data y)
+    | syntax.Left x _ _ => Left (untype_data x)
+    | syntax.Right y _ _ => Right (untype_data y)
     | syntax.Some_ x => Some_ (untype_data x)
     | syntax.None_ => None_
     | syntax.Concrete_list l => Concrete_seq (List.map (fun x => untype_data x) l)
@@ -100,15 +100,15 @@ Require Import String.
     | syntax.CONS => CONS
     | syntax.NIL a => NIL a
     | syntax.IF_CONS i1 i2 => IF_CONS (untype_instruction i1) (untype_instruction i2)
-    | syntax.CREATE_CONTRACT g p i => CREATE_CONTRACT g p (untype_instruction i)
+    | syntax.CREATE_CONTRACT g p an i => CREATE_CONTRACT g p an (untype_instruction i)
     | syntax.TRANSFER_TOKENS => TRANSFER_TOKENS
     | syntax.SET_DELEGATE => SET_DELEGATE
     | syntax.BALANCE => BALANCE
     | syntax.ADDRESS => ADDRESS
-    | syntax.CONTRACT a => CONTRACT a
+    | syntax.CONTRACT an a => CONTRACT an a
     | syntax.SOURCE => SOURCE
     | syntax.SENDER => SENDER
-    | syntax.SELF => SELF
+    | syntax.SELF an _ => SELF an
     | syntax.AMOUNT => AMOUNT
     | syntax.IMPLICIT_ACCOUNT => IMPLICIT_ACCOUNT
     | syntax.NOW => NOW
@@ -161,10 +161,10 @@ Require Import String.
             P st A B i1 ->
             P st (a ::: A) B i2 ->
             P st (option a ::: A) B (syntax.IF_NONE i1 i2))
-        (HIF_LEFT : forall st a b A B i1 i2,
+        (HIF_LEFT : forall st a b an bn A B i1 i2,
             P st (a ::: A) B i1 ->
             P st (b ::: A) B i2 ->
-            P st (or a b ::: A) B (syntax.IF_LEFT i1 i2))
+            P st (or a an b bn ::: A) B (syntax.IF_LEFT i1 i2))
         (HIF_CONS : forall st a A B i1 i2,
             P st (a ::: list a ::: A) B i1 ->
             P st A B i2 ->
@@ -222,7 +222,7 @@ Require Import String.
               fun _ => I) i2
        else
          fun _ => I) i1
-    | @syntax.IF_LEFT _ a b A B tffa tffb i1 i2 =>
+    | @syntax.IF_LEFT _ a an b bn A B tffa tffb i1 i2 =>
       (if tffa as tffa return
           forall i1, P' _ (tffa && tffb)%bool _ _ (syntax.IF_LEFT i1 i2)
        then
@@ -232,7 +232,7 @@ Require Import String.
                  P' _ tffb _ _ (syntax.IF_LEFT i1 i2)
             then
               fun i2 =>
-                HIF_LEFT _ _ _ _ _ i1 i2
+                HIF_LEFT _ _ _ _ _ _ _ i1 i2
                     (tail_fail_induction _ _ _ i1 P HFAILWITH HSEQ HIF HIF_NONE HIF_LEFT HIF_CONS)
                     (tail_fail_induction _ _ _ i2 P HFAILWITH HSEQ HIF HIF_NONE HIF_LEFT HIF_CONS)
             else
@@ -291,7 +291,7 @@ Require Import String.
       apply (syntax.IF_ i1 i2).
     - intros st a A B _ _ i1 i2.
       apply (syntax.IF_NONE i1 i2).
-    - intros st a b A B _ _ i1 i2.
+    - intros st a b an bn A B _ _ i1 i2.
       apply (syntax.IF_LEFT i1 i2).
     - intros st a A B _ _ i1 i2.
       apply (syntax.IF_CONS i1 i2).
@@ -376,7 +376,7 @@ Require Import String.
   Inductive IF_instruction : forall (A1 A2 A : Datatypes.list type), Set :=
   | IF_i A : IF_instruction A A (bool ::: A)
   | IF_NONE_i a A : IF_instruction A (a ::: A) (option a ::: A)
-  | IF_LEFT_i a b A : IF_instruction (a ::: A) (b ::: A) (or a b ::: A)
+  | IF_LEFT_i a b an bn A : IF_instruction (a ::: A) (b ::: A) (or a an b bn ::: A)
   | IF_CONS_i a A : IF_instruction (a ::: list a ::: A) A (list a ::: A).
 
   Definition IF_instruction_to_instruction {self_type} A1 A2 A (IFi : IF_instruction A1 A2 A) :
@@ -386,7 +386,7 @@ Require Import String.
     match IFi with
     | IF_i A => fun B ttffa tffb i1 i2 => syntax.IF_ i1 i2
     | IF_NONE_i a A => fun B ttffa tffb i1 i2 => syntax.IF_NONE i1 i2
-    | IF_LEFT_i a b A => fun B ttffa tffb i1 i2 => syntax.IF_LEFT i1 i2
+    | IF_LEFT_i a b an bn A => fun B ttffa tffb i1 i2 => syntax.IF_LEFT i1 i2
     | IF_CONS_i a A => fun B ttffa tffb i1 i2 => syntax.IF_CONS i1 i2
     end.
 
@@ -477,13 +477,13 @@ Require Import String.
         reflexivity.
       + trans_refl (
           let! x := typer.type_data (untype_data d) a in
-          Return (@syntax.Left a b x)
+          Return (@syntax.Left a b x an bn)
         ).
         rewrite (untype_type_data _ d).
         reflexivity.
       + trans_refl (
           let! x := typer.type_data (untype_data d) b in
-          Return (@syntax.Right a b x)
+          Return (@syntax.Right a b x an bn)
         ).
         rewrite (untype_type_data _ d).
         reflexivity.
@@ -602,7 +602,7 @@ Require Import String.
         rewrite untype_type_check_instruction_no_tail_fail; auto.
       + trans_refl (
           let! i := typer.type_check_instruction_no_tail_fail
-            typer.type_instruction (untype_instruction i) _ (or a b ::: A) in
+            typer.type_instruction (untype_instruction i) _ (or a an b bn ::: A) in
           Return (@typer.Inferred_type self_type _ _ (syntax.LOOP_LEFT i))
         ).
         rewrite untype_type_check_instruction_no_tail_fail; auto.
@@ -724,7 +724,7 @@ Require Import String.
              typer.type_instruction
              (untype_instruction i1)
              (untype_instruction i2) _ _ _
-             (IF_instruction_to_instruction _ _ _ (IF_LEFT_i a b A))).
+             (IF_instruction_to_instruction _ _ _ (IF_LEFT_i a b an bn A))).
         rewrite untype_type_branches; auto.
       + unfold untype_type_spec; simpl.
         rewrite instruction_cast_domain_same.
@@ -745,6 +745,16 @@ Require Import String.
       + unfold untype_type_spec; simpl.
         rewrite instruction_cast_domain_same.
         reflexivity.
+      + unfold untype_type_spec; simpl.
+        assert (isSome_maybe (Typing string "No such self entrypoint"%string)
+                             (get_entrypoint_opt annot_opt self_type self_annot) = Return H).
+        * destruct (get_entrypoint_opt annot_opt self_type self_annot) as [x|].
+          -- simpl.
+             destruct H.
+             reflexivity.
+          -- inversion H.
+        * rewrite H0.
+          reflexivity.
       + unfold untype_type_spec.
         simpl. unfold type_check_dig.
         simpl.
diff --git a/src/michocoq/util.v b/src/michocoq/util.v
index be14206c..6a4eac34 100644
--- a/src/michocoq/util.v
+++ b/src/michocoq/util.v
@@ -116,6 +116,10 @@ Proof.
   intuition.
 Qed.
 
+Lemma or_both {P Q R S} : P <-> R -> Q <-> S -> ((P \/ Q) <-> (R \/ S)).
+Proof.
+  intuition.
+Qed.
 
 Lemma eqb_eq a c1 c2 :
   BinInt.Z.eqb (comparison_to_int (compare a c1 c2)) Z0 = true <->
@@ -211,3 +215,15 @@ Lemma eq_sym_iff {A : Type} (x y : A) : x = y <-> y = x.
 Proof.
   split; apply eq_sym.
 Qed.
+
+Lemma destruct_if (b : Datatypes.bool) P Q :
+  (if b then P else Q) <-> ((b = true /\ P ) \/ (b = false /\ Q)).
+Proof.
+  destruct b; intuition discriminate.
+Qed.
+
+Lemma bool_not_false b : b = false <-> ~ b = true.
+Proof.
+  destruct b; intuition congruence.
+Qed.
+
-- 
GitLab


From 3ae9aaf149b5c77ad9362a96f5fa690f7f0d59e9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Fri, 13 Mar 2020 16:54:06 +0100
Subject: [PATCH 12/56] [Tests] Update the test suite

---
 src/contracts/testsuite/attic/bad_lockup.tz   |  6 +-
 .../testsuite/attic/create_add1_lists.tz      |  3 -
 src/contracts/testsuite/attic/forward.tz      | 12 ++-
 .../testsuite/attic/list_of_transactions.tz   |  6 +-
 src/contracts/testsuite/attic/reentrancy.tz   |  8 +-
 .../{mini_scenarios => attic}/reservoir.tz    |  4 +-
 .../scrutable_reservoir.tz                    |  9 ++-
 .../testsuite/attic/spawn_identities.tz       |  2 -
 .../testsuite/deprecated/create_account.tz    | 29 +++++++
 .../testsuite/deprecated/create_contract.tz   | 18 +++++
 .../originator.tz                             |  0
 .../entrypoints/big_map_entrypoints.tz        | 31 ++++++++
 .../entrypoints/delegatable_target.tz         | 79 +++++++++++++++++++
 .../testsuite/entrypoints/manager.tz          | 31 ++++++++
 .../entrypoints/no_default_target.tz          | 11 +++
 .../entrypoints/no_entrypoint_target.tz       | 11 +++
 .../testsuite/entrypoints/rooted_target.tz    | 11 +++
 .../testsuite/ill_typed/big_map_arity.tz      |  5 ++
 .../ill_typed/invalid_self_entrypoint.tz      | 10 +++
 .../ill_typed/merge_comparable_pairs.tz       | 14 ++++
 .../testsuite/ill_typed/pack_big_map.tz       |  7 ++
 .../testsuite/ill_typed/pack_operation.tz     | 20 +++++
 .../mini_scenarios/authentication.tz          | 30 +++++++
 .../mini_scenarios/big_map_entrypoints.tz     | 31 ++++++++
 .../testsuite/mini_scenarios/big_map_magic.tz | 41 ++++++++++
 .../mini_scenarios/create_account.tz          | 12 ---
 .../mini_scenarios/create_contract.tz         | 33 +++++---
 .../mini_scenarios/create_contract_simple.tz  | 14 ++++
 .../mini_scenarios/default_account.tz         |  4 +
 .../testsuite/mini_scenarios/lockup.tz        |  3 +-
 .../testsuite/mini_scenarios/multiple_en2.tz  | 77 ++++++++++++++++++
 .../multiple_entrypoints_counter.tz           | 29 +++++++
 .../testsuite/mini_scenarios/replay.tz        |  1 +
 .../mini_scenarios/reveal_signed_preimage.tz  |  8 +-
 .../mini_scenarios/weather_insurance.tz       |  5 +-
 .../testsuite/mini_scenarios/xcat.tz          |  6 +-
 .../testsuite/non_regression/bug_262.tz       |  5 ++
 src/contracts/testsuite/opcodes/abs.tz        |  5 ++
 src/contracts/testsuite/opcodes/add.tz        | 25 ++++++
 src/contracts/testsuite/opcodes/address.tz    |  3 +
 src/contracts/testsuite/opcodes/and_binary.tz | 27 +++++++
 .../testsuite/opcodes/and_logical_1.tz        |  3 +
 .../testsuite/opcodes/big_map_mem_nat.tz      |  7 ++
 .../testsuite/opcodes/big_map_mem_string.tz   |  7 ++
 .../testsuite/opcodes/big_map_to_self.tz      | 22 ++++++
 src/contracts/testsuite/opcodes/car.tz        |  3 +
 src/contracts/testsuite/opcodes/cdr.tz        |  3 +
 src/contracts/testsuite/opcodes/chain_id.tz   |  3 +
 .../testsuite/opcodes/chain_id_store.tz       |  3 +
 .../testsuite/opcodes/check_signature.tz      |  8 +-
 src/contracts/testsuite/opcodes/compare.tz    | 52 ++++++++++++
 .../testsuite/opcodes/comparisons.tz          | 15 ++++
 .../testsuite/opcodes/concat_hello_bytes.tz   |  4 +
 src/contracts/testsuite/opcodes/cons.tz       |  3 +
 src/contracts/testsuite/opcodes/contract.tz   | 11 +++
 .../testsuite/opcodes/create_contract.tz      | 14 ++++
 src/contracts/testsuite/opcodes/dig_eq.tz     | 14 ++++
 src/contracts/testsuite/opcodes/dign.tz       |  3 +
 src/contracts/testsuite/opcodes/dip.tz        |  8 ++
 src/contracts/testsuite/opcodes/dipn.tz       |  3 +
 src/contracts/testsuite/opcodes/dropn.tz      |  3 +
 src/contracts/testsuite/opcodes/dugn.tz       |  3 +
 src/contracts/testsuite/opcodes/ediv.tz       | 13 +++
 src/contracts/testsuite/opcodes/ediv_mutez.tz | 12 +++
 .../testsuite/opcodes/get_big_map_value.tz    |  6 ++
 src/contracts/testsuite/opcodes/int.tz        |  5 ++
 src/contracts/testsuite/opcodes/list_size.tz  |  3 +
 src/contracts/testsuite/opcodes/map_map.tz    |  8 ++
 .../testsuite/opcodes/map_map_sideeffect.tz   | 12 +++
 .../testsuite/opcodes/map_mem_nat.tz          |  7 ++
 .../testsuite/opcodes/map_mem_string.tz       |  7 ++
 src/contracts/testsuite/opcodes/mul.tz        | 48 +++++++++++
 .../testsuite/opcodes/mul_overflow.tz         | 18 +++++
 src/contracts/testsuite/opcodes/neg.tz        |  8 ++
 src/contracts/testsuite/opcodes/none.tz       |  3 +
 src/contracts/testsuite/opcodes/not_binary.tz | 12 +++
 src/contracts/testsuite/opcodes/or_binary.tz  |  9 +++
 .../testsuite/opcodes/packunpack_rev.tz       | 41 ++++++++++
 .../testsuite/opcodes/packunpack_rev_cty.tz   | 31 ++++++++
 src/contracts/testsuite/opcodes/pexec.tz      |  6 ++
 src/contracts/testsuite/opcodes/pexec_2.tz    | 11 +++
 src/contracts/testsuite/opcodes/proxy.tz      | 13 +++
 src/contracts/testsuite/opcodes/self.tz       |  4 +-
 .../opcodes/self_with_default_entrypoint.tz   | 19 +++++
 .../testsuite/opcodes/self_with_entrypoint.tz | 26 ++++++
 src/contracts/testsuite/opcodes/sender.tz     |  8 ++
 .../testsuite/opcodes/set_delegate.tz         |  9 +++
 src/contracts/testsuite/opcodes/shifts.tz     | 18 +++++
 src/contracts/testsuite/opcodes/slice.tz      |  5 ++
 .../testsuite/opcodes/slice_bytes.tz          |  5 ++
 src/contracts/testsuite/opcodes/source.tz     | 10 +++
 .../testsuite/opcodes/steps_to_quota.tz       |  3 -
 .../testsuite/opcodes/update_big_map.tz       |  6 ++
 src/contracts/testsuite/opcodes/xor.tz        | 16 +++-
 94 files changed, 1221 insertions(+), 59 deletions(-)
 rename src/contracts/testsuite/{mini_scenarios => attic}/reservoir.tz (81%)
 rename src/contracts/testsuite/{mini_scenarios => attic}/scrutable_reservoir.tz (86%)
 create mode 100644 src/contracts/testsuite/deprecated/create_account.tz
 create mode 100644 src/contracts/testsuite/deprecated/create_contract.tz
 rename src/contracts/testsuite/{mini_scenarios => deprecated}/originator.tz (100%)
 create mode 100644 src/contracts/testsuite/entrypoints/big_map_entrypoints.tz
 create mode 100644 src/contracts/testsuite/entrypoints/delegatable_target.tz
 create mode 100644 src/contracts/testsuite/entrypoints/manager.tz
 create mode 100644 src/contracts/testsuite/entrypoints/no_default_target.tz
 create mode 100644 src/contracts/testsuite/entrypoints/no_entrypoint_target.tz
 create mode 100644 src/contracts/testsuite/entrypoints/rooted_target.tz
 create mode 100644 src/contracts/testsuite/ill_typed/big_map_arity.tz
 create mode 100644 src/contracts/testsuite/ill_typed/invalid_self_entrypoint.tz
 create mode 100644 src/contracts/testsuite/ill_typed/merge_comparable_pairs.tz
 create mode 100644 src/contracts/testsuite/ill_typed/pack_big_map.tz
 create mode 100644 src/contracts/testsuite/ill_typed/pack_operation.tz
 create mode 100644 src/contracts/testsuite/mini_scenarios/authentication.tz
 create mode 100644 src/contracts/testsuite/mini_scenarios/big_map_entrypoints.tz
 create mode 100644 src/contracts/testsuite/mini_scenarios/big_map_magic.tz
 delete mode 100644 src/contracts/testsuite/mini_scenarios/create_account.tz
 create mode 100644 src/contracts/testsuite/mini_scenarios/create_contract_simple.tz
 create mode 100644 src/contracts/testsuite/mini_scenarios/multiple_en2.tz
 create mode 100644 src/contracts/testsuite/mini_scenarios/multiple_entrypoints_counter.tz
 create mode 100644 src/contracts/testsuite/non_regression/bug_262.tz
 create mode 100644 src/contracts/testsuite/opcodes/abs.tz
 create mode 100644 src/contracts/testsuite/opcodes/add.tz
 create mode 100644 src/contracts/testsuite/opcodes/address.tz
 create mode 100644 src/contracts/testsuite/opcodes/and_binary.tz
 create mode 100644 src/contracts/testsuite/opcodes/and_logical_1.tz
 create mode 100644 src/contracts/testsuite/opcodes/big_map_mem_nat.tz
 create mode 100644 src/contracts/testsuite/opcodes/big_map_mem_string.tz
 create mode 100644 src/contracts/testsuite/opcodes/big_map_to_self.tz
 create mode 100644 src/contracts/testsuite/opcodes/car.tz
 create mode 100644 src/contracts/testsuite/opcodes/cdr.tz
 create mode 100644 src/contracts/testsuite/opcodes/chain_id.tz
 create mode 100644 src/contracts/testsuite/opcodes/chain_id_store.tz
 create mode 100644 src/contracts/testsuite/opcodes/compare.tz
 create mode 100644 src/contracts/testsuite/opcodes/comparisons.tz
 create mode 100644 src/contracts/testsuite/opcodes/concat_hello_bytes.tz
 create mode 100644 src/contracts/testsuite/opcodes/cons.tz
 create mode 100644 src/contracts/testsuite/opcodes/contract.tz
 create mode 100644 src/contracts/testsuite/opcodes/create_contract.tz
 create mode 100644 src/contracts/testsuite/opcodes/dig_eq.tz
 create mode 100644 src/contracts/testsuite/opcodes/dign.tz
 create mode 100644 src/contracts/testsuite/opcodes/dip.tz
 create mode 100644 src/contracts/testsuite/opcodes/dipn.tz
 create mode 100644 src/contracts/testsuite/opcodes/dropn.tz
 create mode 100644 src/contracts/testsuite/opcodes/dugn.tz
 create mode 100644 src/contracts/testsuite/opcodes/ediv.tz
 create mode 100644 src/contracts/testsuite/opcodes/ediv_mutez.tz
 create mode 100644 src/contracts/testsuite/opcodes/get_big_map_value.tz
 create mode 100644 src/contracts/testsuite/opcodes/int.tz
 create mode 100644 src/contracts/testsuite/opcodes/list_size.tz
 create mode 100644 src/contracts/testsuite/opcodes/map_map.tz
 create mode 100644 src/contracts/testsuite/opcodes/map_map_sideeffect.tz
 create mode 100644 src/contracts/testsuite/opcodes/map_mem_nat.tz
 create mode 100644 src/contracts/testsuite/opcodes/map_mem_string.tz
 create mode 100644 src/contracts/testsuite/opcodes/mul.tz
 create mode 100644 src/contracts/testsuite/opcodes/mul_overflow.tz
 create mode 100644 src/contracts/testsuite/opcodes/neg.tz
 create mode 100644 src/contracts/testsuite/opcodes/none.tz
 create mode 100644 src/contracts/testsuite/opcodes/not_binary.tz
 create mode 100644 src/contracts/testsuite/opcodes/or_binary.tz
 create mode 100644 src/contracts/testsuite/opcodes/packunpack_rev.tz
 create mode 100644 src/contracts/testsuite/opcodes/packunpack_rev_cty.tz
 create mode 100644 src/contracts/testsuite/opcodes/pexec.tz
 create mode 100644 src/contracts/testsuite/opcodes/pexec_2.tz
 create mode 100644 src/contracts/testsuite/opcodes/proxy.tz
 create mode 100644 src/contracts/testsuite/opcodes/self_with_default_entrypoint.tz
 create mode 100644 src/contracts/testsuite/opcodes/self_with_entrypoint.tz
 create mode 100644 src/contracts/testsuite/opcodes/sender.tz
 create mode 100644 src/contracts/testsuite/opcodes/set_delegate.tz
 create mode 100644 src/contracts/testsuite/opcodes/shifts.tz
 create mode 100644 src/contracts/testsuite/opcodes/slice.tz
 create mode 100644 src/contracts/testsuite/opcodes/slice_bytes.tz
 create mode 100644 src/contracts/testsuite/opcodes/source.tz
 delete mode 100644 src/contracts/testsuite/opcodes/steps_to_quota.tz
 create mode 100644 src/contracts/testsuite/opcodes/update_big_map.tz

diff --git a/src/contracts/testsuite/attic/bad_lockup.tz b/src/contracts/testsuite/attic/bad_lockup.tz
index aeb3ec7f..f334e899 100644
--- a/src/contracts/testsuite/attic/bad_lockup.tz
+++ b/src/contracts/testsuite/attic/bad_lockup.tz
@@ -1,6 +1,6 @@
 parameter unit;
-storage (pair timestamp (pair (contract unit) (contract unit)));
+storage (pair timestamp (pair address address));
 code { CDR; DUP; CAR; NOW; CMPLT; IF {FAIL} {};
-       DUP; CDAR; PUSH mutez 100000000; UNIT; TRANSFER_TOKENS; SWAP;
-       DUP; CDDR; PUSH mutez 100000000; UNIT; TRANSFER_TOKENS; DIP {SWAP} ;
+       DUP; CDAR; CONTRACT unit ; ASSERT_SOME ; PUSH mutez 100000000; UNIT; TRANSFER_TOKENS; SWAP;
+       DUP; CDDR; CONTRACT unit ; ASSERT_SOME ; PUSH mutez 100000000; UNIT; TRANSFER_TOKENS; DIP {SWAP} ;
        NIL operation ; SWAP ; CONS ; SWAP ; CONS ; PAIR }
diff --git a/src/contracts/testsuite/attic/create_add1_lists.tz b/src/contracts/testsuite/attic/create_add1_lists.tz
index c183ad1e..5a424596 100644
--- a/src/contracts/testsuite/attic/create_add1_lists.tz
+++ b/src/contracts/testsuite/attic/create_add1_lists.tz
@@ -2,10 +2,7 @@ parameter unit;
 storage address;
 code { DROP; NIL int; # starting storage for contract
        AMOUNT;                   # Push the starting balance
-       PUSH bool False;          # Not spendable
-       DUP;                      # Or delegatable
        NONE key_hash;                 # No delegate
-       PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5";
        CREATE_CONTRACT          # Create the contract
          { parameter (list int) ;
            storage (list int) ;
diff --git a/src/contracts/testsuite/attic/forward.tz b/src/contracts/testsuite/attic/forward.tz
index 9894dae2..5b66891b 100644
--- a/src/contracts/testsuite/attic/forward.tz
+++ b/src/contracts/testsuite/attic/forward.tz
@@ -8,8 +8,8 @@ storage
         (pair
            (pair mutez mutez) # K C
            (pair
-              (pair (contract unit) (contract unit)) # B S
-              (contract unit))))) ; # W
+              (pair address address) # B S
+              address)))) ; # W
 code
   { DUP ; CDDADDR ; # Z
     PUSH int 86400 ; SWAP ; ADD ; # one day in second
@@ -49,15 +49,18 @@ code
          IF { # refund the parties
               CDR ; DUP ; CADAR ; # amount versed by the buyer
               DIP { DUP ; CDDDAAR } ; # B
+              DIP { CONTRACT unit ; ASSERT_SOME } ;
               UNIT ; TRANSFER_TOKENS ;
               NIL operation ; SWAP ; CONS ; SWAP ;
               DUP ; CADDR ; # amount versed by the seller
               DIP { DUP ; CDDDADR } ; # S
+              DIP { CONTRACT unit ; ASSERT_SOME } ;
               UNIT ; TRANSFER_TOKENS ; SWAP ;
               DIP { CONS } ;
               DUP ; CADAR ; DIP { DUP ; CADDR } ; ADD ;
               BALANCE ; SUB ; # bonus to the warehouse
               DIP { DUP ; CDDDDR } ; # W
+              DIP { CONTRACT unit ; ASSERT_SOME } ;
               UNIT ; TRANSFER_TOKENS ;
               DIP { SWAP } ; CONS ;
               # leave the storage as-is, as the balance is now 0
@@ -101,6 +104,7 @@ code
                              BALANCE ;
                              DIP { DUP ; CDDDDADR } ; # S
                              DIIP { CDR } ;
+                             DIP { CONTRACT unit ; ASSERT_SOME } ;
                              UNIT ; TRANSFER_TOKENS ;
                              NIL operation ; SWAP ; CONS ; PAIR }
                            { # otherwise continue
@@ -110,7 +114,7 @@ code
                              NOW ; COMPARE ; LT ;
                              IF { # Between T + 24 and T + 48
                                   # We accept only delivery notifications, from W
-                                  DUP ; CDDDDDR ; ADDRESS ; # W
+                                  DUP ; CDDDDDR ; # W
                                   SENDER ;
                                   COMPARE ; NEQ ;
                                   IF { FAIL } {} ; # fail if not the warehouse
@@ -132,6 +136,7 @@ code
                                            BALANCE ;
                                            DIP { DUP ; CDDDDADR } ; # S
                                            DIIP { CDR } ;
+                                           DIP { CONTRACT unit ; ASSERT_SOME } ;
                                            UNIT ; TRANSFER_TOKENS ;
                                            NIL operation ; SWAP ; CONS } } ;
                                   PAIR }
@@ -139,6 +144,7 @@ code
                                   BALANCE ;
                                   DIP { DUP ; CDDDDAAR } ; # B
                                   DIIP { CDR } ;
+                                  DIP { CONTRACT unit ; ASSERT_SOME } ;
                                   UNIT ; TRANSFER_TOKENS ;
                                   NIL operation ; SWAP ; CONS ;
                                   PAIR} } } } } } }
\ No newline at end of file
diff --git a/src/contracts/testsuite/attic/list_of_transactions.tz b/src/contracts/testsuite/attic/list_of_transactions.tz
index 412112aa..620ceedd 100644
--- a/src/contracts/testsuite/attic/list_of_transactions.tz
+++ b/src/contracts/testsuite/attic/list_of_transactions.tz
@@ -1,8 +1,8 @@
 parameter unit;
-storage (list (contract unit));
+storage (list address);
 code { CDR; DUP;
        DIP {NIL operation}; PUSH bool True;     # Setup loop
-       LOOP {IF_CONS { PUSH mutez 1000000; UNIT; TRANSFER_TOKENS; # Make transfer
+       LOOP {IF_CONS { CONTRACT unit ; ASSERT_SOME ; PUSH mutez 1000000; UNIT; TRANSFER_TOKENS; # Make transfer
                        SWAP; DIP {CONS}; PUSH bool True}                   # Setup for next round of loop
-                     { NIL (contract unit); PUSH bool False}}; # Data to satisfy types and end loop
+                     { NIL address ; PUSH bool False}}; # Data to satisfy types and end loop
        DROP; PAIR};                                                 # Calling convention
diff --git a/src/contracts/testsuite/attic/reentrancy.tz b/src/contracts/testsuite/attic/reentrancy.tz
index 2e5d9206..b9e614a4 100644
--- a/src/contracts/testsuite/attic/reentrancy.tz
+++ b/src/contracts/testsuite/attic/reentrancy.tz
@@ -1,7 +1,7 @@
 parameter unit;
-storage (pair (contract unit) (contract unit));
-code { CDR; DUP; CAR; PUSH mutez 5000000; UNIT;
-       TRANSFER_TOKENS;
+storage (pair address address);
+code { CDR; DUP; CAR;
+       CONTRACT unit ; ASSERT_SOME ; PUSH mutez 5000000; UNIT; TRANSFER_TOKENS;
        DIP {DUP; CDR;
-            PUSH mutez 5000000; UNIT; TRANSFER_TOKENS};
+            CONTRACT unit ; ASSERT_SOME ; PUSH mutez 5000000; UNIT; TRANSFER_TOKENS};
        DIIP{NIL operation};DIP{CONS};CONS;PAIR};
diff --git a/src/contracts/testsuite/mini_scenarios/reservoir.tz b/src/contracts/testsuite/attic/reservoir.tz
similarity index 81%
rename from src/contracts/testsuite/mini_scenarios/reservoir.tz
rename to src/contracts/testsuite/attic/reservoir.tz
index 4e693c9b..291e09b2 100644
--- a/src/contracts/testsuite/mini_scenarios/reservoir.tz
+++ b/src/contracts/testsuite/attic/reservoir.tz
@@ -2,7 +2,7 @@ parameter unit ;
 storage
   (pair
      (pair (timestamp %T) (mutez %N))
-     (pair (contract %A unit) (contract %B unit))) ;
+     (pair (address %A) (address %B))) ;
 code
   { CDR ; DUP ; CAAR %T; # T
     NOW ; COMPARE ; LE ;
@@ -11,11 +11,13 @@ code
          COMPARE ; LE ;
          IF { NIL operation ; PAIR }
             { DUP ; CDDR %B; # B
+              CONTRACT unit ; ASSERT_SOME ;
               BALANCE ; UNIT ;
               TRANSFER_TOKENS ;
               NIL operation ; SWAP ; CONS ;
               PAIR } }
        { DUP ; CDAR %A; # A
+         CONTRACT unit ; ASSERT_SOME ;
          BALANCE ;
          UNIT ;
          TRANSFER_TOKENS ;
diff --git a/src/contracts/testsuite/mini_scenarios/scrutable_reservoir.tz b/src/contracts/testsuite/attic/scrutable_reservoir.tz
similarity index 86%
rename from src/contracts/testsuite/mini_scenarios/scrutable_reservoir.tz
rename to src/contracts/testsuite/attic/scrutable_reservoir.tz
index 9e30a1a7..d415cdda 100644
--- a/src/contracts/testsuite/mini_scenarios/scrutable_reservoir.tz
+++ b/src/contracts/testsuite/attic/scrutable_reservoir.tz
@@ -7,8 +7,8 @@ storage
         (pair
            (pair mutez mutez) # P N
            (pair
-              (contract unit) # X
-              (pair (contract unit) (contract unit)))))) ; # A B
+              address # X
+              (pair address address))))) ; # A B
 code
   { DUP ; CDAR ; # S
     PUSH string "open" ;
@@ -34,10 +34,12 @@ code
                    # We transfer the fee to the broker
                    DUP ; CDDAAR ; # P
                    DIP { DUP ; CDDDAR } ; # X
+                   DIP { CONTRACT unit ; ASSERT_SOME } ;
                    UNIT ; TRANSFER_TOKENS ;
                    # We transfer the rest to A
                    DIP { DUP ; CDDADR ; # N
                          DIP { DUP ; CDDDDAR } ; # A
+                         DIP { CONTRACT unit ; ASSERT_SOME } ;
                          UNIT ; TRANSFER_TOKENS } ;
                    NIL operation ; SWAP ; CONS ; SWAP ; CONS ;
                    PAIR } }
@@ -50,13 +52,16 @@ code
               COMPARE ; LT ; # available < P
               IF { BALANCE ; # available
                    DIP { DUP ; CDDDAR } ; # X
+                   DIP { CONTRACT unit ; ASSERT_SOME } ;
                    UNIT ; TRANSFER_TOKENS }
                  { DUP ; CDDAAR ; # P
                    DIP { DUP ; CDDDAR } ; # X
+                   DIP { CONTRACT unit ; ASSERT_SOME } ;
                    UNIT ; TRANSFER_TOKENS } ;
               # We transfer the rest to B
               DIP { BALANCE ; # available
                     DIP { DUP ; CDDDDDR } ; # B
+                    DIP { CONTRACT unit ; ASSERT_SOME } ;
                     UNIT ; TRANSFER_TOKENS } ;
               NIL operation ; SWAP ; CONS ; SWAP ; CONS ;
               PAIR } } }
diff --git a/src/contracts/testsuite/attic/spawn_identities.tz b/src/contracts/testsuite/attic/spawn_identities.tz
index 91b062af..b8e64bb8 100644
--- a/src/contracts/testsuite/attic/spawn_identities.tz
+++ b/src/contracts/testsuite/attic/spawn_identities.tz
@@ -9,9 +9,7 @@ code { DUP;
                  { PUSH nat 1; SWAP; SUB; ABS; # Subtract 1. The ABS is to make it back into a nat
                    PUSH string "init"; # Storage type
                    PUSH mutez 5000000; # Strating balance
-                   PUSH bool False; DUP; # Not spendable or delegatable
                    NONE key_hash;
-                   PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5";
                    CREATE_CONTRACT
                      { parameter string ;
                        storage string ;
diff --git a/src/contracts/testsuite/deprecated/create_account.tz b/src/contracts/testsuite/deprecated/create_account.tz
new file mode 100644
index 00000000..7cd38465
--- /dev/null
+++ b/src/contracts/testsuite/deprecated/create_account.tz
@@ -0,0 +1,29 @@
+/*
+- optional storage: the address of the created account
+- param: Left [hash]:
+
+  Create an account with manager [hash]; then perform a recursive call
+  on Right [addr] where [addr] is the address of the newly created
+  account.
+
+  The created account has an initial balance of 100tz. It is not
+  delegatable.
+
+- param: Right [addr]:
+
+  Check that the sender is self and that [addr] is a contract of type
+  [unit]. Finally store [addr].
+
+*/
+parameter (or key_hash address) ;
+storage (option address) ;
+code { CAR;
+       IF_LEFT
+         { DIP { PUSH mutez 100000000 ; PUSH bool False ; NONE key_hash };
+           CREATE_ACCOUNT ;
+           DIP { RIGHT key_hash ; DIP { SELF ; PUSH mutez 0 } ; TRANSFER_TOKENS ;
+                 NIL operation ; SWAP ; CONS } ;
+           CONS ; NONE address ; SWAP ; PAIR }
+         { SELF ; ADDRESS ; SENDER ; IFCMPNEQ { FAIL } {} ;
+           DUP ; CONTRACT unit ; IF_SOME { DROP ; SOME } { FAIL } ;
+           NIL operation ; PAIR } } ;
diff --git a/src/contracts/testsuite/deprecated/create_contract.tz b/src/contracts/testsuite/deprecated/create_contract.tz
new file mode 100644
index 00000000..a162044a
--- /dev/null
+++ b/src/contracts/testsuite/deprecated/create_contract.tz
@@ -0,0 +1,18 @@
+parameter (or key_hash address);
+storage unit;
+code { CAR;
+       IF_LEFT
+         { DIP { PUSH string "dummy";
+                 PUSH mutez 100000000 ; PUSH bool False ;
+                 PUSH bool False ; NONE key_hash } ;
+           CREATE_CONTRACT
+             { parameter string ;
+               storage string ;
+               code { CAR ; NIL operation ; PAIR } } ;
+           DIP { RIGHT key_hash ; DIP { SELF ; PUSH mutez 0 } ; TRANSFER_TOKENS ;
+                 NIL operation ; SWAP ; CONS } ;
+           CONS ; UNIT ; SWAP ; PAIR }
+         { SELF ; ADDRESS ; SENDER ; IFCMPNEQ { FAIL } {} ;
+           CONTRACT string ; IF_SOME {} { FAIL } ;
+           PUSH mutez 0 ; PUSH string "abcdefg" ; TRANSFER_TOKENS ;
+           NIL operation; SWAP; CONS ; UNIT ; SWAP ; PAIR } };
diff --git a/src/contracts/testsuite/mini_scenarios/originator.tz b/src/contracts/testsuite/deprecated/originator.tz
similarity index 100%
rename from src/contracts/testsuite/mini_scenarios/originator.tz
rename to src/contracts/testsuite/deprecated/originator.tz
diff --git a/src/contracts/testsuite/entrypoints/big_map_entrypoints.tz b/src/contracts/testsuite/entrypoints/big_map_entrypoints.tz
new file mode 100644
index 00000000..d49e6257
--- /dev/null
+++ b/src/contracts/testsuite/entrypoints/big_map_entrypoints.tz
@@ -0,0 +1,31 @@
+storage
+  (pair (big_map string nat) (big_map string nat)) ;
+parameter
+  (or (unit %default)
+      (or (or %mem (string %mem_left) (string %mem_right))
+          (or (or %add (pair %add_left string nat) (pair %add_right string nat))
+              (or %rem (string %rem_left) (string %rem_right))))) ;
+code { UNPAIR ;
+       IF_LEFT
+         { DROP ;
+           DUP ; CAR ;
+           PUSH mutez 0 ;
+           NONE key_hash ;
+           CREATE_CONTRACT
+             { parameter string ;
+               storage (big_map string nat) ;
+               code { UNPAIR ; DROP ; NIL operation ; PAIR }} ;
+           DIP { DROP } ;
+           NIL operation ; SWAP ; CONS ; PAIR }
+         { IF_LEFT
+             { IF_LEFT
+                 { DIP { UNPAIR } ; DIP { DUP } ; MEM ; ASSERT }
+                 { DIP { UNPAIR ; SWAP } ; DIP { DUP } ; MEM ; ASSERT ; SWAP } }
+             { IF_LEFT
+                 { IF_LEFT
+                     { UNPAIR ; DIIP { UNPAIR } ; DIP { SOME } ; UPDATE }
+                     { UNPAIR ; DIIP { UNPAIR ; SWAP } ; DIP { SOME } ; UPDATE ; SWAP } }
+                 { IF_LEFT
+                     { DIP { UNPAIR } ; DIP { NONE nat } ; UPDATE }
+                     { DIP { UNPAIR ; SWAP } ; DIP { NONE nat } ; UPDATE ; SWAP } } } ;
+           PAIR ; NIL operation ; PAIR } }
diff --git a/src/contracts/testsuite/entrypoints/delegatable_target.tz b/src/contracts/testsuite/entrypoints/delegatable_target.tz
new file mode 100644
index 00000000..0db00f49
--- /dev/null
+++ b/src/contracts/testsuite/entrypoints/delegatable_target.tz
@@ -0,0 +1,79 @@
+# Michelson pseudo-code to transform from source script.
+  # This transformation adds 'set_delegate' entrypoint, e.g.:
+  #
+  #  parameter <parameter_expr> ;
+  #  storage <storage_expr> ;
+  #  code <code_expr> ;
+  #
+  # to:
+parameter
+  (or
+     (or (key_hash %set_delegate)
+         (unit %remove_delegate))
+     (or %default string nat)
+  ) ;
+
+storage
+  (pair
+     key_hash # manager
+     (pair string nat)
+  ) ;
+
+code {
+       DUP ;
+       CAR ;
+       IF_LEFT
+         { # 'set_delegate'/'remove_delegate' entrypoints
+           # Assert no token was sent:
+           # to send tokens, the default entry point should be used
+           PUSH mutez 0 ;
+           AMOUNT ;
+           ASSERT_CMPEQ ;
+           # Assert that the sender is the manager
+           DUUP ;
+           CDR ;
+           CAR ;
+           IMPLICIT_ACCOUNT ; ADDRESS ;
+           SENDER ;
+           IFCMPNEQ
+             { SENDER ;
+               PUSH string "Only the owner can operate." ;
+               PAIR ;
+               FAILWITH ;
+             }
+             { DIP { CDR ; NIL operation } ;
+               IF_LEFT
+                 { # 'set_delegate' entrypoint
+                   SOME ;
+                   SET_DELEGATE ;
+                   CONS ;
+                   PAIR ;
+                 }
+                 { # 'remove_delegate' entrypoint
+                   DROP ;
+                   NONE key_hash ;
+                   SET_DELEGATE ;
+                   CONS ;
+                   PAIR ;
+                 }
+             }
+         }
+         { # Transform the inputs to the original script types
+           DIP { CDR ; DUP ; CDR } ;
+           PAIR ;
+
+           # 'default' entrypoint - original code
+           { UNPAIR;
+             IF_LEFT
+               { DIP { UNPAIR ; DROP } }
+               { DUG 1; UNPAIR ; DIP { DROP } } ;
+             PAIR ; NIL operation ; PAIR }
+           # Transform the outputs to the new script types (manager's storage is unchanged)
+           SWAP ;
+           CAR ;
+           SWAP ;
+           UNPAIR ;
+           DIP { SWAP ; PAIR } ;
+           PAIR ;
+         }
+     }
diff --git a/src/contracts/testsuite/entrypoints/manager.tz b/src/contracts/testsuite/entrypoints/manager.tz
new file mode 100644
index 00000000..06d9b106
--- /dev/null
+++ b/src/contracts/testsuite/entrypoints/manager.tz
@@ -0,0 +1,31 @@
+parameter
+  (or
+     (lambda %do unit (list operation))
+     (unit %default));
+storage key_hash;
+code
+  { UNPAIR ;
+    IF_LEFT
+      { # 'do' entrypoint
+        # Assert no token was sent:
+        # to send tokens, the default entry point should be used
+        PUSH mutez 0 ;
+        AMOUNT ;
+        ASSERT_CMPEQ ;
+        # Assert that the sender is the manager
+        DUUP ;
+        IMPLICIT_ACCOUNT ;
+        ADDRESS ;
+        SENDER ;
+        ASSERT_CMPEQ ;
+        # Execute the lambda argument
+        UNIT ;
+        EXEC ;
+        PAIR ;
+      }
+      { # 'default' entrypoint
+        DROP ;
+        NIL operation ;
+        PAIR ;
+      }
+  };
diff --git a/src/contracts/testsuite/entrypoints/no_default_target.tz b/src/contracts/testsuite/entrypoints/no_default_target.tz
new file mode 100644
index 00000000..48d5d53d
--- /dev/null
+++ b/src/contracts/testsuite/entrypoints/no_default_target.tz
@@ -0,0 +1,11 @@
+storage (pair string nat) ;
+parameter
+  (or unit (or %data string nat)) ;
+code { UNPAIR ;
+       IF_LEFT
+         { DROP ; NIL operation ; PAIR }
+         { IF_LEFT
+             { DIP { UNPAIR ; DROP } }
+             { DUG 1; UNPAIR ; DIP { DROP } } ;
+           PAIR ; NIL operation ; PAIR }
+     }
diff --git a/src/contracts/testsuite/entrypoints/no_entrypoint_target.tz b/src/contracts/testsuite/entrypoints/no_entrypoint_target.tz
new file mode 100644
index 00000000..d8041507
--- /dev/null
+++ b/src/contracts/testsuite/entrypoints/no_entrypoint_target.tz
@@ -0,0 +1,11 @@
+storage (pair string nat) ;
+parameter
+  (or unit (or string nat)) ;
+code { UNPAIR ;
+       IF_LEFT
+         { DROP ; NIL operation ; PAIR }
+         { IF_LEFT
+             { DIP { UNPAIR ; DROP } }
+             { DUG 1; UNPAIR ; DIP { DROP } } ;
+           PAIR ; NIL operation ; PAIR }
+     }
diff --git a/src/contracts/testsuite/entrypoints/rooted_target.tz b/src/contracts/testsuite/entrypoints/rooted_target.tz
new file mode 100644
index 00000000..2ca2dfb1
--- /dev/null
+++ b/src/contracts/testsuite/entrypoints/rooted_target.tz
@@ -0,0 +1,11 @@
+storage (pair string nat) ;
+parameter
+  (or %root unit (or %default string nat)) ;
+code { UNPAIR ;
+       IF_LEFT
+         { DROP ; NIL operation ; PAIR }
+         { IF_LEFT
+             { DIP { UNPAIR ; DROP } }
+             { DUG 1; UNPAIR ; DIP { DROP } } ;
+           PAIR ; NIL operation ; PAIR }
+     }
diff --git a/src/contracts/testsuite/ill_typed/big_map_arity.tz b/src/contracts/testsuite/ill_typed/big_map_arity.tz
new file mode 100644
index 00000000..5e5a7d60
--- /dev/null
+++ b/src/contracts/testsuite/ill_typed/big_map_arity.tz
@@ -0,0 +1,5 @@
+# This contract tests the error message in case the EMPTY_BIG_MAP instruction has bad arity (1 argument instead of 2).
+# The expected type-checking error is "primitive EMPTY_BIG_MAP expects 2 arguments but is given 1."
+parameter unit;
+storage unit;
+code { DROP;  EMPTY_BIG_MAP nat;  DROP; UNIT;  NIL operation; PAIR; }
diff --git a/src/contracts/testsuite/ill_typed/invalid_self_entrypoint.tz b/src/contracts/testsuite/ill_typed/invalid_self_entrypoint.tz
new file mode 100644
index 00000000..4fac9c63
--- /dev/null
+++ b/src/contracts/testsuite/ill_typed/invalid_self_entrypoint.tz
@@ -0,0 +1,10 @@
+parameter (or (or (nat %A) (bool %B)) (or %maybe_C (unit %Z) (string %C)));
+storage unit;
+code {
+       DROP;
+       # This entrypoint does not exist
+       SELF %D; DROP;
+       UNIT;
+       NIL operation;
+       PAIR;
+     }
diff --git a/src/contracts/testsuite/ill_typed/merge_comparable_pairs.tz b/src/contracts/testsuite/ill_typed/merge_comparable_pairs.tz
new file mode 100644
index 00000000..14fcc734
--- /dev/null
+++ b/src/contracts/testsuite/ill_typed/merge_comparable_pairs.tz
@@ -0,0 +1,14 @@
+# tests that merging comparable pair types works
+parameter (set (pair (nat %n) (pair %p (string %s) (int %i))));
+storage nat;
+code {UNPAIR;
+      SWAP;
+      PUSH nat 3;
+      COMPARE;
+      GT;
+      IF {}
+         {DROP;
+          EMPTY_SET (pair nat (pair string int));};
+      SIZE;
+      NIL operation;
+      PAIR;}
diff --git a/src/contracts/testsuite/ill_typed/pack_big_map.tz b/src/contracts/testsuite/ill_typed/pack_big_map.tz
new file mode 100644
index 00000000..29ae0d66
--- /dev/null
+++ b/src/contracts/testsuite/ill_typed/pack_big_map.tz
@@ -0,0 +1,7 @@
+parameter unit;
+storage (pair (big_map int int) unit);
+code { CDAR;
+       DUP; PACK; DROP;
+       UNIT; SWAP; PAIR;
+       NIL operation;
+       PAIR; }
diff --git a/src/contracts/testsuite/ill_typed/pack_operation.tz b/src/contracts/testsuite/ill_typed/pack_operation.tz
new file mode 100644
index 00000000..349ca053
--- /dev/null
+++ b/src/contracts/testsuite/ill_typed/pack_operation.tz
@@ -0,0 +1,20 @@
+parameter unit;
+storage unit;
+code { DROP;
+       UNIT; # starting storage for contract
+       AMOUNT;                   # Push the starting balance
+       NONE key_hash;                 # No delegate
+       CREATE_CONTRACT          # Create the contract
+         { parameter unit ;
+           storage unit ;
+           code
+             { CDR;
+               NIL operation;
+               PAIR; } };
+       DIP { DROP };
+       # invalid PACK
+       PACK;
+       DROP;
+       UNIT;
+       NIL operation;
+       PAIR; }
diff --git a/src/contracts/testsuite/mini_scenarios/authentication.tz b/src/contracts/testsuite/mini_scenarios/authentication.tz
new file mode 100644
index 00000000..021bbd26
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/authentication.tz
@@ -0,0 +1,30 @@
+/*
+
+This contract is an example of using a cryptographic signature to
+handle authentication. A public key is stored, and only the owner of
+the secret key associated to this public key can interact with the
+contract. She is allowed to perform any list of operations by sending
+them wrapped in a lambda to the contract with a cryptographic
+signature.
+
+To ensure that each signature is used only once and is not replayed by
+an attacker, not only the lambda is signed but also the unique
+identifier of the contract (a pair of the contract address and the
+chain id) and a counter that is incremented at each successful call.
+
+More precisely, the signature should check against pack ((chain_id,
+self) (param, counter)).
+
+*/
+parameter (pair (lambda unit (list operation)) signature);
+storage (pair (nat %counter) key);
+code
+  {
+    UNPPAIPAIR;
+    DUUUP; DUUP ; SELF; CHAIN_ID ; PPAIPAIR; PACK;
+    DIP { SWAP }; DUUUUUP ; DIP { SWAP };
+    DUUUP; DIP {CHECK_SIGNATURE}; SWAP; IF {DROP} {FAILWITH};
+    UNIT; EXEC;
+    DIP { PUSH nat 1; ADD };
+    PAPAIR
+  }
diff --git a/src/contracts/testsuite/mini_scenarios/big_map_entrypoints.tz b/src/contracts/testsuite/mini_scenarios/big_map_entrypoints.tz
new file mode 100644
index 00000000..d49e6257
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/big_map_entrypoints.tz
@@ -0,0 +1,31 @@
+storage
+  (pair (big_map string nat) (big_map string nat)) ;
+parameter
+  (or (unit %default)
+      (or (or %mem (string %mem_left) (string %mem_right))
+          (or (or %add (pair %add_left string nat) (pair %add_right string nat))
+              (or %rem (string %rem_left) (string %rem_right))))) ;
+code { UNPAIR ;
+       IF_LEFT
+         { DROP ;
+           DUP ; CAR ;
+           PUSH mutez 0 ;
+           NONE key_hash ;
+           CREATE_CONTRACT
+             { parameter string ;
+               storage (big_map string nat) ;
+               code { UNPAIR ; DROP ; NIL operation ; PAIR }} ;
+           DIP { DROP } ;
+           NIL operation ; SWAP ; CONS ; PAIR }
+         { IF_LEFT
+             { IF_LEFT
+                 { DIP { UNPAIR } ; DIP { DUP } ; MEM ; ASSERT }
+                 { DIP { UNPAIR ; SWAP } ; DIP { DUP } ; MEM ; ASSERT ; SWAP } }
+             { IF_LEFT
+                 { IF_LEFT
+                     { UNPAIR ; DIIP { UNPAIR } ; DIP { SOME } ; UPDATE }
+                     { UNPAIR ; DIIP { UNPAIR ; SWAP } ; DIP { SOME } ; UPDATE ; SWAP } }
+                 { IF_LEFT
+                     { DIP { UNPAIR } ; DIP { NONE nat } ; UPDATE }
+                     { DIP { UNPAIR ; SWAP } ; DIP { NONE nat } ; UPDATE ; SWAP } } } ;
+           PAIR ; NIL operation ; PAIR } }
diff --git a/src/contracts/testsuite/mini_scenarios/big_map_magic.tz b/src/contracts/testsuite/mini_scenarios/big_map_magic.tz
new file mode 100644
index 00000000..f4e36f63
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/big_map_magic.tz
@@ -0,0 +1,41 @@
+# this contracts handles two big_maps
+storage
+  (or (pair (big_map string string) (big_map string string)) unit) ;
+parameter
+  # it has 5 entry points
+  # swap: swaps the two maps.
+  (or (unit %swap)
+     # reset: resets storage, either to a new pair of maps, or to unit
+      (or (or %reset (pair (big_map string string) (big_map string string)) unit)
+          # import: drops the existing storage and creates two maps
+          # from the given lists of string pairs.
+          (or (pair %import (list (pair string string)) (list (pair string string)))
+              # add: adds the given list of key - value pairs into the
+              # first map
+              (or (list %add (pair string string))
+                  # rem: removes the given list of key - value pairs
+                  # from the first map
+                  (list %rem string))))) ;
+code { UNPAIR ;
+       IF_LEFT
+         { DROP ; ASSERT_LEFT ; UNPAIR ; SWAP ; PAIR ; LEFT unit }
+         { IF_LEFT
+             { SWAP ; DROP }
+             { IF_LEFT
+                 { DIP { ASSERT_RIGHT ; DROP } ;
+                   UNPAIR ;
+                   DIP { EMPTY_BIG_MAP string string } ;
+                   ITER { UNPAIR ; DIP { SOME } ; UPDATE } ;
+                   SWAP ;
+                   DIP { EMPTY_BIG_MAP string string } ;
+                   ITER { UNPAIR ; DIP { SOME } ; UPDATE } ;
+                   SWAP ;
+                   PAIR ; LEFT unit }
+                 { IF_LEFT
+                     { DIP { ASSERT_LEFT ; UNPAIR } ;
+                       ITER { UNPAIR ; DIP { SOME } ; UPDATE } ;
+                       PAIR ; LEFT unit }
+                     { DIP { ASSERT_LEFT ; UNPAIR } ;
+                       ITER { DIP { NONE string } ; UPDATE } ;
+                       PAIR ; LEFT unit } }} } ;
+       NIL operation ; PAIR }
\ No newline at end of file
diff --git a/src/contracts/testsuite/mini_scenarios/create_account.tz b/src/contracts/testsuite/mini_scenarios/create_account.tz
deleted file mode 100644
index 6d0d261e..00000000
--- a/src/contracts/testsuite/mini_scenarios/create_account.tz
+++ /dev/null
@@ -1,12 +0,0 @@
-parameter (or key_hash address) ;
-storage (option (contract unit)) ;
-code { CAR;
-       IF_LEFT
-         { DIP { PUSH mutez 100000000 ; PUSH bool False ; NONE key_hash };
-           CREATE_ACCOUNT ;
-           DIP { RIGHT key_hash ; DIP { SELF ; PUSH mutez 0 } ; TRANSFER_TOKENS ;
-                 NIL operation ; SWAP ; CONS } ;
-           CONS ; NONE (contract unit) ; SWAP ; PAIR }
-         { SELF ; ADDRESS ; SENDER ; IFCMPNEQ { FAIL } {} ;
-           CONTRACT unit ; DUP ; IF_SOME { DROP } { FAIL } ;
-           NIL operation ; PAIR } } ;
diff --git a/src/contracts/testsuite/mini_scenarios/create_contract.tz b/src/contracts/testsuite/mini_scenarios/create_contract.tz
index a162044a..0d09a1fd 100644
--- a/src/contracts/testsuite/mini_scenarios/create_contract.tz
+++ b/src/contracts/testsuite/mini_scenarios/create_contract.tz
@@ -1,18 +1,33 @@
-parameter (or key_hash address);
-storage unit;
-code { CAR;
-       IF_LEFT
-         { DIP { PUSH string "dummy";
-                 PUSH mutez 100000000 ; PUSH bool False ;
-                 PUSH bool False ; NONE key_hash } ;
+/*
+- param: None:
+
+  Create a contract then perform a recursive call on Some [addr] where
+  [addr] is the address of the newly created contract.
+
+  The created contract simply stores its parameter (a string).  It is
+  initialized with the storage "dummy" and has an initial balance of
+  100tz. It has no delegate so these 100tz are totally frozen.
+
+- param: Some [addr]:
+
+  Check that the sender is self, call the contract at address [addr]
+  with param "abcdefg" transferring 0tz.
+
+*/
+parameter (option address) ;
+storage unit ;
+code { CAR ;
+       IF_NONE
+         { PUSH string "dummy" ;
+           PUSH mutez 100000000 ; NONE key_hash ;
            CREATE_CONTRACT
              { parameter string ;
                storage string ;
                code { CAR ; NIL operation ; PAIR } } ;
-           DIP { RIGHT key_hash ; DIP { SELF ; PUSH mutez 0 } ; TRANSFER_TOKENS ;
+           DIP { SOME ; DIP { SELF ; PUSH mutez 0 } ; TRANSFER_TOKENS ;
                  NIL operation ; SWAP ; CONS } ;
            CONS ; UNIT ; SWAP ; PAIR }
          { SELF ; ADDRESS ; SENDER ; IFCMPNEQ { FAIL } {} ;
            CONTRACT string ; IF_SOME {} { FAIL } ;
            PUSH mutez 0 ; PUSH string "abcdefg" ; TRANSFER_TOKENS ;
-           NIL operation; SWAP; CONS ; UNIT ; SWAP ; PAIR } };
+           NIL operation; SWAP; CONS ; UNIT ; SWAP ; PAIR } } ;
\ No newline at end of file
diff --git a/src/contracts/testsuite/mini_scenarios/create_contract_simple.tz b/src/contracts/testsuite/mini_scenarios/create_contract_simple.tz
new file mode 100644
index 00000000..2a5185d7
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/create_contract_simple.tz
@@ -0,0 +1,14 @@
+parameter unit;
+storage unit;
+code { CAR;
+       PUSH string "foo";
+       PUSH mutez 0;
+       NONE key_hash;
+       CREATE_CONTRACT
+         { parameter string ;
+           storage string ;
+           code { CAR ; NIL operation ; PAIR } } ;
+       DROP; DROP;
+       NIL operation;
+       PAIR;
+     }
diff --git a/src/contracts/testsuite/mini_scenarios/default_account.tz b/src/contracts/testsuite/mini_scenarios/default_account.tz
index db9f0115..74e7693d 100644
--- a/src/contracts/testsuite/mini_scenarios/default_account.tz
+++ b/src/contracts/testsuite/mini_scenarios/default_account.tz
@@ -1,3 +1,7 @@
+/*
+Send 100 tz to the implicit account given as parameter.
+*/
+
 parameter key_hash;
 storage unit;
 code {DIP{UNIT}; CAR; IMPLICIT_ACCOUNT;
diff --git a/src/contracts/testsuite/mini_scenarios/lockup.tz b/src/contracts/testsuite/mini_scenarios/lockup.tz
index a68a8628..eb238fd6 100644
--- a/src/contracts/testsuite/mini_scenarios/lockup.tz
+++ b/src/contracts/testsuite/mini_scenarios/lockup.tz
@@ -1,5 +1,5 @@
 parameter unit;
-storage (pair timestamp (pair mutez (contract unit)));
+storage (pair timestamp (pair mutez address));
 code { CDR;                      # Ignore the parameter
        DUP;                      # Duplicate the storage
        CAR;                      # Get the timestamp
@@ -12,6 +12,7 @@ code { CDR;                      # Ignore the parameter
        DUP;                      # Duplicate the transfer information
        CAR;                      # Get the amount of the transfer on top of the stack
        DIP{CDR};                 # Put the contract underneath it
+       DIP { CONTRACT unit ; ASSERT_SOME } ;
        UNIT;                     # Put the contract's argument type on top of the stack
        TRANSFER_TOKENS;          # Emit the transfer
        NIL operation; SWAP; CONS;# Make a singleton list of internal operations
diff --git a/src/contracts/testsuite/mini_scenarios/multiple_en2.tz b/src/contracts/testsuite/mini_scenarios/multiple_en2.tz
new file mode 100644
index 00000000..a1acafd4
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/multiple_en2.tz
@@ -0,0 +1,77 @@
+{ parameter unit ;
+  storage (option address) ;
+  code { SENDER ;
+         SELF ;
+         ADDRESS ;
+         { COMPARE ;
+           EQ ;
+           IF { CDR ;
+                { IF_NONE { { UNIT ; FAILWITH } } {} } ;
+                DIP { NIL operation } ;
+                DUP ;
+                CONTRACT %add unit ;
+                { IF_NONE {} { { UNIT ; FAILWITH } } } ;
+                DUP ;
+                CONTRACT %fact nat ;
+                { IF_NONE {} { { UNIT ; FAILWITH } } } ;
+                DUP ;
+                CONTRACT %add nat ;
+                { IF_NONE { { UNIT ; FAILWITH } } {} } ;
+                PUSH mutez 0 ;
+                PUSH nat 12 ;
+                TRANSFER_TOKENS ;
+                SWAP ;
+                DIP { CONS } ;
+                DUP ;
+                CONTRACT unit ;
+                { IF_NONE { { UNIT ; FAILWITH } } {} } ;
+                PUSH mutez 0 ;
+                PUSH unit Unit ;
+                TRANSFER_TOKENS ;
+                SWAP ;
+                DIP { CONS } ;
+                DUP ;
+                CONTRACT %sub nat ;
+                { IF_NONE { { UNIT ; FAILWITH } } {} } ;
+                PUSH mutez 0 ;
+                PUSH nat 3 ;
+                TRANSFER_TOKENS ;
+                SWAP ;
+                DIP { CONS } ;
+                DUP ;
+                CONTRACT %add nat ;
+                { IF_NONE { { UNIT ; FAILWITH } } {} } ;
+                PUSH mutez 0 ;
+                PUSH nat 5 ;
+                TRANSFER_TOKENS ;
+                SWAP ;
+                DIP { CONS } ;
+                DROP ;
+                DIP { NONE address } ;
+                PAIR }
+              { CAR ;
+                DUP ;
+                DIP { DIP { PUSH int 0 ; PUSH mutez 0 ; NONE key_hash } ;
+                      DROP ;
+                      CREATE_CONTRACT
+                        { parameter (or (or (nat %add) (nat %sub)) (unit %default)) ;
+                          storage int ;
+                          code { AMOUNT ;
+                                 PUSH mutez 0 ;
+                                 { { COMPARE ; EQ } ; IF {} { { UNIT ; FAILWITH } } } ;
+                                 { { DUP ; CAR ; DIP { CDR } } } ;
+                                 IF_LEFT
+                                   { IF_LEFT { ADD } { SWAP ; SUB } }
+                                   { DROP ; DROP ; PUSH int 0 } ;
+                                 NIL operation ;
+                                 PAIR } } } ;
+                DIP { SELF ; PUSH mutez 0 } ;
+                TRANSFER_TOKENS ;
+                NIL operation ;
+                SWAP ;
+                CONS ;
+                SWAP ;
+                CONS ;
+                DIP { SOME } ;
+                PAIR } }
+       } }
diff --git a/src/contracts/testsuite/mini_scenarios/multiple_entrypoints_counter.tz b/src/contracts/testsuite/mini_scenarios/multiple_entrypoints_counter.tz
new file mode 100644
index 00000000..74019069
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/multiple_entrypoints_counter.tz
@@ -0,0 +1,29 @@
+{ parameter unit ;
+  storage (option address) ;
+  code { SENDER ; SELF ; ADDRESS ;
+         IFCMPEQ
+           { CDR ; ASSERT_SOME ;
+             DIP { NIL operation } ;
+             DUP ; CONTRACT %add unit ; ASSERT_NONE ;
+             DUP ; CONTRACT %fact nat ; ASSERT_NONE ;
+             DUP ; CONTRACT %add nat ; ASSERT_SOME ; PUSH mutez 0 ; PUSH nat 12 ; TRANSFER_TOKENS ; SWAP ; DIP { CONS } ;
+             DUP ; CONTRACT unit ; ASSERT_SOME ; PUSH mutez 0 ; PUSH unit Unit ; TRANSFER_TOKENS ; SWAP ; DIP { CONS } ;
+             DUP ; CONTRACT %sub nat ; ASSERT_SOME ; PUSH mutez 0 ; PUSH nat 3 ; TRANSFER_TOKENS ; SWAP ; DIP { CONS } ;
+             DUP ; CONTRACT %add nat ; ASSERT_SOME ; PUSH mutez 0 ; PUSH nat 5 ; TRANSFER_TOKENS ; SWAP ; DIP { CONS } ;
+             DROP ; DIP { NONE address } ; PAIR }
+           { CAR ; DUP ;
+             DIP
+               { DIP { PUSH int 0 ; PUSH mutez 0 ; NONE key_hash } ;
+                 DROP ;
+                 CREATE_CONTRACT
+                   { parameter (or (or (nat %add) (nat %sub)) (unit %default)) ;
+                     storage int ;
+                     code { AMOUNT ; PUSH mutez 0 ; ASSERT_CMPEQ ;
+                            UNPAIR ;
+                            IF_LEFT
+                              { IF_LEFT { ADD } { SWAP ; SUB } }
+                              { DROP ; DROP ; PUSH int 0 } ;
+                            NIL operation ; PAIR } } } ;
+             DIP { SELF ; PUSH mutez 0 } ; TRANSFER_TOKENS ;
+             NIL operation ; SWAP ; CONS ; SWAP ; CONS ;
+             DIP { SOME } ; PAIR } } }
\ No newline at end of file
diff --git a/src/contracts/testsuite/mini_scenarios/replay.tz b/src/contracts/testsuite/mini_scenarios/replay.tz
index d00e368d..73ac145a 100644
--- a/src/contracts/testsuite/mini_scenarios/replay.tz
+++ b/src/contracts/testsuite/mini_scenarios/replay.tz
@@ -1,3 +1,4 @@
+# This contract always fail because it tries to execute twice the same operation
 parameter unit ;
 storage unit ;
 code { CDR ; NIL operation ;
diff --git a/src/contracts/testsuite/mini_scenarios/reveal_signed_preimage.tz b/src/contracts/testsuite/mini_scenarios/reveal_signed_preimage.tz
index 520707c6..1a7e97eb 100644
--- a/src/contracts/testsuite/mini_scenarios/reveal_signed_preimage.tz
+++ b/src/contracts/testsuite/mini_scenarios/reveal_signed_preimage.tz
@@ -1,7 +1,13 @@
 parameter (pair bytes signature) ;
 storage (pair bytes key) ;
-code { DUP ; UNPAIR ; CAR ; SHA256 ; DIP { CAR } ; ASSERT_CMPEQ ;
+code {
+       #check that sha256(param.bytes) == storage.bytes
+       DUP ; UNPAIR ; CAR; SHA256; DIP { CAR } ; ASSERT_CMPEQ ;
+
+       # check that the sig is a valid signature of the preimage
        DUP ; UNPAIR ; SWAP ; DIP { UNPAIR ; SWAP } ; CDR ; CHECK_SIGNATURE ; ASSERT ;
+
+       # send all our tokens to the implicit account corresponding to the stored public key
        CDR ; DUP ; CDR ; HASH_KEY ; IMPLICIT_ACCOUNT ;
        BALANCE ; UNIT ; TRANSFER_TOKENS ;
        NIL operation ; SWAP ; CONS ; PAIR }
\ No newline at end of file
diff --git a/src/contracts/testsuite/mini_scenarios/weather_insurance.tz b/src/contracts/testsuite/mini_scenarios/weather_insurance.tz
index 858fe918..e7e99e01 100644
--- a/src/contracts/testsuite/mini_scenarios/weather_insurance.tz
+++ b/src/contracts/testsuite/mini_scenarios/weather_insurance.tz
@@ -1,7 +1,7 @@
 parameter (pair (signature %signed_weather_data) (nat :rain %actual_level));
 # (pair (under_key over_key) (pair weather_service_key (pair rain_level days_in_future)))
-storage (pair (pair (contract %under_key unit)
-                    (contract %over_key unit))
+storage (pair (pair (address %under_key)
+                    (address %over_key))
               (pair (nat :rain %rain_level) (key %weather_service_key)));
 code { DUP; DUP;
        CAR; MAP_CDR{PACK ; BLAKE2B};
@@ -13,6 +13,7 @@ code { DUP; DUP;
        DIP{CADR %actual_level};   # Get actual rain
        CDDAR %rain_level;         # Get rain threshold
        CMPLT; IF {CAR %under_key} {CDR %over_key};     # Select contract to receive tokens
+       CONTRACT unit ; ASSERT_SOME ;
        BALANCE; UNIT ; TRANSFER_TOKENS @trans.op; # Setup and execute transfer
        NIL operation ; SWAP ; CONS ;
        PAIR };
diff --git a/src/contracts/testsuite/mini_scenarios/xcat.tz b/src/contracts/testsuite/mini_scenarios/xcat.tz
index 254f4d82..83e6c7ac 100644
--- a/src/contracts/testsuite/mini_scenarios/xcat.tz
+++ b/src/contracts/testsuite/mini_scenarios/xcat.tz
@@ -9,8 +9,10 @@ code {
              # There's a temptation to use @storage to parametrize
              # a contract but, in general, there's no reason to encumber
              # @storage with immutable values.
-             PUSH @from (contract unit) "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"; #changeme
-             PUSH @to   (contract unit) "tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN"; #changeme
+             PUSH @from key_hash "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"; #changeme
+             IMPLICIT_ACCOUNT ;
+             PUSH @to   key_hash "tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN"; #changeme
+             IMPLICIT_ACCOUNT ;
              PUSH @target_hash bytes 0x123456; #changeme
              PUSH @deadline timestamp "2018-08-08 00:00:00Z"; #changeme
            };
diff --git a/src/contracts/testsuite/non_regression/bug_262.tz b/src/contracts/testsuite/non_regression/bug_262.tz
new file mode 100644
index 00000000..63475c5a
--- /dev/null
+++ b/src/contracts/testsuite/non_regression/bug_262.tz
@@ -0,0 +1,5 @@
+{ parameter unit ;
+  storage unit ;
+  code { DROP ;
+         LAMBDA unit unit {} ; UNIT ; EXEC ;
+         NIL operation ; PAIR } }
\ No newline at end of file
diff --git a/src/contracts/testsuite/opcodes/abs.tz b/src/contracts/testsuite/opcodes/abs.tz
new file mode 100644
index 00000000..d03d0883
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/abs.tz
@@ -0,0 +1,5 @@
+parameter nat;
+storage unit;
+code { CAR;
+       DUP; NEG; ABS; COMPARE; ASSERT_EQ;
+       UNIT; NIL operation; PAIR}
diff --git a/src/contracts/testsuite/opcodes/add.tz b/src/contracts/testsuite/opcodes/add.tz
new file mode 100644
index 00000000..cbefea08
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/add.tz
@@ -0,0 +1,25 @@
+parameter unit;
+storage unit;
+code
+  {
+    CAR;
+
+    PUSH int 2; PUSH int 2; ADD; PUSH int 4; ASSERT_CMPEQ;
+    PUSH int 2; PUSH int 2; ADD; PUSH int 4; ASSERT_CMPEQ;
+    PUSH int 2; PUSH nat 2; ADD; PUSH int 4; ASSERT_CMPEQ;
+    PUSH nat 2; PUSH int 2; ADD; PUSH int 4; ASSERT_CMPEQ;
+    PUSH nat 2; PUSH nat 2; ADD; PUSH nat 4; ASSERT_CMPEQ;
+
+    # Offset a timestamp by 60 seconds
+    PUSH int 60; PUSH timestamp "2019-09-09T12:08:37Z"; ADD;
+    PUSH timestamp "2019-09-09T12:09:37Z"; ASSERT_CMPEQ;
+
+    PUSH timestamp "2019-09-09T12:08:37Z"; PUSH int 60; ADD;
+    PUSH timestamp "2019-09-09T12:09:37Z"; ASSERT_CMPEQ;
+
+    PUSH mutez 1000; PUSH mutez 1000; ADD;
+    PUSH mutez 2000; ASSERT_CMPEQ;
+
+    NIL operation;
+    PAIR;
+  }
diff --git a/src/contracts/testsuite/opcodes/address.tz b/src/contracts/testsuite/opcodes/address.tz
new file mode 100644
index 00000000..7e6bcdec
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/address.tz
@@ -0,0 +1,3 @@
+parameter (contract unit);
+storage (option address);
+code {CAR; ADDRESS; SOME; NIL operation; PAIR }
diff --git a/src/contracts/testsuite/opcodes/and_binary.tz b/src/contracts/testsuite/opcodes/and_binary.tz
new file mode 100644
index 00000000..96f60082
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/and_binary.tz
@@ -0,0 +1,27 @@
+parameter unit;
+storage unit;
+code { DROP;
+
+       # 0101 & 0110 = 0100
+       PUSH nat 5; PUSH nat 6; AND; PUSH nat 4; ASSERT_CMPEQ;
+
+       # 0110 & 0101 = 0100
+       PUSH nat 6; PUSH int 5; AND; PUSH nat 4; ASSERT_CMPEQ;
+
+       # Negative numbers are represented as with a initial virtual
+       # infinite series of 1's.
+       # Hence, AND with -1 (1111...) is identity:
+
+       #   12 = ...1100
+       # & -1 = ...1111
+       #   ----
+       # = 12 = ...1100
+       PUSH nat 12; PUSH int -1; AND; PUSH nat 12; ASSERT_CMPEQ;
+
+       #   12 = ...0001100
+       # & -5 = ...1111011
+       # -----------------
+       #    8 = ...0001000
+       PUSH nat 12; PUSH int -5; AND; PUSH nat 8; ASSERT_CMPEQ;
+
+       UNIT; NIL @noop operation; PAIR; };
diff --git a/src/contracts/testsuite/opcodes/and_logical_1.tz b/src/contracts/testsuite/opcodes/and_logical_1.tz
new file mode 100644
index 00000000..20743c0b
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/and_logical_1.tz
@@ -0,0 +1,3 @@
+parameter (pair bool bool);
+storage bool;
+code { CAR ; UNPAIR; AND @and; NIL @noop operation; PAIR; };
diff --git a/src/contracts/testsuite/opcodes/big_map_mem_nat.tz b/src/contracts/testsuite/opcodes/big_map_mem_nat.tz
new file mode 100644
index 00000000..71ecaf2c
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/big_map_mem_nat.tz
@@ -0,0 +1,7 @@
+parameter nat;
+storage (pair (big_map nat nat) (option bool)) ;
+# stores (map, Some flag) where flag = parameter is a member of
+# the map in first component of storage
+code { UNPAIR;
+       DIP { CAR; DUP };
+       MEM; SOME; SWAP; PAIR; NIL operation; PAIR;}
diff --git a/src/contracts/testsuite/opcodes/big_map_mem_string.tz b/src/contracts/testsuite/opcodes/big_map_mem_string.tz
new file mode 100644
index 00000000..8c557f7d
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/big_map_mem_string.tz
@@ -0,0 +1,7 @@
+parameter string;
+storage (pair (big_map string nat) (option bool)) ;
+# stores (map, Some flag) where flag = parameter is a member of
+# the map in first component of storage
+code { UNPAIR;
+       DIP { CAR; DUP };
+       MEM; SOME; SWAP; PAIR; NIL operation; PAIR;}
diff --git a/src/contracts/testsuite/opcodes/big_map_to_self.tz b/src/contracts/testsuite/opcodes/big_map_to_self.tz
new file mode 100644
index 00000000..6a9442b9
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/big_map_to_self.tz
@@ -0,0 +1,22 @@
+parameter (or (pair %have_fun (big_map string nat) unit) (unit %default));
+storage (big_map string nat);
+code {
+       UNPAIR;
+       DIP {NIL operation};
+       IF_LEFT {
+                 DROP
+               }
+               {
+                 DROP;
+                 SELF %have_fun;
+                 PUSH mutez 0;
+                 DUP 4;
+                 PUSH (option nat) (Some 8);
+                 PUSH string "hahaha";
+                 UPDATE;
+                 UNIT; SWAP; PAIR;
+                 TRANSFER_TOKENS;
+                 CONS
+               };
+       PAIR
+     }
diff --git a/src/contracts/testsuite/opcodes/car.tz b/src/contracts/testsuite/opcodes/car.tz
new file mode 100644
index 00000000..8fd03ba5
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/car.tz
@@ -0,0 +1,3 @@
+parameter (pair (nat :l) (nat :r));
+storage nat;
+code { CAR; CAR ; NIL operation ; PAIR }
diff --git a/src/contracts/testsuite/opcodes/cdr.tz b/src/contracts/testsuite/opcodes/cdr.tz
new file mode 100644
index 00000000..dae260c5
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/cdr.tz
@@ -0,0 +1,3 @@
+parameter (pair (nat :l) (nat :r));
+storage nat;
+code { CAR; CDR ; NIL operation ; PAIR }
diff --git a/src/contracts/testsuite/opcodes/chain_id.tz b/src/contracts/testsuite/opcodes/chain_id.tz
new file mode 100644
index 00000000..783d13fa
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/chain_id.tz
@@ -0,0 +1,3 @@
+parameter unit;
+storage unit;
+code { CHAIN_ID; DROP; CAR; NIL operation; PAIR }
diff --git a/src/contracts/testsuite/opcodes/chain_id_store.tz b/src/contracts/testsuite/opcodes/chain_id_store.tz
new file mode 100644
index 00000000..11e57fd2
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/chain_id_store.tz
@@ -0,0 +1,3 @@
+parameter unit;
+storage (option chain_id);
+code { DROP; CHAIN_ID; SOME; NIL operation; PAIR }
diff --git a/src/contracts/testsuite/opcodes/check_signature.tz b/src/contracts/testsuite/opcodes/check_signature.tz
index 1d0569cb..b5d5b284 100644
--- a/src/contracts/testsuite/opcodes/check_signature.tz
+++ b/src/contracts/testsuite/opcodes/check_signature.tz
@@ -1,8 +1,10 @@
 parameter key;
 storage (pair signature string);
-code { DUP; DUP;
+code {
+       DUP; DUP;
        DIP{ CDR; DUP; CAR;
-            DIP{CDR; PACK ; BLAKE2B}; PAIR};
-       CAR; DIP {UNPAIR}; CHECK_SIGNATURE;
+            DIP{CDR; PACK}};
+       CAR; CHECK_SIGNATURE;
        IF {} {FAIL} ;
        CDR; NIL operation ; PAIR};
+
diff --git a/src/contracts/testsuite/opcodes/compare.tz b/src/contracts/testsuite/opcodes/compare.tz
new file mode 100644
index 00000000..963215fb
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/compare.tz
@@ -0,0 +1,52 @@
+parameter unit;
+storage unit;
+code {
+       DROP;
+
+       # bool
+       PUSH bool True; DUP; COMPARE; ASSERT_EQ;
+       PUSH bool False; DUP; COMPARE; ASSERT_EQ;
+       PUSH bool False; PUSH bool True; COMPARE; ASSERT_GT;
+       PUSH bool True; PUSH bool False; COMPARE; ASSERT_LT;
+
+       # bytes
+       PUSH bytes 0xAABBCC; DUP; COMPARE; ASSERT_EQ;
+       PUSH bytes 0x; PUSH bytes 0x; COMPARE; ASSERT_EQ;
+       PUSH bytes 0x; PUSH bytes 0x01; COMPARE; ASSERT_GT;
+       PUSH bytes 0x01; PUSH bytes 0x02; COMPARE; ASSERT_GT;
+       PUSH bytes 0x02; PUSH bytes 0x01; COMPARE; ASSERT_LT;
+
+       # int
+       PUSH int 1; DUP; COMPARE; ASSERT_EQ;
+       PUSH int 10; PUSH int 5; COMPARE; ASSERT_LT;
+       PUSH int -4; PUSH int 1923; COMPARE; ASSERT_GT;
+
+       # nat
+       PUSH nat 1; DUP; COMPARE; ASSERT_EQ;
+       PUSH nat 10; PUSH nat 5; COMPARE; ASSERT_LT;
+       PUSH nat 4; PUSH nat 1923; COMPARE; ASSERT_GT;
+
+       # key_hash
+       PUSH key_hash "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"; DUP; COMPARE; ASSERT_EQ;
+       PUSH key_hash "tz1ddb9NMYHZi5UzPdzTZMYQQZoMub195zgv"; PUSH key_hash "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"; COMPARE; ASSERT_LT;
+       PUSH key_hash "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"; PUSH key_hash "tz1ddb9NMYHZi5UzPdzTZMYQQZoMub195zgv"; COMPARE; ASSERT_GT;
+
+       # mutez
+       PUSH mutez 1; DUP; COMPARE; ASSERT_EQ;
+       PUSH mutez 10; PUSH mutez 5; COMPARE; ASSERT_LT;
+       PUSH mutez 4; PUSH mutez 1923; COMPARE; ASSERT_GT;
+
+       # string
+       PUSH string "AABBCC"; DUP; COMPARE; ASSERT_EQ;
+       PUSH string ""; PUSH string ""; COMPARE; ASSERT_EQ;
+       PUSH string ""; PUSH string "a"; COMPARE; ASSERT_GT;
+       PUSH string "a"; PUSH string "b"; COMPARE; ASSERT_GT;
+       PUSH string "b"; PUSH string "a"; COMPARE; ASSERT_LT;
+
+       # timestamp
+       PUSH timestamp "2019-09-16T08:38:05Z"; DUP; COMPARE; ASSERT_EQ;
+       PUSH timestamp "2017-09-16T08:38:04Z"; PUSH timestamp "2019-09-16T08:38:05Z"; COMPARE; ASSERT_GT;
+       PUSH timestamp "2019-09-16T08:38:05Z"; PUSH timestamp "2019-09-16T08:38:04Z"; COMPARE; ASSERT_LT;
+
+       UNIT; NIL operation; PAIR;
+     }
diff --git a/src/contracts/testsuite/opcodes/comparisons.tz b/src/contracts/testsuite/opcodes/comparisons.tz
new file mode 100644
index 00000000..c603f073
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/comparisons.tz
@@ -0,0 +1,15 @@
+parameter (list int);
+storage (list (list bool));
+code {
+       CAR;
+
+       NIL (list bool);
+       DIP {DUP; MAP { EQ; };}; SWAP; CONS;
+       DIP {DUP; MAP { NEQ; };}; SWAP; CONS;
+       DIP {DUP; MAP { LE; };}; SWAP; CONS;
+       DIP {DUP; MAP { LT; };}; SWAP; CONS;
+       DIP {DUP; MAP { GE; };}; SWAP; CONS;
+       DIP {MAP { GT; };}; SWAP; CONS;
+
+       NIL operation; PAIR;
+     }
diff --git a/src/contracts/testsuite/opcodes/concat_hello_bytes.tz b/src/contracts/testsuite/opcodes/concat_hello_bytes.tz
new file mode 100644
index 00000000..55f8ab7a
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/concat_hello_bytes.tz
@@ -0,0 +1,4 @@
+parameter (list bytes);
+storage (list bytes);
+code{ CAR;
+      MAP { PUSH bytes 0xFF; CONCAT }; NIL operation; PAIR};
diff --git a/src/contracts/testsuite/opcodes/cons.tz b/src/contracts/testsuite/opcodes/cons.tz
new file mode 100644
index 00000000..5189b47c
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/cons.tz
@@ -0,0 +1,3 @@
+parameter int;
+storage (list int);
+code { UNPAIR; CONS; NIL operation; PAIR; };
diff --git a/src/contracts/testsuite/opcodes/contract.tz b/src/contracts/testsuite/opcodes/contract.tz
new file mode 100644
index 00000000..93933791
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/contract.tz
@@ -0,0 +1,11 @@
+parameter address;
+storage unit;
+code {
+       CAR;
+       CONTRACT unit;
+       ASSERT_SOME;
+       DROP;
+       UNIT;
+       NIL operation;
+       PAIR
+     };
diff --git a/src/contracts/testsuite/opcodes/create_contract.tz b/src/contracts/testsuite/opcodes/create_contract.tz
new file mode 100644
index 00000000..d3fb8dc6
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/create_contract.tz
@@ -0,0 +1,14 @@
+parameter unit;
+storage (option address);
+code { DROP;
+       UNIT; # starting storage for contract
+       AMOUNT;                   # Push the starting balance
+       NONE key_hash;                 # No delegate
+       CREATE_CONTRACT          # Create the contract
+         { parameter unit ;
+           storage unit ;
+           code
+             { CDR;
+               NIL operation;
+               PAIR; } };
+       DIP {SOME;NIL operation};CONS ; PAIR} # Ending calling convention stuff
diff --git a/src/contracts/testsuite/opcodes/dig_eq.tz b/src/contracts/testsuite/opcodes/dig_eq.tz
new file mode 100644
index 00000000..fff548bb
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/dig_eq.tz
@@ -0,0 +1,14 @@
+parameter (pair nat (pair nat (pair nat (pair nat (pair nat (pair nat (pair nat (pair nat (pair nat (pair nat (pair nat (pair nat (pair nat (pair nat (pair nat (pair nat nat))))))))))))))));
+storage unit;
+# this contract receives a 17-tuple, unpairs it, reverses the order, reverses it again, and pairs it and verifies that the result is the same as the original tuple.
+code { CAR;
+       DUP;
+
+       UNPAPAPAPAPAPAPAPAPAPAPAPAPAPAPAPAIR;
+       DIG 0; DIG 1; DIG 2; DIG 3; DIG 4; DIG 5; DIG 6; DIG 7; DIG 8; DIG 9; DIG 10; DIG 11; DIG 12; DIG 13; DIG 14; DIG 15; DIG 16;
+       # PUSH nat 1; ADD;
+       DIG 0; DIG 1; DIG 2; DIG 3; DIG 4; DIG 5; DIG 6; DIG 7; DIG 8; DIG 9; DIG 10; DIG 11; DIG 12; DIG 13; DIG 14; DIG 15; DIG 16;
+       PAPAPAPAPAPAPAPAPAPAPAPAPAPAPAPAIR;
+       ASSERT_CMPEQ;
+
+       UNIT; NIL operation; PAIR};
diff --git a/src/contracts/testsuite/opcodes/dign.tz b/src/contracts/testsuite/opcodes/dign.tz
new file mode 100644
index 00000000..ec8a339d
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/dign.tz
@@ -0,0 +1,3 @@
+parameter (pair (pair (pair (pair nat nat) nat) nat) nat);
+storage nat;
+code {CAR; UNPAIR ; UNPAIR ; UNPAIR ; UNPAIR ; DIG 4 ; DIP { DROP ; DROP ; DROP ; DROP } ; NIL operation; PAIR};
diff --git a/src/contracts/testsuite/opcodes/dip.tz b/src/contracts/testsuite/opcodes/dip.tz
new file mode 100644
index 00000000..f0c32a83
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/dip.tz
@@ -0,0 +1,8 @@
+parameter (pair nat nat);
+storage (pair nat nat);
+code{
+      CAR; UNPAIR;
+      DUP; DIP { ADD };
+      PAIR;
+      NIL operation;
+      PAIR};
diff --git a/src/contracts/testsuite/opcodes/dipn.tz b/src/contracts/testsuite/opcodes/dipn.tz
new file mode 100644
index 00000000..55d088e5
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/dipn.tz
@@ -0,0 +1,3 @@
+parameter (pair (pair (pair (pair nat nat) nat) nat) nat);
+storage nat;
+code {CAR; UNPAIR ; UNPAIR ; UNPAIR ; UNPAIR ; DIP 5 {PUSH nat 6} ; DROP ; DROP ; DROP ; DROP ; DROP ; NIL operation; PAIR};
diff --git a/src/contracts/testsuite/opcodes/dropn.tz b/src/contracts/testsuite/opcodes/dropn.tz
new file mode 100644
index 00000000..4b5379b3
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/dropn.tz
@@ -0,0 +1,3 @@
+parameter (pair (pair (pair (pair nat nat) nat) nat) nat);
+storage nat;
+code {CAR; UNPAIR ; UNPAIR ; UNPAIR ; UNPAIR ; DROP 4 ; NIL operation; PAIR};
diff --git a/src/contracts/testsuite/opcodes/dugn.tz b/src/contracts/testsuite/opcodes/dugn.tz
new file mode 100644
index 00000000..521c052f
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/dugn.tz
@@ -0,0 +1,3 @@
+parameter (pair (pair (pair (pair nat nat) nat) nat) nat);
+storage nat;
+code {CAR; UNPAIR ; UNPAIR ; UNPAIR ; UNPAIR ; DUG 4 ; DROP ; DROP ; DROP ; DROP ; NIL operation; PAIR};
diff --git a/src/contracts/testsuite/opcodes/ediv.tz b/src/contracts/testsuite/opcodes/ediv.tz
new file mode 100644
index 00000000..ee577a4d
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/ediv.tz
@@ -0,0 +1,13 @@
+parameter (pair int int);
+storage (pair (option (pair int nat)) (pair (option (pair int nat)) (pair (option (pair int nat)) (option (pair nat nat)))));
+code { CAR;
+       # :: nat : nat : 'S   ->   option (pair nat nat) : 'S
+       DUP; UNPAIR; ABS; DIP { ABS; }; EDIV; SWAP;
+       # :: nat : int : 'S   ->   option (pair int nat) : 'S
+       DUP; UNPAIR; ABS; EDIV; SWAP;
+       # :: int : nat : 'S   ->   option (pair int nat) : 'S
+       DUP; UNPAIR; DIP { ABS; }; EDIV; SWAP;
+       # :: int : int : 'S   ->   option (pair int nat) : 'S
+       UNPAIR; EDIV;
+       PAPAPAIR;
+       NIL operation; PAIR}
diff --git a/src/contracts/testsuite/opcodes/ediv_mutez.tz b/src/contracts/testsuite/opcodes/ediv_mutez.tz
new file mode 100644
index 00000000..2df73dd4
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/ediv_mutez.tz
@@ -0,0 +1,12 @@
+parameter (pair mutez (or mutez nat));
+storage (or (option (pair nat mutez)) (option (pair mutez mutez)));
+code { CAR;
+       UNPAIR;
+       SWAP;
+       IF_LEFT {
+                 SWAP; EDIV; LEFT (option (pair mutez mutez));
+               }
+               {
+                 SWAP; EDIV; RIGHT (option (pair nat mutez));
+               };
+       NIL operation; PAIR}
diff --git a/src/contracts/testsuite/opcodes/get_big_map_value.tz b/src/contracts/testsuite/opcodes/get_big_map_value.tz
new file mode 100644
index 00000000..4ca52343
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/get_big_map_value.tz
@@ -0,0 +1,6 @@
+parameter string;
+storage (pair (big_map string string) (option string));
+# retrieves the values stored in the big_map on the left side of the
+# pair at the key denoted by the parameter and puts it in the right
+# hand side of the storage
+code {DUP; CAR; DIP{CDAR; DUP}; GET; SWAP; PAIR; NIL operation; PAIR};
diff --git a/src/contracts/testsuite/opcodes/int.tz b/src/contracts/testsuite/opcodes/int.tz
new file mode 100644
index 00000000..3f199881
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/int.tz
@@ -0,0 +1,5 @@
+parameter nat;
+storage (option int);
+# this contract takes a natural number as parameter, converts it to an
+# integer and stores it.
+code { CAR; INT; SOME; NIL operation; PAIR };
diff --git a/src/contracts/testsuite/opcodes/list_size.tz b/src/contracts/testsuite/opcodes/list_size.tz
new file mode 100644
index 00000000..6ced1279
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/list_size.tz
@@ -0,0 +1,3 @@
+parameter (list int);
+storage nat;
+code {CAR; SIZE; NIL operation; PAIR}
diff --git a/src/contracts/testsuite/opcodes/map_map.tz b/src/contracts/testsuite/opcodes/map_map.tz
new file mode 100644
index 00000000..4acbd63c
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/map_map.tz
@@ -0,0 +1,8 @@
+parameter nat;
+storage (map string nat);
+# this contract adds the value passed by parameter to each entry in
+# the stored map.
+code { UNPAIR; SWAP;
+       MAP { CDR; DIP {DUP}; ADD; };
+       DIP { DROP; };
+       NIL operation; PAIR; }
diff --git a/src/contracts/testsuite/opcodes/map_map_sideeffect.tz b/src/contracts/testsuite/opcodes/map_map_sideeffect.tz
new file mode 100644
index 00000000..960b02a5
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/map_map_sideeffect.tz
@@ -0,0 +1,12 @@
+parameter nat;
+storage (pair (map string nat) nat);
+# this contract adds the value passed by parameter to each entry in
+# the stored map, and it sets the second component of the pair to the
+# sum of the map's elements
+code { UNPAIR; SWAP; CAR;
+       DIP 2 { PUSH @sum nat 0; };
+       MAP { CDR; DIP {DUP}; ADD;
+             DUP; DUG 2; DIP 2 { ADD @sum };
+           };
+       DIP { DROP; }; PAIR;
+       NIL operation; PAIR; }
diff --git a/src/contracts/testsuite/opcodes/map_mem_nat.tz b/src/contracts/testsuite/opcodes/map_mem_nat.tz
new file mode 100644
index 00000000..0c245d7e
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/map_mem_nat.tz
@@ -0,0 +1,7 @@
+parameter nat;
+storage (pair (map nat nat) (option bool)) ;
+# stores (map, Some flag) where flag = parameter is a member of
+# the map in first component of storage
+code { UNPAIR;
+       DIP { CAR; DUP };
+       MEM; SOME; SWAP; PAIR; NIL operation; PAIR;}
diff --git a/src/contracts/testsuite/opcodes/map_mem_string.tz b/src/contracts/testsuite/opcodes/map_mem_string.tz
new file mode 100644
index 00000000..3fa5cd5b
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/map_mem_string.tz
@@ -0,0 +1,7 @@
+parameter string;
+storage (pair (map string nat) (option bool)) ;
+# stores (map, Some flag) where flag = parameter is a member of
+# the map in first component of storage
+code { UNPAIR;
+       DIP { CAR; DUP };
+       MEM; SOME; SWAP; PAIR; NIL operation; PAIR;}
diff --git a/src/contracts/testsuite/opcodes/mul.tz b/src/contracts/testsuite/opcodes/mul.tz
new file mode 100644
index 00000000..8432394b
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/mul.tz
@@ -0,0 +1,48 @@
+parameter unit ;
+storage unit ;
+code { CAR ;
+       DROP ;
+       # tez-nat, no overflow
+       PUSH nat 7987 ;
+       PUSH mutez 10 ;
+       MUL ;
+       PUSH mutez 79870 ;
+       COMPARE ;
+       ASSERT_EQ ;
+       # nat-tez, no overflow
+       PUSH mutez 10 ;
+       PUSH nat 7987 ;
+       MUL ;
+       PUSH mutez 79870 ;
+       COMPARE ;
+       ASSERT_EQ ;
+       # int-int, no overflow
+       PUSH int 10 ;
+       PUSH int -7987 ;
+       MUL ;
+       PUSH int -79870 ;
+       COMPARE ;
+       ASSERT_EQ ;
+       # int-nat, no overflow
+       PUSH nat 10 ;
+       PUSH int -7987 ;
+       MUL ;
+       PUSH int -79870 ;
+       COMPARE ;
+       ASSERT_EQ ;
+       # nat-int, no overflow
+       PUSH int -10 ;
+       PUSH nat 7987 ;
+       MUL ;
+       PUSH int -79870 ;
+       COMPARE ;
+       ASSERT_EQ ;
+       # nat-nat, no overflow
+       PUSH nat 10 ;
+       PUSH nat 7987 ;
+       MUL ;
+       PUSH nat 79870 ;
+       COMPARE ;
+       ASSERT_EQ ;
+
+       UNIT ; NIL operation ; PAIR }
diff --git a/src/contracts/testsuite/opcodes/mul_overflow.tz b/src/contracts/testsuite/opcodes/mul_overflow.tz
new file mode 100644
index 00000000..5d2b3a3d
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/mul_overflow.tz
@@ -0,0 +1,18 @@
+parameter (or unit unit) ;
+storage unit ;
+code { CAR ;
+       IF_LEFT
+         {
+           PUSH nat 922337203685477580700 ;
+           PUSH mutez 10 ;
+           MUL ; # FAILURE
+           DROP
+         }
+         {
+           PUSH mutez 10 ;
+           PUSH nat 922337203685477580700 ;
+           MUL ; # FAILURE
+           DROP
+         } ;
+
+       NIL operation ; PAIR }
diff --git a/src/contracts/testsuite/opcodes/neg.tz b/src/contracts/testsuite/opcodes/neg.tz
new file mode 100644
index 00000000..9cedf765
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/neg.tz
@@ -0,0 +1,8 @@
+parameter (or int nat);
+storage int;
+code {
+       CAR;
+       IF_LEFT {NEG} {NEG};
+       NIL operation;
+       PAIR
+     }
diff --git a/src/contracts/testsuite/opcodes/none.tz b/src/contracts/testsuite/opcodes/none.tz
new file mode 100644
index 00000000..473a288b
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/none.tz
@@ -0,0 +1,3 @@
+parameter unit;
+storage (option nat);
+code { DROP; NONE nat; NIL operation; PAIR; };
diff --git a/src/contracts/testsuite/opcodes/not_binary.tz b/src/contracts/testsuite/opcodes/not_binary.tz
new file mode 100644
index 00000000..c1e0f979
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/not_binary.tz
@@ -0,0 +1,12 @@
+parameter (or int nat);
+storage (option int);
+code { CAR;
+       IF_LEFT
+         {
+           NOT;
+         }
+         {
+           NOT;
+         } ;
+       SOME; NIL operation ; PAIR
+     }
diff --git a/src/contracts/testsuite/opcodes/or_binary.tz b/src/contracts/testsuite/opcodes/or_binary.tz
new file mode 100644
index 00000000..a31f1098
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/or_binary.tz
@@ -0,0 +1,9 @@
+parameter (pair nat nat);
+storage (option nat);
+# This contract takes a pair of natural numbers as argument and
+# stores the result of their binary OR.
+code { CAR;
+       UNPAIR;
+       OR;
+       SOME; NIL operation; PAIR
+     }
diff --git a/src/contracts/testsuite/opcodes/packunpack_rev.tz b/src/contracts/testsuite/opcodes/packunpack_rev.tz
new file mode 100644
index 00000000..86871a5c
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/packunpack_rev.tz
@@ -0,0 +1,41 @@
+parameter (pair
+             int
+             (pair
+                nat
+                (pair
+                   string
+                   (pair bytes (pair mutez (pair bool (pair key_hash (pair timestamp address))))))));
+storage unit ;
+code { CAR;
+       # Check the int
+       DUP; CAR; DIP { UNPAIR; }; PACK; UNPACK int; ASSERT_SOME; ASSERT_CMPEQ;
+       # Check the nat
+       DUP; CAR; DIP { UNPAIR; }; PACK; UNPACK nat; ASSERT_SOME; ASSERT_CMPEQ;
+       # Check the string
+       DUP; CAR; DIP { UNPAIR; }; PACK; UNPACK string; ASSERT_SOME; ASSERT_CMPEQ;
+       # Check the bytes
+       DUP; CAR; DIP { UNPAIR; }; PACK; UNPACK bytes; ASSERT_SOME; ASSERT_CMPEQ;
+       # Check the mutez
+       DUP; CAR; DIP { UNPAIR; }; PACK; UNPACK mutez; ASSERT_SOME; ASSERT_CMPEQ;
+       # Check the bool
+       DUP; CAR; DIP { UNPAIR; }; PACK; UNPACK bool; ASSERT_SOME; ASSERT_CMPEQ;
+       # Check the key_hash
+       DUP; CAR; DIP { UNPAIR; }; PACK; UNPACK key_hash; ASSERT_SOME; ASSERT_CMPEQ;
+       # Check the timestamp
+       DUP; CAR; DIP { UNPAIR; }; PACK; UNPACK timestamp; ASSERT_SOME; ASSERT_CMPEQ;
+       # Check the address
+       DUP; PACK; UNPACK address; ASSERT_SOME; ASSERT_CMPEQ;
+
+       # Assert failure modes of unpack
+       PUSH int 0; PACK; UNPACK nat; ASSERT_SOME; DROP;
+       PUSH int -1; PACK; UNPACK nat; ASSERT_NONE;
+
+       # Try deserializing invalid byte sequence (no magic number)
+       PUSH bytes 0x; UNPACK nat; ASSERT_NONE;
+       PUSH bytes 0x04; UNPACK nat; ASSERT_NONE;
+
+       # Assert failure for byte sequences that do not correspond to
+       # any micheline value
+       PUSH bytes 0x05; UNPACK nat; ASSERT_NONE;
+
+       UNIT ; NIL operation ; PAIR }
diff --git a/src/contracts/testsuite/opcodes/packunpack_rev_cty.tz b/src/contracts/testsuite/opcodes/packunpack_rev_cty.tz
new file mode 100644
index 00000000..5e32b8a6
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/packunpack_rev_cty.tz
@@ -0,0 +1,31 @@
+parameter (pair key (pair unit (pair signature (pair (option signature) (pair (list unit) (pair (set bool) (pair (pair int int) (pair (or key_hash timestamp) (pair (map int string) (lambda string bytes))))))))));
+storage unit ;
+# for each uncomparable type t (we take an arbitrary parameter for
+# parametric data-types e.g. pair, list),
+# that is packable (which excludes big_map, operation, and contract)
+# this contract receives a parameter v_t.
+# it verifies that pack v_t == pack (unpack (pack v_t))
+code { CAR;
+       # packable uncomparable types
+       # checking: key
+       DUP; CAR; DIP { UNPAIR; }; PACK; DIP { PACK; UNPACK key; ASSERT_SOME; PACK; }; ASSERT_CMPEQ;
+       # checking: unit
+       DUP; CAR; DIP { UNPAIR; }; PACK; DIP { PACK; UNPACK unit; ASSERT_SOME; PACK; }; ASSERT_CMPEQ;
+       # checking: signature
+       DUP; CAR; DIP { UNPAIR; }; PACK; DIP { PACK; UNPACK (signature); ASSERT_SOME; PACK; }; ASSERT_CMPEQ;
+       # checking: option signature
+       DUP; CAR; DIP { UNPAIR; }; PACK; DIP { PACK; UNPACK (option signature); ASSERT_SOME; PACK; }; ASSERT_CMPEQ;
+       # checking: list unit
+       DUP; CAR; DIP { UNPAIR; }; PACK; DIP { PACK; UNPACK (list unit); ASSERT_SOME; PACK; }; ASSERT_CMPEQ;
+       # checking: set bool
+       DUP; CAR; DIP { UNPAIR; }; PACK; DIP { PACK; UNPACK (set bool); ASSERT_SOME; PACK; }; ASSERT_CMPEQ;
+       # checking: pair int int
+       DUP; CAR; DIP { UNPAIR; }; PACK; DIP { PACK; UNPACK (pair int int); ASSERT_SOME; PACK; }; ASSERT_CMPEQ;
+       # checking: or key_hash timestamp
+       DUP; CAR; DIP { UNPAIR; }; PACK; DIP { PACK; UNPACK (or key_hash timestamp); ASSERT_SOME; PACK; }; ASSERT_CMPEQ;
+       # checking: map int string
+       DUP; CAR; DIP { UNPAIR; }; PACK; DIP { PACK; UNPACK (map int string); ASSERT_SOME; PACK; }; ASSERT_CMPEQ;
+       # checking: lambda string bytes
+       DUP; PACK; DIP { PACK; UNPACK (lambda string bytes); ASSERT_SOME; PACK; }; ASSERT_CMPEQ;
+
+       UNIT ; NIL operation ; PAIR }
diff --git a/src/contracts/testsuite/opcodes/pexec.tz b/src/contracts/testsuite/opcodes/pexec.tz
new file mode 100644
index 00000000..eab0c71b
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/pexec.tz
@@ -0,0 +1,6 @@
+parameter nat;
+storage nat;
+code {
+      LAMBDA (pair nat nat) nat
+             {UNPAIR ; ADD};
+      SWAP; UNPAIR ; DIP { APPLY } ; EXEC ; NIL operation; PAIR};
diff --git a/src/contracts/testsuite/opcodes/pexec_2.tz b/src/contracts/testsuite/opcodes/pexec_2.tz
new file mode 100644
index 00000000..d64f7442
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/pexec_2.tz
@@ -0,0 +1,11 @@
+parameter int;
+storage (list int);
+code {
+      UNPAIR @p @s ; # p :: s
+      LAMBDA (pair int (pair int int)) int
+             { UNPAIR ; DIP { UNPAIR } ; ADD ; MUL }; # l :: p :: s
+      SWAP ; APPLY ; # l :: s
+      PUSH int 3 ; APPLY ; # l :: s
+      SWAP ; MAP { DIP { DUP } ; EXEC } ; # s :: l
+      DIP { DROP } ; # s
+      NIL operation; PAIR };
diff --git a/src/contracts/testsuite/opcodes/proxy.tz b/src/contracts/testsuite/opcodes/proxy.tz
new file mode 100644
index 00000000..a9f17836
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/proxy.tz
@@ -0,0 +1,13 @@
+/* This proxy contract transfers the recieved amount to the contract given as parameter.
+   It is used to test the SOURCE and SENDER opcodes; see source.tz and sender.tz. */
+parameter (contract unit) ;
+storage unit ;
+code{
+      UNPAIR;
+      AMOUNT ;
+      UNIT ;
+      TRANSFER_TOKENS;
+      DIP {NIL operation} ;
+      CONS;
+      PAIR
+    }
\ No newline at end of file
diff --git a/src/contracts/testsuite/opcodes/self.tz b/src/contracts/testsuite/opcodes/self.tz
index 728cd5f1..d96457fd 100644
--- a/src/contracts/testsuite/opcodes/self.tz
+++ b/src/contracts/testsuite/opcodes/self.tz
@@ -1,3 +1,3 @@
 parameter unit ;
-storage (contract unit) ;
-code { DROP ; SELF ; NIL operation ; PAIR }
+storage address ;
+code { DROP ; SELF ; ADDRESS ; NIL operation ; PAIR }
diff --git a/src/contracts/testsuite/opcodes/self_with_default_entrypoint.tz b/src/contracts/testsuite/opcodes/self_with_default_entrypoint.tz
new file mode 100644
index 00000000..47f848c0
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/self_with_default_entrypoint.tz
@@ -0,0 +1,19 @@
+parameter (or (or (nat %A) (bool %B)) (or %maybe_C (unit %default) (string %C)));
+storage unit;
+code {
+       DROP;
+       SELF; DROP;
+       # Refers to entrypoint A of the current contract.
+       SELF %A; DROP;
+       # Refers to the default entry of the current contract
+       SELF %default; PACK;
+       # "SELF" w/o annotation also refers to the default
+       # entry of the current contract. Internally, they are equal.
+       SELF; PACK; ASSERT_CMPEQ;
+       # The following instruction would not typecheck:
+       #    SELF %D,
+       # since there is no entrypoint D.
+       UNIT;
+       NIL operation;
+       PAIR;
+     }
diff --git a/src/contracts/testsuite/opcodes/self_with_entrypoint.tz b/src/contracts/testsuite/opcodes/self_with_entrypoint.tz
new file mode 100644
index 00000000..bf9cd8d1
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/self_with_entrypoint.tz
@@ -0,0 +1,26 @@
+parameter (or (or (nat %A) (bool %B)) (or %maybe_C (unit %Z) (string %C)));
+storage unit;
+code {
+       DROP;
+       # Refers to entrypoint A of the current contract.
+       SELF %A; PACK @Apacked;
+       # Refers to the default entry of the current contract
+       SELF %default; PACK @defpacked; DUP; DIP { SWAP }; ASSERT_CMPNEQ;
+       # "SELF" w/o annotation also refers to the default
+       # entry of the current contract
+       SELF; PACK @selfpacked; ASSERT_CMPEQ;
+
+       # Verify the types of the different entrypoints.  CAST is noop
+       # if its argument is convertible with the type of the top of
+       # the stack. is conver
+       SELF %A; CAST (contract nat); DROP;
+       SELF %B; CAST (contract bool); DROP;
+       SELF %maybe_C; CAST (contract (or (unit) (string))); DROP;
+       SELF %Z; CAST (contract unit); DROP;
+       SELF; CAST (contract (or (or (nat %A) (bool %B)) (or %maybe_C (unit %Z) (string %C)))); DROP;
+       SELF %default; CAST (contract (or (or (nat %A) (bool %B)) (or %maybe_C (unit %Z) (string %C)))); DROP;
+
+       UNIT;
+       NIL operation;
+       PAIR;
+     }
diff --git a/src/contracts/testsuite/opcodes/sender.tz b/src/contracts/testsuite/opcodes/sender.tz
new file mode 100644
index 00000000..fb174179
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/sender.tz
@@ -0,0 +1,8 @@
+parameter unit ;
+storage address ;
+code{
+      DROP ;
+      SENDER;
+      NIL operation ;
+      PAIR
+    }
diff --git a/src/contracts/testsuite/opcodes/set_delegate.tz b/src/contracts/testsuite/opcodes/set_delegate.tz
new file mode 100644
index 00000000..a7e051e5
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/set_delegate.tz
@@ -0,0 +1,9 @@
+parameter (option key_hash);
+storage unit;
+code {
+       UNPAIR;
+       SET_DELEGATE;
+       DIP {NIL operation};
+       CONS;
+       PAIR
+     }
diff --git a/src/contracts/testsuite/opcodes/shifts.tz b/src/contracts/testsuite/opcodes/shifts.tz
new file mode 100644
index 00000000..71964750
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/shifts.tz
@@ -0,0 +1,18 @@
+parameter (or (pair nat nat) (pair nat nat));
+storage (option nat);
+# this contract takes either (Left a b) and stores (a << b)
+# or (Right a b) and stores (a >> b).
+# i.e., in the first case, the first component shifted to the left by
+# the second, and the second case, component shifted to the right by
+# the second.
+code { CAR;
+       IF_LEFT {
+                 UNPAIR; LSL;
+               }
+               {
+                 UNPAIR; LSR;
+               };
+       SOME;
+       NIL operation;
+       PAIR;
+     };
diff --git a/src/contracts/testsuite/opcodes/slice.tz b/src/contracts/testsuite/opcodes/slice.tz
new file mode 100644
index 00000000..3461bb55
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/slice.tz
@@ -0,0 +1,5 @@
+parameter (pair nat nat);
+storage (option string);
+code { UNPAIR; SWAP;
+       IF_SOME {SWAP; UNPAIR; SLICE;} {DROP; NONE string;};
+       NIL operation; PAIR}
diff --git a/src/contracts/testsuite/opcodes/slice_bytes.tz b/src/contracts/testsuite/opcodes/slice_bytes.tz
new file mode 100644
index 00000000..c0f60f35
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/slice_bytes.tz
@@ -0,0 +1,5 @@
+parameter (pair nat nat);
+storage (option bytes);
+code { UNPAIR; SWAP;
+       IF_SOME {SWAP; UNPAIR; SLICE;} {DROP; NONE bytes;};
+       NIL operation; PAIR}
diff --git a/src/contracts/testsuite/opcodes/source.tz b/src/contracts/testsuite/opcodes/source.tz
new file mode 100644
index 00000000..fc3c6420
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/source.tz
@@ -0,0 +1,10 @@
+parameter unit ;
+
+storage address ;
+
+code{
+      DROP ;
+      SOURCE;
+      NIL operation ;
+      PAIR
+    }
\ No newline at end of file
diff --git a/src/contracts/testsuite/opcodes/steps_to_quota.tz b/src/contracts/testsuite/opcodes/steps_to_quota.tz
deleted file mode 100644
index 4981864b..00000000
--- a/src/contracts/testsuite/opcodes/steps_to_quota.tz
+++ /dev/null
@@ -1,3 +0,0 @@
-parameter unit;
-storage nat;
-code {DROP; STEPS_TO_QUOTA; NIL operation; PAIR};
diff --git a/src/contracts/testsuite/opcodes/update_big_map.tz b/src/contracts/testsuite/opcodes/update_big_map.tz
new file mode 100644
index 00000000..c403975a
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/update_big_map.tz
@@ -0,0 +1,6 @@
+storage (pair (big_map string string) unit);
+parameter (map string (option string));
+# this contract the stored big_map according to the map taken in parameter
+code { UNPAPAIR;
+       ITER { UNPAIR; UPDATE; } ;
+       PAIR; NIL operation; PAIR};
diff --git a/src/contracts/testsuite/opcodes/xor.tz b/src/contracts/testsuite/opcodes/xor.tz
index ab8dcf57..557eaa64 100644
--- a/src/contracts/testsuite/opcodes/xor.tz
+++ b/src/contracts/testsuite/opcodes/xor.tz
@@ -1,3 +1,13 @@
-parameter (pair bool bool);
-storage (option bool);
-code {CAR; DUP; CAR; DIP{CDR}; XOR; SOME; NIL operation ; PAIR};
+parameter (or (pair bool bool) (pair nat nat));
+storage (option (or bool nat));
+code {
+       CAR;
+       IF_LEFT
+         {
+           UNPAIR; XOR; LEFT nat
+         }
+         {
+           UNPAIR; XOR; RIGHT bool
+         } ;
+       SOME; NIL operation ; PAIR
+     }
-- 
GitLab


From 123c097185c474a4ca413e7bcc177bfeb56a0f68 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Fri, 13 Mar 2020 17:48:13 +0100
Subject: [PATCH 13/56] [Tests] Regression testing

Tests are run with `make test` and regression traces are reset with
`make RESET_REGRESSION=true test`.
---
 Makefile.local | 21 +++++++++++++++++++++
 1 file changed, 21 insertions(+)
 create mode 100644 Makefile.local

diff --git a/Makefile.local b/Makefile.local
new file mode 100644
index 00000000..5db71ffd
--- /dev/null
+++ b/Makefile.local
@@ -0,0 +1,21 @@
+
+## Tests
+
+MICHOCOQ=src/michocoq/extraction/michocoq.native
+
+RESET_REGRESSION=false
+
+TESTS=$(wildcard src/contracts/testsuite/*/*.tz)
+
+TESTS_RESULTS=$(TESTS:.tz=.tz.res)
+
+%.tz.res: %.tz
+	$(MICHOCOQ) "$$(cat $<)" > $*.tz.res
+ifeq ($(RESET_REGRESSION),true)
+	@cp $*.tz.res $*.tz.expected
+else
+	@diff $*.tz.res $*.tz.expected
+endif
+
+test: all $(TESTS_RESULTS)
+	@rm $(TESTS_RESULTS)
-- 
GitLab


From 2eeac09cf88870e8c4d911328fb18265c5f41c67 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Fri, 13 Mar 2020 17:35:42 +0100
Subject: [PATCH 14/56] [Tests] Regression traces

---
 src/contracts/testsuite/attic/accounts.tz.expected           | 5 +++++
 src/contracts/testsuite/attic/add1.tz.expected               | 5 +++++
 src/contracts/testsuite/attic/add1_list.tz.expected          | 5 +++++
 src/contracts/testsuite/attic/after_strategy.tz.expected     | 5 +++++
 src/contracts/testsuite/attic/always.tz.expected             | 5 +++++
 src/contracts/testsuite/attic/append.tz.expected             | 5 +++++
 src/contracts/testsuite/attic/at_least.tz.expected           | 5 +++++
 src/contracts/testsuite/attic/auction.tz.expected            | 5 +++++
 src/contracts/testsuite/attic/bad_lockup.tz.expected         | 5 +++++
 src/contracts/testsuite/attic/big_map_union.tz.expected      | 5 +++++
 src/contracts/testsuite/attic/cadr_annotation.tz.expected    | 5 +++++
 src/contracts/testsuite/attic/concat.tz.expected             | 5 +++++
 src/contracts/testsuite/attic/conditionals.tz.expected       | 5 +++++
 src/contracts/testsuite/attic/cons_twice.tz.expected         | 5 +++++
 src/contracts/testsuite/attic/cps_fact.tz.expected           | 5 +++++
 src/contracts/testsuite/attic/create_add1_lists.tz.expected  | 5 +++++
 src/contracts/testsuite/attic/data_publisher.tz.expected     | 5 +++++
 src/contracts/testsuite/attic/dispatch.tz.expected           | 5 +++++
 src/contracts/testsuite/attic/empty.tz.expected              | 5 +++++
 src/contracts/testsuite/attic/fail_amount.tz.expected        | 5 +++++
 src/contracts/testsuite/attic/faucet.tz.expected             | 5 +++++
 src/contracts/testsuite/attic/forward.tz.expected            | 5 +++++
 src/contracts/testsuite/attic/id.tz.expected                 | 5 +++++
 src/contracts/testsuite/attic/infinite_loop.tz.expected      | 5 +++++
 src/contracts/testsuite/attic/insertion_sort.tz.expected     | 5 +++++
 src/contracts/testsuite/attic/int_publisher.tz.expected      | 5 +++++
 src/contracts/testsuite/attic/king_of_tez.tz.expected        | 5 +++++
 .../testsuite/attic/list_of_transactions.tz.expected         | 5 +++++
 src/contracts/testsuite/attic/queue.tz.expected              | 5 +++++
 src/contracts/testsuite/attic/reduce_map.tz.expected         | 5 +++++
 src/contracts/testsuite/attic/reentrancy.tz.expected         | 5 +++++
 src/contracts/testsuite/attic/reservoir.tz.expected          | 5 +++++
 .../testsuite/attic/scrutable_reservoir.tz.expected          | 5 +++++
 src/contracts/testsuite/attic/spawn_identities.tz.expected   | 5 +++++
 .../testsuite/deprecated/create_account.tz.expected          | 5 +++++
 .../testsuite/deprecated/create_contract.tz.expected         | 5 +++++
 src/contracts/testsuite/deprecated/originator.tz.expected    | 5 +++++
 .../testsuite/entrypoints/big_map_entrypoints.tz.expected    | 5 +++++
 .../testsuite/entrypoints/delegatable_target.tz.expected     | 5 +++++
 src/contracts/testsuite/entrypoints/manager.tz.expected      | 5 +++++
 .../testsuite/entrypoints/no_default_target.tz.expected      | 5 +++++
 .../testsuite/entrypoints/no_entrypoint_target.tz.expected   | 5 +++++
 .../testsuite/entrypoints/rooted_target.tz.expected          | 5 +++++
 src/contracts/testsuite/ill_typed/big_map_arity.tz.expected  | 5 +++++
 .../testsuite/ill_typed/invalid_self_entrypoint.tz.expected  | 5 +++++
 .../testsuite/ill_typed/merge_comparable_pairs.tz.expected   | 5 +++++
 src/contracts/testsuite/ill_typed/pack_big_map.tz.expected   | 5 +++++
 src/contracts/testsuite/ill_typed/pack_operation.tz.expected | 5 +++++
 src/contracts/testsuite/macros/assert.tz.expected            | 5 +++++
 src/contracts/testsuite/macros/assert_cmpeq.tz.expected      | 5 +++++
 src/contracts/testsuite/macros/assert_cmpge.tz.expected      | 5 +++++
 src/contracts/testsuite/macros/assert_cmpgt.tz.expected      | 5 +++++
 src/contracts/testsuite/macros/assert_cmple.tz.expected      | 5 +++++
 src/contracts/testsuite/macros/assert_cmplt.tz.expected      | 5 +++++
 src/contracts/testsuite/macros/assert_cmpneq.tz.expected     | 5 +++++
 src/contracts/testsuite/macros/assert_eq.tz.expected         | 5 +++++
 src/contracts/testsuite/macros/assert_ge.tz.expected         | 5 +++++
 src/contracts/testsuite/macros/assert_gt.tz.expected         | 5 +++++
 src/contracts/testsuite/macros/assert_le.tz.expected         | 5 +++++
 src/contracts/testsuite/macros/assert_lt.tz.expected         | 5 +++++
 src/contracts/testsuite/macros/assert_neq.tz.expected        | 5 +++++
 src/contracts/testsuite/macros/big_map_get_add.tz.expected   | 5 +++++
 src/contracts/testsuite/macros/big_map_mem.tz.expected       | 5 +++++
 src/contracts/testsuite/macros/build_list.tz.expected        | 5 +++++
 src/contracts/testsuite/macros/compare.tz.expected           | 5 +++++
 src/contracts/testsuite/macros/compare_bytes.tz.expected     | 5 +++++
 src/contracts/testsuite/macros/fail.tz.expected              | 5 +++++
 src/contracts/testsuite/macros/guestbook.tz.expected         | 5 +++++
 src/contracts/testsuite/macros/macro_annotations.tz.expected | 5 +++++
 src/contracts/testsuite/macros/map_caddaadr.tz.expected      | 5 +++++
 src/contracts/testsuite/macros/max_in_list.tz.expected       | 5 +++++
 src/contracts/testsuite/macros/min.tz.expected               | 5 +++++
 src/contracts/testsuite/macros/pair_macro.tz.expected        | 5 +++++
 src/contracts/testsuite/macros/set_caddaadr.tz.expected      | 5 +++++
 src/contracts/testsuite/macros/take_my_money.tz.expected     | 5 +++++
 src/contracts/testsuite/macros/unpair_macro.tz.expected      | 5 +++++
 .../testsuite/mini_scenarios/authentication.tz.expected      | 5 +++++
 .../testsuite/mini_scenarios/big_map_entrypoints.tz.expected | 5 +++++
 .../testsuite/mini_scenarios/big_map_magic.tz.expected       | 5 +++++
 .../testsuite/mini_scenarios/create_contract.tz.expected     | 5 +++++
 .../mini_scenarios/create_contract_simple.tz.expected        | 5 +++++
 .../testsuite/mini_scenarios/default_account.tz.expected     | 5 +++++
 src/contracts/testsuite/mini_scenarios/hardlimit.tz.expected | 5 +++++
 src/contracts/testsuite/mini_scenarios/lockup.tz.expected    | 5 +++++
 .../testsuite/mini_scenarios/multiple_en2.tz.expected        | 5 +++++
 .../mini_scenarios/multiple_entrypoints_counter.tz.expected  | 5 +++++
 .../mini_scenarios/parameterized_multisig.tz.expected        | 5 +++++
 src/contracts/testsuite/mini_scenarios/replay.tz.expected    | 5 +++++
 .../mini_scenarios/reveal_signed_preimage.tz.expected        | 5 +++++
 .../testsuite/mini_scenarios/vote_for_delegate.tz.expected   | 5 +++++
 .../testsuite/mini_scenarios/weather_insurance.tz.expected   | 5 +++++
 src/contracts/testsuite/mini_scenarios/xcat.tz.expected      | 5 +++++
 src/contracts/testsuite/mini_scenarios/xcat_dapp.tz.expected | 5 +++++
 src/contracts/testsuite/non_regression/bug_262.tz.expected   | 5 +++++
 src/contracts/testsuite/opcodes/abs.tz.expected              | 5 +++++
 src/contracts/testsuite/opcodes/add.tz.expected              | 5 +++++
 .../testsuite/opcodes/add_delta_timestamp.tz.expected        | 5 +++++
 .../testsuite/opcodes/add_timestamp_delta.tz.expected        | 5 +++++
 src/contracts/testsuite/opcodes/address.tz.expected          | 5 +++++
 src/contracts/testsuite/opcodes/and.tz.expected              | 5 +++++
 src/contracts/testsuite/opcodes/and_binary.tz.expected       | 5 +++++
 src/contracts/testsuite/opcodes/and_logical_1.tz.expected    | 5 +++++
 src/contracts/testsuite/opcodes/balance.tz.expected          | 5 +++++
 src/contracts/testsuite/opcodes/big_map_mem_nat.tz.expected  | 5 +++++
 .../testsuite/opcodes/big_map_mem_string.tz.expected         | 5 +++++
 src/contracts/testsuite/opcodes/big_map_to_self.tz.expected  | 5 +++++
 src/contracts/testsuite/opcodes/car.tz.expected              | 5 +++++
 src/contracts/testsuite/opcodes/cdr.tz.expected              | 5 +++++
 src/contracts/testsuite/opcodes/chain_id.tz.expected         | 5 +++++
 src/contracts/testsuite/opcodes/chain_id_store.tz.expected   | 5 +++++
 src/contracts/testsuite/opcodes/check_signature.tz.expected  | 5 +++++
 src/contracts/testsuite/opcodes/compare.tz.expected          | 5 +++++
 src/contracts/testsuite/opcodes/comparisons.tz.expected      | 5 +++++
 src/contracts/testsuite/opcodes/concat_hello.tz.expected     | 5 +++++
 .../testsuite/opcodes/concat_hello_bytes.tz.expected         | 5 +++++
 src/contracts/testsuite/opcodes/concat_list.tz.expected      | 5 +++++
 src/contracts/testsuite/opcodes/cons.tz.expected             | 5 +++++
 src/contracts/testsuite/opcodes/contains_all.tz.expected     | 5 +++++
 src/contracts/testsuite/opcodes/contract.tz.expected         | 5 +++++
 src/contracts/testsuite/opcodes/create_contract.tz.expected  | 5 +++++
 src/contracts/testsuite/opcodes/diff_timestamps.tz.expected  | 5 +++++
 src/contracts/testsuite/opcodes/dig_eq.tz.expected           | 5 +++++
 src/contracts/testsuite/opcodes/dign.tz.expected             | 5 +++++
 src/contracts/testsuite/opcodes/dip.tz.expected              | 5 +++++
 src/contracts/testsuite/opcodes/dipn.tz.expected             | 5 +++++
 src/contracts/testsuite/opcodes/dropn.tz.expected            | 5 +++++
 src/contracts/testsuite/opcodes/dugn.tz.expected             | 5 +++++
 src/contracts/testsuite/opcodes/ediv.tz.expected             | 5 +++++
 src/contracts/testsuite/opcodes/ediv_mutez.tz.expected       | 5 +++++
 src/contracts/testsuite/opcodes/empty_map.tz.expected        | 5 +++++
 src/contracts/testsuite/opcodes/exec_concat.tz.expected      | 5 +++++
 src/contracts/testsuite/opcodes/first.tz.expected            | 5 +++++
 .../testsuite/opcodes/get_big_map_value.tz.expected          | 5 +++++
 src/contracts/testsuite/opcodes/get_map_value.tz.expected    | 5 +++++
 .../testsuite/opcodes/hash_consistency_checker.tz.expected   | 5 +++++
 src/contracts/testsuite/opcodes/hash_key.tz.expected         | 5 +++++
 src/contracts/testsuite/opcodes/hash_string.tz.expected      | 5 +++++
 src/contracts/testsuite/opcodes/if.tz.expected               | 5 +++++
 src/contracts/testsuite/opcodes/if_some.tz.expected          | 5 +++++
 src/contracts/testsuite/opcodes/int.tz.expected              | 5 +++++
 src/contracts/testsuite/opcodes/left_right.tz.expected       | 5 +++++
 src/contracts/testsuite/opcodes/list_concat.tz.expected      | 5 +++++
 .../testsuite/opcodes/list_concat_bytes.tz.expected          | 5 +++++
 src/contracts/testsuite/opcodes/list_id.tz.expected          | 5 +++++
 src/contracts/testsuite/opcodes/list_id_map.tz.expected      | 5 +++++
 src/contracts/testsuite/opcodes/list_iter.tz.expected        | 5 +++++
 src/contracts/testsuite/opcodes/list_map_block.tz.expected   | 5 +++++
 src/contracts/testsuite/opcodes/list_size.tz.expected        | 5 +++++
 src/contracts/testsuite/opcodes/loop_left.tz.expected        | 5 +++++
 src/contracts/testsuite/opcodes/map_car.tz.expected          | 5 +++++
 src/contracts/testsuite/opcodes/map_id.tz.expected           | 5 +++++
 src/contracts/testsuite/opcodes/map_iter.tz.expected         | 5 +++++
 src/contracts/testsuite/opcodes/map_map.tz.expected          | 5 +++++
 .../testsuite/opcodes/map_map_sideeffect.tz.expected         | 5 +++++
 src/contracts/testsuite/opcodes/map_mem_nat.tz.expected      | 5 +++++
 src/contracts/testsuite/opcodes/map_mem_string.tz.expected   | 5 +++++
 src/contracts/testsuite/opcodes/map_size.tz.expected         | 5 +++++
 src/contracts/testsuite/opcodes/mul.tz.expected              | 5 +++++
 src/contracts/testsuite/opcodes/mul_overflow.tz.expected     | 5 +++++
 src/contracts/testsuite/opcodes/neg.tz.expected              | 5 +++++
 src/contracts/testsuite/opcodes/none.tz.expected             | 5 +++++
 src/contracts/testsuite/opcodes/noop.tz.expected             | 5 +++++
 src/contracts/testsuite/opcodes/not.tz.expected              | 5 +++++
 src/contracts/testsuite/opcodes/not_binary.tz.expected       | 5 +++++
 src/contracts/testsuite/opcodes/or.tz.expected               | 5 +++++
 src/contracts/testsuite/opcodes/or_binary.tz.expected        | 5 +++++
 src/contracts/testsuite/opcodes/packunpack.tz.expected       | 5 +++++
 src/contracts/testsuite/opcodes/packunpack_rev.tz.expected   | 5 +++++
 .../testsuite/opcodes/packunpack_rev_cty.tz.expected         | 5 +++++
 src/contracts/testsuite/opcodes/pair_id.tz.expected          | 5 +++++
 src/contracts/testsuite/opcodes/pexec.tz.expected            | 5 +++++
 src/contracts/testsuite/opcodes/pexec_2.tz.expected          | 5 +++++
 src/contracts/testsuite/opcodes/proxy.tz.expected            | 5 +++++
 src/contracts/testsuite/opcodes/ret_int.tz.expected          | 5 +++++
 src/contracts/testsuite/opcodes/reverse.tz.expected          | 5 +++++
 src/contracts/testsuite/opcodes/reverse_loop.tz.expected     | 5 +++++
 src/contracts/testsuite/opcodes/self.tz.expected             | 5 +++++
 .../opcodes/self_with_default_entrypoint.tz.expected         | 5 +++++
 .../testsuite/opcodes/self_with_entrypoint.tz.expected       | 5 +++++
 src/contracts/testsuite/opcodes/sender.tz.expected           | 5 +++++
 src/contracts/testsuite/opcodes/set_car.tz.expected          | 5 +++++
 src/contracts/testsuite/opcodes/set_cdr.tz.expected          | 5 +++++
 src/contracts/testsuite/opcodes/set_delegate.tz.expected     | 5 +++++
 src/contracts/testsuite/opcodes/set_id.tz.expected           | 5 +++++
 src/contracts/testsuite/opcodes/set_iter.tz.expected         | 5 +++++
 src/contracts/testsuite/opcodes/set_member.tz.expected       | 5 +++++
 src/contracts/testsuite/opcodes/set_size.tz.expected         | 5 +++++
 src/contracts/testsuite/opcodes/shifts.tz.expected           | 5 +++++
 src/contracts/testsuite/opcodes/slice.tz.expected            | 5 +++++
 src/contracts/testsuite/opcodes/slice_bytes.tz.expected      | 5 +++++
 src/contracts/testsuite/opcodes/slices.tz.expected           | 5 +++++
 src/contracts/testsuite/opcodes/source.tz.expected           | 5 +++++
 src/contracts/testsuite/opcodes/split_bytes.tz.expected      | 5 +++++
 src/contracts/testsuite/opcodes/split_string.tz.expected     | 5 +++++
 src/contracts/testsuite/opcodes/store_input.tz.expected      | 5 +++++
 src/contracts/testsuite/opcodes/store_now.tz.expected        | 5 +++++
 src/contracts/testsuite/opcodes/str_id.tz.expected           | 5 +++++
 .../testsuite/opcodes/sub_timestamp_delta.tz.expected        | 5 +++++
 src/contracts/testsuite/opcodes/subset.tz.expected           | 5 +++++
 src/contracts/testsuite/opcodes/tez_add_sub.tz.expected      | 5 +++++
 src/contracts/testsuite/opcodes/transfer_amount.tz.expected  | 5 +++++
 src/contracts/testsuite/opcodes/transfer_tokens.tz.expected  | 5 +++++
 src/contracts/testsuite/opcodes/update_big_map.tz.expected   | 5 +++++
 src/contracts/testsuite/opcodes/xor.tz.expected              | 5 +++++
 204 files changed, 1020 insertions(+)
 create mode 100644 src/contracts/testsuite/attic/accounts.tz.expected
 create mode 100644 src/contracts/testsuite/attic/add1.tz.expected
 create mode 100644 src/contracts/testsuite/attic/add1_list.tz.expected
 create mode 100644 src/contracts/testsuite/attic/after_strategy.tz.expected
 create mode 100644 src/contracts/testsuite/attic/always.tz.expected
 create mode 100644 src/contracts/testsuite/attic/append.tz.expected
 create mode 100644 src/contracts/testsuite/attic/at_least.tz.expected
 create mode 100644 src/contracts/testsuite/attic/auction.tz.expected
 create mode 100644 src/contracts/testsuite/attic/bad_lockup.tz.expected
 create mode 100644 src/contracts/testsuite/attic/big_map_union.tz.expected
 create mode 100644 src/contracts/testsuite/attic/cadr_annotation.tz.expected
 create mode 100644 src/contracts/testsuite/attic/concat.tz.expected
 create mode 100644 src/contracts/testsuite/attic/conditionals.tz.expected
 create mode 100644 src/contracts/testsuite/attic/cons_twice.tz.expected
 create mode 100644 src/contracts/testsuite/attic/cps_fact.tz.expected
 create mode 100644 src/contracts/testsuite/attic/create_add1_lists.tz.expected
 create mode 100644 src/contracts/testsuite/attic/data_publisher.tz.expected
 create mode 100644 src/contracts/testsuite/attic/dispatch.tz.expected
 create mode 100644 src/contracts/testsuite/attic/empty.tz.expected
 create mode 100644 src/contracts/testsuite/attic/fail_amount.tz.expected
 create mode 100644 src/contracts/testsuite/attic/faucet.tz.expected
 create mode 100644 src/contracts/testsuite/attic/forward.tz.expected
 create mode 100644 src/contracts/testsuite/attic/id.tz.expected
 create mode 100644 src/contracts/testsuite/attic/infinite_loop.tz.expected
 create mode 100644 src/contracts/testsuite/attic/insertion_sort.tz.expected
 create mode 100644 src/contracts/testsuite/attic/int_publisher.tz.expected
 create mode 100644 src/contracts/testsuite/attic/king_of_tez.tz.expected
 create mode 100644 src/contracts/testsuite/attic/list_of_transactions.tz.expected
 create mode 100644 src/contracts/testsuite/attic/queue.tz.expected
 create mode 100644 src/contracts/testsuite/attic/reduce_map.tz.expected
 create mode 100644 src/contracts/testsuite/attic/reentrancy.tz.expected
 create mode 100644 src/contracts/testsuite/attic/reservoir.tz.expected
 create mode 100644 src/contracts/testsuite/attic/scrutable_reservoir.tz.expected
 create mode 100644 src/contracts/testsuite/attic/spawn_identities.tz.expected
 create mode 100644 src/contracts/testsuite/deprecated/create_account.tz.expected
 create mode 100644 src/contracts/testsuite/deprecated/create_contract.tz.expected
 create mode 100644 src/contracts/testsuite/deprecated/originator.tz.expected
 create mode 100644 src/contracts/testsuite/entrypoints/big_map_entrypoints.tz.expected
 create mode 100644 src/contracts/testsuite/entrypoints/delegatable_target.tz.expected
 create mode 100644 src/contracts/testsuite/entrypoints/manager.tz.expected
 create mode 100644 src/contracts/testsuite/entrypoints/no_default_target.tz.expected
 create mode 100644 src/contracts/testsuite/entrypoints/no_entrypoint_target.tz.expected
 create mode 100644 src/contracts/testsuite/entrypoints/rooted_target.tz.expected
 create mode 100644 src/contracts/testsuite/ill_typed/big_map_arity.tz.expected
 create mode 100644 src/contracts/testsuite/ill_typed/invalid_self_entrypoint.tz.expected
 create mode 100644 src/contracts/testsuite/ill_typed/merge_comparable_pairs.tz.expected
 create mode 100644 src/contracts/testsuite/ill_typed/pack_big_map.tz.expected
 create mode 100644 src/contracts/testsuite/ill_typed/pack_operation.tz.expected
 create mode 100644 src/contracts/testsuite/macros/assert.tz.expected
 create mode 100644 src/contracts/testsuite/macros/assert_cmpeq.tz.expected
 create mode 100644 src/contracts/testsuite/macros/assert_cmpge.tz.expected
 create mode 100644 src/contracts/testsuite/macros/assert_cmpgt.tz.expected
 create mode 100644 src/contracts/testsuite/macros/assert_cmple.tz.expected
 create mode 100644 src/contracts/testsuite/macros/assert_cmplt.tz.expected
 create mode 100644 src/contracts/testsuite/macros/assert_cmpneq.tz.expected
 create mode 100644 src/contracts/testsuite/macros/assert_eq.tz.expected
 create mode 100644 src/contracts/testsuite/macros/assert_ge.tz.expected
 create mode 100644 src/contracts/testsuite/macros/assert_gt.tz.expected
 create mode 100644 src/contracts/testsuite/macros/assert_le.tz.expected
 create mode 100644 src/contracts/testsuite/macros/assert_lt.tz.expected
 create mode 100644 src/contracts/testsuite/macros/assert_neq.tz.expected
 create mode 100644 src/contracts/testsuite/macros/big_map_get_add.tz.expected
 create mode 100644 src/contracts/testsuite/macros/big_map_mem.tz.expected
 create mode 100644 src/contracts/testsuite/macros/build_list.tz.expected
 create mode 100644 src/contracts/testsuite/macros/compare.tz.expected
 create mode 100644 src/contracts/testsuite/macros/compare_bytes.tz.expected
 create mode 100644 src/contracts/testsuite/macros/fail.tz.expected
 create mode 100644 src/contracts/testsuite/macros/guestbook.tz.expected
 create mode 100644 src/contracts/testsuite/macros/macro_annotations.tz.expected
 create mode 100644 src/contracts/testsuite/macros/map_caddaadr.tz.expected
 create mode 100644 src/contracts/testsuite/macros/max_in_list.tz.expected
 create mode 100644 src/contracts/testsuite/macros/min.tz.expected
 create mode 100644 src/contracts/testsuite/macros/pair_macro.tz.expected
 create mode 100644 src/contracts/testsuite/macros/set_caddaadr.tz.expected
 create mode 100644 src/contracts/testsuite/macros/take_my_money.tz.expected
 create mode 100644 src/contracts/testsuite/macros/unpair_macro.tz.expected
 create mode 100644 src/contracts/testsuite/mini_scenarios/authentication.tz.expected
 create mode 100644 src/contracts/testsuite/mini_scenarios/big_map_entrypoints.tz.expected
 create mode 100644 src/contracts/testsuite/mini_scenarios/big_map_magic.tz.expected
 create mode 100644 src/contracts/testsuite/mini_scenarios/create_contract.tz.expected
 create mode 100644 src/contracts/testsuite/mini_scenarios/create_contract_simple.tz.expected
 create mode 100644 src/contracts/testsuite/mini_scenarios/default_account.tz.expected
 create mode 100644 src/contracts/testsuite/mini_scenarios/hardlimit.tz.expected
 create mode 100644 src/contracts/testsuite/mini_scenarios/lockup.tz.expected
 create mode 100644 src/contracts/testsuite/mini_scenarios/multiple_en2.tz.expected
 create mode 100644 src/contracts/testsuite/mini_scenarios/multiple_entrypoints_counter.tz.expected
 create mode 100644 src/contracts/testsuite/mini_scenarios/parameterized_multisig.tz.expected
 create mode 100644 src/contracts/testsuite/mini_scenarios/replay.tz.expected
 create mode 100644 src/contracts/testsuite/mini_scenarios/reveal_signed_preimage.tz.expected
 create mode 100644 src/contracts/testsuite/mini_scenarios/vote_for_delegate.tz.expected
 create mode 100644 src/contracts/testsuite/mini_scenarios/weather_insurance.tz.expected
 create mode 100644 src/contracts/testsuite/mini_scenarios/xcat.tz.expected
 create mode 100644 src/contracts/testsuite/mini_scenarios/xcat_dapp.tz.expected
 create mode 100644 src/contracts/testsuite/non_regression/bug_262.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/abs.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/add.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/add_delta_timestamp.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/add_timestamp_delta.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/address.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/and.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/and_binary.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/and_logical_1.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/balance.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/big_map_mem_nat.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/big_map_mem_string.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/big_map_to_self.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/car.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/cdr.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/chain_id.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/chain_id_store.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/check_signature.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/compare.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/comparisons.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/concat_hello.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/concat_hello_bytes.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/concat_list.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/cons.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/contains_all.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/contract.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/create_contract.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/diff_timestamps.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/dig_eq.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/dign.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/dip.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/dipn.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/dropn.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/dugn.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/ediv.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/ediv_mutez.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/empty_map.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/exec_concat.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/first.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/get_big_map_value.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/get_map_value.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/hash_consistency_checker.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/hash_key.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/hash_string.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/if.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/if_some.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/int.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/left_right.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/list_concat.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/list_concat_bytes.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/list_id.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/list_id_map.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/list_iter.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/list_map_block.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/list_size.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/loop_left.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/map_car.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/map_id.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/map_iter.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/map_map.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/map_map_sideeffect.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/map_mem_nat.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/map_mem_string.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/map_size.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/mul.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/mul_overflow.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/neg.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/none.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/noop.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/not.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/not_binary.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/or.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/or_binary.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/packunpack.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/packunpack_rev.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/packunpack_rev_cty.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/pair_id.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/pexec.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/pexec_2.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/proxy.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/ret_int.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/reverse.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/reverse_loop.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/self.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/self_with_default_entrypoint.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/self_with_entrypoint.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/sender.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/set_car.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/set_cdr.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/set_delegate.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/set_id.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/set_iter.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/set_member.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/set_size.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/shifts.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/slice.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/slice_bytes.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/slices.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/source.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/split_bytes.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/split_string.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/store_input.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/store_now.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/str_id.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/sub_timestamp_delta.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/subset.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/tez_add_sub.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/transfer_amount.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/transfer_tokens.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/update_big_map.tz.expected
 create mode 100644 src/contracts/testsuite/opcodes/xor.tz.expected

diff --git a/src/contracts/testsuite/attic/accounts.tz.expected b/src/contracts/testsuite/attic/accounts.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/accounts.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/add1.tz.expected b/src/contracts/testsuite/attic/add1.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/add1.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/add1_list.tz.expected b/src/contracts/testsuite/attic/add1_list.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/add1_list.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/after_strategy.tz.expected b/src/contracts/testsuite/attic/after_strategy.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/after_strategy.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/always.tz.expected b/src/contracts/testsuite/attic/always.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/always.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/append.tz.expected b/src/contracts/testsuite/attic/append.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/append.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/at_least.tz.expected b/src/contracts/testsuite/attic/at_least.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/at_least.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/auction.tz.expected b/src/contracts/testsuite/attic/auction.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/auction.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/bad_lockup.tz.expected b/src/contracts/testsuite/attic/bad_lockup.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/bad_lockup.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/big_map_union.tz.expected b/src/contracts/testsuite/attic/big_map_union.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/big_map_union.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/cadr_annotation.tz.expected b/src/contracts/testsuite/attic/cadr_annotation.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/cadr_annotation.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/concat.tz.expected b/src/contracts/testsuite/attic/concat.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/concat.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/conditionals.tz.expected b/src/contracts/testsuite/attic/conditionals.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/conditionals.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/cons_twice.tz.expected b/src/contracts/testsuite/attic/cons_twice.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/cons_twice.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/cps_fact.tz.expected b/src/contracts/testsuite/attic/cps_fact.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/cps_fact.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/create_add1_lists.tz.expected b/src/contracts/testsuite/attic/create_add1_lists.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/create_add1_lists.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/data_publisher.tz.expected b/src/contracts/testsuite/attic/data_publisher.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/data_publisher.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/dispatch.tz.expected b/src/contracts/testsuite/attic/dispatch.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/dispatch.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/empty.tz.expected b/src/contracts/testsuite/attic/empty.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/empty.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/fail_amount.tz.expected b/src/contracts/testsuite/attic/fail_amount.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/fail_amount.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/faucet.tz.expected b/src/contracts/testsuite/attic/faucet.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/faucet.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/forward.tz.expected b/src/contracts/testsuite/attic/forward.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/forward.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/id.tz.expected b/src/contracts/testsuite/attic/id.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/id.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/infinite_loop.tz.expected b/src/contracts/testsuite/attic/infinite_loop.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/infinite_loop.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/insertion_sort.tz.expected b/src/contracts/testsuite/attic/insertion_sort.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/insertion_sort.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/int_publisher.tz.expected b/src/contracts/testsuite/attic/int_publisher.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/int_publisher.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/king_of_tez.tz.expected b/src/contracts/testsuite/attic/king_of_tez.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/king_of_tez.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/list_of_transactions.tz.expected b/src/contracts/testsuite/attic/list_of_transactions.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/list_of_transactions.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/queue.tz.expected b/src/contracts/testsuite/attic/queue.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/queue.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/reduce_map.tz.expected b/src/contracts/testsuite/attic/reduce_map.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/reduce_map.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/reentrancy.tz.expected b/src/contracts/testsuite/attic/reentrancy.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/reentrancy.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/reservoir.tz.expected b/src/contracts/testsuite/attic/reservoir.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/reservoir.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/scrutable_reservoir.tz.expected b/src/contracts/testsuite/attic/scrutable_reservoir.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/scrutable_reservoir.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/attic/spawn_identities.tz.expected b/src/contracts/testsuite/attic/spawn_identities.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/attic/spawn_identities.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/deprecated/create_account.tz.expected b/src/contracts/testsuite/deprecated/create_account.tz.expected
new file mode 100644
index 00000000..a237d4ff
--- /dev/null
+++ b/src/contracts/testsuite/deprecated/create_account.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: Unknown primitive CREATE_ACCOUNT between line 23 column 11 and line 23 column 24
+Type checking: Unknown primitive CREATE_ACCOUNT between line 23 column 11 and line 23 column 24
+
diff --git a/src/contracts/testsuite/deprecated/create_contract.tz.expected b/src/contracts/testsuite/deprecated/create_contract.tz.expected
new file mode 100644
index 00000000..de2bb5f3
--- /dev/null
+++ b/src/contracts/testsuite/deprecated/create_contract.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: Typing error
+
diff --git a/src/contracts/testsuite/deprecated/originator.tz.expected b/src/contracts/testsuite/deprecated/originator.tz.expected
new file mode 100644
index 00000000..5da234fc
--- /dev/null
+++ b/src/contracts/testsuite/deprecated/originator.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: Unknown primitive CREATE_ACCOUNT between line 11 column 8 and line 11 column 21
+Type checking: Unknown primitive CREATE_ACCOUNT between line 11 column 8 and line 11 column 21
+
diff --git a/src/contracts/testsuite/entrypoints/big_map_entrypoints.tz.expected b/src/contracts/testsuite/entrypoints/big_map_entrypoints.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/entrypoints/big_map_entrypoints.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/entrypoints/delegatable_target.tz.expected b/src/contracts/testsuite/entrypoints/delegatable_target.tz.expected
new file mode 100644
index 00000000..c8ec5552
--- /dev/null
+++ b/src/contracts/testsuite/entrypoints/delegatable_target.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: Parsing error
+Expansion: Parsing error
+Type checking: Parsing error
+
diff --git a/src/contracts/testsuite/entrypoints/manager.tz.expected b/src/contracts/testsuite/entrypoints/manager.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/entrypoints/manager.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/entrypoints/no_default_target.tz.expected b/src/contracts/testsuite/entrypoints/no_default_target.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/entrypoints/no_default_target.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/entrypoints/no_entrypoint_target.tz.expected b/src/contracts/testsuite/entrypoints/no_entrypoint_target.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/entrypoints/no_entrypoint_target.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/entrypoints/rooted_target.tz.expected b/src/contracts/testsuite/entrypoints/rooted_target.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/entrypoints/rooted_target.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/ill_typed/big_map_arity.tz.expected b/src/contracts/testsuite/ill_typed/big_map_arity.tz.expected
new file mode 100644
index 00000000..06af7b57
--- /dev/null
+++ b/src/contracts/testsuite/ill_typed/big_map_arity.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: Unknown primitive EMPTY_BIG_MAP between line 5 column 10 and line 5 column 25
+Type checking: Unknown primitive EMPTY_BIG_MAP between line 5 column 10 and line 5 column 25
+
diff --git a/src/contracts/testsuite/ill_typed/invalid_self_entrypoint.tz.expected b/src/contracts/testsuite/ill_typed/invalid_self_entrypoint.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/ill_typed/invalid_self_entrypoint.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/ill_typed/merge_comparable_pairs.tz.expected b/src/contracts/testsuite/ill_typed/merge_comparable_pairs.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/ill_typed/merge_comparable_pairs.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/ill_typed/pack_big_map.tz.expected b/src/contracts/testsuite/ill_typed/pack_big_map.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/ill_typed/pack_big_map.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/ill_typed/pack_operation.tz.expected b/src/contracts/testsuite/ill_typed/pack_operation.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/ill_typed/pack_operation.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/assert.tz.expected b/src/contracts/testsuite/macros/assert.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/assert.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/assert_cmpeq.tz.expected b/src/contracts/testsuite/macros/assert_cmpeq.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/assert_cmpeq.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/assert_cmpge.tz.expected b/src/contracts/testsuite/macros/assert_cmpge.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/assert_cmpge.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/assert_cmpgt.tz.expected b/src/contracts/testsuite/macros/assert_cmpgt.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/assert_cmpgt.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/assert_cmple.tz.expected b/src/contracts/testsuite/macros/assert_cmple.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/assert_cmple.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/assert_cmplt.tz.expected b/src/contracts/testsuite/macros/assert_cmplt.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/assert_cmplt.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/assert_cmpneq.tz.expected b/src/contracts/testsuite/macros/assert_cmpneq.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/assert_cmpneq.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/assert_eq.tz.expected b/src/contracts/testsuite/macros/assert_eq.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/assert_eq.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/assert_ge.tz.expected b/src/contracts/testsuite/macros/assert_ge.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/assert_ge.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/assert_gt.tz.expected b/src/contracts/testsuite/macros/assert_gt.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/assert_gt.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/assert_le.tz.expected b/src/contracts/testsuite/macros/assert_le.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/assert_le.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/assert_lt.tz.expected b/src/contracts/testsuite/macros/assert_lt.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/assert_lt.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/assert_neq.tz.expected b/src/contracts/testsuite/macros/assert_neq.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/assert_neq.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/big_map_get_add.tz.expected b/src/contracts/testsuite/macros/big_map_get_add.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/big_map_get_add.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/big_map_mem.tz.expected b/src/contracts/testsuite/macros/big_map_mem.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/big_map_mem.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/build_list.tz.expected b/src/contracts/testsuite/macros/build_list.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/build_list.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/compare.tz.expected b/src/contracts/testsuite/macros/compare.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/compare.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/compare_bytes.tz.expected b/src/contracts/testsuite/macros/compare_bytes.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/compare_bytes.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/fail.tz.expected b/src/contracts/testsuite/macros/fail.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/fail.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/guestbook.tz.expected b/src/contracts/testsuite/macros/guestbook.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/guestbook.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/macro_annotations.tz.expected b/src/contracts/testsuite/macros/macro_annotations.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/macro_annotations.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/map_caddaadr.tz.expected b/src/contracts/testsuite/macros/map_caddaadr.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/map_caddaadr.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/max_in_list.tz.expected b/src/contracts/testsuite/macros/max_in_list.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/max_in_list.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/min.tz.expected b/src/contracts/testsuite/macros/min.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/min.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/pair_macro.tz.expected b/src/contracts/testsuite/macros/pair_macro.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/pair_macro.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/set_caddaadr.tz.expected b/src/contracts/testsuite/macros/set_caddaadr.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/set_caddaadr.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/take_my_money.tz.expected b/src/contracts/testsuite/macros/take_my_money.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/take_my_money.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/macros/unpair_macro.tz.expected b/src/contracts/testsuite/macros/unpair_macro.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/macros/unpair_macro.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/mini_scenarios/authentication.tz.expected b/src/contracts/testsuite/mini_scenarios/authentication.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/authentication.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/mini_scenarios/big_map_entrypoints.tz.expected b/src/contracts/testsuite/mini_scenarios/big_map_entrypoints.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/big_map_entrypoints.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/mini_scenarios/big_map_magic.tz.expected b/src/contracts/testsuite/mini_scenarios/big_map_magic.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/big_map_magic.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/mini_scenarios/create_contract.tz.expected b/src/contracts/testsuite/mini_scenarios/create_contract.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/create_contract.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/mini_scenarios/create_contract_simple.tz.expected b/src/contracts/testsuite/mini_scenarios/create_contract_simple.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/create_contract_simple.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/mini_scenarios/default_account.tz.expected b/src/contracts/testsuite/mini_scenarios/default_account.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/default_account.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/mini_scenarios/hardlimit.tz.expected b/src/contracts/testsuite/mini_scenarios/hardlimit.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/hardlimit.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/mini_scenarios/lockup.tz.expected b/src/contracts/testsuite/mini_scenarios/lockup.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/lockup.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/mini_scenarios/multiple_en2.tz.expected b/src/contracts/testsuite/mini_scenarios/multiple_en2.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/multiple_en2.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/mini_scenarios/multiple_entrypoints_counter.tz.expected b/src/contracts/testsuite/mini_scenarios/multiple_entrypoints_counter.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/multiple_entrypoints_counter.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/mini_scenarios/parameterized_multisig.tz.expected b/src/contracts/testsuite/mini_scenarios/parameterized_multisig.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/parameterized_multisig.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/mini_scenarios/replay.tz.expected b/src/contracts/testsuite/mini_scenarios/replay.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/replay.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/mini_scenarios/reveal_signed_preimage.tz.expected b/src/contracts/testsuite/mini_scenarios/reveal_signed_preimage.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/reveal_signed_preimage.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/mini_scenarios/vote_for_delegate.tz.expected b/src/contracts/testsuite/mini_scenarios/vote_for_delegate.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/vote_for_delegate.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/mini_scenarios/weather_insurance.tz.expected b/src/contracts/testsuite/mini_scenarios/weather_insurance.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/weather_insurance.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/mini_scenarios/xcat.tz.expected b/src/contracts/testsuite/mini_scenarios/xcat.tz.expected
new file mode 100644
index 00000000..de2bb5f3
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/xcat.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: Typing error
+
diff --git a/src/contracts/testsuite/mini_scenarios/xcat_dapp.tz.expected b/src/contracts/testsuite/mini_scenarios/xcat_dapp.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/mini_scenarios/xcat_dapp.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/non_regression/bug_262.tz.expected b/src/contracts/testsuite/non_regression/bug_262.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/non_regression/bug_262.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/abs.tz.expected b/src/contracts/testsuite/opcodes/abs.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/abs.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/add.tz.expected b/src/contracts/testsuite/opcodes/add.tz.expected
new file mode 100644
index 00000000..de2bb5f3
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/add.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: Typing error
+
diff --git a/src/contracts/testsuite/opcodes/add_delta_timestamp.tz.expected b/src/contracts/testsuite/opcodes/add_delta_timestamp.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/add_delta_timestamp.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/add_timestamp_delta.tz.expected b/src/contracts/testsuite/opcodes/add_timestamp_delta.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/add_timestamp_delta.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/address.tz.expected b/src/contracts/testsuite/opcodes/address.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/address.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/and.tz.expected b/src/contracts/testsuite/opcodes/and.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/and.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/and_binary.tz.expected b/src/contracts/testsuite/opcodes/and_binary.tz.expected
new file mode 100644
index 00000000..de2bb5f3
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/and_binary.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: Typing error
+
diff --git a/src/contracts/testsuite/opcodes/and_logical_1.tz.expected b/src/contracts/testsuite/opcodes/and_logical_1.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/and_logical_1.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/balance.tz.expected b/src/contracts/testsuite/opcodes/balance.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/balance.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/big_map_mem_nat.tz.expected b/src/contracts/testsuite/opcodes/big_map_mem_nat.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/big_map_mem_nat.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/big_map_mem_string.tz.expected b/src/contracts/testsuite/opcodes/big_map_mem_string.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/big_map_mem_string.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/big_map_to_self.tz.expected b/src/contracts/testsuite/opcodes/big_map_to_self.tz.expected
new file mode 100644
index 00000000..de2bb5f3
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/big_map_to_self.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: Typing error
+
diff --git a/src/contracts/testsuite/opcodes/car.tz.expected b/src/contracts/testsuite/opcodes/car.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/car.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/cdr.tz.expected b/src/contracts/testsuite/opcodes/cdr.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/cdr.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/chain_id.tz.expected b/src/contracts/testsuite/opcodes/chain_id.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/chain_id.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/chain_id_store.tz.expected b/src/contracts/testsuite/opcodes/chain_id_store.tz.expected
new file mode 100644
index 00000000..070189dc
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/chain_id_store.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: Expansion error between line 2 column 13 and line 2 column 20
+Type checking: Expansion error between line 2 column 13 and line 2 column 20
+
diff --git a/src/contracts/testsuite/opcodes/check_signature.tz.expected b/src/contracts/testsuite/opcodes/check_signature.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/check_signature.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/compare.tz.expected b/src/contracts/testsuite/opcodes/compare.tz.expected
new file mode 100644
index 00000000..de2bb5f3
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/compare.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: Typing error
+
diff --git a/src/contracts/testsuite/opcodes/comparisons.tz.expected b/src/contracts/testsuite/opcodes/comparisons.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/comparisons.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/concat_hello.tz.expected b/src/contracts/testsuite/opcodes/concat_hello.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/concat_hello.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/concat_hello_bytes.tz.expected b/src/contracts/testsuite/opcodes/concat_hello_bytes.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/concat_hello_bytes.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/concat_list.tz.expected b/src/contracts/testsuite/opcodes/concat_list.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/concat_list.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/cons.tz.expected b/src/contracts/testsuite/opcodes/cons.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/cons.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/contains_all.tz.expected b/src/contracts/testsuite/opcodes/contains_all.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/contains_all.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/contract.tz.expected b/src/contracts/testsuite/opcodes/contract.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/contract.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/create_contract.tz.expected b/src/contracts/testsuite/opcodes/create_contract.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/create_contract.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/diff_timestamps.tz.expected b/src/contracts/testsuite/opcodes/diff_timestamps.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/diff_timestamps.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/dig_eq.tz.expected b/src/contracts/testsuite/opcodes/dig_eq.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/dig_eq.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/dign.tz.expected b/src/contracts/testsuite/opcodes/dign.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/dign.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/dip.tz.expected b/src/contracts/testsuite/opcodes/dip.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/dip.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/dipn.tz.expected b/src/contracts/testsuite/opcodes/dipn.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/dipn.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/dropn.tz.expected b/src/contracts/testsuite/opcodes/dropn.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/dropn.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/dugn.tz.expected b/src/contracts/testsuite/opcodes/dugn.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/dugn.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/ediv.tz.expected b/src/contracts/testsuite/opcodes/ediv.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/ediv.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/ediv_mutez.tz.expected b/src/contracts/testsuite/opcodes/ediv_mutez.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/ediv_mutez.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/empty_map.tz.expected b/src/contracts/testsuite/opcodes/empty_map.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/empty_map.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/exec_concat.tz.expected b/src/contracts/testsuite/opcodes/exec_concat.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/exec_concat.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/first.tz.expected b/src/contracts/testsuite/opcodes/first.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/first.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/get_big_map_value.tz.expected b/src/contracts/testsuite/opcodes/get_big_map_value.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/get_big_map_value.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/get_map_value.tz.expected b/src/contracts/testsuite/opcodes/get_map_value.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/get_map_value.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/hash_consistency_checker.tz.expected b/src/contracts/testsuite/opcodes/hash_consistency_checker.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/hash_consistency_checker.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/hash_key.tz.expected b/src/contracts/testsuite/opcodes/hash_key.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/hash_key.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/hash_string.tz.expected b/src/contracts/testsuite/opcodes/hash_string.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/hash_string.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/if.tz.expected b/src/contracts/testsuite/opcodes/if.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/if.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/if_some.tz.expected b/src/contracts/testsuite/opcodes/if_some.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/if_some.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/int.tz.expected b/src/contracts/testsuite/opcodes/int.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/int.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/left_right.tz.expected b/src/contracts/testsuite/opcodes/left_right.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/left_right.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/list_concat.tz.expected b/src/contracts/testsuite/opcodes/list_concat.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/list_concat.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/list_concat_bytes.tz.expected b/src/contracts/testsuite/opcodes/list_concat_bytes.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/list_concat_bytes.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/list_id.tz.expected b/src/contracts/testsuite/opcodes/list_id.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/list_id.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/list_id_map.tz.expected b/src/contracts/testsuite/opcodes/list_id_map.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/list_id_map.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/list_iter.tz.expected b/src/contracts/testsuite/opcodes/list_iter.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/list_iter.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/list_map_block.tz.expected b/src/contracts/testsuite/opcodes/list_map_block.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/list_map_block.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/list_size.tz.expected b/src/contracts/testsuite/opcodes/list_size.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/list_size.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/loop_left.tz.expected b/src/contracts/testsuite/opcodes/loop_left.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/loop_left.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/map_car.tz.expected b/src/contracts/testsuite/opcodes/map_car.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/map_car.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/map_id.tz.expected b/src/contracts/testsuite/opcodes/map_id.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/map_id.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/map_iter.tz.expected b/src/contracts/testsuite/opcodes/map_iter.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/map_iter.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/map_map.tz.expected b/src/contracts/testsuite/opcodes/map_map.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/map_map.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/map_map_sideeffect.tz.expected b/src/contracts/testsuite/opcodes/map_map_sideeffect.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/map_map_sideeffect.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/map_mem_nat.tz.expected b/src/contracts/testsuite/opcodes/map_mem_nat.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/map_mem_nat.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/map_mem_string.tz.expected b/src/contracts/testsuite/opcodes/map_mem_string.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/map_mem_string.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/map_size.tz.expected b/src/contracts/testsuite/opcodes/map_size.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/map_size.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/mul.tz.expected b/src/contracts/testsuite/opcodes/mul.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/mul.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/mul_overflow.tz.expected b/src/contracts/testsuite/opcodes/mul_overflow.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/mul_overflow.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/neg.tz.expected b/src/contracts/testsuite/opcodes/neg.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/neg.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/none.tz.expected b/src/contracts/testsuite/opcodes/none.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/none.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/noop.tz.expected b/src/contracts/testsuite/opcodes/noop.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/noop.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/not.tz.expected b/src/contracts/testsuite/opcodes/not.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/not.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/not_binary.tz.expected b/src/contracts/testsuite/opcodes/not_binary.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/not_binary.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/or.tz.expected b/src/contracts/testsuite/opcodes/or.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/or.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/or_binary.tz.expected b/src/contracts/testsuite/opcodes/or_binary.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/or_binary.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/packunpack.tz.expected b/src/contracts/testsuite/opcodes/packunpack.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/packunpack.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/packunpack_rev.tz.expected b/src/contracts/testsuite/opcodes/packunpack_rev.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/packunpack_rev.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/packunpack_rev_cty.tz.expected b/src/contracts/testsuite/opcodes/packunpack_rev_cty.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/packunpack_rev_cty.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/pair_id.tz.expected b/src/contracts/testsuite/opcodes/pair_id.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/pair_id.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/pexec.tz.expected b/src/contracts/testsuite/opcodes/pexec.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/pexec.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/pexec_2.tz.expected b/src/contracts/testsuite/opcodes/pexec_2.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/pexec_2.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/proxy.tz.expected b/src/contracts/testsuite/opcodes/proxy.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/proxy.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/ret_int.tz.expected b/src/contracts/testsuite/opcodes/ret_int.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/ret_int.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/reverse.tz.expected b/src/contracts/testsuite/opcodes/reverse.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/reverse.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/reverse_loop.tz.expected b/src/contracts/testsuite/opcodes/reverse_loop.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/reverse_loop.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/self.tz.expected b/src/contracts/testsuite/opcodes/self.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/self.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/self_with_default_entrypoint.tz.expected b/src/contracts/testsuite/opcodes/self_with_default_entrypoint.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/self_with_default_entrypoint.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/self_with_entrypoint.tz.expected b/src/contracts/testsuite/opcodes/self_with_entrypoint.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/self_with_entrypoint.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/sender.tz.expected b/src/contracts/testsuite/opcodes/sender.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/sender.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/set_car.tz.expected b/src/contracts/testsuite/opcodes/set_car.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/set_car.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/set_cdr.tz.expected b/src/contracts/testsuite/opcodes/set_cdr.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/set_cdr.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/set_delegate.tz.expected b/src/contracts/testsuite/opcodes/set_delegate.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/set_delegate.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/set_id.tz.expected b/src/contracts/testsuite/opcodes/set_id.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/set_id.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/set_iter.tz.expected b/src/contracts/testsuite/opcodes/set_iter.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/set_iter.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/set_member.tz.expected b/src/contracts/testsuite/opcodes/set_member.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/set_member.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/set_size.tz.expected b/src/contracts/testsuite/opcodes/set_size.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/set_size.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/shifts.tz.expected b/src/contracts/testsuite/opcodes/shifts.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/shifts.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/slice.tz.expected b/src/contracts/testsuite/opcodes/slice.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/slice.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/slice_bytes.tz.expected b/src/contracts/testsuite/opcodes/slice_bytes.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/slice_bytes.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/slices.tz.expected b/src/contracts/testsuite/opcodes/slices.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/slices.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/source.tz.expected b/src/contracts/testsuite/opcodes/source.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/source.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/split_bytes.tz.expected b/src/contracts/testsuite/opcodes/split_bytes.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/split_bytes.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/split_string.tz.expected b/src/contracts/testsuite/opcodes/split_string.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/split_string.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/store_input.tz.expected b/src/contracts/testsuite/opcodes/store_input.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/store_input.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/store_now.tz.expected b/src/contracts/testsuite/opcodes/store_now.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/store_now.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/str_id.tz.expected b/src/contracts/testsuite/opcodes/str_id.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/str_id.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/sub_timestamp_delta.tz.expected b/src/contracts/testsuite/opcodes/sub_timestamp_delta.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/sub_timestamp_delta.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/subset.tz.expected b/src/contracts/testsuite/opcodes/subset.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/subset.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/tez_add_sub.tz.expected b/src/contracts/testsuite/opcodes/tez_add_sub.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/tez_add_sub.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/transfer_amount.tz.expected b/src/contracts/testsuite/opcodes/transfer_amount.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/transfer_amount.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/transfer_tokens.tz.expected b/src/contracts/testsuite/opcodes/transfer_tokens.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/transfer_tokens.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/update_big_map.tz.expected b/src/contracts/testsuite/opcodes/update_big_map.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/update_big_map.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
diff --git a/src/contracts/testsuite/opcodes/xor.tz.expected b/src/contracts/testsuite/opcodes/xor.tz.expected
new file mode 100644
index 00000000..aa765d66
--- /dev/null
+++ b/src/contracts/testsuite/opcodes/xor.tz.expected
@@ -0,0 +1,5 @@
+Lexing: OK
+Parsing: OK
+Expansion: OK
+Type checking: OK
+
-- 
GitLab


From b6d740af4eeeea70eda4ce3003642f828afa0f98 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Fri, 13 Mar 2020 17:46:47 +0100
Subject: [PATCH 15/56] [Build|Tests]: add a build-test target for Opam

---
 coq-mi-cho-coq.opam | 1 +
 1 file changed, 1 insertion(+)

diff --git a/coq-mi-cho-coq.opam b/coq-mi-cho-coq.opam
index 93005091..8b14fac4 100644
--- a/coq-mi-cho-coq.opam
+++ b/coq-mi-cho-coq.opam
@@ -27,6 +27,7 @@ depends: [
   "ott" {build & >= "0.29"}
   "zarith"
 ]
+build-test: [ make "test" ]
 
 description: """
 Michelson is a language for writing smart contracts on the Tezos blockchain.
-- 
GitLab


From 75ba1ed53890a60030628492962503997b1eab69 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Fri, 13 Mar 2020 17:48:52 +0100
Subject: [PATCH 16/56] [CI|Tests] Run the tests in the CI

---
 .gitlab-ci.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index aeb80f59..e109d568 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -15,7 +15,7 @@ stages:
     - wget -qO- "https://github.com/koalaman/shellcheck/releases/download/latest/shellcheck-"${scversion}".linux.x86_64.tar.xz" | tar -xJv
     - shellcheck-"${scversion}"/shellcheck `find -name 'configure'`
     - emacs --batch -l scripts/org-lint-README.el --kill
-    - opam pin add -k git -y -j ${NJOBS} coq-mi-cho-coq .
+    - opam pin add -k git -y -j ${NJOBS} coq-mi-cho-coq . --with-test
     - which michocoq
 
 coq:8.8:
-- 
GitLab


From 30ec384ac274c1c620238966474e436fefee0c69 Mon Sep 17 00:00:00 2001
From: Guillaume Claret <dev@clarus.me>
Date: Tue, 10 Mar 2020 22:16:49 +0100
Subject: [PATCH 17/56] [Michocoq] Add parsing of timestamps

---
 .gitlab-ci.yml                                         |  6 ++++--
 coq-mi-cho-coq.opam                                    |  2 ++
 .../testsuite/mini_scenarios/xcat.tz.expected          |  2 +-
 src/contracts/testsuite/opcodes/add.tz.expected        |  2 +-
 src/contracts/testsuite/opcodes/compare.tz.expected    |  2 +-
 src/michocoq/extraction/extraction.v                   |  5 ++++-
 src/michocoq/typer.v                                   | 10 ++++++++++
 7 files changed, 23 insertions(+), 6 deletions(-)

diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index e109d568..f86ecbe9 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -10,12 +10,14 @@ stages:
     - sudo apt-get update -y -q
   script:
     - sudo chown -R coq:coq "$CI_PROJECT_DIR"
-    - DEBIAN_FRONTEND=noninteractive sudo apt-get install -y -q xz-utils wget emacs libgmp-dev
+    - DEBIAN_FRONTEND=noninteractive sudo apt-get install -y -q xz-utils wget emacs
     - export scversion="latest"
     - wget -qO- "https://github.com/koalaman/shellcheck/releases/download/latest/shellcheck-"${scversion}".linux.x86_64.tar.xz" | tar -xJv
     - shellcheck-"${scversion}"/shellcheck `find -name 'configure'`
     - emacs --batch -l scripts/org-lint-README.el --kill
-    - opam pin add -k git -y -j ${NJOBS} coq-mi-cho-coq . --with-test
+    - opam pin add -k git -y --no-action coq-mi-cho-coq .
+    - opam depext -y coq-mi-cho-coq
+    - opam install -y -j ${NJOBS} --with-test coq-mi-cho-coq
     - which michocoq
 
 coq:8.8:
diff --git a/coq-mi-cho-coq.opam b/coq-mi-cho-coq.opam
index 8b14fac4..c59ec254 100644
--- a/coq-mi-cho-coq.opam
+++ b/coq-mi-cho-coq.opam
@@ -18,7 +18,9 @@ install: [
   make "install"
 ]
 depends: [
+  "coq-list-string"
   "coq-menhirlib" {>= "20190626"}
+  "coq-moment" {>= "1.2.0"}
   "coq-ott" {>= "0.29"}
   "coq" {>= "8.8"}
   "menhir"
diff --git a/src/contracts/testsuite/mini_scenarios/xcat.tz.expected b/src/contracts/testsuite/mini_scenarios/xcat.tz.expected
index de2bb5f3..aa765d66 100644
--- a/src/contracts/testsuite/mini_scenarios/xcat.tz.expected
+++ b/src/contracts/testsuite/mini_scenarios/xcat.tz.expected
@@ -1,5 +1,5 @@
 Lexing: OK
 Parsing: OK
 Expansion: OK
-Type checking: Typing error
+Type checking: OK
 
diff --git a/src/contracts/testsuite/opcodes/add.tz.expected b/src/contracts/testsuite/opcodes/add.tz.expected
index de2bb5f3..aa765d66 100644
--- a/src/contracts/testsuite/opcodes/add.tz.expected
+++ b/src/contracts/testsuite/opcodes/add.tz.expected
@@ -1,5 +1,5 @@
 Lexing: OK
 Parsing: OK
 Expansion: OK
-Type checking: Typing error
+Type checking: OK
 
diff --git a/src/contracts/testsuite/opcodes/compare.tz.expected b/src/contracts/testsuite/opcodes/compare.tz.expected
index de2bb5f3..aa765d66 100644
--- a/src/contracts/testsuite/opcodes/compare.tz.expected
+++ b/src/contracts/testsuite/opcodes/compare.tz.expected
@@ -1,5 +1,5 @@
 Lexing: OK
 Parsing: OK
 Expansion: OK
-Type checking: Typing error
+Type checking: OK
 
diff --git a/src/michocoq/extraction/extraction.v b/src/michocoq/extraction/extraction.v
index 7a033074..f37a6e36 100644
--- a/src/michocoq/extraction/extraction.v
+++ b/src/michocoq/extraction/extraction.v
@@ -97,7 +97,10 @@ Extract Inlined Constant sign => "(fun x -> Int64.compare x 0L < 0)".
 Extract Inlined Constant to_Z => "Zarith.of_int64".
 Extract Inlined Constant of_Z => "Zarith.to_int64".
 
-Recursive Extraction Library main.
+(* Avoid a name collision for the module [Char] from the [coq-list-string]
+   library. *)
+Extraction Blacklist Char.
+Separate Extraction main.
 
 (* Require Import Michocoq.main. *)
 (* Recursive Extraction Library main. *)
diff --git a/src/michocoq/typer.v b/src/michocoq/typer.v
index 004798bd..b351426c 100644
--- a/src/michocoq/typer.v
+++ b/src/michocoq/typer.v
@@ -1,4 +1,6 @@
 Require Import ZArith List Nat String.
+Require Import ListString.All.
+Require Import Moment.All.
 Require syntax semantics.
 Require Import syntax_type.
 Require Import untyped_syntax error.
@@ -204,6 +206,14 @@ Qed.
         | key => Return (syntax.Key_constant s)
         | Comparable_type key_hash => Return (syntax.Key_hash_constant s)
         | Comparable_type address => Return (syntax.Address_constant (syntax.Mk_address s))
+        | Comparable_type timestamp =>
+          match Moment.Parse.rfc3339_non_strict (LString.s s) with
+          | Some (moment, nil) =>
+            let z := Moment.to_epoch moment in
+            Return (syntax.Timestamp_constant z)
+          | _ =>
+            Failed _ (Typing _ ("Cannot parse timestamp according to rfc3339"%string, s))
+          end
         | chain_id => Return (syntax.Chain_id_constant (syntax.Mk_chain_id s))
         | _ => Failed _ (Typing _ (d, ty))
         end
-- 
GitLab


From ba48cdfa6acdbc15bd69ef90c11bf81aefebbaa0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Fri, 24 Jan 2020 11:26:23 +0100
Subject: [PATCH 18/56] Remove the return_to_sender contract

This is a duplicate of the boomerang contract.
---
 src/contracts/arthur/return_to_sender.tz |  27 -----
 src/contracts_coq/return_to_sender.v     | 120 -----------------------
 2 files changed, 147 deletions(-)
 delete mode 100644 src/contracts/arthur/return_to_sender.tz
 delete mode 100644 src/contracts_coq/return_to_sender.v

diff --git a/src/contracts/arthur/return_to_sender.tz b/src/contracts/arthur/return_to_sender.tz
deleted file mode 100644
index 5054e90a..00000000
--- a/src/contracts/arthur/return_to_sender.tz
+++ /dev/null
@@ -1,27 +0,0 @@
-# (She wrote upon it)
-
-parameter unit;
-
-storage unit;
-
-code {
-       CDR ;
-       NIL operation ;
-       AMOUNT;
-       PUSH mutez 0;
-       IFCMPEQ
-         # Typical scenario, no operation needed
-         {
-         }
-         # Return funds if sent by mistake
-         {
-           SOURCE ;
-           CONTRACT unit ;
-           ASSERT_SOME ;
-           AMOUNT ;
-           UNIT ;
-           TRANSFER_TOKENS ;
-           CONS ;
-         };
-       PAIR;
-     }
diff --git a/src/contracts_coq/return_to_sender.v b/src/contracts_coq/return_to_sender.v
deleted file mode 100644
index 4b99dbad..00000000
--- a/src/contracts_coq/return_to_sender.v
+++ /dev/null
@@ -1,120 +0,0 @@
-(* Open Source License *)
-(* Copyright (c) 2019 Nomadic Labs. <contact@nomadic-labs.com> *)
-
-(* Permission is hereby granted, free of charge, to any person obtaining a *)
-(* copy of this software and associated documentation files (the "Software"), *)
-(* to deal in the Software without restriction, including without limitation *)
-(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
-(* and/or sell copies of the Software, and to permit persons to whom the *)
-(* Software is furnished to do so, subject to the following conditions: *)
-
-(* The above copyright notice and this permission notice shall be included *)
-(* in all copies or substantial portions of the Software. *)
-
-(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR *)
-(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
-(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
-(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *)
-(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
-(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
-(* DEALINGS IN THE SOFTWARE. *)
-
-Require Import Michocoq.macros.
-Import syntax.
-Import comparable.
-Require Import ZArith.
-Require Import semantics.
-Require Import util.
-Import error.
-Require List.
-
-Definition parameter_ty := unit.
-Definition storage_ty := unit.
-
-Module return_to_sender(C:ContractContext).
-
-Module semantics := Semantics C. Import semantics.
-
-Definition return_to_sender : full_contract _ parameter_ty None storage_ty :=
-  (
-    CDR ;;
-    NIL operation ;;
-       AMOUNT;;
-       PUSH mutez (0 ~mutez);;
-       IFCMPEQ NOOP
-         (
-           SOURCE ;;
-           CONTRACT None unit ;;
-           ASSERT_SOME ;;
-           AMOUNT ;;
-           UNIT ;;
-           TRANSFER_TOKENS ;;
-           CONS
-         );;
-       PAIR
-  ).
-
-Lemma eqb_eq a c1 c2 :
-  BinInt.Z.eqb (comparison_to_int (compare a c1 c2)) Z0 = true <->
-  c1 = c2.
-Proof.
-  rewrite BinInt.Z.eqb_eq.
-  rewrite comparison_to_int_Eq.
-  apply comparable.compare_eq_iff.
-Qed.
-
-Lemma eqb_neq a c1 c2 :
-  BinInt.Z.eqb (comparison_to_int (compare a c1 c2)) Z0 = false <->
-  c1 <> c2.
-Proof.
-  split.
-  - intros Hf He.
-    rewrite <- eqb_eq in He.
-    congruence.
-  - intro Hneq.
-    rewrite <- eqb_eq in Hneq.
-    destruct ((comparison_to_int (compare a c1 c2) =? 0)%Z); congruence.
-Qed.
-
-Lemma return_to_sender_correct :
-  forall env (ops : data (list operation)) (fuel : Datatypes.nat),
-  fuel >= 42 ->
-  eval env return_to_sender fuel ((tt, tt), tt) = Return ((ops, tt), tt)
-  <->
-  (amount env = (0 ~Mutez) /\ ops = nil) \/
-  (amount env <> (0 ~Mutez) /\
-    exists ctr, contract_ env None unit (source env) = Some ctr /\
-           ops = ((transfer_tokens env unit tt (amount env) ctr) :: nil)%list).
-Proof.
-  intros env ops fuel Hfuel.
-  rewrite return_precond.
-  unfold eval.
-  rewrite eval_precond_correct.
-  unfold ">=" in Hfuel.
-  repeat (more_fuel ; simpl).
-  rewrite destruct_if.
-  apply or_both; apply and_both_0.
-  - rewrite (eqb_eq mutez).
-    intuition.
-  - intuition congruence.
-  - rewrite bool_not_false.
-    rewrite (eqb_eq mutez).
-    intuition.
-  - pose (c := contract_ env None unit (source env)).
-    pose (transfer := transfer_tokens env unit tt (amount env)).
-    change (match c with Some b => ((transfer b :: nil)%list, tt, tt) = (ops, tt, tt) | None => False end <-> (exists ctr, c = Some ctr /\ ops = (transfer ctr :: nil)%list)).
-    destruct c.
-    + split.
-      * intro H.
-        exists d.
-        intuition congruence.
-      * intros (c, (Hc, Hops)).
-        injection Hc; clear Hc.
-        intro; subst.
-        reflexivity.
-    + split; [contradiction|].
-      intros (c, (Habs, _)).
-      discriminate.
-Qed.
-
-End return_to_sender.
-- 
GitLab


From ab60300dc56f7f317c5858724a6403c9c037f108 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Thu, 7 May 2020 23:15:25 +0200
Subject: [PATCH 19/56] Remove syntax_equiv.v

This is incomplete and broken.
---
 src/michocoq/of_ocaml/syntax_equiv.v | 249 ---------------------------
 1 file changed, 249 deletions(-)
 delete mode 100644 src/michocoq/of_ocaml/syntax_equiv.v

diff --git a/src/michocoq/of_ocaml/syntax_equiv.v b/src/michocoq/of_ocaml/syntax_equiv.v
deleted file mode 100644
index 8f5abb9d..00000000
--- a/src/michocoq/of_ocaml/syntax_equiv.v
+++ /dev/null
@@ -1,249 +0,0 @@
-(** Comparison of the OCaml and MiChoCoq syntax. *)
-Require of_ocaml.script_typed_ir_ml.
-Require of_ocaml.syntax_type_equiv.
-Require syntax.
-Require syntax_type.
-
-Import of_ocaml.syntax_type_equiv.Option.
-Import syntax syntax_type of_ocaml.script_typed_ir_ml.
-
-Parameter default_location
-  : Tezos_raw_protocol_alpha.Alpha_context.Script.location.
-
-Definition comparable_coq_to_ocaml
-  (comparable : syntax_type.comparable_type)
-  : script_typed_ir_ml.comparable_ty
-    (syntax_type_equiv.typ.coq_to_ocaml_typ
-      (comparable_type_to_type comparable)
-    ).
-  rewrite <- syntax_type_equiv.typ.coq_comparable_to_ocaml_typ_eq.
-  apply syntax_type_equiv.comparable.coq_to_ocaml.
-Defined.
-
-(** We define a partial injection from the MiChoCoq syntax to the OCaml AST. *)
-Definition to_coq_concrete_data
-  {type : syntax_type.type}
-  (concrete_data : syntax.concrete_data type)
-  : Datatypes.option (of_ocaml.syntax_type_equiv.typ.coq_to_ocaml_typ type) :=
-  match concrete_data with
-  | Int_constant _ =>
-    Some (
-      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num_make
-        Tezos_raw_protocol_alpha.Alpha_context.Script_int.z_sample
-    )
-  | Nat_constant _ =>
-    Some (
-      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num_make
-        Tezos_raw_protocol_alpha.Alpha_context.Script_int.n_sample
-    )
-  | _ => None
-  end.
-
-Fixpoint of_coq
-  {self_type : syntax.self_info}
-  {tail_fail_flag : Datatypes.bool}
-  {A B : Datatypes.list syntax_type.type}
-  (instruction : syntax.instruction self_type tail_fail_flag A B)
-  : Datatypes.option (
-    of_ocaml.script_typed_ir_ml.instr
-      (of_ocaml.syntax_type_equiv.typ.coq_to_ocaml_typs A)
-      (of_ocaml.syntax_type_equiv.typ.coq_to_ocaml_typs B)
-    ) :=
-  match instruction with
-  | NOOP => Some Nop
-  | @FAILWITH _ _ _ a =>
-    let? ty_a := of_ocaml.syntax_type_equiv.typ.coq_to_ocaml a in
-    Some (Failwith ty_a)
-  | @SEQ _ A B C _ instruction_a instruction_b =>
-    let? bef := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls A in
-    let? trans := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls B in
-    let? aft := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls C in
-    let? instruction_a' := of_coq instruction_a in
-    let? instruction_b' := of_coq instruction_b in
-    Some (Seq
-      {|
-        loc := default_location;
-        bef := bef;
-        aft := trans;
-        instr_ := instruction_a';
-      |}
-      {|
-        loc := default_location;
-        bef := trans;
-        aft := aft;
-        instr_ := instruction_b';
-      |}
-    )
-  | @IF_ _ A B _ _ instruction_a instruction_b =>
-    let? bef := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls A in
-    let? aft := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls B in
-    let? instruction_a' := of_coq instruction_a in
-    let? instruction_b' := of_coq instruction_b in
-    Some (If
-      {|
-        loc := default_location;
-        bef := bef;
-        aft := aft;
-        instr_ := instruction_a';
-      |}
-      {|
-        loc := default_location;
-        bef := bef;
-        aft := aft;
-        instr_ := instruction_a';
-      |}
-    )
-  | @LOOP _ A instruction =>
-    let? rest := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls A in
-    let? instruction' := of_coq instruction in
-    Some (Loop
-      {|
-        loc := default_location;
-        bef := rest;
-        aft := Item_t (Bool_t None) rest None;
-        instr_ := instruction';
-      |}
-    )
-  | @LOOP_LEFT _ a b an bn A instruction =>
-    let? bef := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls (a :: A) in
-    let? aft := of_ocaml.syntax_type_equiv.typ.coq_to_ocamls (or a an b bn :: A) in
-    let? instruction' := of_coq instruction in
-    Some (Loop_left
-      {|
-        loc := default_location;
-        bef := bef;
-        aft := aft;
-        instr_ := instruction';
-      |}
-    )
-  | EXEC => None
-  | APPLY => None
-  | DUP => Some Dup
-  | SWAP => Some Swap
-  | PUSH _ x =>
-    let? x' := to_coq_concrete_data x in
-    Some (Const x')
-  (** FIXME: the `UNIT` instruction is not in the OCaml AST. It should be
-      added rather than removed during type-checking.
-  *)
-  | UNIT => None
-  | LAMBDA _ _ _ => None
-  | EQ => Some Eq
-  | NEQ => Some Neq
-  | LT => Some Lt
-  | GT => Some Gt
-  | LE => Some Le
-  | GE => Some Ge
-  | @OR _ _ s _ =>
-    let 'syntax.Mk_bitwise _ variant := s in
-    match variant with
-    | syntax.Bitwise_variant_bool => Some Or
-    | syntax.Bitwise_variant_nat => Some Or_nat
-    end
-  | @AND _ _ s _ =>
-    let 'syntax.Mk_bitwise _ variant := s in
-    match variant with
-    | syntax.Bitwise_variant_bool => Some And
-    | syntax.Bitwise_variant_nat => Some And_nat
-    end
-  | @XOR _ _ s _ =>
-    let 'syntax.Mk_bitwise _ variant := s in
-    match variant with
-    | syntax.Bitwise_variant_bool => Some Xor
-    | syntax.Bitwise_variant_nat => Some Xor_nat
-    end
-  | @NOT _ _ s _ =>
-    let 'syntax.Mk_not _ _ variant := s in
-    match variant with
-    | syntax.Not_variant_bool => Some Not
-    | syntax.Not_variant_nat => Some Not_nat
-    | syntax.Not_variant_int => Some Not_int
-    end
-  | @NEG _ _ s _ =>
-    let 'syntax.Mk_neg _ variant := s in
-    match variant with
-    | syntax.Neg_variant_nat => Some Neg_nat
-    | syntax.Neg_variant_int => Some Neg_int
-    end
-  | ABS => Some Abs_int
-  | ISNAT => Some Is_nat
-  | INT => Some Int_nat
-  | @ADD _ _ _ s _ =>
-    let 'syntax.Mk_add _ _ _ variant := s in
-    match variant with
-    | syntax.Add_variant_nat_nat => Some Add_natnat
-    | syntax.Add_variant_nat_int => Some Add_natint
-    | syntax.Add_variant_int_nat => Some Add_intnat
-    | syntax.Add_variant_int_int => Some Add_intint
-    | syntax.Add_variant_timestamp_int => Some Add_timestamp_to_seconds
-    | syntax.Add_variant_int_timestamp => Some Add_seconds_to_timestamp
-    | syntax.Add_variant_tez_tez => Some Add_tez
-    end
-  | @SUB _ _ _ s _ =>
-    let 'syntax.Mk_sub _ _ _ variant := s in
-    match variant with
-    | syntax.Sub_variant_nat_nat => Some Sub_int
-    | syntax.Sub_variant_nat_int => Some Sub_int
-    | syntax.Sub_variant_int_nat => Some Sub_int
-    | syntax.Sub_variant_int_int => Some Sub_int
-    | syntax.Sub_variant_timestamp_int => Some Sub_timestamp_seconds
-    | syntax.Sub_variant_timestamp_timestamp => Some Diff_timestamps
-    | syntax.Sub_variant_tez_tez => Some Sub_tez
-    end
-  | @MUL _ _ _ s _ =>
-    let 'syntax.Mk_mul _ _ _ variant := s in
-    match variant with
-    | syntax.Mul_variant_nat_nat => Some Mul_natnat
-    | syntax.Mul_variant_nat_int => Some Mul_natint
-    | syntax.Mul_variant_int_nat => Some Mul_intnat
-    | syntax.Mul_variant_int_int => Some Mul_intint
-    | syntax.Mul_variant_tez_nat => Some Mul_teznat
-    | syntax.Mul_variant_nat_tez => Some Mul_nattez
-    end
-  | @EDIV _ _ _ s _ =>
-    let 'syntax.Mk_ediv _ _ _ _ variant := s in
-    match variant with
-    | syntax.Ediv_variant_nat_nat => Some Ediv_natnat
-    | syntax.Ediv_variant_nat_int => Some Ediv_natint
-    | syntax.Ediv_variant_int_nat => Some Ediv_intnat
-    | syntax.Ediv_variant_int_int => Some Ediv_intint
-    | syntax.Ediv_variant_tez_nat => Some Ediv_teznat
-    | syntax.Ediv_variant_tez_tez => Some Ediv_tez
-    end
-  | LSL => Some Lsl_nat
-  | LSR => Some Lsr_nat
-  | @COMPARE _ a _ => Some (Compare (comparable_coq_to_ocaml a))
-  | @CONCAT _ _ i _ =>
-    let 'syntax.Mk_stringlike _ variant := i in
-    match variant with
-    | syntax.Stringlike_variant_string => Some Concat_string_pair
-    | syntax.Stringlike_variant_bytes => Some Concat_bytes_pair
-    end
-  | @CONCAT_list _ _ i _ =>
-    let 'syntax.Mk_stringlike _ variant := i in
-    match variant with
-    | syntax.Stringlike_variant_string => Some Concat_string
-    | syntax.Stringlike_variant_bytes => Some Concat_bytes
-    end
-  | @SIZE _ _ i _ =>
-    let 'syntax.Mk_size _ variant := i in
-    match variant with
-    | syntax.Size_variant_set _ => Some Set_size
-    | syntax.Size_variant_map _ _ => Some Map_size
-    | syntax.Size_variant_list _ => Some List_size
-    | syntax.Size_variant_string => Some String_size
-    | syntax.Size_variant_bytes => Some Bytes_size
-    end
-  | @SLICE _ _ i _ =>
-    let 'syntax.Mk_stringlike _ variant := i in
-    match variant with
-    | syntax.Stringlike_variant_string => Some Slice_string
-    | syntax.Stringlike_variant_bytes => Some Slice_bytes
-    end
-  | PAIR => Some Cons_pair
-  | CAR => Some Car
-  | CDR => Some Cdr
-  | EMPTY_SET elt =>
-    Some (Empty_set (syntax_type_equiv.comparable.coq_to_ocaml elt))
-  | _ => None
-  end.
-- 
GitLab


From 95b18b854255ff48ed9526b439a08bed1e902195 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Tue, 17 Mar 2020 18:40:39 +0100
Subject: [PATCH 20/56] [michocoq] Stratify opcodes and instructions.

We call opcodes the instructions that do not take subprograms as
argument nor have special treatment in the type-checker or
evaluator. Most of the instructions in Michelson fall into this
category, putting them aside makes the number of constructors of the
instruction ASTs much smaller which is needed when reasoning on the
syntax.

In particular, many optimisations at the Michelson level require to
reason about several terms in these ASTs by nesting destructs which
was not tractable with more than 80 constructors.
---
 src/michocoq/micheline2michelson.v | 134 +++----
 src/michocoq/michelson2micheline.v |  66 ++--
 src/michocoq/semantics.v           | 473 +++++++++++--------------
 src/michocoq/syntax.v              | 187 +++++-----
 src/michocoq/typer.v               | 544 +++++++++++++++--------------
 src/michocoq/untyped_syntax.v      | 136 ++++----
 src/michocoq/untyper.v             | 270 +++++++-------
 7 files changed, 894 insertions(+), 916 deletions(-)

diff --git a/src/michocoq/micheline2michelson.v b/src/michocoq/micheline2michelson.v
index 77e9556f..4eb1cb84 100644
--- a/src/michocoq/micheline2michelson.v
+++ b/src/michocoq/micheline2michelson.v
@@ -162,8 +162,8 @@ Fixpoint DIPn n code :=
 
 Fixpoint DUP_Sn n :=
   match n with
-  | 0 => DUP
-  | S n => DIP 1 (DUP_Sn n) ;; SWAP
+  | 0 => instruction_opcode DUP
+  | S n => DIP 1 (DUP_Sn n) ;; instruction_opcode SWAP
   end.
 
 Definition IF_SOME bt bf := IF_NONE bf bt.
@@ -381,81 +381,81 @@ Fixpoint micheline2michelson_instruction (m : loc_micheline) : M instruction :=
        end) l
   | Mk_loc_micheline (_, PRIM (_, "FAILWITH") nil) => Return FAILWITH
   | Mk_loc_micheline (_, PRIM (_, "EXEC") nil) => Return EXEC
-  | Mk_loc_micheline (_, PRIM (_, "APPLY") nil) => Return APPLY
-  | Mk_loc_micheline (_, PRIM (_, "DROP") nil) => Return (DROP 1)
+  | Mk_loc_micheline (_, PRIM (_, "APPLY") nil) => Return (instruction_opcode APPLY)
+  | Mk_loc_micheline (_, PRIM (_, "DROP") nil) => Return (instruction_opcode (DROP 1))
   | Mk_loc_micheline (_, PRIM (_, "DROP")
                               (Mk_loc_micheline (_, NUMBER n) :: nil)) =>
-    Return (DROP (BinInt.Z.to_nat n))
-  | Mk_loc_micheline (_, PRIM (_, "DUP") nil) => Return DUP
-  | Mk_loc_micheline (_, PRIM (_, "SWAP") nil) => Return SWAP
-  | Mk_loc_micheline (_, PRIM (_, "UNIT") nil) => Return UNIT
-  | Mk_loc_micheline (_, PRIM (_, "EQ") nil) => Return EQ
-  | Mk_loc_micheline (_, PRIM (_, "NEQ") nil) => Return NEQ
-  | Mk_loc_micheline (_, PRIM (_, "LT") nil) => Return LT
-  | Mk_loc_micheline (_, PRIM (_, "GT") nil) => Return GT
-  | Mk_loc_micheline (_, PRIM (_, "LE") nil) => Return LE
-  | Mk_loc_micheline (_, PRIM (_, "GE") nil) => Return GE
-  | Mk_loc_micheline (_, PRIM (_, "OR") nil) => Return OR
-  | Mk_loc_micheline (_, PRIM (_, "AND") nil) => Return AND
-  | Mk_loc_micheline (_, PRIM (_, "XOR") nil) => Return XOR
-  | Mk_loc_micheline (_, PRIM (_, "NOT") nil) => Return NOT
-  | Mk_loc_micheline (_, PRIM (_, "NEG") nil) => Return NEG
-  | Mk_loc_micheline (_, PRIM (_, "ABS") nil) => Return ABS
-  | Mk_loc_micheline (_, PRIM (_, "ISNAT") nil) => Return ISNAT
-  | Mk_loc_micheline (_, PRIM (_, "INT") nil) => Return INT
-  | Mk_loc_micheline (_, PRIM (_, "ADD") nil) => Return ADD
-  | Mk_loc_micheline (_, PRIM (_, "SUB") nil) => Return SUB
-  | Mk_loc_micheline (_, PRIM (_, "MUL") nil) => Return MUL
-  | Mk_loc_micheline (_, PRIM (_, "EDIV") nil) => Return EDIV
-  | Mk_loc_micheline (_, PRIM (_, "LSL") nil) => Return LSL
-  | Mk_loc_micheline (_, PRIM (_, "LSR") nil) => Return LSR
-  | Mk_loc_micheline (_, PRIM (_, "COMPARE") nil) => Return COMPARE
-  | Mk_loc_micheline (_, PRIM (_, "CONCAT") nil) => Return CONCAT
-  | Mk_loc_micheline (_, PRIM (_, "SIZE") nil) => Return SIZE
-  | Mk_loc_micheline (_, PRIM (_, "SLICE") nil) => Return SLICE
-  | Mk_loc_micheline (_, PRIM (_, "PAIR") nil) => Return PAIR
-  | Mk_loc_micheline (_, PRIM (_, "CAR") nil) => Return CAR
-  | Mk_loc_micheline (_, PRIM (_, "CDR") nil) => Return CDR
-  | Mk_loc_micheline (_, PRIM (_, "GET") nil) => Return GET
-  | Mk_loc_micheline (_, PRIM (_, "SOME") nil) => Return SOME
+    Return (instruction_opcode (DROP (BinInt.Z.to_nat n)))
+  | Mk_loc_micheline (_, PRIM (_, "DUP") nil) => Return (instruction_opcode DUP)
+  | Mk_loc_micheline (_, PRIM (_, "SWAP") nil) => Return (instruction_opcode SWAP)
+  | Mk_loc_micheline (_, PRIM (_, "UNIT") nil) => Return (instruction_opcode UNIT)
+  | Mk_loc_micheline (_, PRIM (_, "EQ") nil) => Return (instruction_opcode EQ)
+  | Mk_loc_micheline (_, PRIM (_, "NEQ") nil) => Return (instruction_opcode NEQ)
+  | Mk_loc_micheline (_, PRIM (_, "LT") nil) => Return (instruction_opcode LT)
+  | Mk_loc_micheline (_, PRIM (_, "GT") nil) => Return (instruction_opcode GT)
+  | Mk_loc_micheline (_, PRIM (_, "LE") nil) => Return (instruction_opcode LE)
+  | Mk_loc_micheline (_, PRIM (_, "GE") nil) => Return (instruction_opcode GE)
+  | Mk_loc_micheline (_, PRIM (_, "OR") nil) => Return (instruction_opcode OR)
+  | Mk_loc_micheline (_, PRIM (_, "AND") nil) => Return (instruction_opcode AND)
+  | Mk_loc_micheline (_, PRIM (_, "XOR") nil) => Return (instruction_opcode XOR)
+  | Mk_loc_micheline (_, PRIM (_, "NOT") nil) => Return (instruction_opcode NOT)
+  | Mk_loc_micheline (_, PRIM (_, "NEG") nil) => Return (instruction_opcode NEG)
+  | Mk_loc_micheline (_, PRIM (_, "ABS") nil) => Return (instruction_opcode ABS)
+  | Mk_loc_micheline (_, PRIM (_, "ISNAT") nil) => Return (instruction_opcode ISNAT)
+  | Mk_loc_micheline (_, PRIM (_, "INT") nil) => Return (instruction_opcode INT)
+  | Mk_loc_micheline (_, PRIM (_, "ADD") nil) => Return (instruction_opcode ADD)
+  | Mk_loc_micheline (_, PRIM (_, "SUB") nil) => Return (instruction_opcode SUB)
+  | Mk_loc_micheline (_, PRIM (_, "MUL") nil) => Return (instruction_opcode MUL)
+  | Mk_loc_micheline (_, PRIM (_, "EDIV") nil) => Return (instruction_opcode EDIV)
+  | Mk_loc_micheline (_, PRIM (_, "LSL") nil) => Return (instruction_opcode LSL)
+  | Mk_loc_micheline (_, PRIM (_, "LSR") nil) => Return (instruction_opcode LSR)
+  | Mk_loc_micheline (_, PRIM (_, "COMPARE") nil) => Return (instruction_opcode COMPARE)
+  | Mk_loc_micheline (_, PRIM (_, "CONCAT") nil) => Return (instruction_opcode CONCAT)
+  | Mk_loc_micheline (_, PRIM (_, "SIZE") nil) => Return (instruction_opcode SIZE)
+  | Mk_loc_micheline (_, PRIM (_, "SLICE") nil) => Return (instruction_opcode SLICE)
+  | Mk_loc_micheline (_, PRIM (_, "PAIR") nil) => Return (instruction_opcode PAIR)
+  | Mk_loc_micheline (_, PRIM (_, "CAR") nil) => Return (instruction_opcode CAR)
+  | Mk_loc_micheline (_, PRIM (_, "CDR") nil) => Return (instruction_opcode CDR)
+  | Mk_loc_micheline (_, PRIM (_, "GET") nil) => Return (instruction_opcode GET)
+  | Mk_loc_micheline (_, PRIM (_, "SOME") nil) => Return (instruction_opcode SOME)
   | Mk_loc_micheline (_, PRIM (_, "NONE") (ty :: nil)) =>
     let! ty := micheline2michelson_type ty in
-    Return (NONE ty)
+    Return (instruction_opcode (NONE ty))
   | Mk_loc_micheline (_, PRIM (_, "LEFT") (ty :: nil)) =>
     let! ty := micheline2michelson_type ty in
-    Return (LEFT ty)
+    Return (instruction_opcode (LEFT ty))
   | Mk_loc_micheline (_, PRIM (_, "RIGHT") (ty :: nil)) =>
     let! ty := micheline2michelson_type ty in
-    Return (RIGHT ty)
-  | Mk_loc_micheline (_, PRIM (_, "CONS") nil) => Return CONS
+    Return (instruction_opcode (RIGHT ty))
+  | Mk_loc_micheline (_, PRIM (_, "CONS") nil) => Return (instruction_opcode CONS)
   | Mk_loc_micheline (_, PRIM (_, "NIL") (ty :: nil)) =>
     let! ty := micheline2michelson_type ty in
-    Return (NIL ty)
-  | Mk_loc_micheline (_, PRIM (_, "TRANSFER_TOKENS") nil) => Return TRANSFER_TOKENS
-  | Mk_loc_micheline (_, PRIM (_, "SET_DELEGATE") nil) => Return SET_DELEGATE
-  | Mk_loc_micheline (_, PRIM (_, "BALANCE") nil) => Return BALANCE
-  | Mk_loc_micheline (_, PRIM (_, "ADDRESS") nil) => Return ADDRESS
+    Return (instruction_opcode (NIL ty))
+  | Mk_loc_micheline (_, PRIM (_, "TRANSFER_TOKENS") nil) => Return (instruction_opcode TRANSFER_TOKENS)
+  | Mk_loc_micheline (_, PRIM (_, "SET_DELEGATE") nil) => Return (instruction_opcode SET_DELEGATE)
+  | Mk_loc_micheline (_, PRIM (_, "BALANCE") nil) => Return (instruction_opcode BALANCE)
+  | Mk_loc_micheline (_, PRIM (_, "ADDRESS") nil) => Return (instruction_opcode ADDRESS)
   | Mk_loc_micheline (_, PRIM (_, "CONTRACT") (ty :: nil)) =>
     let! ty := micheline2michelson_type ty in
-    Return (CONTRACT None ty)
-  | Mk_loc_micheline (_, PRIM (_, "SOURCE") nil) => Return SOURCE
-  | Mk_loc_micheline (_, PRIM (_, "SENDER") nil) => Return SENDER
+    Return (instruction_opcode (CONTRACT None ty))
+  | Mk_loc_micheline (_, PRIM (_, "SOURCE") nil) => Return (instruction_opcode SOURCE)
+  | Mk_loc_micheline (_, PRIM (_, "SENDER") nil) => Return (instruction_opcode SENDER)
   | Mk_loc_micheline (_, PRIM (_, "SELF") nil) => Return (SELF None)
-  | Mk_loc_micheline (_, PRIM (_, "AMOUNT") nil) => Return AMOUNT
-  | Mk_loc_micheline (_, PRIM (_, "IMPLICIT_ACCOUNT") nil) => Return IMPLICIT_ACCOUNT
-  | Mk_loc_micheline (_, PRIM (_, "NOW") nil) => Return NOW
-  | Mk_loc_micheline (_, PRIM (_, "PACK") nil) => Return PACK
+  | Mk_loc_micheline (_, PRIM (_, "AMOUNT") nil) => Return (instruction_opcode AMOUNT)
+  | Mk_loc_micheline (_, PRIM (_, "IMPLICIT_ACCOUNT") nil) => Return (instruction_opcode IMPLICIT_ACCOUNT)
+  | Mk_loc_micheline (_, PRIM (_, "NOW") nil) => Return (instruction_opcode NOW)
+  | Mk_loc_micheline (_, PRIM (_, "PACK") nil) => Return (instruction_opcode PACK)
   | Mk_loc_micheline (_, PRIM (_, "UNPACK") (ty :: nil)) =>
     let! ty := micheline2michelson_type ty in
-    Return (UNPACK ty)
-  | Mk_loc_micheline (_, PRIM (_, "HASH_KEY") nil) => Return HASH_KEY
-  | Mk_loc_micheline (_, PRIM (_, "BLAKE2B") nil) => Return BLAKE2B
-  | Mk_loc_micheline (_, PRIM (_, "SHA256") nil) => Return SHA256
-  | Mk_loc_micheline (_, PRIM (_, "SHA512") nil) => Return SHA512
-  | Mk_loc_micheline (_, PRIM (_, "CHECK_SIGNATURE") nil) => Return CHECK_SIGNATURE
-  | Mk_loc_micheline (_, PRIM (_, "MEM") nil) => Return MEM
-  | Mk_loc_micheline (_, PRIM (_, "UPDATE") nil) => Return UPDATE
-  | Mk_loc_micheline (_, PRIM (_, "CHAIN_ID") nil) => Return CHAIN_ID
+    Return (instruction_opcode (UNPACK ty))
+  | Mk_loc_micheline (_, PRIM (_, "HASH_KEY") nil) => Return (instruction_opcode HASH_KEY)
+  | Mk_loc_micheline (_, PRIM (_, "BLAKE2B") nil) => Return (instruction_opcode BLAKE2B)
+  | Mk_loc_micheline (_, PRIM (_, "SHA256") nil) => Return (instruction_opcode SHA256)
+  | Mk_loc_micheline (_, PRIM (_, "SHA512") nil) => Return (instruction_opcode SHA512)
+  | Mk_loc_micheline (_, PRIM (_, "CHECK_SIGNATURE") nil) => Return (instruction_opcode CHECK_SIGNATURE)
+  | Mk_loc_micheline (_, PRIM (_, "MEM") nil) => Return (instruction_opcode MEM)
+  | Mk_loc_micheline (_, PRIM (_, "UPDATE") nil) => Return (instruction_opcode UPDATE)
+  | Mk_loc_micheline (_, PRIM (_, "CHAIN_ID") nil) => Return (instruction_opcode CHAIN_ID)
   | Mk_loc_micheline (_, PRIM (_, "LOOP") (i :: nil)) =>
     let! i := micheline2michelson_instruction i in
     Return (LOOP i)
@@ -469,9 +469,9 @@ Fixpoint micheline2michelson_instruction (m : loc_micheline) : M instruction :=
     let! i := micheline2michelson_instruction i in
     Return (DIP (BinInt.Z.to_nat n) i)
   | Mk_loc_micheline (_, PRIM (_, "DIG") (Mk_loc_micheline (_, NUMBER n) :: nil)) =>
-    Return (DIG (BinInt.Z.to_nat n))
+    Return (instruction_opcode (DIG (BinInt.Z.to_nat n)))
   | Mk_loc_micheline (_, PRIM (_, "DUG") (Mk_loc_micheline (_, NUMBER n) :: nil)) =>
-    Return (DUG (BinInt.Z.to_nat n))
+    Return (instruction_opcode (DUG (BinInt.Z.to_nat n)))
   | Mk_loc_micheline (_, PRIM (_, "ITER") (i :: nil)) =>
     let! i := micheline2michelson_instruction i in
     Return (ITER i)
@@ -504,15 +504,15 @@ Fixpoint micheline2michelson_instruction (m : loc_micheline) : M instruction :=
     Return (CREATE_CONTRACT sty pty None i)
   | Mk_loc_micheline (_, PRIM (_, "EMPTY_SET") (cty :: nil)) =>
     let! cty := micheline2michelson_ctype cty in
-    Return (EMPTY_SET cty)
+    Return (instruction_opcode (EMPTY_SET cty))
   | Mk_loc_micheline (_, PRIM (_, "EMPTY_MAP") (kty :: vty :: nil)) =>
     let! kty := micheline2michelson_ctype kty in
     let! vty := micheline2michelson_type vty in
-    Return (EMPTY_MAP kty vty)
+    Return (instruction_opcode (EMPTY_MAP kty vty))
   | Mk_loc_micheline (_, PRIM (_, "EMPTY_BIG_MAP") (kty :: vty :: nil)) =>
     let! kty := micheline2michelson_ctype kty in
     let! vty := micheline2michelson_type vty in
-    Return (EMPTY_BIG_MAP kty vty)
+    Return (instruction_opcode (EMPTY_BIG_MAP kty vty))
   | Mk_loc_micheline (_, PRIM (_, "IF") (i1 :: i2 :: nil)) =>
     let! i1 := micheline2michelson_instruction i1 in
     let! i2 := micheline2michelson_instruction i2 in
diff --git a/src/michocoq/michelson2micheline.v b/src/michocoq/michelson2micheline.v
index 812e4f0c..3c407c20 100644
--- a/src/michocoq/michelson2micheline.v
+++ b/src/michocoq/michelson2micheline.v
@@ -90,25 +90,8 @@ Fixpoint michelson2micheline_data (d : concrete_data) : loc_micheline :=
   | Instruction _ => dummy_prim "NOOP" [] (* Should never occur *)
   end.
 
-Fixpoint michelson2micheline_ins (i : instruction) : loc_micheline :=
-  match i with
-  | NOOP => dummy_mich (SEQ [])
-  | untyped_syntax.SEQ i1 i2 =>
-    let m1 := michelson2micheline_ins i1 in
-    let m2 := michelson2micheline_ins i2 in
-    let ls1 :=
-        match m1 with
-        | Mk_loc_micheline (_, _, (SEQ ls1)) => ls1
-        | _ => [m1]%list
-        end in
-    let ls2 :=
-        match m2 with
-        | Mk_loc_micheline (_, _, (SEQ ls2)) => ls2
-        | _ => [m2]%list
-        end in
-    dummy_mich (SEQ (List.app ls1 ls2))
-  | FAILWITH => dummy_prim "FAILWITH" []
-  | EXEC => dummy_prim "EXEC" []
+Definition michelson2micheline_opcode (o : opcode) : loc_micheline :=
+  match o with
   | APPLY => dummy_prim "APPLY" []
   | DUP => dummy_prim "DUP" []
   | SWAP => dummy_prim "SWAP" []
@@ -156,11 +139,6 @@ Fixpoint michelson2micheline_ins (i : instruction) : loc_micheline :=
                                         michelson2micheline_type t]
   | MEM => dummy_prim "MEM" []
   | UPDATE => dummy_prim "UPDATE" []
-  | CREATE_CONTRACT t1 t2 an i => dummy_prim "CREATE_CONTRACT"
-                                          [michelson2micheline_type t1;
-                                             michelson2micheline_atype
-                                               michelson2micheline_type t2 an;
-                                             michelson2micheline_ins i]
   | TRANSFER_TOKENS => dummy_prim "TRANSFER_TOKENS" []
   | SET_DELEGATE => dummy_prim "SET_DELEGATE" []
   | BALANCE => dummy_prim "BALANCE" []
@@ -170,8 +148,6 @@ Fixpoint michelson2micheline_ins (i : instruction) : loc_micheline :=
     dummy_prim "CONTRACT" [dummy_prim an []; michelson2micheline_type t]
   | SOURCE => dummy_prim "SOURCE" []
   | SENDER => dummy_prim "SENDER" []
-  | SELF None => dummy_prim "SELF" []
-  | SELF (Some an) => dummy_prim "SELF" [dummy_prim an []]
   | AMOUNT => dummy_prim "AMOUNT" []
   | IMPLICIT_ACCOUNT => dummy_prim "IMPLICIT_ACCOUNT" []
   | NOW => dummy_prim "NOW" []
@@ -182,6 +158,35 @@ Fixpoint michelson2micheline_ins (i : instruction) : loc_micheline :=
   | SHA256 => dummy_prim "SHA256" []
   | SHA512 => dummy_prim "SHA512" []
   | CHECK_SIGNATURE => dummy_prim "CHECK_SIGNATURE" []
+  | DIG n => dummy_prim "DIG" [dummy_mich (NUMBER (BinInt.Z.of_nat n))]
+  | DUG n => dummy_prim "DUG" [dummy_mich (NUMBER (BinInt.Z.of_nat n))]
+  | DROP n => dummy_prim "DROP" [dummy_mich (NUMBER (BinInt.Z.of_nat n))]
+  | CHAIN_ID => dummy_prim "CHAIN_ID" []
+  end.
+
+Fixpoint michelson2micheline_ins (i : instruction) : loc_micheline :=
+  match i with
+  | NOOP => dummy_mich (SEQ [])
+  | untyped_syntax.SEQ i1 i2 =>
+    let m1 := michelson2micheline_ins i1 in
+    let m2 := michelson2micheline_ins i2 in
+    let ls1 :=
+        match m1 with
+        | Mk_loc_micheline (_, _, (SEQ ls1)) => ls1
+        | _ => [m1]%list
+        end in
+    let ls2 :=
+        match m2 with
+        | Mk_loc_micheline (_, _, (SEQ ls2)) => ls2
+        | _ => [m2]%list
+        end in
+    dummy_mich (SEQ (List.app ls1 ls2))
+  | FAILWITH => dummy_prim "FAILWITH" []
+  | CREATE_CONTRACT t1 t2 an i => dummy_prim "CREATE_CONTRACT"
+                                          [michelson2micheline_type t1;
+                                             michelson2micheline_atype
+                                               michelson2micheline_type t2 an;
+                                             michelson2micheline_ins i]
   | IF_ i1 i2 =>
     dummy_prim "IF" [dummy_seq (michelson2micheline_ins i1);
                        dummy_seq (michelson2micheline_ins i2)]
@@ -214,12 +219,13 @@ Fixpoint michelson2micheline_ins (i : instruction) : loc_micheline :=
     dummy_prim "LAMBDA" [ michelson2micheline_type t1;
                             michelson2micheline_type t2;
                             dummy_seq (michelson2micheline_ins i)]
-  | DIG n => dummy_prim "DIG" [dummy_mich (NUMBER (BinInt.Z.of_nat n))]
-  | DUG n => dummy_prim "DUG" [dummy_mich (NUMBER (BinInt.Z.of_nat n))]
-  | DROP n => dummy_prim "DROP" [dummy_mich (NUMBER (BinInt.Z.of_nat n))]
   | DIP n i => dummy_prim "DIP" [dummy_mich (NUMBER (BinInt.Z.of_nat n));
                                    dummy_seq (michelson2micheline_ins i)]
-  | CHAIN_ID => dummy_prim "CHAIN_ID" []
+  | SELF None => dummy_prim "SELF" []
+  | SELF (Some an) => dummy_prim "SELF" [dummy_prim an []]
+  | EXEC => dummy_prim "EXEC" []
+  | instruction_opcode o =>
+    michelson2micheline_opcode o
   end.
 
 Definition eqb_ascii (a b : ascii) : Datatypes.bool :=
diff --git a/src/michocoq/semantics.v b/src/michocoq/semantics.v
index 4b511b15..20b8fab9 100644
--- a/src/michocoq/semantics.v
+++ b/src/michocoq/semantics.v
@@ -149,7 +149,7 @@ Module Semantics(C : ContractContext).
       + inversion H; reflexivity.
     - split; intros; subst.
       + constructor. rewrite <- (IHt (stack t)); reflexivity.
-      + inversion H; subst. 
+      + inversion H; subst.
         assert (stack t = S) by (rewrite (IHt S); assumption); subst; reflexivity.
   Qed.
 
@@ -547,6 +547,112 @@ Module Semantics(C : ContractContext).
   amount of gas that is actually required to run the contract because
   in the SEQ case, both instructions are run with gas n *)
 
+  Definition eval_opcode param_ty (env : @proto_env param_ty) {A B : stack_type}
+             (o : @opcode param_ty A B) (SA : stack A) : M (stack B) :=
+    match o, SA with
+      | @APPLY _ a b c D i, (x, (existT _ _ f, SA)) =>
+        Return (existT
+                    _ _
+                    (PUSH _ (data_to_concrete_data _ i x) ;; PAIR ;; f), SA)
+      | DUP, (x, SA) => Return (x, (x, SA))
+      | SWAP, (x, (y, SA)) => Return (y, (x, SA))
+      | UNIT, SA => Return (tt, SA)
+      | EQ, (x, SA) => Return ((x =? 0)%Z, SA)
+      | NEQ, (x, SA) => Return (negb (x =? 0)%Z, SA)
+      | LT, (x, SA) => Return ((x <? 0)%Z, SA)
+      | GT, (x, SA) => Return ((x >? 0)%Z, SA)
+      | LE, (x, SA) => Return ((x <=? 0)%Z, SA)
+      | GE, (x, SA) => Return ((x >=? 0)%Z, SA)
+      | @OR _ _ s, (x, (y, SA)) =>
+        Return (or_fun _ (bitwise_variant_field _ s) x y, SA)
+      | @AND _ _ s, (x, (y, SA)) =>
+        Return (and _ (bitwise_variant_field _ s) x y, SA)
+      | @XOR _ _ s, (x, (y, SA)) =>
+        Return (xor _ (bitwise_variant_field _ s) x y, SA)
+      | @NOT _ _ s, (x, SA) => Return (not _ _ (not_variant_field _ s) x, SA)
+      | @NEG _ _ s, (x, SA) => Return (neg _ (neg_variant_field _ s) x, SA)
+      | ABS, (x, SA) => Return (Z.abs_N x, SA)
+      | ISNAT, (x, SA) =>
+        Return (if (x >=? 0)%Z then (Some (Z.to_N x), SA) else (None, SA))
+      | INT, (x, SA) => Return (Z.of_N x, SA)
+      | @ADD _ _ _ s, (x, (y, SA)) =>
+        let! r := add _ _ _ (add_variant_field _ _ s) x y in
+        Return (r, SA)
+      | @SUB _ _ _ s, (x, (y, SA)) =>
+        let! r := sub _ _ _ (sub_variant_field _ _ s) x y in
+        Return (r, SA)
+      | @MUL _ _ _ s, (x, (y, SA)) =>
+        let! r := mul _ _ _ (mul_variant_field _ _ s) x y in
+        Return (r, SA)
+      | @EDIV _ _ _ s, (x, (y, SA)) =>
+        Return (ediv _ _ _ _ (ediv_variant_field _ _ s) x y, SA)
+      | LSL, (x, (y, SA)) => Return (N.shiftl x y, SA)
+      | LSR, (x, (y, SA)) => Return (N.shiftr x y, SA)
+      | COMPARE, (x, (y, SA)) =>
+        Return (comparison_to_int
+                    (compare _
+                             (data_to_comparable_data _ x)
+                             (data_to_comparable_data _ y)), SA)
+      | @CONCAT _ _ s _, (x, (y, SA)) =>
+        Return (concat _ (stringlike_variant_field _ s) x y, SA)
+      | @CONCAT_list _ _ s _, (l, SA) =>
+        Return (concat_list _ (stringlike_variant_field _ s) l, SA)
+      | @SLICE _ _ i, (n1, (n2, (s, SA))) =>
+        Return (slice _ (stringlike_variant_field _ i) n1 n2 s, SA)
+      | PAIR, (x, (y, SA)) => Return ((x, y), SA)
+      | CAR, ((x, y), SA) => Return (x, SA)
+      | CDR, ((x, y), SA) => Return (y, SA)
+      | EMPTY_SET a, SA => Return (set.empty _ (compare a), SA)
+      | @MEM _ _ _ s _, (x, (y, SA)) =>
+        Return (mem _ _
+                      (mem_variant_field _ _ s)
+                      (data_to_comparable_data _ x)
+                      y, SA)
+      | @UPDATE _ _ _ _ s _, (x, (y, (z, SA))) =>
+        Return (update _ _ _ (update_variant_field _ _ _ s) (data_to_comparable_data _ x) y z, SA)
+      | @SIZE _ _ s, (x, SA) =>
+        Return (N.of_nat (size _ (size_variant_field _ s) x), SA)
+      | EMPTY_MAP k val, SA =>
+        Return (map.empty (comparable_data k) (data val) _, SA)
+      | EMPTY_BIG_MAP k val, SA =>
+        Return (map.empty (comparable_data k) (data val) _, SA)
+      | @GET _ _ _ s _, (x, (y, SA)) =>
+        Return (get _ _ _
+                      (get_variant_field _ _ s)
+                      (data_to_comparable_data _ x)
+                      y, SA)
+      | SOME, (x, SA) => Return (Some x, SA)
+      | NONE _, SA => Return (None, SA)
+      | LEFT _, (x, SA) => Return (inl x, SA)
+      | RIGHT _, (x, SA) => Return (inr x, SA)
+      | CONS, (x, (y, SA)) => Return (cons x y, SA)
+      | NIL _, SA => Return (nil, SA)
+      | TRANSFER_TOKENS, (a, (b, (c, SA))) =>
+        Return (transfer_tokens env _ a b c, SA)
+      | SET_DELEGATE, (x, SA) => Return (set_delegate env x, SA)
+      | BALANCE, SA => Return (balance env, SA)
+      | ADDRESS, (x, SA) => Return (address_ env _ x, SA)
+      | CONTRACT ao p, (x, SA) => Return (contract_ env ao p x, SA)
+      | SOURCE, SA => Return (source env, SA)
+      | SENDER, SA => Return (sender env, SA)
+      | AMOUNT, SA => Return (amount env, SA)
+      | IMPLICIT_ACCOUNT, (x, SA) => Return (implicit_account env x, SA)
+      | NOW, SA => Return (now env, SA)
+      | PACK, (x, SA) => Return (pack env _ x, SA)
+      | UNPACK ty, (x, SA) => Return (unpack env ty x, SA)
+      | HASH_KEY, (x, SA) => Return (hash_key env x, SA)
+      | BLAKE2B, (x, SA) => Return (blake2b env x, SA)
+      | SHA256, (x, SA) => Return (sha256 env x, SA)
+      | SHA512, (x, SA) => Return (sha512 env x, SA)
+      | CHECK_SIGNATURE, (x, (y, (z, SA))) =>
+        Return (check_signature env x y z, SA)
+      | DIG n Hlen, SA => Return (stack_dig SA)
+      | DUG n Hlen, SA => Return (stack_dug SA)
+      | DROP n Hlen, SA =>
+        let (S1, S2) := stack_split SA in Return S2
+      | CHAIN_ID, SA => Return (chain_id_ env, SA)
+    end.
+
   Fixpoint eval {param_ty : self_info} {tff0} (env : @proto_env param_ty) {A : stack_type} {B : stack_type}
            (i : instruction param_ty tff0 A B) (fuel : Datatypes.nat) (SA : stack A) {struct fuel} : M (stack B) :=
     match fuel with
@@ -574,71 +680,11 @@ Module Semantics(C : ContractContext).
         | inl x => eval env (body;; LOOP_LEFT body) n (x, SA)
         | inr y => Return (y, SA)
         end
+      | PUSH a x, SA, _ => Return (concrete_data_to_data _ x, SA)
+      | LAMBDA a b code, SA, _ => Return (existT _ _ code, SA)
       | EXEC, (x, (existT _ tff f, SA)), env =>
         let! (y, tt) := eval (no_self env) f n (x, tt) in
         Return (y, SA)
-      | @APPLY _ a b c D i, (x, (existT _ _ f, SA)), env =>
-        Return (existT
-                    _ _
-                    (PUSH _ (data_to_concrete_data _ i x) ;; PAIR ;; f), SA)
-      | DUP, (x, SA), _ => Return (x, (x, SA))
-      | SWAP, (x, (y, SA)), _ => Return (y, (x, SA))
-      | PUSH a x, SA, _ => Return (concrete_data_to_data _ x, SA)
-      | UNIT, SA, _ => Return (tt, SA)
-      | LAMBDA a b code, SA, _ => Return (existT _ _ code, SA)
-      | EQ, (x, SA), _ => Return ((x =? 0)%Z, SA)
-      | NEQ, (x, SA), _ => Return (negb (x =? 0)%Z, SA)
-      | LT, (x, SA), _ => Return ((x <? 0)%Z, SA)
-      | GT, (x, SA), _ => Return ((x >? 0)%Z, SA)
-      | LE, (x, SA), _ => Return ((x <=? 0)%Z, SA)
-      | GE, (x, SA), _ => Return ((x >=? 0)%Z, SA)
-      | @OR _ _ s, (x, (y, SA)), _ =>
-        Return (or_fun _ (bitwise_variant_field _ s) x y, SA)
-      | @AND _ _ s, (x, (y, SA)), _ =>
-        Return (and _ (bitwise_variant_field _ s) x y, SA)
-      | @XOR _ _ s, (x, (y, SA)), _ =>
-        Return (xor _ (bitwise_variant_field _ s) x y, SA)
-      | @NOT _ _ s, (x, SA), _ => Return (not _ _ (not_variant_field _ s) x, SA)
-      | @NEG _ _ s, (x, SA), _ => Return (neg _ (neg_variant_field _ s) x, SA)
-      | ABS, (x, SA), _ => Return (Z.abs_N x, SA)
-      | ISNAT, (x, SA), _ =>
-        Return (if (x >=? 0)%Z then (Some (Z.to_N x), SA) else (None, SA))
-      | INT, (x, SA), _ => Return (Z.of_N x, SA)
-      | @ADD _ _ _ s, (x, (y, SA)), _ =>
-        let! r := add _ _ _ (add_variant_field _ _ s) x y in
-        Return (r, SA)
-      | @SUB _ _ _ s, (x, (y, SA)), _ =>
-        let! r := sub _ _ _ (sub_variant_field _ _ s) x y in
-        Return (r, SA)
-      | @MUL _ _ _ s, (x, (y, SA)), _ =>
-        let! r := mul _ _ _ (mul_variant_field _ _ s) x y in
-        Return (r, SA)
-      | @EDIV _ _ _ s, (x, (y, SA)), _ =>
-        Return (ediv _ _ _ _ (ediv_variant_field _ _ s) x y, SA)
-      | LSL, (x, (y, SA)), _ => Return (N.shiftl x y, SA)
-      | LSR, (x, (y, SA)), _ => Return (N.shiftr x y, SA)
-      | COMPARE, (x, (y, SA)), _ =>
-        Return (comparison_to_int
-                    (compare _
-                             (data_to_comparable_data _ x)
-                             (data_to_comparable_data _ y)), SA)
-      | @CONCAT _ _ s _, (x, (y, SA)), _ =>
-        Return (concat _ (stringlike_variant_field _ s) x y, SA)
-      | @CONCAT_list _ _ s _, (l, SA), _ =>
-        Return (concat_list _ (stringlike_variant_field _ s) l, SA)
-      | @SLICE _ _ i, (n1, (n2, (s, SA))), _ =>
-        Return (slice _ (stringlike_variant_field _ i) n1 n2 s, SA)
-      | PAIR, (x, (y, SA)), _ => Return ((x, y), SA)
-      | CAR, ((x, y), SA), _ => Return (x, SA)
-      | CDR, ((x, y), SA), _ => Return (y, SA)
-      | EMPTY_SET a, SA, _ => Return (set.empty _ (compare a), SA)
-      | @MEM _ _ _ s _, (x, (y, SA)), _ =>
-        Return (mem _ _
-                      (mem_variant_field _ _ s)
-                      (data_to_comparable_data _ x)
-                      y, SA)
-      | @UPDATE _ _ _ _ s _, (x, (y, (z, SA))), _ =>
-        Return (update _ _ _ (update_variant_field _ _ _ s) (data_to_comparable_data _ x) y z, SA)
       | @ITER _ _ s _ body, (x, SA), env =>
         match iter_destruct _ _ (iter_variant_field _ s) x with
         | None => Return SA
@@ -646,17 +692,6 @@ Module Semantics(C : ContractContext).
           let! SB := eval env body n (a, SA) in
           eval env (ITER body) n (y, SB)
         end
-      | @SIZE _ _ s, (x, SA), _ =>
-        Return (N.of_nat (size _ (size_variant_field _ s) x), SA)
-      | EMPTY_MAP k val, SA, _ =>
-        Return (map.empty (comparable_data k) (data val) _, SA)
-      | EMPTY_BIG_MAP k val, SA, _ =>
-        Return (map.empty (comparable_data k) (data val) _, SA)
-      | @GET _ _ _ s _, (x, (y, SA)), _ =>
-        Return (get _ _ _
-                      (get_variant_field _ _ s)
-                      (data_to_comparable_data _ x)
-                      y, SA)
       | @MAP _ _ _ s _ body, (x, SA), env =>
         let v := (map_variant_field _ _ s) in
         match map_destruct _ _ _ _ v x with
@@ -666,22 +701,16 @@ Module Semantics(C : ContractContext).
           let! (c, SC) := eval env (MAP body) n (y, SB) in
           Return (map_insert _ _ _ _ v a b c, SC)
         end
-      | SOME, (x, SA), _ => Return (Some x, SA)
-      | NONE _, SA, _ => Return (None, SA)
       | IF_NONE bt bf, (b, SA), env =>
         match b with
         | None => eval env bt n SA
         | Some b => eval env bf n (b, SA)
         end
-      | LEFT _, (x, SA), _ => Return (inl x, SA)
-      | RIGHT _, (x, SA), _ => Return (inr x, SA)
       | IF_LEFT bt bf, (b, SA), env =>
         match b with
         | inl a => eval env bt n (a, SA)
         | inr b => eval env bf n (b, SA)
         end
-      | CONS, (x, (y, SA)), _ => Return (cons x y, SA)
-      | NIL _, SA, _ => Return (nil, SA)
       | IF_CONS bt bf, (l, SA), env =>
         match l with
         | cons a b => eval env bt n (a, (b, SA))
@@ -690,35 +719,13 @@ Module Semantics(C : ContractContext).
       | CREATE_CONTRACT g p an f, (a, (b, (c, SA))), env =>
         let (oper, addr) := create_contract env g p an _ a b f c in
         Return (oper, (addr, SA))
-      | TRANSFER_TOKENS, (a, (b, (c, SA))), env =>
-        Return (transfer_tokens env _ a b c, SA)
-      | SET_DELEGATE, (x, SA), env => Return (set_delegate env x, SA)
-      | BALANCE, SA, env => Return (balance env, SA)
-      | ADDRESS, (x, SA), env => Return (address_ env _ x, SA)
-      | CONTRACT ao p, (x, SA), env => Return (contract_ env ao p x, SA)
-      | SOURCE, SA, env => Return (source env, SA)
-      | SENDER, SA, env => Return (sender env, SA)
       | SELF ao H, SA, env => Return (self env ao H, SA)
-      | AMOUNT, SA, env => Return (amount env, SA)
-      | IMPLICIT_ACCOUNT, (x, SA), env => Return (implicit_account env x, SA)
-      | NOW, SA, env => Return (now env, SA)
-      | PACK, (x, SA), env => Return (pack env _ x, SA)
-      | UNPACK ty, (x, SA), env => Return (unpack env ty x, SA)
-      | HASH_KEY, (x, SA), env => Return (hash_key env x, SA)
-      | BLAKE2B, (x, SA), env => Return (blake2b env x, SA)
-      | SHA256, (x, SA), env => Return (sha256 env x, SA)
-      | SHA512, (x, SA), env => Return (sha512 env x, SA)
-      | CHECK_SIGNATURE, (x, (y, (z, SA))), env =>
-        Return (check_signature env x y z, SA)
-      | DIG n Hlen, SA, _ => Return (stack_dig SA)
-      | DUG n Hlen, SA, _ => Return (stack_dug SA)
       | DIP nl Hlen i, SA, env =>
         let (S1, S2) := stack_split SA in
         let! S3 := eval env i n S2 in
         Return (stack_app S1 S3)
-      | DROP n Hlen, SA, _ =>
-        let (S1, S2) := stack_split SA in Return S2
-      | CHAIN_ID, SA, env => Return (chain_id_ env, SA)
+      | Instruction_opcode o, SA, env =>
+        eval_opcode _ env o SA
       end
     end.
 
@@ -754,13 +761,6 @@ Module Semantics(C : ContractContext).
         * destruct st as ([x|y], st).
           -- rewrite IHfuel1; try assumption; reflexivity.
           -- reflexivity.
-        * destruct st as (x, ((tff, f), SA)).
-          f_equal.
-          rewrite IHfuel1.
-          -- reflexivity.
-          -- simpl in Hsucc.
-             apply success_bind_arg in Hsucc.
-             assumption.
         * destruct st as (x, SA).
           generalize Hsucc; clear Hsucc.
           simpl.
@@ -816,6 +816,13 @@ Module Semantics(C : ContractContext).
           -- exact Hsucc.
           -- reflexivity.
           -- exact Hsucc.
+        * destruct st as (x, ((tff, f), SA)).
+          f_equal.
+          rewrite IHfuel1.
+          -- reflexivity.
+          -- simpl in Hsucc.
+             apply success_bind_arg in Hsucc.
+             assumption.
         * simpl in Hsucc.
           destruct (stack_split st); rewrite IHfuel1.
           -- reflexivity.
@@ -838,41 +845,14 @@ Module Semantics(C : ContractContext).
       apply eval_deterministic_le; assumption.
   Qed.
 
-  Definition eval_precond_body
-             (eval_precond_n : forall {self_type},
-                 @proto_env self_type ->
-                 forall {tff0 A B},
-                   instruction self_type tff0 A B ->
-                   (stack B -> Prop) -> stack A -> Prop)
-             {self_type} env tff0 A B
-             (i : instruction self_type tff0 A B)
-             (psi : stack B -> Prop)
-             (SA : stack A) : Prop :=
-    match i, env, psi, SA with
-    | FAILWITH, _, _, _ => false
-    | NOOP, env, psi, st => psi st
-    | SEQ B C, env, psi, st =>
-      eval_precond_n env B (eval_precond_n env C psi) st
-    | IF_ bt bf, env, psi, (b, SA) =>
-      if b then eval_precond_n env bt psi SA
-      else eval_precond_n env bf psi SA
-    | LOOP body, env, psi, (b, SA) =>
-      if b then eval_precond_n env (body;; (LOOP body)) psi SA
-      else psi SA
-    | LOOP_LEFT body, env, psi, (ab, SA) =>
-      match ab with
-      | inl x => eval_precond_n env (body;; LOOP_LEFT body) psi (x, SA)
-      | inr y => psi (y, SA)
-      end
-    | EXEC, env, psi, (x, (existT _ _ f, SA)) =>
-      eval_precond_n (no_self env) f (fun '(y, tt) => psi (y, SA)) (x, tt)
+  Definition eval_precond_opcode {self_type} (env : @proto_env self_type)
+             A B (o : @opcode self_type A B) (psi : stack B -> Prop) (SA : stack A) : Prop :=
+    match o, env, psi, SA with
     | @APPLY _ a b c D i, env, psi, (x, (existT _ _ f, SA)) =>
-      psi (existT _ _ (PUSH _ (data_to_concrete_data _ i x) ;; PAIR ;; f), SA)
+      psi (existT _ _ (PUSH _ (data_to_concrete_data _ i x) ;; Instruction_opcode PAIR ;; f), SA)
     | DUP, env, psi, (x, SA) => psi (x, (x, SA))
     | SWAP, env, psi, (x, (y, SA)) => psi (y, (x, SA))
-    | PUSH a x, env, psi, SA => psi (concrete_data_to_data _ x, SA)
     | UNIT, env, psi, SA => psi (tt, SA)
-    | LAMBDA a b code, env, psi, SA => psi (existT _ _ code, SA)
     | EQ, env, psi, (x, SA) => psi ((x =? 0)%Z, SA)
     | NEQ, env, psi, (x, SA) => psi (negb (x =? 0)%Z, SA)
     | LT, env, psi, (x, SA) => psi ((x <? 0)%Z, SA)
@@ -912,6 +892,73 @@ Module Semantics(C : ContractContext).
       psi (mem _ _ (mem_variant_field _ _ s) (data_to_comparable_data _ x) y, SA)
     | @UPDATE _ _ _ _ s _, env, psi, (x, (y, (z, SA))) =>
       psi (update _ _ _ (update_variant_field _ _ _ s) (data_to_comparable_data _ x) y z, SA)
+    | @SIZE _ _ s, env, psi, (x, SA) => psi (N.of_nat (size _ (size_variant_field _ s) x), SA)
+    | EMPTY_MAP k val, env, psi, SA => psi (map.empty (comparable_data k) (data val) _, SA)
+    | EMPTY_BIG_MAP k val, env, psi, SA => psi (map.empty (comparable_data k) (data val) _, SA)
+    | @GET _ _ _ s _, env, psi, (x, (y, SA)) => psi (get _ _ _ (get_variant_field _ _ s) (data_to_comparable_data _ x) y, SA)
+    | SOME, env, psi, (x, SA) => psi (Some x, SA)
+    | NONE _, env, psi, SA => psi (None, SA)
+    | LEFT _, env, psi, (x, SA) => psi (inl x, SA)
+    | RIGHT _, env, psi, (x, SA) => psi (inr x, SA)
+    | CONS, env, psi, (x, (y, SA)) => psi (cons x y, SA)
+    | NIL _, env, psi, SA => psi (nil, SA)
+    | TRANSFER_TOKENS, env, psi, (a, (b, (c, SA))) =>
+      psi (transfer_tokens env _ a b c, SA)
+    | SET_DELEGATE, env, psi, (x, SA) =>
+      psi (set_delegate env x, SA)
+    | BALANCE, env, psi, SA => psi (balance env, SA)
+    | ADDRESS, env, psi, (x, SA) => psi (address_ env _ x, SA)
+    | CONTRACT ao p, env, psi, (x, SA) => psi (contract_ env ao p x, SA)
+    | SOURCE, env, psi, SA => psi (source env, SA)
+    | SENDER, env, psi, SA => psi (sender env, SA)
+    | AMOUNT, env, psi, SA => psi (amount env, SA)
+    | IMPLICIT_ACCOUNT, env, psi, (x, SA) => psi (implicit_account env x, SA)
+    | NOW, env, psi, SA => psi (now env, SA)
+    | PACK, env, psi, (x, SA) => psi (pack env _ x, SA)
+    | UNPACK ty, env, psi, (x, SA) => psi (unpack env ty x, SA)
+    | HASH_KEY, env, psi, (x, SA) => psi (hash_key env x, SA)
+    | BLAKE2B, env, psi, (x, SA) => psi (blake2b env x, SA)
+    | SHA256, env, psi, (x, SA) => psi (sha256 env x, SA)
+    | SHA512, env, psi, (x, SA) => psi (sha512 env x, SA)
+    | CHECK_SIGNATURE, env, psi, (x, (y, (z, SA))) =>
+      psi (check_signature env x y z, SA)
+    | DIG n Hlen, env, psi, st => psi (stack_dig st)
+    | DUG n Hlen, env, psi, st => psi (stack_dug st)
+    | DROP n Hlen, env, psi, SA =>
+      let (S1, S2) := stack_split SA in psi S2
+    | CHAIN_ID, env, psi, SA => psi (chain_id_ env, SA)
+    end.
+
+  Definition eval_precond_body
+             (eval_precond_n : forall {self_type},
+                 @proto_env self_type ->
+                 forall {tff0 A B},
+                   instruction self_type tff0 A B ->
+                   (stack B -> Prop) -> stack A -> Prop)
+             {self_type} env tff0 A B
+             (i : instruction self_type tff0 A B)
+             (psi : stack B -> Prop)
+             (SA : stack A) : Prop :=
+    match i, env, psi, SA with
+    | FAILWITH, _, _, _ => false
+    | NOOP, env, psi, st => psi st
+    | SEQ B C, env, psi, st =>
+      eval_precond_n env B (eval_precond_n env C psi) st
+    | IF_ bt bf, env, psi, (b, SA) =>
+      if b then eval_precond_n env bt psi SA
+      else eval_precond_n env bf psi SA
+    | LOOP body, env, psi, (b, SA) =>
+      if b then eval_precond_n env (body;; (LOOP body)) psi SA
+      else psi SA
+    | LOOP_LEFT body, env, psi, (ab, SA) =>
+      match ab with
+      | inl x => eval_precond_n env (body;; LOOP_LEFT body) psi (x, SA)
+      | inr y => psi (y, SA)
+      end
+    | EXEC, env, psi, (x, (existT _ _ f, SA)) =>
+      eval_precond_n (no_self env) f (fun '(y, tt) => psi (y, SA)) (x, tt)
+    | PUSH a x, env, psi, SA => psi (concrete_data_to_data _ x, SA)
+    | LAMBDA a b code, env, psi, SA => psi (existT _ _ code, SA)
     | @ITER _ _ s _ body, env, psi, (x, SA) =>
       match iter_destruct _ _ (iter_variant_field _ s) x with
       | None => psi SA
@@ -921,10 +968,6 @@ Module Semantics(C : ContractContext).
           (fun SB => eval_precond_n env (ITER body) psi (y, SB))
           (a, SA)
       end
-    | @SIZE _ _ s, env, psi, (x, SA) => psi (N.of_nat (size _ (size_variant_field _ s) x), SA)
-    | EMPTY_MAP k val, env, psi, SA => psi (map.empty (comparable_data k) (data val) _, SA)
-    | EMPTY_BIG_MAP k val, env, psi, SA => psi (map.empty (comparable_data k) (data val) _, SA)
-    | @GET _ _ _ s _, env, psi, (x, (y, SA)) => psi (get _ _ _ (get_variant_field _ _ s) (data_to_comparable_data _ x) y, SA)
     | @MAP _ _ _ s _ body, env, psi, (x, SA) =>
       let v := (map_variant_field _ _ s) in
       match map_destruct _ _ _ _ v x with
@@ -939,22 +982,16 @@ Module Semantics(C : ContractContext).
                (y, SB))
           (a, SA)
       end
-    | SOME, env, psi, (x, SA) => psi (Some x, SA)
-    | NONE _, env, psi, SA => psi (None, SA)
     | IF_NONE bt bf, env, psi, (b, SA) =>
       match b with
       | None => eval_precond_n env bt psi SA
       | Some b => eval_precond_n env bf psi (b, SA)
       end
-    | LEFT _, env, psi, (x, SA) => psi (inl x, SA)
-    | RIGHT _, env, psi, (x, SA) => psi (inr x, SA)
     | IF_LEFT bt bf, env, psi, (b, SA) =>
       match b with
       | inl a => eval_precond_n env bt psi (a, SA)
       | inr b => eval_precond_n env bf psi (b, SA)
       end
-    | CONS, env, psi, (x, (y, SA)) => psi (cons x y, SA)
-    | NIL _, env, psi, SA => psi (nil, SA)
     | IF_CONS bt bf, env, psi, (l, SA) =>
       match l with
       | cons a b => eval_precond_n env bt psi (a, (b, SA))
@@ -963,35 +1000,12 @@ Module Semantics(C : ContractContext).
     | CREATE_CONTRACT g p an f, env, psi, (a, (b, (c, SA))) =>
       let (oper, addr) := create_contract env g p an _ a b f c in
       psi (oper, (addr, SA))
-    | TRANSFER_TOKENS, env, psi, (a, (b, (c, SA))) =>
-      psi (transfer_tokens env _ a b c, SA)
-    | SET_DELEGATE, env, psi, (x, SA) =>
-      psi (set_delegate env x, SA)
-    | BALANCE, env, psi, SA => psi (balance env, SA)
-    | ADDRESS, env, psi, (x, SA) => psi (address_ env _ x, SA)
-    | CONTRACT ao p, env, psi, (x, SA) => psi (contract_ env ao p x, SA)
-    | SOURCE, env, psi, SA => psi (source env, SA)
-    | SENDER, env, psi, SA => psi (sender env, SA)
     | SELF ao H, env, psi, SA => psi (self env ao H, SA)
-    | AMOUNT, env, psi, SA => psi (amount env, SA)
-    | IMPLICIT_ACCOUNT, env, psi, (x, SA) => psi (implicit_account env x, SA)
-    | NOW, env, psi, SA => psi (now env, SA)
-    | PACK, env, psi, (x, SA) => psi (pack env _ x, SA)
-    | UNPACK ty, env, psi, (x, SA) => psi (unpack env ty x, SA)
-    | HASH_KEY, env, psi, (x, SA) => psi (hash_key env x, SA)
-    | BLAKE2B, env, psi, (x, SA) => psi (blake2b env x, SA)
-    | SHA256, env, psi, (x, SA) => psi (sha256 env x, SA)
-    | SHA512, env, psi, (x, SA) => psi (sha512 env x, SA)
-    | CHECK_SIGNATURE, env, psi, (x, (y, (z, SA))) =>
-      psi (check_signature env x y z, SA)
-    | DIG n Hlen, env, psi, st => psi (stack_dig st)
-    | DUG n Hlen, env, psi, st => psi (stack_dug st)
     | DIP n Hlen i, env, psi, SA =>
       let (S1, S2) := stack_split SA in
       eval_precond_n env i (fun SB => psi (stack_app S1 SB)) S2
-    | DROP n Hlen, env, psi, SA =>
-      let (S1, S2) := stack_split SA in psi S2
-    | CHAIN_ID, env, psi, SA => psi (chain_id_ env, SA)
+    | Instruction_opcode o, env, psi, SA =>
+      eval_precond_opcode env _ _ o psi SA
     end.
 
   Fixpoint eval_precond (fuel : Datatypes.nat) :
@@ -1004,6 +1018,20 @@ Module Semantics(C : ContractContext).
       @eval_precond_body (@eval_precond n)
     end.
 
+  Lemma eval_precond_opcode_correct {sty env A B} (o : opcode A B) st psi :
+    precond (eval_opcode sty env o st) psi <-> eval_precond_opcode env _ _ o psi st.
+  Proof.
+    destruct o; simpl;
+      try reflexivity;
+      try (destruct st; reflexivity);
+      try (destruct st as (x, (y, st)); reflexivity);
+      try (destruct st as (x, (y, st)); rewrite precond_bind; reflexivity);
+      try (destruct st as (x, (y, (z, SA))); reflexivity);
+      try (destruct st as ((x, y), st); reflexivity).
+    - destruct st as (x, ((tff, y), st)); reflexivity.
+    - destruct (stack_split st); reflexivity.
+  Qed.
+
   Lemma eval_precond_correct {sty env tff0 A B} (i : instruction sty tff0 A B) n st psi :
     precond (eval env i n st) psi <-> eval_precond n env i psi st.
   Proof.
@@ -1024,50 +1052,8 @@ Module Semantics(C : ContractContext).
     - destruct st as ([|], st); simpl.
       + apply (IHn _ _ _ _ _ (i;; LOOP_LEFT i)).
       + reflexivity.
-    - destruct st as (x, ((tff, f), st)).
-      rewrite precond_bind.
-      rewrite <- (IHn _ _ _ _ _ f (x, tt) (fun '(y, tt) => psi (y, st))).
-      apply precond_eqv.
-      intros (y, []).
-      simpl.
-      reflexivity.
-    - destruct st as (x, ((tff, y), st)); reflexivity.
-    - destruct st; reflexivity.
-    - destruct st as (x, (y, st)); reflexivity.
-    - reflexivity.
-    - reflexivity.
     - reflexivity.
-    - destruct st; reflexivity.
-    - destruct st; reflexivity.
-    - destruct st; reflexivity.
-    - destruct st; reflexivity.
-    - destruct st; reflexivity.
-    - destruct st; reflexivity.
-    - destruct st as (x, (y, st)); reflexivity.
-    - destruct st as (x, (y, st)); reflexivity.
-    - destruct st as (x, (y, st)); reflexivity.
-    - destruct st; reflexivity.
-    - destruct st; reflexivity.
-    - destruct st; reflexivity.
-    - destruct st; reflexivity.
-    - destruct st; reflexivity.
-    - destruct st as (x, (y, st)); rewrite precond_bind; reflexivity.
-    - destruct st as (x, (y, st)); rewrite precond_bind; reflexivity.
-    - destruct st as (x, (y, st)); rewrite precond_bind; reflexivity.
-    - destruct st as (x, (y, st)); reflexivity.
-    - destruct st as (x, (y, st)); reflexivity.
-    - destruct st as (x, (y, st)); reflexivity.
-    - destruct st as (x, (y, st)); reflexivity.
-    - destruct st as (x, (y, st)); reflexivity.
-    - destruct st; reflexivity.
-    - destruct st; reflexivity.
-    - destruct st as (x, (y, (z, st))); reflexivity.
-    - destruct st as (x, (y, st)); reflexivity.
-    - destruct st as ((x, y), st); reflexivity.
-    - destruct st as ((x, y), st); reflexivity.
     - reflexivity.
-    - destruct st as (x, (y, st)); reflexivity.
-    - destruct st as (x, (y, (z, st))); reflexivity.
     - destruct st as (x, st).
       destruct (iter_destruct (iter_elt_type collection i) collection
                               (iter_variant_field collection i) x) as [(hd, tl)|].
@@ -1077,9 +1063,6 @@ Module Semantics(C : ContractContext).
         intro SA.
         apply IHn.
       + reflexivity.
-    - reflexivity.
-    - reflexivity.
-    - destruct st as (x, (y, st)); reflexivity.
     - destruct st as (x, st).
       destruct (map_destruct (map_in_type collection b i) b collection
                              (map_out_collection_type collection b i)
@@ -1094,56 +1077,24 @@ Module Semantics(C : ContractContext).
         intros (c, B).
         reflexivity.
       + reflexivity.
-    - destruct st; reflexivity.
-    - reflexivity.
     - destruct st as ([|], st); apply IHn.
-    - destruct st; reflexivity.
-    - destruct st; reflexivity.
     - destruct st as ([|], st); apply IHn.
-    - destruct st as (x, (y, st)); reflexivity.
-    - reflexivity.
     - destruct st as ([|], st); apply IHn.
     - destruct st as (a, (b, (c, SA))).
       destruct (create_contract env g p an _ a b i c).
       reflexivity.
-    - destruct st as (a, (b, (c, SA))).
-      reflexivity.
-    - destruct st as (a, SA).
-      reflexivity.
-    - reflexivity.
-    - destruct st as (a, SA).
-      reflexivity.
-    - destruct st as (a, SA).
-      reflexivity.
-    - reflexivity.
-    - reflexivity.
-    - reflexivity.
-    - reflexivity.
-    - destruct st as (a, SA).
-      reflexivity.
     - reflexivity.
-    - destruct st as (x, SA).
-      reflexivity.
-    - destruct st as (x, SA).
-      reflexivity.
-    - destruct st as (x, SA).
-      reflexivity.
-    - destruct st as (x, SA).
-      reflexivity.
-    - destruct st as (x, SA).
-      reflexivity.
-    - destruct st as (x, SA).
-      reflexivity.
-    - destruct st as (a, (b, (c, SA))).
+    - destruct st as (x, ((tff, f), st)).
+      rewrite precond_bind.
+      rewrite <- (IHn _ _ _ _ _ f (x, tt) (fun '(y, tt) => psi (y, st))).
+      apply precond_eqv.
+      intros (y, []).
+      simpl.
       reflexivity.
-    - reflexivity.
-    - reflexivity.
     - destruct (stack_split st).
       rewrite precond_bind.
       apply IHn.
-    - destruct (stack_split st).
-      reflexivity.
-    - reflexivity.
+    - apply eval_precond_opcode_correct.
   Qed.
 
 End Semantics.
diff --git a/src/michocoq/syntax.v b/src/michocoq/syntax.v
index be09c5d4..85593b2a 100644
--- a/src/michocoq/syntax.v
+++ b/src/michocoq/syntax.v
@@ -348,6 +348,97 @@ Definition get_opt {A : Set} (m : Datatypes.option A) (H : isSome m) : A :=
 
 Definition self_info := Datatypes.option (type * annot_o)%type.
 
+(* The self_type parameter is only here to ensure the so-called
+   uniform inheritance condition allowing to use Instruction_opcode as
+   an implicit coearcion *)
+
+Inductive opcode {self_type : self_info} : forall (A B : Datatypes.list type), Set :=
+| APPLY {a b c D} {_ : Bool.Is_true (is_packable a)} :
+    opcode (a ::: lambda (pair a b) c ::: D) (lambda b c ::: D)
+| DUP {a A} : opcode (a ::: A) (a ::: a ::: A)
+| SWAP {a b A} : opcode (a ::: b ::: A) (b ::: a ::: A)
+| UNIT {A} : opcode A (unit :: A)
+| EQ {S} : opcode (int ::: S) (bool ::: S)
+| NEQ {S} : opcode (int ::: S) (bool ::: S)
+| LT {S} : opcode (int ::: S) (bool ::: S)
+| GT {S} : opcode (int ::: S) (bool ::: S)
+| LE {S} : opcode (int ::: S) (bool ::: S)
+| GE {S} : opcode (int ::: S) (bool ::: S)
+| OR {b} {s : bitwise_struct b} {S} : opcode (b ::: b ::: S) (b ::: S)
+| AND {b} {s : bitwise_struct b} {S} : opcode (b ::: b ::: S) (b ::: S)
+| XOR {b} {s : bitwise_struct b} {S} : opcode (b ::: b ::: S) (b ::: S)
+| NOT {b} {s : not_struct b} {S} : opcode (b ::: S) (not_ret_type _ s ::: S)
+| NEG {n} {s : neg_struct n} {S} : opcode (n ::: S) (int ::: S)
+| ABS {S} : opcode (int ::: S) (nat ::: S)
+| ISNAT {S} : opcode (int ::: S) (option nat ::: S)
+| INT {S} : opcode (nat ::: S) (int ::: S)
+| ADD {a b} {s : add_struct a b} {S} :
+    opcode (a ::: b ::: S) (add_ret_type _ _ s ::: S)
+| SUB {a b} {s : sub_struct a b} {S} :
+    opcode (a ::: b ::: S) (sub_ret_type _ _ s ::: S)
+| MUL {a b} {s : mul_struct a b} {S} :
+    opcode (a ::: b ::: S) (mul_ret_type _ _ s ::: S)
+| EDIV {a b} {s : ediv_struct a b} {S} : opcode (a ::: b ::: S) (option (pair (ediv_quo_type _ _ s) (ediv_rem_type _ _ s)) :: S)
+| LSL {S} : opcode (nat ::: nat ::: S) (nat ::: S)
+| LSR {S} : opcode (nat ::: nat ::: S) (nat ::: S)
+| COMPARE {a : comparable_type} {S} : opcode (a ::: a ::: S) (int ::: S)
+| CONCAT {a} {i : stringlike_struct a} {S} : opcode (a ::: a ::: S) (a ::: S)
+| CONCAT_list {a} {i : stringlike_struct a} {S} : opcode (list a ::: S) (a ::: S)
+| SIZE {a} {i : size_struct a} {S} :
+    opcode (a ::: S) (nat ::: S)
+| SLICE {a} {i : stringlike_struct a} {S} :
+    opcode (nat ::: nat ::: a ::: S) (option a ::: S)
+| PAIR {a b S} : opcode (a ::: b ::: S) (pair a b :: S)
+| CAR {a b S} : opcode (pair a b :: S) (a :: S)
+| CDR {a b S} : opcode (pair a b :: S) (b :: S)
+| EMPTY_SET elt {S} : opcode S (set elt ::: S)
+| MEM {elt a} {i : mem_struct elt a} {S} :
+    opcode (elt ::: a ::: S) (bool ::: S)
+| UPDATE {elt val collection} {i : update_struct elt val collection} {S} :
+    opcode (elt ::: val ::: collection ::: S) (collection ::: S)
+| EMPTY_MAP (key : comparable_type) (val : type) {S} :
+    opcode S (map key val :: S)
+| EMPTY_BIG_MAP (key : comparable_type) (val : type) {S} :
+    opcode S (big_map key val :: S)
+| GET {key collection} {i : get_struct key collection} {S} :
+    opcode (key ::: collection ::: S) (option (get_val_type _ _ i) :: S)
+| SOME {a S} : opcode (a :: S) (option a :: S)
+| NONE (a : type) {S} : opcode S (option a :: S)
+| LEFT {a} (b : type) {S} : opcode (a :: S) (or a None b None :: S)
+| RIGHT (a : type) {b S} : opcode (b :: S) (or a None b None :: S)
+| CONS {a S} : opcode (a ::: list a ::: S) (list a :: S)
+| NIL (a : type) {S} : opcode S (list a :: S)
+| TRANSFER_TOKENS {p S} :
+    opcode (p ::: mutez ::: contract p ::: S) (operation ::: S)
+| SET_DELEGATE {S} :
+    opcode (option key_hash ::: S) (operation ::: S)
+| BALANCE {S} : opcode S (mutez ::: S)
+| ADDRESS {p S} : opcode (contract p ::: S) (address ::: S)
+| CONTRACT {S} (annot_opt : Datatypes.option annotation) p :
+    opcode (address ::: S) (option (contract p) ::: S)
+| SOURCE {S} : opcode S (address ::: S)
+| SENDER {S} : opcode S (address ::: S)
+| AMOUNT {S} : opcode S (mutez ::: S)
+| IMPLICIT_ACCOUNT {S} : opcode (key_hash ::: S) (contract unit :: S)
+| NOW {S} : opcode S (timestamp ::: S)
+| PACK {a S} : opcode (a ::: S) (bytes ::: S)
+| UNPACK a {S} : opcode (bytes ::: S) (option a ::: S)
+| HASH_KEY {S} : opcode (key ::: S) (key_hash ::: S)
+| BLAKE2B {S} : opcode (bytes ::: S) (bytes ::: S)
+| SHA256 {S} : opcode (bytes ::: S) (bytes ::: S)
+| SHA512 {S} : opcode (bytes ::: S) (bytes ::: S)
+| CHECK_SIGNATURE {S} : opcode (key ::: signature ::: bytes ::: S) (bool ::: S)
+| DIG (n : Datatypes.nat) {S1 S2 t} :
+    length S1 = n ->
+    opcode (S1 +++ (t ::: S2)) (t ::: S1 +++ S2)
+| DUG (n : Datatypes.nat) {S1 S2 t} :
+    length S1 = n ->
+    opcode (t ::: S1 +++ S2) (S1 +++ (t ::: S2))
+| DROP (n : Datatypes.nat) {A B} :
+    length A = n ->
+    opcode (A +++ B) B
+| CHAIN_ID {S} : opcode S (chain_id ::: S).
+
 Inductive instruction :
   forall (self_i : self_info) (tail_fail_flag : Datatypes.bool) (A B : Datatypes.list type), Set :=
 | NOOP {self_type A} : instruction self_type Datatypes.false A A    (* Undocumented *)
@@ -363,79 +454,23 @@ this constructor "IF" but we can make a notation for it. *)
 | LOOP {self_type A} : instruction self_type Datatypes.false A (bool ::: A) -> instruction self_type Datatypes.false (bool ::: A) A
 | LOOP_LEFT {self_type a b an bn A} : instruction self_type Datatypes.false (a :: A) (or a an b bn :: A) ->
                       instruction self_type Datatypes.false (or a an b bn :: A) (b :: A)
-| EXEC {self_type a b C} : instruction self_type Datatypes.false (a ::: lambda a b ::: C) (b :: C)
-| APPLY {self_type a b c D} {_ : Bool.Is_true (is_packable a)} :
-    instruction self_type Datatypes.false (a ::: lambda (pair a b) c ::: D) (lambda b c ::: D)
-| DUP {self_type a A} : instruction self_type Datatypes.false (a ::: A) (a ::: a ::: A)
-| SWAP {self_type a b A} : instruction self_type Datatypes.false (a ::: b ::: A) (b ::: a ::: A)
 | PUSH (a : type) (x : concrete_data a) {self_type A} : instruction self_type Datatypes.false A (a :: A)
-| UNIT {self_type A} : instruction self_type Datatypes.false A (unit :: A)
 | LAMBDA (a b : type) {self_type A tff} :
     instruction None tff (a :: nil) (b :: nil) ->
     instruction self_type Datatypes.false A (lambda a b :: A)
-| EQ {self_type S} : instruction self_type Datatypes.false (int ::: S) (bool ::: S)
-| NEQ {self_type S} : instruction self_type Datatypes.false (int ::: S) (bool ::: S)
-| LT {self_type S} : instruction self_type Datatypes.false (int ::: S) (bool ::: S)
-| GT {self_type S} : instruction self_type Datatypes.false (int ::: S) (bool ::: S)
-| LE {self_type S} : instruction self_type Datatypes.false (int ::: S) (bool ::: S)
-| GE {self_type S} : instruction self_type Datatypes.false (int ::: S) (bool ::: S)
-| OR {self_type b} {s : bitwise_struct b} {S} : instruction self_type Datatypes.false (b ::: b ::: S) (b ::: S)
-| AND {self_type b} {s : bitwise_struct b} {S} : instruction self_type Datatypes.false (b ::: b ::: S) (b ::: S)
-| XOR {self_type b} {s : bitwise_struct b} {S} : instruction self_type Datatypes.false (b ::: b ::: S) (b ::: S)
-| NOT {self_type b} {s : not_struct b} {S} : instruction self_type Datatypes.false (b ::: S) (not_ret_type _ s ::: S)
-| NEG {self_type n} {s : neg_struct n} {S} : instruction self_type Datatypes.false (n ::: S) (int ::: S)
-| ABS {self_type S} : instruction self_type Datatypes.false (int ::: S) (nat ::: S)
-| ISNAT {self_type S} : instruction self_type Datatypes.false (int ::: S) (option nat ::: S)
-| INT {self_type S} : instruction self_type Datatypes.false (nat ::: S) (int ::: S)
-| ADD {self_type a b} {s : add_struct a b} {S} :
-    instruction self_type Datatypes.false (a ::: b ::: S) (add_ret_type _ _ s ::: S)
-| SUB {self_type a b} {s : sub_struct a b} {S} :
-    instruction self_type Datatypes.false (a ::: b ::: S) (sub_ret_type _ _ s ::: S)
-| MUL {self_type a b} {s : mul_struct a b} {S} :
-    instruction self_type Datatypes.false (a ::: b ::: S) (mul_ret_type _ _ s ::: S)
-| EDIV {self_type a b} {s : ediv_struct a b} {S} : instruction self_type Datatypes.false (a ::: b ::: S) (option (pair (ediv_quo_type _ _ s) (ediv_rem_type _ _ s)) :: S)
-| LSL {self_type S} : instruction self_type Datatypes.false (nat ::: nat ::: S) (nat ::: S)
-| LSR {self_type S} : instruction self_type Datatypes.false (nat ::: nat ::: S) (nat ::: S)
-| COMPARE {self_type} {a : comparable_type} {S} : instruction self_type Datatypes.false (a ::: a ::: S) (int ::: S)
-| CONCAT {self_type a} {i : stringlike_struct a} {S} : instruction self_type Datatypes.false (a ::: a ::: S) (a ::: S)
-| CONCAT_list {self_type a} {i : stringlike_struct a} {S} : instruction self_type Datatypes.false (list a ::: S) (a ::: S)
-| SIZE {self_type a} {i : size_struct a} {S} :
-    instruction self_type Datatypes.false (a ::: S) (nat ::: S)
-| SLICE {self_type a} {i : stringlike_struct a} {S} :
-    instruction self_type Datatypes.false (nat ::: nat ::: a ::: S) (option a ::: S)
-| PAIR {self_type a b S} : instruction self_type Datatypes.false (a ::: b ::: S) (pair a b :: S)
-| CAR {self_type a b S} : instruction self_type Datatypes.false (pair a b :: S) (a :: S)
-| CDR {self_type a b S} : instruction self_type Datatypes.false (pair a b :: S) (b :: S)
-| EMPTY_SET elt {self_type S} : instruction self_type Datatypes.false S (set elt ::: S)
-| MEM {self_type elt a} {i : mem_struct elt a} {S} :
-    instruction self_type Datatypes.false (elt ::: a ::: S) (bool ::: S)
-| UPDATE {self_type elt val collection} {i : update_struct elt val collection} {S} :
-    instruction self_type Datatypes.false (elt ::: val ::: collection ::: S) (collection ::: S)
 | ITER {self_type collection} {i : iter_struct collection} {A} :
     instruction self_type Datatypes.false (iter_elt_type _ i ::: A) A -> instruction self_type Datatypes.false (collection :: A) A
-| EMPTY_MAP (key : comparable_type) (val : type) {self_type S} :
-    instruction self_type Datatypes.false S (map key val :: S)
-| EMPTY_BIG_MAP (key : comparable_type) (val : type) {self_type S} :
-    instruction self_type Datatypes.false S (big_map key val :: S)
-| GET {self_type key collection} {i : get_struct key collection} {S} :
-    instruction self_type Datatypes.false (key ::: collection ::: S) (option (get_val_type _ _ i) :: S)
 | MAP {self_type collection b} {i : map_struct collection b} {A} :
     instruction self_type Datatypes.false (map_in_type _ _ i :: A) (b :: A) ->
     instruction self_type Datatypes.false (collection :: A) (map_out_collection_type _ _ i :: A)
-| SOME {self_type a S} : instruction self_type Datatypes.false (a :: S) (option a :: S)
-| NONE (a : type) {self_type S} : instruction self_type Datatypes.false S (option a :: S)
 (* Not the one documented, see https://gitlab.com/tezos/tezos/issues/471 *)
 | IF_NONE {self_type a A B tffa tffb} :
     instruction self_type tffa A B -> instruction self_type tffb (a :: A) B ->
     instruction self_type (tffa && tffb) (option a :: A) B
-| LEFT {self_type a} (b : type) {S} : instruction self_type Datatypes.false (a :: S) (or a None b None :: S)
-| RIGHT (a : type) {self_type b S} : instruction self_type Datatypes.false (b :: S) (or a None b None :: S)
 | IF_LEFT {self_type a an b bn A B tffa tffb} :
     instruction self_type tffa (a :: A) B ->
     instruction self_type tffb (b :: A) B ->
     instruction self_type (tffa && tffb) (or a an b bn :: A) B
-| CONS {self_type a S} : instruction self_type Datatypes.false (a ::: list a ::: S) (list a :: S)
-| NIL (a : type) {self_type S} : instruction self_type Datatypes.false S (list a :: S)
 | IF_CONS {self_type a A B tffa tffb} :
     instruction self_type tffa (a ::: list a ::: A) B ->
     instruction self_type tffb A B ->
@@ -445,43 +480,15 @@ this constructor "IF" but we can make a notation for it. *)
     instruction self_type Datatypes.false
                 (option key_hash ::: mutez ::: g ::: S)
                 (operation ::: address ::: S)
-| TRANSFER_TOKENS {self_type p S} :
-    instruction self_type Datatypes.false (p ::: mutez ::: contract p ::: S) (operation ::: S)
-| SET_DELEGATE {self_type S} :
-    instruction self_type Datatypes.false (option key_hash ::: S) (operation ::: S)
-| BALANCE {self_type S} : instruction self_type Datatypes.false S (mutez ::: S)
-| ADDRESS {self_type p S} : instruction self_type Datatypes.false (contract p ::: S) (address ::: S)
-| CONTRACT {self_type S} (annot_opt : Datatypes.option annotation) p : instruction self_type Datatypes.false (address ::: S) (option (contract p) ::: S)
-(* Mistake in the doc: the return type must be an option *)
-| SOURCE {self_type S} : instruction self_type Datatypes.false S (address ::: S)
-| SENDER {self_type S} : instruction self_type Datatypes.false S (address ::: S)
 | SELF {self_type self_annot S} (annot_opt : annot_o) (H : isSome (get_entrypoint_opt annot_opt self_type self_annot)) :
     instruction (Some (self_type, self_annot)) Datatypes.false S (contract (get_opt _ H) :: S)
-(* p should be the current parameter type *)
-| AMOUNT {self_type S} : instruction self_type Datatypes.false S (mutez ::: S)
-| IMPLICIT_ACCOUNT {self_type S} : instruction self_type Datatypes.false (key_hash ::: S) (contract unit :: S)
-| NOW {self_type S} : instruction self_type Datatypes.false S (timestamp ::: S)
-| PACK {self_type a S} : instruction self_type Datatypes.false (a ::: S) (bytes ::: S)
-| UNPACK a {self_type S} : instruction self_type Datatypes.false (bytes ::: S) (option a ::: S)
-| HASH_KEY {self_type S} : instruction self_type Datatypes.false (key ::: S) (key_hash ::: S)
-| BLAKE2B {self_type S} : instruction self_type Datatypes.false (bytes ::: S) (bytes ::: S)
-| SHA256 {self_type S} : instruction self_type Datatypes.false (bytes ::: S) (bytes ::: S)
-| SHA512 {self_type S} : instruction self_type Datatypes.false (bytes ::: S) (bytes ::: S)
-| CHECK_SIGNATURE {self_type S} : instruction self_type Datatypes.false (key ::: signature ::: bytes ::: S) (bool ::: S)
-| DIG (n : Datatypes.nat) {self_type S1 S2 t} :
-    length S1 = n ->
-    instruction self_type Datatypes.false (S1 +++ (t ::: S2)) (t ::: S1 +++ S2)
-| DUG (n : Datatypes.nat) {self_type S1 S2 t} :
-    length S1 = n ->
-    instruction self_type Datatypes.false (t ::: S1 +++ S2) (S1 +++ (t ::: S2))
+| EXEC {self_type a b C} : instruction self_type Datatypes.false
+                                       (a ::: lambda a b ::: C) (b :: C)
 | DIP (n : Datatypes.nat) {self_type A B C} :
     length A = n ->
     instruction self_type Datatypes.false B C ->
     instruction self_type Datatypes.false (A +++ B) (A +++ C)
-| DROP (n : Datatypes.nat) {self_type A B} :
-    length A = n ->
-    instruction self_type Datatypes.false (A +++ B) B
-| CHAIN_ID {self_type S} : instruction self_type Datatypes.false S (chain_id ::: S)
+| Instruction_opcode {self_type A B} : opcode (self_type := self_type) A B -> instruction self_type Datatypes.false A B
 with
 concrete_data : type -> Set :=
 | Int_constant : Z -> concrete_data int
@@ -513,6 +520,9 @@ concrete_data : type -> Set :=
 | Chain_id_constant : chain_id_constant -> concrete_data chain_id.
 (* TODO: add the no-ops CAST and RENAME *)
 
+Coercion Instruction_opcode : opcode >-> instruction.
+
+
 Coercion int_constant := Int_constant.
 Coercion nat_constant := Nat_constant.
 Coercion string_constant := String_constant.
@@ -541,9 +551,6 @@ Notation "'IF'" := (IF_).
 
 Notation "A ;; B" := (SEQ A B) (at level 100, right associativity).
 
-(* For debugging purpose, a version of ;; with explicit stack type *)
-Notation "A ;;; S ;;;; B" := (@SEQ _ _ S _ A B) (at level 100, only parsing).
-
 Notation "n ~Mutez" := (exist _ (int64bv.of_Z n) eq_refl) (at level 100).
 
 Notation "n ~mutez" := (Mutez_constant (Mk_mutez (n ~Mutez))) (at level 100).
diff --git a/src/michocoq/typer.v b/src/michocoq/typer.v
index b351426c..903851a4 100644
--- a/src/michocoq/typer.v
+++ b/src/michocoq/typer.v
@@ -23,6 +23,14 @@ Qed.
     exact i.
   Defined.
 
+  Definition safe_opcode_cast {self_type} A A' B B' :
+    syntax.opcode (self_type := self_type) A B -> A = A' -> B = B' ->
+    syntax.opcode (self_type := self_type) A' B'.
+  Proof.
+    intros o [] [].
+    exact o.
+  Defined.
+
   Record cast_error :=
     Mk_cast_error
       {
@@ -41,12 +49,21 @@ Qed.
     | _, _ => Failed _ (Typing cast_error (Mk_cast_error A B A' B' tff _ i))
     end.
 
+  Definition opcode_cast {self_type} A A' B B' o : M (syntax.opcode A' B') :=
+    match stype_dec A A', stype_dec B B' with
+    | left HA, left HB => Return (safe_opcode_cast A A' B B' o HA HB)
+    | _, _ => Failed _ (Typing cast_error (Mk_cast_error A B A' B' Datatypes.false self_type (syntax.Instruction_opcode o)))
+    end.
+
   Definition instruction_cast_range {self_type tff} A B B' (i : instruction self_type tff A B)
     : M (instruction self_type tff A B') := instruction_cast A A B B' i.
 
   Definition instruction_cast_domain {self_type tff} A A' B (i : instruction self_type tff A B)
     : M (instruction self_type tff A' B) := instruction_cast A A' B B i.
 
+  Definition opcode_cast_domain self_type A A' B (o : @syntax.opcode self_type A B)
+    : M (@syntax.opcode self_type A' B) := opcode_cast A A' B B o.
+
   Inductive typer_result {self_type} A : Set :=
   | Inferred_type B : instruction self_type false A B -> typer_result A
   | Any_type : (forall B, instruction self_type true A B) -> typer_result A.
@@ -151,17 +168,17 @@ Qed.
         repeat decide equality.
   Qed.
 
-  Definition type_check_dig {self_type} n (S:syntax.stack_type) : M (typer_result (self_type := self_type) S) :=
+  Definition type_check_dig {self_type} n (S:syntax.stack_type) : M { B : syntax.stack_type & syntax.opcode S B} :=
     let! (exist _ S1 H1, tS2) := take_n S n in
     let! (t, S2) := take_one tS2 in
-    let! i := instruction_cast_domain (S1 +++ t ::: S2) S _ (syntax.DIG n H1) in
-    Return (Inferred_type S (t ::: S1 +++ S2) i).
+    let! o := opcode_cast_domain self_type (S1 +++ t ::: S2) S _ (syntax.DIG n H1) in
+    Return (existT _ (t ::: S1 +++ S2) o).
 
-  Definition type_check_dug {self_type} n (S:syntax.stack_type) : M (typer_result (self_type := self_type) S) :=
+  Definition type_check_dug {self_type} n (S:syntax.stack_type) : M { B : syntax.stack_type & syntax.opcode S B} :=
     let! (t, S12) := take_one S in
     let! (exist _ S1 H1, S2) := take_n S12 n in
-    let! i := instruction_cast_domain (t ::: S1 +++ S2) S _ (syntax.DUG n H1) in
-    Return (Inferred_type S (S1 +++ t ::: S2) i).
+    let! o := opcode_cast_domain self_type (t ::: S1 +++ S2) S _ (syntax.DUG n H1) in
+    Return (existT _ (S1 +++ t ::: S2) o).
 
   Fixpoint as_comparable (a : type) : M comparable_type :=
     match a with
@@ -182,6 +199,265 @@ Qed.
       reflexivity.
   Qed.
 
+  Definition type_opcode {self_type} (o : opcode) A : M { B : syntax.stack_type & @syntax.opcode self_type A B} :=
+    match o, A with
+    | APPLY, a :: lambda (pair a' b) c :: B =>
+      let A := a :: lambda (pair a' b) c :: B in
+      let A' := a :: lambda (pair a b) c :: B in
+      (if is_packable a as b return is_packable a = b -> _
+       then fun h =>
+        let o := @syntax.APPLY _ _ _ _ _ (IT_eq_rev _ h) in
+        let! o := opcode_cast_domain self_type A' A _ o in
+        Return (existT _ _ o)
+       else fun _ => Failed _ (Typing _ "APPLY"%string)) eq_refl
+    | DUP, a :: A =>
+      Return (existT _ _ syntax.DUP)
+    | SWAP, a :: b :: A =>
+      Return (existT _ _ syntax.SWAP)
+    | UNIT, A => Return (existT _ _ syntax.UNIT)
+    | EQ, Comparable_type int :: A =>
+      Return (existT _ _ syntax.EQ)
+    | NEQ, Comparable_type int :: A =>
+      Return (existT _ _ syntax.NEQ)
+    | LT, Comparable_type int :: A =>
+      Return (existT _ _ syntax.LT)
+    | GT, Comparable_type int :: A =>
+      Return (existT _ _ syntax.GT)
+    | LE, Comparable_type int :: A =>
+      Return (existT _ _ syntax.LE)
+    | GE, Comparable_type int :: A =>
+      Return (existT _ _ syntax.GE)
+    | OR, Comparable_type bool :: Comparable_type bool :: A =>
+      Return (existT _ _ (@syntax.OR _ _ syntax.bitwise_bool _))
+    | OR, Comparable_type nat :: Comparable_type nat :: A =>
+      Return (existT _ _ (@syntax.OR _ _ syntax.bitwise_nat _))
+    | AND, Comparable_type bool :: Comparable_type bool :: A =>
+      Return (existT _ _ (@syntax.AND _ _ syntax.bitwise_bool _))
+    | AND, Comparable_type nat :: Comparable_type nat :: A =>
+      Return (existT _ _ (@syntax.AND _ _ syntax.bitwise_nat _))
+    | XOR, Comparable_type bool :: Comparable_type bool :: A =>
+      Return (existT _ _ (@syntax.XOR _ _ syntax.bitwise_bool _))
+    | XOR, Comparable_type nat :: Comparable_type nat :: A =>
+      Return (existT _ _ (@syntax.XOR _ _ syntax.bitwise_nat _))
+    | NOT, Comparable_type bool :: A =>
+      Return (existT _ _ (@syntax.NOT _ _ syntax.not_bool _))
+    | NOT, Comparable_type nat :: A =>
+      Return (existT _ _ (@syntax.NOT _ _ syntax.not_nat _))
+    | NOT, Comparable_type int :: A =>
+      Return (existT _ _ (@syntax.NOT _ _ syntax.not_int _))
+    | NEG, Comparable_type nat :: A =>
+      Return (existT _ _ (@syntax.NEG _ _ syntax.neg_nat _))
+    | NEG, Comparable_type int :: A =>
+      Return (existT _ _ (@syntax.NEG _ _ syntax.neg_int _))
+    | ABS, Comparable_type int :: A =>
+      Return (existT _ _ syntax.ABS)
+    | INT, Comparable_type nat :: A =>
+      Return (existT _ _ syntax.INT)
+    | ISNAT, Comparable_type int :: A =>
+      Return (existT _ _ syntax.ISNAT)
+    | ADD, Comparable_type nat :: Comparable_type nat :: A =>
+      Return (existT _ _ (@syntax.ADD _ _ _ syntax.add_nat_nat _))
+    | ADD, Comparable_type nat :: Comparable_type int :: A =>
+      Return (existT _ _ (@syntax.ADD _ _ _ syntax.add_nat_int _))
+    | ADD, Comparable_type int :: Comparable_type nat :: A =>
+      Return (existT _ _ (@syntax.ADD _ _ _ syntax.add_int_nat _))
+    | ADD, Comparable_type int :: Comparable_type int :: A =>
+      Return (existT _ _ (@syntax.ADD _ _ _ syntax.add_int_int _))
+    | ADD, Comparable_type timestamp :: Comparable_type int :: A =>
+      Return (existT _ _ (@syntax.ADD _ _ _ syntax.add_timestamp_int _))
+    | ADD, Comparable_type int :: Comparable_type timestamp :: A =>
+      Return (existT _ _ (@syntax.ADD _ _ _ syntax.add_int_timestamp _))
+    | ADD, Comparable_type mutez :: Comparable_type mutez :: A =>
+      Return (existT _ _ (@syntax.ADD _ _ _ syntax.add_tez_tez _))
+    | SUB, Comparable_type nat :: Comparable_type nat :: A =>
+      Return (existT _ _ (@syntax.SUB _ _ _ syntax.sub_nat_nat _))
+    | SUB, Comparable_type nat :: Comparable_type int :: A =>
+      Return (existT _ _ (@syntax.SUB _ _ _ syntax.sub_nat_int _))
+    | SUB, Comparable_type int :: Comparable_type nat :: A =>
+      Return (existT _ _ (@syntax.SUB _ _ _ syntax.sub_int_nat _))
+    | SUB, Comparable_type int :: Comparable_type int :: A =>
+      Return (existT _ _ (@syntax.SUB _ _ _ syntax.sub_int_int _))
+    | SUB, Comparable_type timestamp :: Comparable_type int :: A =>
+      Return (existT _ _ (@syntax.SUB _ _ _ syntax.sub_timestamp_int _))
+    | SUB, Comparable_type timestamp :: Comparable_type timestamp :: A =>
+      Return (existT _ _ (@syntax.SUB _ _ _ syntax.sub_timestamp_timestamp _))
+    | SUB, Comparable_type mutez :: Comparable_type mutez :: A =>
+      Return (existT _ _ (@syntax.SUB _ _ _ syntax.sub_tez_tez _))
+    | MUL, Comparable_type nat :: Comparable_type nat :: A =>
+      Return (existT _ _ (@syntax.MUL _ _ _ syntax.mul_nat_nat _))
+    | MUL, Comparable_type nat :: Comparable_type int :: A =>
+      Return (existT _ _ (@syntax.MUL _ _ _ syntax.mul_nat_int _))
+    | MUL, Comparable_type int :: Comparable_type nat :: A =>
+      Return (existT _ _ (@syntax.MUL _ _ _ syntax.mul_int_nat _))
+    | MUL, Comparable_type int :: Comparable_type int :: A =>
+      Return (existT _ _ (@syntax.MUL _ _ _ syntax.mul_int_int _))
+    | MUL, Comparable_type mutez :: Comparable_type nat :: A =>
+      Return (existT _ _ (@syntax.MUL _ _ _ syntax.mul_tez_nat _))
+    | MUL, Comparable_type nat :: Comparable_type mutez :: A =>
+      Return (existT _ _ (@syntax.MUL _ _ _ syntax.mul_nat_tez _))
+    | EDIV, Comparable_type nat :: Comparable_type nat :: A =>
+      Return (existT _ _ (@syntax.EDIV _ _ _ syntax.ediv_nat_nat _))
+    | EDIV, Comparable_type nat :: Comparable_type int :: A =>
+      Return (existT _ _ (@syntax.EDIV _ _ _ syntax.ediv_nat_int _))
+    | EDIV, Comparable_type int :: Comparable_type nat :: A =>
+      Return (existT _ _ (@syntax.EDIV _ _ _ syntax.ediv_int_nat _))
+    | EDIV, Comparable_type int :: Comparable_type int :: A =>
+      Return (existT _ _ (@syntax.EDIV _ _ _ syntax.ediv_int_int _))
+    | EDIV, Comparable_type mutez :: Comparable_type nat :: A =>
+      Return (existT _ _ (@syntax.EDIV _ _ _ syntax.ediv_tez_nat _))
+    | EDIV, Comparable_type mutez :: Comparable_type mutez :: A =>
+      Return (existT _ _ (@syntax.EDIV _ _ _ syntax.ediv_tez_tez _))
+    | LSL, Comparable_type nat :: Comparable_type nat :: A =>
+      Return (existT _ _ syntax.LSL)
+    | LSR, Comparable_type nat :: Comparable_type nat :: A =>
+      Return (existT _ _ syntax.LSR)
+    | COMPARE, a :: a' :: B =>
+      let A := a ::: a' ::: B in
+      let! a : comparable_type := as_comparable a in
+      let! a' : comparable_type := as_comparable a' in
+      let A' := a ::: a ::: B in
+      let! o := opcode_cast_domain self_type A' A (int ::: B) (syntax.COMPARE (a := a)) in
+      Return (existT _ _ o)
+    | CONCAT, Comparable_type string :: Comparable_type string :: B =>
+      Return (existT _ _ (@syntax.CONCAT _ _ syntax.stringlike_string _))
+    | CONCAT, Comparable_type bytes :: Comparable_type bytes :: B =>
+      Return (existT _ _ (@syntax.CONCAT _ _ syntax.stringlike_bytes _))
+    | CONCAT, list (Comparable_type string) :: B =>
+      Return (existT _ _ (@syntax.CONCAT_list _ _ syntax.stringlike_string _))
+    | CONCAT, list (Comparable_type bytes) :: B =>
+      Return (existT _ _ (@syntax.CONCAT_list _ _ syntax.stringlike_bytes _))
+    | SIZE, set a :: A =>
+      Return (existT _ _ (@syntax.SIZE _ _ (syntax.size_set a) _))
+    | SIZE, cons (list a) A =>
+      Return (existT _ _ (@syntax.SIZE _ _ (syntax.size_list a) _))
+    | SIZE, cons (map a b) A =>
+      Return (existT _ _ (@syntax.SIZE _ _ (syntax.size_map a b) _))
+    | SIZE, Comparable_type string :: A =>
+      Return (existT _ _ (@syntax.SIZE _ _ syntax.size_string _))
+    | SIZE, Comparable_type bytes :: A =>
+      Return (existT _ _ (@syntax.SIZE _ _ syntax.size_bytes _))
+    | SLICE, Comparable_type nat :: Comparable_type nat :: Comparable_type string :: A =>
+      Return (existT _ _ (@syntax.SLICE _ _ syntax.stringlike_string _))
+    | SLICE, Comparable_type nat :: Comparable_type nat :: Comparable_type bytes :: A =>
+      Return (existT _ _ (@syntax.SLICE _ _ syntax.stringlike_bytes _))
+    | PAIR, a :: b :: A =>
+      Return (existT _ _ syntax.PAIR)
+    | CAR, pair a b :: A =>
+      Return (existT _ _ syntax.CAR)
+    | CDR, pair a b :: A =>
+      Return (existT _ _ syntax.CDR)
+    | EMPTY_SET c, A =>
+      Return (existT _ _ (syntax.EMPTY_SET c))
+    | MEM, elt' :: set elt :: B =>
+      let A := elt' :: set elt :: B in
+      let A' := elt ::: set elt :: B in
+      let! o := opcode_cast_domain
+        self_type A' A _ (@syntax.MEM _ _ _ (syntax.mem_set elt) _) in
+      Return (existT _ _ o)
+    | MEM, kty' :: map kty vty :: B =>
+      let A := kty' :: map kty vty :: B in
+      let A' := kty ::: map kty vty :: B in
+      let! o := opcode_cast_domain
+        self_type A' A _ (@syntax.MEM _ _ _ (syntax.mem_map kty vty) _) in
+      Return (existT _ _ o)
+    | MEM, kty' :: big_map kty vty :: B =>
+      let A := kty' :: big_map kty vty :: B in
+      let A' := kty ::: big_map kty vty :: B in
+      let! o := opcode_cast_domain
+        self_type A' A _ (@syntax.MEM _ _ _ (syntax.mem_bigmap kty vty) _) in
+      Return (existT _ _ o)
+    | UPDATE, elt' :: Comparable_type bool :: set elt :: B =>
+      let A := elt' ::: bool ::: set elt :: B in
+      let A' := elt ::: bool ::: set elt :: B in
+      let! o := opcode_cast_domain
+        self_type A' A _ (@syntax.UPDATE _ _ _ _ (syntax.update_set elt) _) in
+      Return (existT _ _ o)
+    | UPDATE, kty' :: option vty' :: map kty vty :: B =>
+      let A := kty' ::: option vty' ::: map kty vty :: B in
+      let A' := kty ::: option vty ::: map kty vty :: B in
+      let! o := opcode_cast_domain
+        self_type A' A _ (@syntax.UPDATE _ _ _ _ (syntax.update_map kty vty) _) in
+      Return (existT _ _ o)
+    | UPDATE, kty' :: option vty' :: big_map kty vty :: B =>
+      let A := kty' ::: option vty' ::: big_map kty vty :: B in
+      let A' := kty ::: option vty ::: big_map kty vty :: B in
+      let! o := opcode_cast_domain
+        self_type A' A _ (@syntax.UPDATE _ _ _ _ (syntax.update_bigmap kty vty) _) in
+      Return (existT _ _ o)
+    | EMPTY_MAP kty vty, A =>
+      Return (existT _ _ (syntax.EMPTY_MAP kty vty))
+    | EMPTY_BIG_MAP kty vty, A =>
+      Return (existT _ _ (syntax.EMPTY_BIG_MAP kty vty))
+    | GET, kty' :: map kty vty :: B =>
+      let A := kty' :: map kty vty :: B in
+      let A' := kty ::: map kty vty :: B in
+      let! o := opcode_cast_domain
+        self_type A' A _ (@syntax.GET _ _ _ (syntax.get_map kty vty) _) in
+      Return (existT _ _ o)
+    | GET, kty' :: big_map kty vty :: B =>
+      let A := kty' :: big_map kty vty :: B in
+      let A' := kty ::: big_map kty vty :: B in
+      let! o := opcode_cast_domain
+        self_type A' A _ (@syntax.GET _ _ _ (syntax.get_bigmap kty vty) _) in
+      Return (existT _ _ o)
+    | SOME, a :: A => Return (existT _ _ syntax.SOME)
+    | NONE a, A => Return (existT _ _ (syntax.NONE a))
+    | LEFT b, a :: A => Return (existT _ _ (syntax.LEFT b))
+    | RIGHT a, b :: A => Return (existT _ _ (syntax.RIGHT a))
+    | CONS, a' :: list a :: B =>
+      let A := a' :: list a :: B in
+      let A' := a :: list a :: B in
+      let! o := opcode_cast_domain self_type A' A _ (syntax.CONS) in
+      Return (existT _ _ o)
+    | NIL a, A => Return (existT _ _ (syntax.NIL a))
+    | TRANSFER_TOKENS, p1 :: Comparable_type mutez :: contract p2 :: B =>
+      let A := p1 ::: mutez ::: contract p2 ::: B in
+      let A' := p1 ::: mutez ::: contract p1 ::: B in
+      let! o := opcode_cast_domain self_type A' A _ syntax.TRANSFER_TOKENS in
+      Return (existT _ _ o)
+    | SET_DELEGATE, option (Comparable_type key_hash) :: A =>
+      Return (existT _ _ syntax.SET_DELEGATE)
+    | BALANCE, A =>
+      Return (existT _ _ syntax.BALANCE)
+    | ADDRESS, contract _ :: A =>
+      Return (existT _ _ syntax.ADDRESS)
+    | CONTRACT an ty, Comparable_type address :: A =>
+      Return (existT _ _ (syntax.CONTRACT an ty))
+    | SOURCE, A =>
+      Return (existT _ _ syntax.SOURCE)
+    | SENDER, A =>
+      Return (existT _ _ syntax.SENDER)
+    | AMOUNT, A =>
+      Return (existT _ _ syntax.AMOUNT)
+    | IMPLICIT_ACCOUNT, Comparable_type key_hash :: A =>
+      Return (existT _ _ syntax.IMPLICIT_ACCOUNT)
+    | NOW, A =>
+      Return (existT _ _ syntax.NOW)
+    | PACK, a :: A =>
+      Return (existT _ _ syntax.PACK)
+    | UNPACK ty, Comparable_type bytes :: A =>
+      Return (existT _ _ (syntax.UNPACK ty))
+    | HASH_KEY, key :: A =>
+      Return (existT _ _ syntax.HASH_KEY)
+    | BLAKE2B, Comparable_type bytes :: A =>
+      Return (existT _ _ syntax.BLAKE2B)
+    | SHA256, Comparable_type bytes :: A =>
+      Return (existT _ _ syntax.SHA256)
+    | SHA512, Comparable_type bytes :: A =>
+      Return (existT _ _ syntax.SHA512)
+    | CHECK_SIGNATURE, key :: signature :: Comparable_type bytes :: A =>
+      Return (existT _ _ syntax.CHECK_SIGNATURE)
+    | DIG n, A => type_check_dig n _
+    | DUG n, A => type_check_dug n _
+    | DROP n, S12 =>
+      let! (exist _ S1 H1, S2) := take_n S12 n in
+      let! o := opcode_cast_domain self_type (S1 +++ S2) S12 _ (syntax.DROP n H1) in
+      Return (existT _ _ o)
+    | CHAIN_ID, _ =>
+      Return (existT _ _ syntax.CHAIN_ID)
+    | _, _ => Failed _ (Typing _ (instruction_opcode o, A))
+    end.
+
   Fixpoint type_data (d : concrete_data) {struct d}
     : forall ty, M (syntax.concrete_data ty) :=
     match d with
@@ -369,195 +645,13 @@ Qed.
       let A' := a :: lambda a b :: B in
       let! i := instruction_cast_domain A' A _ syntax.EXEC in
       Return (Inferred_type _ _ i)
-    | APPLY, a :: lambda (pair a' b) c :: B =>
-      let A := a :: lambda (pair a' b) c :: B in
-      let A' := a :: lambda (pair a b) c :: B in
-      (if is_packable a as b return is_packable a = b -> _
-       then fun i =>
-        let! i := instruction_cast_domain A' A _ (@syntax.APPLY _ _ _ _ _ (IT_eq_rev _ i)) in
-        Return (Inferred_type _ _ i)
-       else fun _ => Failed _ (Typing _ "APPLY"%string)) eq_refl
-    | DUP, a :: A =>
-      Return (Inferred_type _ _ syntax.DUP)
-    | SWAP, a :: b :: A =>
-      Return (Inferred_type _ _ syntax.SWAP)
     | PUSH a v, A =>
       let! d := type_data v a in
       Return (Inferred_type _ _ (syntax.PUSH a d))
-    | UNIT, A => Return (Inferred_type _ _ syntax.UNIT)
     | LAMBDA a b i, A =>
       let! existT _ tff i :=
         type_check_instruction type_instruction i (a :: nil) (b :: nil) in
       Return (Inferred_type _ _ (syntax.LAMBDA a b i))
-    | EQ, Comparable_type int :: A =>
-      Return (Inferred_type _ _ syntax.EQ)
-    | NEQ, Comparable_type int :: A =>
-      Return (Inferred_type _ _ syntax.NEQ)
-    | LT, Comparable_type int :: A =>
-      Return (Inferred_type _ _ syntax.LT)
-    | GT, Comparable_type int :: A =>
-      Return (Inferred_type _ _ syntax.GT)
-    | LE, Comparable_type int :: A =>
-      Return (Inferred_type _ _ syntax.LE)
-    | GE, Comparable_type int :: A =>
-      Return (Inferred_type _ _ syntax.GE)
-    | OR, Comparable_type bool :: Comparable_type bool :: A =>
-      Return (Inferred_type _ _ (@syntax.OR _ _ syntax.bitwise_bool _))
-    | OR, Comparable_type nat :: Comparable_type nat :: A =>
-      Return (Inferred_type _ _ (@syntax.OR _ _ syntax.bitwise_nat _))
-    | AND, Comparable_type bool :: Comparable_type bool :: A =>
-      Return (Inferred_type _ _ (@syntax.AND _ _ syntax.bitwise_bool _))
-    | AND, Comparable_type nat :: Comparable_type nat :: A =>
-      Return (Inferred_type _ _ (@syntax.AND _ _ syntax.bitwise_nat _))
-    | XOR, Comparable_type bool :: Comparable_type bool :: A =>
-      Return (Inferred_type _ _ (@syntax.XOR _ _ syntax.bitwise_bool _))
-    | XOR, Comparable_type nat :: Comparable_type nat :: A =>
-      Return (Inferred_type _ _ (@syntax.XOR _ _ syntax.bitwise_nat _))
-    | NOT, Comparable_type bool :: A =>
-      Return (Inferred_type _ _ (@syntax.NOT _ _ syntax.not_bool _))
-    | NOT, Comparable_type nat :: A =>
-      Return (Inferred_type _ _ (@syntax.NOT _ _ syntax.not_nat _))
-    | NOT, Comparable_type int :: A =>
-      Return (Inferred_type _ _ (@syntax.NOT _ _ syntax.not_int _))
-    | NEG, Comparable_type nat :: A =>
-      Return (Inferred_type _ _ (@syntax.NEG _ _ syntax.neg_nat _))
-    | NEG, Comparable_type int :: A =>
-      Return (Inferred_type _ _ (@syntax.NEG _ _ syntax.neg_int _))
-    | ABS, Comparable_type int :: A =>
-      Return (Inferred_type _ _ syntax.ABS)
-    | INT, Comparable_type nat :: A =>
-      Return (Inferred_type _ _ syntax.INT)
-    | ISNAT, Comparable_type int :: A =>
-      Return (Inferred_type _ _ syntax.ISNAT)
-    | ADD, Comparable_type nat :: Comparable_type nat :: A =>
-      Return (Inferred_type _ _ (@syntax.ADD _ _ _ syntax.add_nat_nat _))
-    | ADD, Comparable_type nat :: Comparable_type int :: A =>
-      Return (Inferred_type _ _ (@syntax.ADD _ _ _ syntax.add_nat_int _))
-    | ADD, Comparable_type int :: Comparable_type nat :: A =>
-      Return (Inferred_type _ _ (@syntax.ADD _ _ _ syntax.add_int_nat _))
-    | ADD, Comparable_type int :: Comparable_type int :: A =>
-      Return (Inferred_type _ _ (@syntax.ADD _ _ _ syntax.add_int_int _))
-    | ADD, Comparable_type timestamp :: Comparable_type int :: A =>
-      Return (Inferred_type _ _ (@syntax.ADD _ _ _ syntax.add_timestamp_int _))
-    | ADD, Comparable_type int :: Comparable_type timestamp :: A =>
-      Return (Inferred_type _ _ (@syntax.ADD _ _ _ syntax.add_int_timestamp _))
-    | ADD, Comparable_type mutez :: Comparable_type mutez :: A =>
-      Return (Inferred_type _ _ (@syntax.ADD _ _ _ syntax.add_tez_tez _))
-    | SUB, Comparable_type nat :: Comparable_type nat :: A =>
-      Return (Inferred_type _ _ (@syntax.SUB _ _ _ syntax.sub_nat_nat _))
-    | SUB, Comparable_type nat :: Comparable_type int :: A =>
-      Return (Inferred_type _ _ (@syntax.SUB _ _ _ syntax.sub_nat_int _))
-    | SUB, Comparable_type int :: Comparable_type nat :: A =>
-      Return (Inferred_type _ _ (@syntax.SUB _ _ _ syntax.sub_int_nat _))
-    | SUB, Comparable_type int :: Comparable_type int :: A =>
-      Return (Inferred_type _ _ (@syntax.SUB _ _ _ syntax.sub_int_int _))
-    | SUB, Comparable_type timestamp :: Comparable_type int :: A =>
-      Return (Inferred_type _ _ (@syntax.SUB _ _ _ syntax.sub_timestamp_int _))
-    | SUB, Comparable_type timestamp :: Comparable_type timestamp :: A =>
-      Return (Inferred_type _ _ (@syntax.SUB _ _ _ syntax.sub_timestamp_timestamp _))
-    | SUB, Comparable_type mutez :: Comparable_type mutez :: A =>
-      Return (Inferred_type _ _ (@syntax.SUB _ _ _ syntax.sub_tez_tez _))
-    | MUL, Comparable_type nat :: Comparable_type nat :: A =>
-      Return (Inferred_type _ _ (@syntax.MUL _ _ _ syntax.mul_nat_nat _))
-    | MUL, Comparable_type nat :: Comparable_type int :: A =>
-      Return (Inferred_type _ _ (@syntax.MUL _ _ _ syntax.mul_nat_int _))
-    | MUL, Comparable_type int :: Comparable_type nat :: A =>
-      Return (Inferred_type _ _ (@syntax.MUL _ _ _ syntax.mul_int_nat _))
-    | MUL, Comparable_type int :: Comparable_type int :: A =>
-      Return (Inferred_type _ _ (@syntax.MUL _ _ _ syntax.mul_int_int _))
-    | MUL, Comparable_type mutez :: Comparable_type nat :: A =>
-      Return (Inferred_type _ _ (@syntax.MUL _ _ _ syntax.mul_tez_nat _))
-    | MUL, Comparable_type nat :: Comparable_type mutez :: A =>
-      Return (Inferred_type _ _ (@syntax.MUL _ _ _ syntax.mul_nat_tez _))
-    | EDIV, Comparable_type nat :: Comparable_type nat :: A =>
-      Return (Inferred_type _ _ (@syntax.EDIV _ _ _ syntax.ediv_nat_nat _))
-    | EDIV, Comparable_type nat :: Comparable_type int :: A =>
-      Return (Inferred_type _ _ (@syntax.EDIV _ _ _ syntax.ediv_nat_int _))
-    | EDIV, Comparable_type int :: Comparable_type nat :: A =>
-      Return (Inferred_type _ _ (@syntax.EDIV _ _ _ syntax.ediv_int_nat _))
-    | EDIV, Comparable_type int :: Comparable_type int :: A =>
-      Return (Inferred_type _ _ (@syntax.EDIV _ _ _ syntax.ediv_int_int _))
-    | EDIV, Comparable_type mutez :: Comparable_type nat :: A =>
-      Return (Inferred_type _ _ (@syntax.EDIV _ _ _ syntax.ediv_tez_nat _))
-    | EDIV, Comparable_type mutez :: Comparable_type mutez :: A =>
-      Return (Inferred_type _ _ (@syntax.EDIV _ _ _ syntax.ediv_tez_tez _))
-    | LSL, Comparable_type nat :: Comparable_type nat :: A =>
-      Return (Inferred_type _ _ syntax.LSL)
-    | LSR, Comparable_type nat :: Comparable_type nat :: A =>
-      Return (Inferred_type _ _ syntax.LSR)
-    | COMPARE, a :: a' :: B =>
-      let A := a ::: a' ::: B in
-      let! a : comparable_type := as_comparable a in
-      let! a' : comparable_type := as_comparable a' in
-      let A' := a ::: a ::: B in
-      let! i := instruction_cast_domain A' A (int ::: B) (syntax.COMPARE (a := a)) in
-      Return (Inferred_type _ _ i)
-    | CONCAT, Comparable_type string :: Comparable_type string :: B =>
-      Return (Inferred_type _ _ (@syntax.CONCAT _ _ syntax.stringlike_string _))
-    | CONCAT, Comparable_type bytes :: Comparable_type bytes :: B =>
-      Return (Inferred_type _ _ (@syntax.CONCAT _ _ syntax.stringlike_bytes _))
-    | CONCAT, list (Comparable_type string) :: B =>
-      Return (Inferred_type _ _ (@syntax.CONCAT_list _ _ syntax.stringlike_string _))
-    | CONCAT, list (Comparable_type bytes) :: B =>
-      Return (Inferred_type _ _ (@syntax.CONCAT_list _ _ syntax.stringlike_bytes _))
-    | SIZE, set a :: A =>
-      Return (Inferred_type _ _ (@syntax.SIZE _ _ (syntax.size_set a) _))
-    | SIZE, cons (list a) A =>
-      Return (Inferred_type _ _ (@syntax.SIZE _ _ (syntax.size_list a) _))
-    | SIZE, cons (map a b) A =>
-      Return (Inferred_type _ _ (@syntax.SIZE _ _ (syntax.size_map a b) _))
-    | SIZE, Comparable_type string :: A =>
-      Return (Inferred_type _ _ (@syntax.SIZE _ _ syntax.size_string _))
-    | SIZE, Comparable_type bytes :: A =>
-      Return (Inferred_type _ _ (@syntax.SIZE _ _ syntax.size_bytes _))
-    | SLICE, Comparable_type nat :: Comparable_type nat :: Comparable_type string :: A =>
-      Return (Inferred_type _ _ (@syntax.SLICE _ _ syntax.stringlike_string _))
-    | SLICE, Comparable_type nat :: Comparable_type nat :: Comparable_type bytes :: A =>
-      Return (Inferred_type _ _ (@syntax.SLICE _ _ syntax.stringlike_bytes _))
-    | PAIR, a :: b :: A =>
-      Return (Inferred_type _ _ syntax.PAIR)
-    | CAR, pair a b :: A =>
-      Return (Inferred_type _ _ syntax.CAR)
-    | CDR, pair a b :: A =>
-      Return (Inferred_type _ _ syntax.CDR)
-    | EMPTY_SET c, A =>
-      Return (Inferred_type _ _ (syntax.EMPTY_SET c))
-    | MEM, elt' :: set elt :: B =>
-      let A := elt' :: set elt :: B in
-      let A' := elt ::: set elt :: B in
-      let! i := instruction_cast_domain
-        A' A _ (@syntax.MEM _ _ _ (syntax.mem_set elt) _) in
-      Return (Inferred_type _ _ i)
-    | MEM, kty' :: map kty vty :: B =>
-      let A := kty' :: map kty vty :: B in
-      let A' := kty ::: map kty vty :: B in
-      let! i := instruction_cast_domain
-        A' A _ (@syntax.MEM _ _ _ (syntax.mem_map kty vty) _) in
-      Return (Inferred_type _ _ i)
-    | MEM, kty' :: big_map kty vty :: B =>
-      let A := kty' :: big_map kty vty :: B in
-      let A' := kty ::: big_map kty vty :: B in
-      let! i := instruction_cast_domain
-        A' A _ (@syntax.MEM _ _ _ (syntax.mem_bigmap kty vty) _) in
-      Return (Inferred_type _ _ i)
-    | UPDATE, elt' :: Comparable_type bool :: set elt :: B =>
-      let A := elt' ::: bool ::: set elt :: B in
-      let A' := elt ::: bool ::: set elt :: B in
-      let! i := instruction_cast_domain
-        A' A _ (@syntax.UPDATE _ _ _ _ (syntax.update_set elt) _) in
-      Return (Inferred_type _ _ i)
-    | UPDATE, kty' :: option vty' :: map kty vty :: B =>
-      let A := kty' ::: option vty' ::: map kty vty :: B in
-      let A' := kty ::: option vty ::: map kty vty :: B in
-      let! i := instruction_cast_domain
-        A' A _ (@syntax.UPDATE _ _ _ _ (syntax.update_map kty vty) _) in
-      Return (Inferred_type _ _ i)
-    | UPDATE, kty' :: option vty' :: big_map kty vty :: B =>
-      let A := kty' ::: option vty' ::: big_map kty vty :: B in
-      let A' := kty ::: option vty ::: big_map kty vty :: B in
-      let! i := instruction_cast_domain
-        A' A _ (@syntax.UPDATE _ _ _ _ (syntax.update_bigmap kty vty) _) in
-      Return (Inferred_type _ _ i)
     | ITER i, list a :: A =>
       let! i := type_check_instruction_no_tail_fail type_instruction i (a :: A) A in
       Return (Inferred_type _ _ (syntax.ITER (i := syntax.iter_list _) i))
@@ -567,22 +661,6 @@ Qed.
     | ITER i, map kty vty :: A =>
       let! i := type_check_instruction_no_tail_fail type_instruction i (pair kty vty :: A) A in
       Return (Inferred_type _ _ (syntax.ITER (i := syntax.iter_map _ _) i))
-    | EMPTY_MAP kty vty, A =>
-      Return (Inferred_type _ _ (syntax.EMPTY_MAP kty vty))
-    | EMPTY_BIG_MAP kty vty, A =>
-      Return (Inferred_type _ _ (syntax.EMPTY_BIG_MAP kty vty))
-    | GET, kty' :: map kty vty :: B =>
-      let A := kty' :: map kty vty :: B in
-      let A' := kty ::: map kty vty :: B in
-      let! i := instruction_cast_domain
-        A' A _ (@syntax.GET _ _ _ (syntax.get_map kty vty) _) in
-      Return (Inferred_type _ _ i)
-    | GET, kty' :: big_map kty vty :: B =>
-      let A := kty' :: big_map kty vty :: B in
-      let A' := kty ::: big_map kty vty :: B in
-      let! i := instruction_cast_domain
-        A' A _ (@syntax.GET _ _ _ (syntax.get_bigmap kty vty) _) in
-      Return (Inferred_type _ _ i)
     | MAP i, list a :: A =>
       let! r := type_instruction_no_tail_fail type_instruction i (a :: A) in
       match r with
@@ -599,16 +677,6 @@ Qed.
         Return (Inferred_type _ _ (syntax.MAP (i := syntax.map_map _ _ _) i))
       | _ => Failed _ (Typing _ tt)
       end
-    | SOME, a :: A => Return (Inferred_type _ _ syntax.SOME)
-    | NONE a, A => Return (Inferred_type _ _ (syntax.NONE a))
-    | LEFT b, a :: A => Return (Inferred_type _ _ (syntax.LEFT b))
-    | RIGHT a, b :: A => Return (Inferred_type _ _ (syntax.RIGHT a))
-    | CONS, a' :: list a :: B =>
-      let A := a' :: list a :: B in
-      let A' := a :: list a :: B in
-      let! i := instruction_cast_domain A' A _ (syntax.CONS) in
-      Return (Inferred_type _ _ i)
-    | NIL a, A => Return (Inferred_type _ _ (syntax.NIL a))
     | CREATE_CONTRACT g p an i,
       option (Comparable_type key_hash) :: Comparable_type mutez :: g2 :: B =>
       let A :=
@@ -619,23 +687,6 @@ Qed.
         type_check_instruction (self_type := (Some (p, an))) type_instruction i (pair p g :: nil) (pair (list operation) g :: nil) in
       let! i := instruction_cast_domain A' A _ (syntax.CREATE_CONTRACT g p an i) in
       Return (Inferred_type _ _ i)
-    | TRANSFER_TOKENS, p1 :: Comparable_type mutez :: contract p2 :: B =>
-      let A := p1 ::: mutez ::: contract p2 ::: B in
-      let A' := p1 ::: mutez ::: contract p1 ::: B in
-      let! i := instruction_cast_domain A' A _ syntax.TRANSFER_TOKENS in
-      Return (Inferred_type _ _ i)
-    | SET_DELEGATE, option (Comparable_type key_hash) :: A =>
-      Return (Inferred_type _ _ syntax.SET_DELEGATE)
-    | BALANCE, A =>
-      Return (Inferred_type _ _ syntax.BALANCE)
-    | ADDRESS, contract _ :: A =>
-      Return (Inferred_type _ _ syntax.ADDRESS)
-    | CONTRACT an ty, Comparable_type address :: A =>
-      Return (Inferred_type _ _ (syntax.CONTRACT an ty))
-    | SOURCE, A =>
-      Return (Inferred_type _ _ syntax.SOURCE)
-    | SENDER, A =>
-      Return (Inferred_type _ _ syntax.SENDER)
     | SELF an, A =>
       match self_type with
       | Some (sty, san) =>
@@ -644,38 +695,13 @@ Qed.
         Return (Inferred_type _ _ (syntax.SELF an H))
       | None => Failed _ (Typing _ "SELF is not allowed inside lambdas"%string)
       end
-    | AMOUNT, A =>
-      Return (Inferred_type _ _ syntax.AMOUNT)
-    | IMPLICIT_ACCOUNT, Comparable_type key_hash :: A =>
-      Return (Inferred_type _ _ syntax.IMPLICIT_ACCOUNT)
-    | NOW, A =>
-      Return (Inferred_type _ _ syntax.NOW)
-    | PACK, a :: A =>
-      Return (Inferred_type _ _ syntax.PACK)
-    | UNPACK ty, Comparable_type bytes :: A =>
-      Return (Inferred_type _ _ (syntax.UNPACK ty))
-    | HASH_KEY, key :: A =>
-      Return (Inferred_type _ _ syntax.HASH_KEY)
-    | BLAKE2B, Comparable_type bytes :: A =>
-      Return (Inferred_type _ _ syntax.BLAKE2B)
-    | SHA256, Comparable_type bytes :: A =>
-      Return (Inferred_type _ _ syntax.SHA256)
-    | SHA512, Comparable_type bytes :: A =>
-      Return (Inferred_type _ _ syntax.SHA512)
-    | CHECK_SIGNATURE, key :: signature :: Comparable_type bytes :: A =>
-      Return (Inferred_type _ _ syntax.CHECK_SIGNATURE)
-    | DIG n, A => type_check_dig n _
-    | DUG n, A => type_check_dug n _
     | DIP n i, S12 =>
       let! (exist _ S1 H1, S2) := take_n S12 n in
       let! existT _ B i := type_instruction_no_tail_fail type_instruction i S2 in
       let! i := instruction_cast_domain (S1 +++ S2) S12 _ (syntax.DIP n H1 i) in
       Return (Inferred_type S12 (S1 +++ B) i)
-    | DROP n, S12 =>
-      let! (exist _ S1 H1, S2) := take_n S12 n in
-      let! i := instruction_cast_domain (S1 +++ S2) S12 _ (syntax.DROP n H1) in
-      Return (Inferred_type S12 S2 i)
-    | CHAIN_ID, _ =>
-      Return (Inferred_type _ _ syntax.CHAIN_ID)
+    | instruction_opcode o, A =>
+      let! (existT _ B o) := type_opcode o A in
+      Return (Inferred_type A B (syntax.Instruction_opcode o))
     | _, _ => Failed _ (Typing _ (i, A))
     end.
diff --git a/src/michocoq/untyped_syntax.v b/src/michocoq/untyped_syntax.v
index d4673b07..47549912 100644
--- a/src/michocoq/untyped_syntax.v
+++ b/src/michocoq/untyped_syntax.v
@@ -2,6 +2,71 @@ Require syntax.
 Require Import ZArith String.
 Require Import syntax_type.
 
+Inductive opcode : Set :=
+| APPLY : opcode
+| DUP : opcode
+| SWAP : opcode
+| UNIT : opcode
+| EQ : opcode
+| NEQ : opcode
+| LT : opcode
+| GT : opcode
+| LE : opcode
+| GE : opcode
+| OR : opcode
+| AND : opcode
+| XOR : opcode
+| NOT : opcode
+| NEG : opcode
+| ABS : opcode
+| INT : opcode
+| ISNAT : opcode
+| ADD : opcode
+| SUB : opcode
+| MUL : opcode
+| EDIV : opcode
+| LSL : opcode
+| LSR : opcode
+| COMPARE : opcode
+| CONCAT : opcode
+| SIZE : opcode
+| SLICE : opcode
+| PAIR : opcode
+| CAR : opcode
+| CDR : opcode
+| EMPTY_SET : comparable_type -> opcode
+| MEM : opcode
+| UPDATE : opcode
+| EMPTY_MAP : comparable_type -> type -> opcode
+| EMPTY_BIG_MAP : comparable_type -> type -> opcode
+| GET : opcode
+| SOME : opcode
+| NONE : type -> opcode
+| LEFT : type -> opcode
+| RIGHT : type -> opcode
+| CONS : opcode
+| NIL : type -> opcode
+| TRANSFER_TOKENS : opcode
+| SET_DELEGATE : opcode
+| BALANCE : opcode
+| ADDRESS : opcode
+| CONTRACT : annot_o -> type -> opcode
+| SOURCE : opcode
+| SENDER : opcode
+| AMOUNT : opcode
+| IMPLICIT_ACCOUNT : opcode
+| NOW : opcode
+| PACK : opcode
+| UNPACK : type -> opcode
+| HASH_KEY : opcode
+| BLAKE2B : opcode
+| SHA256 : opcode
+| SHA512 : opcode
+| CHECK_SIGNATURE : opcode
+| DIG : Datatypes.nat -> opcode
+| DUG : Datatypes.nat -> opcode
+| DROP : Datatypes.nat -> opcode
+| CHAIN_ID : opcode.
 
 Inductive instruction : Set :=
 | NOOP : instruction
@@ -10,81 +75,18 @@ Inductive instruction : Set :=
 | IF_ : instruction -> instruction -> instruction
 | LOOP : instruction -> instruction
 | LOOP_LEFT : instruction -> instruction
-| EXEC : instruction
-| APPLY : instruction
-| DUP : instruction
-| SWAP : instruction
 | PUSH : type -> concrete_data -> instruction
-| UNIT : instruction
 | LAMBDA : type -> type -> instruction -> instruction
-| EQ : instruction
-| NEQ : instruction
-| LT : instruction
-| GT : instruction
-| LE : instruction
-| GE : instruction
-| OR : instruction
-| AND : instruction
-| XOR : instruction
-| NOT : instruction
-| NEG : instruction
-| ABS : instruction
-| INT : instruction
-| ISNAT : instruction
-| ADD : instruction
-| SUB : instruction
-| MUL : instruction
-| EDIV : instruction
-| LSL : instruction
-| LSR : instruction
-| COMPARE : instruction
-| CONCAT : instruction
-| SIZE : instruction
-| SLICE : instruction
-| PAIR : instruction
-| CAR : instruction
-| CDR : instruction
-| EMPTY_SET : comparable_type -> instruction
-| MEM : instruction
-| UPDATE : instruction
 | ITER : instruction -> instruction
-| EMPTY_MAP : comparable_type -> type -> instruction
-| EMPTY_BIG_MAP : comparable_type -> type -> instruction
-| GET : instruction
 | MAP : instruction -> instruction
-| SOME : instruction
-| NONE : type -> instruction
 | IF_NONE : instruction -> instruction -> instruction
-| LEFT : type -> instruction
-| RIGHT : type -> instruction
 | IF_LEFT : instruction -> instruction -> instruction
-| CONS : instruction
-| NIL : type -> instruction
 | IF_CONS : instruction -> instruction -> instruction
 | CREATE_CONTRACT : type -> type -> annot_o -> instruction -> instruction
-| TRANSFER_TOKENS : instruction
-| SET_DELEGATE : instruction
-| BALANCE : instruction
-| ADDRESS : instruction
-| CONTRACT : annot_o -> type -> instruction
-| SOURCE : instruction
-| SENDER : instruction
-| SELF : annot_o -> instruction
-| AMOUNT : instruction
-| IMPLICIT_ACCOUNT : instruction
-| NOW : instruction
-| PACK : instruction
-| UNPACK : type -> instruction
-| HASH_KEY : instruction
-| BLAKE2B : instruction
-| SHA256 : instruction
-| SHA512 : instruction
-| CHECK_SIGNATURE : instruction
-| DIG : Datatypes.nat -> instruction
-| DUG : Datatypes.nat -> instruction
 | DIP : Datatypes.nat -> instruction -> instruction
-| DROP : Datatypes.nat -> instruction
-| CHAIN_ID : instruction
+| SELF : annot_o -> instruction
+| EXEC : instruction
+| instruction_opcode : opcode -> instruction
 with
 concrete_data : Set :=
 | Int_constant : Z -> concrete_data
@@ -102,6 +104,8 @@ concrete_data : Set :=
 | Concrete_seq : Datatypes.list concrete_data -> concrete_data
 | Instruction : instruction -> concrete_data.
 
+Coercion instruction_opcode : opcode >-> instruction.
+
 (* Some macros *)
 Definition UNPAIR : instruction :=
   SEQ DUP (SEQ CAR (DIP 1 CDR)).
diff --git a/src/michocoq/untyper.v b/src/michocoq/untyper.v
index 7c4017f4..d5c7f5cb 100644
--- a/src/michocoq/untyper.v
+++ b/src/michocoq/untyper.v
@@ -8,53 +8,13 @@ Import error.Notations.
 (* Not really needed but eases reading of proof states. *)
 Require Import String.
 
-  Fixpoint untype_data {a} (d : syntax.concrete_data a) : concrete_data :=
-    match d with
-    | syntax.Int_constant z => Int_constant z
-    | syntax.Nat_constant n => Int_constant (Z.of_N n)
-    | syntax.String_constant s => String_constant s
-    | syntax.Mutez_constant (Mk_mutez m) => Int_constant (tez.to_Z m)
-    | syntax.Bytes_constant s => Bytes_constant s
-    | syntax.Timestamp_constant t => Int_constant t
-    | syntax.Signature_constant s => String_constant s
-    | syntax.Key_constant s => String_constant s
-    | syntax.Key_hash_constant s => String_constant s
-    | syntax.Address_constant (Mk_address c) => String_constant c
-    | syntax.Unit => Unit
-    | syntax.True_ => True_
-    | syntax.False_ => False_
-    | syntax.Pair x y => Pair (untype_data x) (untype_data y)
-    | syntax.Left x _ _ => Left (untype_data x)
-    | syntax.Right y _ _ => Right (untype_data y)
-    | syntax.Some_ x => Some_ (untype_data x)
-    | syntax.None_ => None_
-    | syntax.Concrete_list l => Concrete_seq (List.map (fun x => untype_data x) l)
-    | syntax.Concrete_set l => Concrete_seq (List.map (fun x => untype_data x) l)
-    | syntax.Concrete_map l =>
-      Concrete_seq (List.map
-                      (fun '(syntax.Elt _ _ x y) => Elt (untype_data x) (untype_data y))
-                      l)
-    | syntax.Instruction _ i => Instruction (untype_instruction i)
-    | syntax.Chain_id_constant (Mk_chain_id c) => String_constant c
-    end
-  with
-  untype_instruction {self_type tff0 A B} (i : syntax.instruction self_type tff0 A B) : instruction :=
-    match i with
-    | syntax.NOOP => NOOP
-    | syntax.FAILWITH => FAILWITH
-    | syntax.SEQ i1 i2 => SEQ (untype_instruction i1) (untype_instruction i2)
-    | syntax.IF_ i1 i2 => IF_ (untype_instruction i1) (untype_instruction i2)
-    | syntax.LOOP i => LOOP (untype_instruction i)
-    | syntax.LOOP_LEFT i => LOOP_LEFT (untype_instruction i)
-    | syntax.DIP n _ i => DIP n (untype_instruction i)
-    | syntax.EXEC => EXEC
+  Definition untype_opcode {self_type A B} (o : @syntax.opcode self_type A B) : opcode :=
+    match o with
     | syntax.APPLY => APPLY
     | syntax.DROP n _ => DROP n
     | syntax.DUP => DUP
     | syntax.SWAP => SWAP
-    | syntax.PUSH a x => PUSH a (untype_data x)
     | syntax.UNIT => UNIT
-    | syntax.LAMBDA a b i => LAMBDA a b (untype_instruction i)
     | syntax.EQ => EQ
     | syntax.NEQ => NEQ
     | syntax.LT => LT
@@ -86,21 +46,15 @@ Require Import String.
     | syntax.EMPTY_SET a => EMPTY_SET a
     | syntax.MEM => MEM
     | syntax.UPDATE => UPDATE
-    | syntax.ITER i => ITER (untype_instruction i)
     | syntax.EMPTY_MAP kty vty => EMPTY_MAP kty vty
     | syntax.EMPTY_BIG_MAP kty vty => EMPTY_BIG_MAP kty vty
     | syntax.GET => GET
-    | syntax.MAP i => MAP (untype_instruction i)
     | syntax.SOME => SOME
     | syntax.NONE a => NONE a
-    | syntax.IF_NONE i1 i2 => IF_NONE (untype_instruction i1) (untype_instruction i2)
     | syntax.LEFT b => LEFT b
     | syntax.RIGHT a => RIGHT a
-    | syntax.IF_LEFT i1 i2 => IF_LEFT (untype_instruction i1) (untype_instruction i2)
     | syntax.CONS => CONS
     | syntax.NIL a => NIL a
-    | syntax.IF_CONS i1 i2 => IF_CONS (untype_instruction i1) (untype_instruction i2)
-    | syntax.CREATE_CONTRACT g p an i => CREATE_CONTRACT g p an (untype_instruction i)
     | syntax.TRANSFER_TOKENS => TRANSFER_TOKENS
     | syntax.SET_DELEGATE => SET_DELEGATE
     | syntax.BALANCE => BALANCE
@@ -108,7 +62,6 @@ Require Import String.
     | syntax.CONTRACT an a => CONTRACT an a
     | syntax.SOURCE => SOURCE
     | syntax.SENDER => SENDER
-    | syntax.SELF an _ => SELF an
     | syntax.AMOUNT => AMOUNT
     | syntax.IMPLICIT_ACCOUNT => IMPLICIT_ACCOUNT
     | syntax.NOW => NOW
@@ -124,6 +77,58 @@ Require Import String.
     | syntax.CHAIN_ID => CHAIN_ID
     end.
 
+  Fixpoint untype_data {a} (d : syntax.concrete_data a) : concrete_data :=
+    match d with
+    | syntax.Int_constant z => Int_constant z
+    | syntax.Nat_constant n => Int_constant (Z.of_N n)
+    | syntax.String_constant s => String_constant s
+    | syntax.Mutez_constant (Mk_mutez m) => Int_constant (tez.to_Z m)
+    | syntax.Bytes_constant s => Bytes_constant s
+    | syntax.Timestamp_constant t => Int_constant t
+    | syntax.Signature_constant s => String_constant s
+    | syntax.Key_constant s => String_constant s
+    | syntax.Key_hash_constant s => String_constant s
+    | syntax.Address_constant (Mk_address c) => String_constant c
+    | syntax.Unit => Unit
+    | syntax.True_ => True_
+    | syntax.False_ => False_
+    | syntax.Pair x y => Pair (untype_data x) (untype_data y)
+    | syntax.Left x _ _ => Left (untype_data x)
+    | syntax.Right y _ _ => Right (untype_data y)
+    | syntax.Some_ x => Some_ (untype_data x)
+    | syntax.None_ => None_
+    | syntax.Concrete_list l => Concrete_seq (List.map (fun x => untype_data x) l)
+    | syntax.Concrete_set l => Concrete_seq (List.map (fun x => untype_data x) l)
+    | syntax.Concrete_map l =>
+      Concrete_seq (List.map
+                      (fun '(syntax.Elt _ _ x y) => Elt (untype_data x) (untype_data y))
+                      l)
+    | syntax.Instruction _ i => Instruction (untype_instruction i)
+    | syntax.Chain_id_constant (Mk_chain_id c) => String_constant c
+    end
+  with
+  untype_instruction {self_type tff0 A B} (i : syntax.instruction self_type tff0 A B) : instruction :=
+    match i with
+    | syntax.NOOP => NOOP
+    | syntax.FAILWITH => FAILWITH
+    | syntax.SEQ i1 i2 => SEQ (untype_instruction i1) (untype_instruction i2)
+    | syntax.IF_ i1 i2 => IF_ (untype_instruction i1) (untype_instruction i2)
+    | syntax.LOOP i => LOOP (untype_instruction i)
+    | syntax.LOOP_LEFT i => LOOP_LEFT (untype_instruction i)
+    | syntax.DIP n _ i => DIP n (untype_instruction i)
+    | syntax.EXEC => EXEC
+    | syntax.PUSH a x => PUSH a (untype_data x)
+    | syntax.LAMBDA a b i => LAMBDA a b (untype_instruction i)
+    | syntax.ITER i => ITER (untype_instruction i)
+    | syntax.MAP i => MAP (untype_instruction i)
+    | syntax.IF_NONE i1 i2 => IF_NONE (untype_instruction i1) (untype_instruction i2)
+    | syntax.IF_LEFT i1 i2 => IF_LEFT (untype_instruction i1) (untype_instruction i2)
+    | syntax.IF_CONS i1 i2 => IF_CONS (untype_instruction i1) (untype_instruction i2)
+    | syntax.CREATE_CONTRACT g p an i => CREATE_CONTRACT g p an (untype_instruction i)
+    | syntax.SELF an _ => SELF an
+    | syntax.Instruction_opcode o => instruction_opcode (untype_opcode o)
+    end.
+
   Lemma stype_dec_same A : stype_dec A A = left eq_refl.
   Proof.
     destruct (stype_dec A A) as [e | n].
@@ -323,6 +328,16 @@ Require Import String.
     reflexivity.
   Qed.
 
+  Lemma opcode_cast_same {self_type} A B
+        (o : syntax.opcode (self_type := self_type) A B) :
+    typer.opcode_cast A A B B o = Return o.
+  Proof.
+    unfold typer.opcode_cast.
+    rewrite stype_dec_same.
+    rewrite stype_dec_same.
+    reflexivity.
+  Qed.
+
   Lemma instruction_cast_range_same {self_type} tffi A B (i : syntax.instruction self_type tffi A B) :
     typer.instruction_cast_range A B B i = Return i.
   Proof.
@@ -335,6 +350,12 @@ Require Import String.
     apply instruction_cast_same.
   Qed.
 
+  Lemma opcode_cast_domain_same self_type A B (o : @syntax.opcode self_type A B) :
+    typer.opcode_cast_domain self_type A A B o = Return o.
+  Proof.
+    apply opcode_cast_same.
+  Qed.
+
   Lemma untype_type_check_instruction {self_type} tffi A B (i : syntax.instruction self_type tffi A B) :
     untype_type_spec _ _ _ i ->
     typer.type_check_instruction typer.type_instruction (untype_instruction i) A B =
@@ -441,6 +462,61 @@ Require Import String.
         specialize (IHl1 l1' l2 l2' (eq_add_S _ _ Hlen) Happ2) as [Hl1 Hl2]. subst. auto.
   Qed.
 
+  Lemma untype_type_opcode self_type A B (o : @syntax.opcode self_type A B) :
+    typer.type_opcode (untype_opcode o) A = Return (existT _ B o).
+  Proof.
+    destruct o; simpl; try reflexivity;
+      try (destruct s as [v]; destruct v; reflexivity);
+      try (destruct s as [c v]; destruct v; reflexivity);
+      try (destruct i as [v]; destruct v; reflexivity);
+      try (destruct i as [v]; destruct v; rewrite opcode_cast_domain_same; reflexivity);
+      try (rewrite opcode_cast_domain_same; reflexivity).
+    - pose (A := a :: lambda (pair a b) c :: D).
+      assert (forall (b : Datatypes.bool) i1,
+                 (if b return is_packable a = b -> _
+                  then fun h =>
+                         let! o := opcode_cast_domain self_type A A _ (@syntax.APPLY _ _ _ _ _ (IT_eq_rev _ h)) in
+                         Return (existT _ _ o)
+                  else fun _ => Failed _ (Typing _ "APPLY"%string)) i1
+                 = Return (existT _ _ (@syntax.APPLY _ _ _ _ _ i))).
+      * intros b0 i1.
+          destruct b0.
+          -- rewrite opcode_cast_domain_same.
+             simpl.
+             repeat f_equal.
+             apply Is_true_UIP.
+          -- exfalso.
+             rewrite i1 in i.
+             exact i.
+        * apply H.
+    - destruct s as [c d v]; destruct v; reflexivity.
+    - simpl.
+      rewrite as_comparable_comparable.
+        destruct a; simpl.
+        * rewrite opcode_cast_domain_same.
+          reflexivity.
+        * rewrite opcode_cast_domain_same.
+          simpl.
+          reflexivity.
+    - destruct i as [x v]; destruct v; rewrite opcode_cast_domain_same; reflexivity.
+    - unfold type_check_dig.
+      simpl.
+      rewrite (take_n_length n S1 (t ::: S2) e).
+      simpl.
+      rewrite opcode_cast_domain_same.
+      reflexivity.
+    - unfold type_check_dug.
+      simpl.
+      rewrite (take_n_length n S1 S2 e).
+      simpl.
+      rewrite opcode_cast_domain_same.
+      reflexivity.
+    - rewrite (take_n_length n A B e).
+      simpl.
+      rewrite opcode_cast_domain_same.
+      reflexivity.
+  Qed.
+
   Fixpoint untype_type_data a (d : syntax.concrete_data a) :
     typer.type_data (untype_data d) a = Return d
   with
@@ -606,30 +682,6 @@ Require Import String.
           Return (@typer.Inferred_type self_type _ _ (syntax.LOOP_LEFT i))
         ).
         rewrite untype_type_check_instruction_no_tail_fail; auto.
-      + unfold untype_type_spec.
-        simpl.
-        rewrite instruction_cast_domain_same.
-        reflexivity.
-      + unfold untype_type_spec.
-        simpl.
-        pose (A := a :: lambda (pair a b) c :: D).
-        assert (forall (b : Datatypes.bool) i1,
-                   (if b return is_packable a = b -> _
-                    then fun i =>
-                      let! i := instruction_cast_domain A A _ (@syntax.APPLY self_type _ _ _ _ (IT_eq_rev _ i)) in
-                      Return (Inferred_type _ _ i)
-                    else fun _ => Failed _ (Typing _ "APPLY"%string)) i1
-                   = Return (Inferred_type A _ (@syntax.APPLY _ _ _ _ _ i))).
-        * intros b0 i1.
-          destruct b0.
-          -- rewrite instruction_cast_domain_same.
-             simpl.
-             repeat f_equal.
-             apply Is_true_UIP.
-          -- exfalso.
-             rewrite i1 in i.
-             exact i.
-        * apply H.
       + trans_refl (
           let! d := typer.type_data (untype_data x) a in
           Return (@typer.Inferred_type self_type A _ (syntax.PUSH a d))
@@ -643,48 +695,6 @@ Require Import String.
           Return (@typer.Inferred_type self_type _ (lambda a b ::: A) (syntax.LAMBDA a b i))
         ).
         rewrite untype_type_check_instruction; auto.
-      + destruct s as [v]; destruct v; reflexivity.
-      + destruct s as [v]; destruct v; reflexivity.
-      + destruct s as [v]; destruct v; reflexivity.
-      + destruct s as [a v]; destruct v; reflexivity.
-      + destruct s as [v]; destruct v; reflexivity.
-      + destruct s as [c v]; destruct v; reflexivity.
-      + destruct s as [c v]; destruct v; reflexivity.
-      + destruct s as [c v]; destruct v; reflexivity.
-      + destruct s as [c d v]; destruct v; reflexivity.
-      + unfold untype_type_spec.
-        simpl.
-        rewrite as_comparable_comparable.
-        destruct a; simpl.
-        * rewrite instruction_cast_domain_same.
-          reflexivity.
-        * rewrite instruction_cast_domain_same.
-          simpl.
-          reflexivity.
-      + destruct i as [v]; destruct v; reflexivity.
-      + destruct i as [v]; destruct v; reflexivity.
-      + destruct i as [v]; destruct v; reflexivity.
-      + destruct i as [v]; destruct v; reflexivity.
-      + destruct i as [v]; destruct v.
-        * unfold untype_type_spec; simpl.
-          rewrite instruction_cast_domain_same.
-          reflexivity.
-        * unfold untype_type_spec; simpl.
-          rewrite instruction_cast_domain_same.
-          reflexivity.
-        * unfold untype_type_spec; simpl.
-          rewrite instruction_cast_domain_same.
-          reflexivity.
-      + destruct i as [v]; destruct v.
-        * unfold untype_type_spec; simpl.
-          rewrite instruction_cast_domain_same.
-          reflexivity.
-        * unfold untype_type_spec; simpl.
-          rewrite instruction_cast_domain_same.
-          reflexivity.
-        * unfold untype_type_spec; simpl.
-          rewrite instruction_cast_domain_same.
-          reflexivity.
       + destruct i as [c v]; destruct v.
         * unfold untype_type_spec; simpl.
           rewrite untype_type_check_instruction_no_tail_fail; auto.
@@ -692,13 +702,6 @@ Require Import String.
           rewrite untype_type_check_instruction_no_tail_fail; auto.
         * unfold untype_type_spec; simpl.
           rewrite untype_type_check_instruction_no_tail_fail; auto.
-      + destruct i as [c v]; destruct v.
-        * unfold untype_type_spec; simpl.
-          rewrite instruction_cast_domain_same.
-          reflexivity.
-        * unfold untype_type_spec; simpl.
-          rewrite instruction_cast_domain_same.
-          reflexivity.
       + destruct i as [a c v]; destruct v.
         * unfold untype_type_spec; simpl.
           rewrite untype_type_instruction_no_tail_fail.
@@ -726,9 +729,6 @@ Require Import String.
              (untype_instruction i2) _ _ _
              (IF_instruction_to_instruction _ _ _ (IF_LEFT_i a b an bn A))).
         rewrite untype_type_branches; auto.
-      + unfold untype_type_spec; simpl.
-        rewrite instruction_cast_domain_same.
-        reflexivity.
       + trans_refl
           (@typer.type_branches self_type
              typer.type_instruction
@@ -742,9 +742,6 @@ Require Import String.
            rewrite instruction_cast_domain_same.
            reflexivity.
         -- auto.
-      + unfold untype_type_spec; simpl.
-        rewrite instruction_cast_domain_same.
-        reflexivity.
       + unfold untype_type_spec; simpl.
         assert (isSome_maybe (Typing string "No such self entrypoint"%string)
                              (get_entrypoint_opt annot_opt self_type self_annot) = Return H).
@@ -755,18 +752,7 @@ Require Import String.
           -- inversion H.
         * rewrite H0.
           reflexivity.
-      + unfold untype_type_spec.
-        simpl. unfold type_check_dig.
-        simpl.
-        rewrite (take_n_length n S1 (t ::: S2) e).
-        simpl.
-        rewrite instruction_cast_domain_same.
-        reflexivity.
-      + unfold untype_type_spec.
-        simpl. unfold type_check_dug.
-        simpl.
-        rewrite (take_n_length n S1 S2 e).
-        simpl.
+      + unfold untype_type_spec; simpl.
         rewrite instruction_cast_domain_same.
         reflexivity.
       + unfold untype_type_spec.
@@ -780,8 +766,6 @@ Require Import String.
         * apply untype_type_instruction.
       + unfold untype_type_spec.
         simpl.
-        rewrite (take_n_length n A B e).
-        simpl.
-        rewrite instruction_cast_domain_same.
+        rewrite untype_type_opcode.
         reflexivity.
   Qed.
-- 
GitLab


From 980a8201abb675c9719066578c9c4eb3d9b9799f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Fri, 29 Nov 2019 15:27:04 +0100
Subject: [PATCH 21/56] [michocoq] Also separate IF_ and LOOP_ instructions
 from the other ones

---
 src/contracts_coq/boomerang.v        |   3 +-
 src/contracts_coq/deposit.v          |  19 +--
 src/contracts_coq/generic_multisig.v |   7 +-
 src/contracts_coq/manager.v          |   2 +
 src/contracts_coq/multisig.v         |   5 +-
 src/contracts_coq/vote.v             |   1 +
 src/michocoq/macros.v                |   6 +-
 src/michocoq/micheline2michelson.v   |  16 +-
 src/michocoq/michelson2micheline.v   |  28 ++--
 src/michocoq/semantics.v             | 121 ++++++--------
 src/michocoq/syntax.v                |  47 +++---
 src/michocoq/typer.v                 |  86 ++++++----
 src/michocoq/untyped_syntax.v        |  19 ++-
 src/michocoq/untyper.v               | 230 ++++++---------------------
 src/michocoq/util.v                  |  10 ++
 15 files changed, 239 insertions(+), 361 deletions(-)

diff --git a/src/contracts_coq/boomerang.v b/src/contracts_coq/boomerang.v
index 753e054c..59e5340b 100644
--- a/src/contracts_coq/boomerang.v
+++ b/src/contracts_coq/boomerang.v
@@ -91,6 +91,7 @@ Proof.
   rewrite eval_precond_correct.
   unfold ">=" in Hfuel.
   repeat (more_fuel ; simpl).
+  rewrite match_if_exchange.
   rewrite destruct_if.
   apply or_both; apply and_both_0.
   - rewrite (eqb_eq mutez).
@@ -101,7 +102,7 @@ Proof.
     intuition.
   - pose (c := contract_ env None unit (source env)).
     pose (transfer := transfer_tokens env unit tt (amount env)).
-    change (match c with Some b => ((transfer b :: nil)%list, tt, tt) = (ops, tt, tt) | None => False end <-> (exists ctr, c = Some ctr /\ ops = (transfer ctr :: nil)%list)).
+    fold c.
     destruct c.
     + split.
       * intro H.
diff --git a/src/contracts_coq/deposit.v b/src/contracts_coq/deposit.v
index a32cbcfb..5b4ff514 100644
--- a/src/contracts_coq/deposit.v
+++ b/src/contracts_coq/deposit.v
@@ -37,15 +37,15 @@ Module deposit(C:ContractContext).
 Module semantics := Semantics C. Import semantics.
 
 Definition deposit : full_contract _ parameter_ty None storage_ty :=
-  ( DUP;; CAR;; DIP1 CDR;;
+  ( Instruction_opcode DUP;; Instruction_opcode CAR;; DIP1 (Instruction_opcode CDR);;
     IF_LEFT
-      ( DROP1;; NIL operation )
-      ( DIP1 ( DUP;;
-               DUP;; SENDER;; COMPARE;; EQ;; IF NOOP FAILWITH;;
-               CONTRACT None unit;; IF_NONE FAILWITH NOOP);;
-        PUSH unit Unit;; TRANSFER_TOKENS;;
-        NIL operation;; SWAP;; CONS);;
-    PAIR ).
+      ( DROP1;; Instruction_opcode (NIL operation) )
+      ( DIP1 ( Instruction_opcode DUP;;
+               Instruction_opcode DUP;; Instruction_opcode SENDER;; Instruction_opcode COMPARE;; Instruction_opcode EQ;; IF NOOP FAILWITH;;
+               Instruction_opcode (CONTRACT None unit);; IF_NONE FAILWITH NOOP);;
+        PUSH unit Unit;; Instruction_opcode TRANSFER_TOKENS;;
+        Instruction_opcode (NIL operation);; Instruction_opcode SWAP;; Instruction_opcode CONS);;
+    Instruction_opcode PAIR ).
 
 Lemma deposit_correct :
   forall (env : @proto_env (Some (parameter_ty, None)))
@@ -74,11 +74,12 @@ Proof.
   - do 2 (more_fuel ; simpl).
     intuition congruence.
   - do 11 (more_fuel ; simpl).
+    rewrite match_if_exchange.
     rewrite if_false_is_and.
     rewrite (eqb_eq address).
     remember (contract_ env None unit storage_in) as d.
     match goal with
-      |- (_ /\ match ?x with | Some b => _ | None => _ end <-> _) =>
+      |- context [match ?x with | Some x => _ | None => _ end] =>
       remember x as d2
     end.
     assert (d = d2) as Hdd2 by (subst; reflexivity).
diff --git a/src/contracts_coq/generic_multisig.v b/src/contracts_coq/generic_multisig.v
index 25b2a35f..5573f9b4 100644
--- a/src/contracts_coq/generic_multisig.v
+++ b/src/contracts_coq/generic_multisig.v
@@ -263,11 +263,13 @@ Proof.
   intros params storage fuel Hfuel.
   unfold multisig_head.
   unfold "+", params, storage, multisig_head_spec.
-  do 11 (more_fuel; simpl); repeat fold_eval_precond.
+  do 11 (more_fuel; simpl).
+  rewrite match_if_exchange.
   rewrite if_false_is_and.
   rewrite (eqb_eq mutez).
   apply and_both.
   repeat simpl.
+  rewrite match_if_exchange.
   rewrite if_false_is_and.
   rewrite (eqb_eq nat).
   rewrite (eq_sym_iff counter stored_counter).
@@ -319,7 +321,8 @@ Proof.
   simpl.
   destruct sigs as [|[sig|] sigs].
   - reflexivity.
-  - rewrite if_false_is_and.
+  - rewrite match_if_exchange.
+    rewrite if_false_is_and.
     apply and_both.
     reflexivity.
   - reflexivity.
diff --git a/src/contracts_coq/manager.v b/src/contracts_coq/manager.v
index 3426e8ed..a632edbc 100644
--- a/src/contracts_coq/manager.v
+++ b/src/contracts_coq/manager.v
@@ -154,10 +154,12 @@ Proof.
   destruct param as [(tff, lam)|[]].
   - do 5 (more_fuel; simpl).
     simpl.
+    rewrite match_if_exchange.
     rewrite if_false_is_and.
     rewrite (eqb_eq mutez).
     apply and_both.
     do 5 (more_fuel; simpl).
+    rewrite match_if_exchange.
     rewrite if_false_is_and.
     rewrite (eqb_eq address).
     apply and_both.
diff --git a/src/contracts_coq/multisig.v b/src/contracts_coq/multisig.v
index 624d4911..ad31b670 100644
--- a/src/contracts_coq/multisig.v
+++ b/src/contracts_coq/multisig.v
@@ -249,6 +249,7 @@ Proof.
   unfold "+", params, storage, multisig_head_spec.
   rewrite eval_precond_correct.
   repeat (more_fuel; simpl).
+  rewrite match_if_exchange.
   rewrite if_false_is_and.
   rewrite (eqb_eq nat).
   intuition.
@@ -297,7 +298,8 @@ Proof.
   simpl.
   destruct sigs as [|[sig|] sigs].
   - reflexivity.
-  - rewrite if_false_is_and.
+  - rewrite match_if_exchange.
+    rewrite if_false_is_and.
     apply and_both.
     reflexivity.
   - reflexivity.
@@ -475,6 +477,7 @@ Proof.
   unfold multisig_tail.
   do 6 more_fuel.
   simpl.
+  rewrite match_if_exchange.
   rewrite if_false_is_and.
   rewrite (leb_le nat).
   unfold lt, lt_comp, compare, simple_compare.
diff --git a/src/contracts_coq/vote.v b/src/contracts_coq/vote.v
index 5fc4549d..86fa3277 100644
--- a/src/contracts_coq/vote.v
+++ b/src/contracts_coq/vote.v
@@ -94,6 +94,7 @@ Proof.
   rewrite return_precond.
   rewrite eval_precond_correct.
   do 15 (more_fuel; simpl).
+  rewrite match_if_exchange.
   rewrite if_false_not.
   apply and_both_0.
   - change (tez.compare (5000000 ~Mutez) (amount env)) with
diff --git a/src/michocoq/macros.v b/src/michocoq/macros.v
index 30db2544..67f505cd 100644
--- a/src/michocoq/macros.v
+++ b/src/michocoq/macros.v
@@ -38,7 +38,7 @@ Definition CMPGE {a S} := CMPop a S GE.
 Definition IFop SA SB tffa tffb
            (bt : instruction self_type tffa SA SB) (bf : instruction self_type tffb SA SB)
            (op : instruction self_type Datatypes.false (int ::: SA) (bool ::: SA)) :=
-  op ;; IF_ bt bf.
+  op ;; IF bt bf.
 
 Definition IFEQ {SA SB tffa tffb} bt bf := IFop SA SB tffa tffb bt bf EQ.
 Definition IFNEQ {SA SB tffa tffb} bt bf := IFop SA SB tffa tffb bt bf NEQ.
@@ -51,7 +51,7 @@ Definition IFCMPop (a : comparable_type) SA SB tffa tffb
            (bt : instruction self_type tffa SA SB) (bf : instruction self_type tffb SA SB)
            (op : instruction self_type Datatypes.false (int ::: SA) (bool ::: SA)) :
   instruction self_type (tffa && tffb) (a ::: a ::: SA) SB :=
-  COMPARE ;; op ;; IF_ bt bf.
+  COMPARE ;; op ;; IF bt bf.
 
 Definition IFCMPEQ {a SA SB tffa tffb} bt bf := IFCMPop a SA SB tffa tffb bt bf EQ.
 Definition IFCMPNEQ {a SA SB tffa tffb} bt bf := IFCMPop a SA SB tffa tffb bt bf NEQ.
@@ -62,7 +62,7 @@ Definition IFCMPGE {a SA SB tffa tffb} bt bf := IFCMPop a SA SB tffa tffb bt bf
 
 Definition FAIL {SA SB} : instruction self_type Datatypes.true SA SB := UNIT ;; FAILWITH.
 
-Definition ASSERT {S} : instruction self_type Datatypes.false (bool ::: S) S := IF_ NOOP FAIL.
+Definition ASSERT {S} : instruction self_type Datatypes.false (bool ::: S) S := (IF_ IF_bool) NOOP FAIL.
 
 Definition ASSERT_op S (op : instruction self_type Datatypes.false (int ::: S) (bool ::: S)) : instruction self_type Datatypes.false (int ::: S) S :=
   IFop _ _ _ _ NOOP FAIL op.
diff --git a/src/michocoq/micheline2michelson.v b/src/michocoq/micheline2michelson.v
index 4eb1cb84..6ad3357c 100644
--- a/src/michocoq/micheline2michelson.v
+++ b/src/michocoq/micheline2michelson.v
@@ -131,13 +131,13 @@ Definition op_of_string (s : String.string) b e :=
   end.
 
 Definition FAIL := UNIT ;; FAILWITH.
-Definition ASSERT := IF_ NOOP FAIL.
+Definition ASSERT := (IF_ IF_bool) NOOP FAIL.
 
 Definition IF_op_of_string (s : String.string) b e bt bf :=
   match s with
   | String "I" (String "F" s) =>
     let! op := op_of_string s b e in
-    Return (op ;; IF_ bt bf)
+    Return (op ;; IF_ IF_bool bt bf)
   | _ => Failed _ (Expansion b e)
   end.
 
@@ -145,7 +145,7 @@ Definition ASSERT_op_of_string (s : String.string) b e :=
   match s with
   | String "A" (String "S" (String "S" (String "E" (String "R" (String "T" (String "_" s)))))) =>
     let! op := op_of_string s b e in
-    Return (op ;; IF_ NOOP FAIL)
+    Return (op ;; ASSERT)
   | _ => Failed _ (Expansion b e)
   end.
 
@@ -516,7 +516,7 @@ Fixpoint micheline2michelson_instruction (m : loc_micheline) : M instruction :=
   | Mk_loc_micheline (_, PRIM (_, "IF") (i1 :: i2 :: nil)) =>
     let! i1 := micheline2michelson_instruction i1 in
     let! i2 := micheline2michelson_instruction i2 in
-    Return (IF_ i1 i2)
+    Return (IF_ IF_bool i1 i2)
   | Mk_loc_micheline (_, PRIM (_, "IF_NONE") (i1 :: i2 :: nil)) =>
     let! i1 := micheline2michelson_instruction i1 in
     let! i2 := micheline2michelson_instruction i2 in
@@ -578,24 +578,24 @@ Fixpoint micheline2michelson_instruction (m : loc_micheline) : M instruction :=
     let! i1 := micheline2michelson_instruction i1 in
     let! i2 := micheline2michelson_instruction i2 in
     let! op := op_of_string s b e in
-    Return (COMPARE ;; op ;; IF_ i1 i2)
+    Return (COMPARE ;; op ;; IF_ IF_bool i1 i2)
   | Mk_loc_micheline ((b, e), PRIM (_,
        String "I" (String "F" s)) (i1 :: i2 :: nil)) =>
     let! i1 := micheline2michelson_instruction i1 in
     let! i2 := micheline2michelson_instruction i2 in
     let! op := op_of_string s b e in
-    Return (op ;; IF_ i1 i2)
+    Return (op ;; IF_ IF_bool i1 i2)
   | Mk_loc_micheline ((b, e), PRIM (_,
       String "A" (String "S" (String "S" (String "E" (String "R" (String "T"
       (String "_" (String "C" (String "M" (String "P" s)))))))))) nil) =>
     let! op := op_of_string s b e in
-    Return (COMPARE;; op ;; IF_ NOOP FAIL)
+    Return (COMPARE;; op ;; IF_ IF_bool NOOP FAIL)
 
   | Mk_loc_micheline ((b, e), PRIM (_,
       String "A" (String "S" (String "S" (String "E" (String "R" (String "T"
       (String "_" s))))))) nil) =>
     let! op := op_of_string s b e in
-    Return (op ;; IF_ NOOP FAIL)
+    Return (op ;; IF_ IF_bool NOOP FAIL)
 
   | Mk_loc_micheline ((b, e), PRIM (_, "CR") nil) =>
     Failed _ (Expansion_prim b e "CR")
diff --git a/src/michocoq/michelson2micheline.v b/src/michocoq/michelson2micheline.v
index 3c407c20..4c2465b3 100644
--- a/src/michocoq/michelson2micheline.v
+++ b/src/michocoq/michelson2micheline.v
@@ -187,22 +187,18 @@ Fixpoint michelson2micheline_ins (i : instruction) : loc_micheline :=
                                              michelson2micheline_atype
                                                michelson2micheline_type t2 an;
                                              michelson2micheline_ins i]
-  | IF_ i1 i2 =>
-    dummy_prim "IF" [dummy_seq (michelson2micheline_ins i1);
-                       dummy_seq (michelson2micheline_ins i2)]
-  | IF_NONE i1 i2 =>
-    dummy_prim "IF_NONE" [dummy_seq (michelson2micheline_ins i1);
-                            dummy_seq (michelson2micheline_ins i2)]
-  | IF_LEFT i1 i2 =>
-    dummy_prim "IF_LEFT" [dummy_seq (michelson2micheline_ins i1);
-                            dummy_seq (michelson2micheline_ins i2)]
-  | IF_CONS i1 i2 =>
-    dummy_prim "IF_CONS" [dummy_seq (michelson2micheline_ins i1);
-                            dummy_seq (michelson2micheline_ins i2)]
-  | LOOP i =>
-    dummy_prim "LOOP" [dummy_seq (michelson2micheline_ins i)]
-  | LOOP_LEFT i =>
-    dummy_prim "LOOP_LEFT" [dummy_seq (michelson2micheline_ins i)]
+  | IF_ f i1 i2 =>
+    let s := match f with
+             | IF_bool => "IF"
+             | IF_or => "IF_LEFT"
+             | IF_option => "IF_NONE"
+             | IF_list => "IF_CONS"
+             end in
+    dummy_prim s [dummy_seq (michelson2micheline_ins i1);
+                    dummy_seq (michelson2micheline_ins i2)]
+  | LOOP_ f i =>
+    let s := match f with LOOP_bool => "LOOP" | LOOP_or => "LOOP_LEFT" end in
+    dummy_prim s [dummy_seq (michelson2micheline_ins i)]
   | ITER i =>
     dummy_prim "ITER" [dummy_seq (michelson2micheline_ins i)]
   | MAP i =>
diff --git a/src/michocoq/semantics.v b/src/michocoq/semantics.v
index 20b8fab9..ec909b60 100644
--- a/src/michocoq/semantics.v
+++ b/src/michocoq/semantics.v
@@ -653,6 +653,26 @@ Module Semantics(C : ContractContext).
       | CHAIN_ID, SA => Return (chain_id_ env, SA)
     end.
 
+  Definition if_family_destruct {A B t} (i : if_family A B t) (x : data t) : stack A + stack B :=
+    match i, x with
+    | IF_bool, true => inl tt
+    | IF_bool, false => inr tt
+    | IF_or _ _ _ _, inl x => inl (x, tt)
+    | IF_or _ _ _ _, inr x => inr (x, tt)
+    | IF_option a, None => inl tt
+    | IF_option a, Some x => inr (x, tt)
+    | IF_list a, cons x l => inl (x, (l, tt))
+    | IF_list a, nil => inr tt
+    end.
+
+  Definition loop_family_destruct {A B t} (i : loop_family A B t) (x : data t) : stack A + stack B :=
+    match i, x with
+    | LOOP_bool, true => inl tt
+    | LOOP_bool, false => inr tt
+    | LOOP_or _ _ _ _, inl x => inl (x, tt)
+    | LOOP_or _ _ _ _, inr x => inr (x, tt)
+    end.
+
   Fixpoint eval {param_ty : self_info} {tff0} (env : @proto_env param_ty) {A : stack_type} {B : stack_type}
            (i : instruction param_ty tff0 A B) (fuel : Datatypes.nat) (SA : stack A) {struct fuel} : M (stack B) :=
     match fuel with
@@ -671,14 +691,15 @@ Module Semantics(C : ContractContext).
       | SEQ B C, SA, env =>
         let! r := eval env B n SA in
         eval env C n r
-      | IF_ bt bf, (b, SA), env =>
-        if b then eval env bt n SA else eval env bf n SA
-      | LOOP body, (b, SA), env =>
-        if b then eval env (body;; (LOOP body)) n SA else Return SA
-      | LOOP_LEFT body, (ab, SA), env =>
-        match ab with
-        | inl x => eval env (body;; LOOP_LEFT body) n (x, SA)
-        | inr y => Return (y, SA)
+      | IF_ f bt bf, (x, SA), env =>
+        match if_family_destruct f x with
+        | inl SB => eval env bt n (stack_app SB SA)
+        | inr SB => eval env bf n (stack_app SB SA)
+        end
+      | LOOP_ f body, (ab, SA), env =>
+        match loop_family_destruct f ab with
+        | inl SB => eval env (body;; LOOP_ f body) n (stack_app SB SA)
+        | inr SB => Return (stack_app SB SA)
         end
       | PUSH a x, SA, _ => Return (concrete_data_to_data _ x, SA)
       | LAMBDA a b code, SA, _ => Return (existT _ _ code, SA)
@@ -701,21 +722,6 @@ Module Semantics(C : ContractContext).
           let! (c, SC) := eval env (MAP body) n (y, SB) in
           Return (map_insert _ _ _ _ v a b c, SC)
         end
-      | IF_NONE bt bf, (b, SA), env =>
-        match b with
-        | None => eval env bt n SA
-        | Some b => eval env bf n (b, SA)
-        end
-      | IF_LEFT bt bf, (b, SA), env =>
-        match b with
-        | inl a => eval env bt n (a, SA)
-        | inr b => eval env bf n (b, SA)
-        end
-      | IF_CONS bt bf, (l, SA), env =>
-        match l with
-        | cons a b => eval env bt n (a, (b, SA))
-        | nil => eval env bf n SA
-        end
       | CREATE_CONTRACT g p an f, (a, (b, (c, SA))), env =>
         let (oper, addr) := create_contract env g p an _ a b f c in
         Return (oper, (addr, SA))
@@ -754,11 +760,11 @@ Module Semantics(C : ContractContext).
              assumption.
           -- apply success_eq_return in H1.
              exact H1.
-        * destruct st as ([], st); rewrite IHfuel1; try assumption; reflexivity.
-        * destruct st as ([], st).
-          -- rewrite IHfuel1; try assumption; reflexivity.
-          -- reflexivity.
-        * destruct st as ([x|y], st).
+        * simpl in Hsucc.
+          destruct st as (x, st); destruct (if_family_destruct _ x) as [SB|SB];
+            rewrite IHfuel1; try assumption; reflexivity.
+        * simpl in Hsucc.
+          destruct st as (x, st); destruct (loop_family_destruct _ x) as [SB|SB].
           -- rewrite IHfuel1; try assumption; reflexivity.
           -- reflexivity.
         * destruct st as (x, SA).
@@ -801,21 +807,6 @@ Module Semantics(C : ContractContext).
              ++ apply success_bind_arg in Hsucc.
                 assumption.
           -- reflexivity.
-        * destruct st as ([|], SA); rewrite IHfuel1.
-          -- reflexivity.
-          -- exact Hsucc.
-          -- reflexivity.
-          -- exact Hsucc.
-        * destruct st as ([|], SA); rewrite IHfuel1.
-          -- reflexivity.
-          -- exact Hsucc.
-          -- reflexivity.
-          -- exact Hsucc.
-        * destruct st as ([|], SA); rewrite IHfuel1.
-          -- reflexivity.
-          -- exact Hsucc.
-          -- reflexivity.
-          -- exact Hsucc.
         * destruct st as (x, ((tff, f), SA)).
           f_equal.
           rewrite IHfuel1.
@@ -944,16 +935,15 @@ Module Semantics(C : ContractContext).
     | NOOP, env, psi, st => psi st
     | SEQ B C, env, psi, st =>
       eval_precond_n env B (eval_precond_n env C psi) st
-    | IF_ bt bf, env, psi, (b, SA) =>
-      if b then eval_precond_n env bt psi SA
-      else eval_precond_n env bf psi SA
-    | LOOP body, env, psi, (b, SA) =>
-      if b then eval_precond_n env (body;; (LOOP body)) psi SA
-      else psi SA
-    | LOOP_LEFT body, env, psi, (ab, SA) =>
-      match ab with
-      | inl x => eval_precond_n env (body;; LOOP_LEFT body) psi (x, SA)
-      | inr y => psi (y, SA)
+    | IF_ f bt bf, env, psi, (x, SA) =>
+      match (if_family_destruct f x) with
+      | inl SB => eval_precond_n env bt psi (stack_app SB SA)
+      | inr SB => eval_precond_n env bf psi (stack_app SB SA)
+      end
+    | LOOP_ f body, env, psi, (x, SA) =>
+      match (loop_family_destruct f x) with
+      | inl SB => eval_precond_n env (body;; LOOP_ f body) psi (stack_app SB SA)
+      | inr SB => psi (stack_app SB SA)
       end
     | EXEC, env, psi, (x, (existT _ _ f, SA)) =>
       eval_precond_n (no_self env) f (fun '(y, tt) => psi (y, SA)) (x, tt)
@@ -982,21 +972,6 @@ Module Semantics(C : ContractContext).
                (y, SB))
           (a, SA)
       end
-    | IF_NONE bt bf, env, psi, (b, SA) =>
-      match b with
-      | None => eval_precond_n env bt psi SA
-      | Some b => eval_precond_n env bf psi (b, SA)
-      end
-    | IF_LEFT bt bf, env, psi, (b, SA) =>
-      match b with
-      | inl a => eval_precond_n env bt psi (a, SA)
-      | inr b => eval_precond_n env bf psi (b, SA)
-      end
-    | IF_CONS bt bf, env, psi, (l, SA) =>
-      match l with
-      | cons a b => eval_precond_n env bt psi (a, (b, SA))
-      | nil => eval_precond_n env bf psi SA
-      end
     | CREATE_CONTRACT g p an f, env, psi, (a, (b, (c, SA))) =>
       let (oper, addr) := create_contract env g p an _ a b f c in
       psi (oper, (addr, SA))
@@ -1045,13 +1020,10 @@ Module Semantics(C : ContractContext).
       apply precond_eqv.
       intro SB.
       apply IHn.
-    - destruct st as ([|], st); auto.
-    - destruct st as ([|], st).
+    - destruct st as (x, st); destruct (if_family_destruct _ x); auto.
+    - destruct st as (x, st); destruct (loop_family_destruct _ x).
       + apply IHn.
       + simpl. reflexivity.
-    - destruct st as ([|], st); simpl.
-      + apply (IHn _ _ _ _ _ (i;; LOOP_LEFT i)).
-      + reflexivity.
     - reflexivity.
     - reflexivity.
     - destruct st as (x, st).
@@ -1077,9 +1049,6 @@ Module Semantics(C : ContractContext).
         intros (c, B).
         reflexivity.
       + reflexivity.
-    - destruct st as ([|], st); apply IHn.
-    - destruct st as ([|], st); apply IHn.
-    - destruct st as ([|], st); apply IHn.
     - destruct st as (a, (b, (c, SA))).
       destruct (create_contract env g p an _ a b i c).
       reflexivity.
diff --git a/src/michocoq/syntax.v b/src/michocoq/syntax.v
index 85593b2a..79610b1b 100644
--- a/src/michocoq/syntax.v
+++ b/src/michocoq/syntax.v
@@ -439,21 +439,28 @@ Inductive opcode {self_type : self_info} : forall (A B : Datatypes.list type), S
     opcode (A +++ B) B
 | CHAIN_ID {S} : opcode S (chain_id ::: S).
 
+Inductive if_family : forall (A B : Datatypes.list type) (a : type), Set :=
+| IF_bool : if_family nil nil bool
+| IF_or a an b bn : if_family (a :: nil) (b :: nil) (or a an b bn)
+| IF_option a : if_family nil (a :: nil) (option a)
+| IF_list a : if_family (a ::: list a ::: nil) nil (list a).
+
+Inductive loop_family : forall (A B : Datatypes.list type) (a : type), Set :=
+| LOOP_bool : loop_family nil nil bool
+| LOOP_or a an b bn : loop_family (a :: nil) (b :: nil) (or a an b bn).
+
 Inductive instruction :
   forall (self_i : self_info) (tail_fail_flag : Datatypes.bool) (A B : Datatypes.list type), Set :=
 | NOOP {self_type A} : instruction self_type Datatypes.false A A    (* Undocumented *)
 | FAILWITH {self_type A B a} : instruction self_type Datatypes.true (a ::: A) B
 | SEQ {self_type A B C tff} : instruction self_type Datatypes.false A B -> instruction self_type tff B C -> instruction self_type tff A C
-(* The instruction self_type SEQ I C is written "{self_type  I ; C }" in Michelson *)
-| IF_ {self_type A B tffa tffb} :
-    instruction self_type tffa A B -> instruction self_type tffb A B ->
-    instruction self_type (tffa && tffb) (bool ::: A) B
-(* "IF" is a reserved keyword in file Coq.Init.Logic because it is
-part of the notation "'IF' c1 'then' c2 'else' c3" so we cannot call
-this constructor "IF" but we can make a notation for it. *)
-| LOOP {self_type A} : instruction self_type Datatypes.false A (bool ::: A) -> instruction self_type Datatypes.false (bool ::: A) A
-| LOOP_LEFT {self_type a b an bn A} : instruction self_type Datatypes.false (a :: A) (or a an b bn :: A) ->
-                      instruction self_type Datatypes.false (or a an b bn :: A) (b :: A)
+(* The instruction self_type SEQ I C is written "{ I ; C }" in Michelson *)
+| IF_ {self_type A B tffa tffb C1 C2 t} (i : if_family C1 C2 t) :
+    instruction self_type tffa (C1 ++ A) B -> instruction self_type tffb (C2 ++ A) B ->
+    instruction self_type (tffa && tffb) (t ::: A) B
+| LOOP_ {self_type C1 C2 t A} (i : loop_family C1 C2 t) :
+    instruction self_type Datatypes.false (C1 ++ A) (t :: A) ->
+    instruction self_type Datatypes.false (t :: A) (C2 ++ A)
 | PUSH (a : type) (x : concrete_data a) {self_type A} : instruction self_type Datatypes.false A (a :: A)
 | LAMBDA (a b : type) {self_type A tff} :
     instruction None tff (a :: nil) (b :: nil) ->
@@ -463,18 +470,6 @@ this constructor "IF" but we can make a notation for it. *)
 | MAP {self_type collection b} {i : map_struct collection b} {A} :
     instruction self_type Datatypes.false (map_in_type _ _ i :: A) (b :: A) ->
     instruction self_type Datatypes.false (collection :: A) (map_out_collection_type _ _ i :: A)
-(* Not the one documented, see https://gitlab.com/tezos/tezos/issues/471 *)
-| IF_NONE {self_type a A B tffa tffb} :
-    instruction self_type tffa A B -> instruction self_type tffb (a :: A) B ->
-    instruction self_type (tffa && tffb) (option a :: A) B
-| IF_LEFT {self_type a an b bn A B tffa tffb} :
-    instruction self_type tffa (a :: A) B ->
-    instruction self_type tffb (b :: A) B ->
-    instruction self_type (tffa && tffb) (or a an b bn :: A) B
-| IF_CONS {self_type a A B tffa tffb} :
-    instruction self_type tffa (a ::: list a ::: A) B ->
-    instruction self_type tffb A B ->
-    instruction self_type (tffa && tffb) (list a :: A) B
 | CREATE_CONTRACT {self_type S tff} (g p : type) (an : annot_o) :
     instruction (Some (p, an)) tff (pair p g :: nil) (pair (list operation) g :: nil) ->
     instruction self_type Datatypes.false
@@ -518,7 +513,6 @@ concrete_data : type -> Set :=
 | Instruction {a b} tff : instruction (None) tff (a ::: nil) (b ::: nil) ->
                           concrete_data (lambda a b)
 | Chain_id_constant : chain_id_constant -> concrete_data chain_id.
-(* TODO: add the no-ops CAST and RENAME *)
 
 Coercion Instruction_opcode : opcode >-> instruction.
 
@@ -547,7 +541,12 @@ Record contract_file : Set :=
           contract_file_storage;
     }.
 
-Notation "'IF'" := (IF_).
+Notation "'IF'" := (IF_ IF_bool).
+Notation "'IF_LEFT'" := (IF_ (IF_or _ _ _ _)).
+Notation "'IF_NONE'" := (IF_ (IF_option _)).
+Notation "'IF_CONS'" := (IF_ (IF_list _)).
+Notation "'LOOP'" := (LOOP_ LOOP_bool).
+Notation "'LOOP_LEFT'" := (LOOP_ (LOOP_or _ _)).
 
 Notation "A ;; B" := (SEQ A B) (at level 100, right associativity).
 
diff --git a/src/michocoq/typer.v b/src/michocoq/typer.v
index 903851a4..e9ead4f2 100644
--- a/src/michocoq/typer.v
+++ b/src/michocoq/typer.v
@@ -52,7 +52,10 @@ Qed.
   Definition opcode_cast {self_type} A A' B B' o : M (syntax.opcode A' B') :=
     match stype_dec A A', stype_dec B B' with
     | left HA, left HB => Return (safe_opcode_cast A A' B B' o HA HB)
-    | _, _ => Failed _ (Typing cast_error (Mk_cast_error A B A' B' Datatypes.false self_type (syntax.Instruction_opcode o)))
+    | _, _ =>
+      Failed _ (Typing cast_error
+                       (Mk_cast_error A B A' B' Datatypes.false self_type
+                                      (syntax.Instruction_opcode o)))
     end.
 
   Definition instruction_cast_range {self_type tff} A B B' (i : instruction self_type tff A B)
@@ -107,33 +110,58 @@ Qed.
     let! r := type_instruction i A in
     assert_not_tail_fail A r.
 
-  Definition type_branches {self_type}
+  Definition type_if_family (f : if_family) (t : type) :
+    M {A & {B & syntax.if_family A B t}} :=
+    match f, t with
+    | IF_bool, Comparable_type bool => Return (existT _ _ (existT _ _ syntax.IF_bool))
+    | IF_option, option a => Return (existT _ _ (existT _ _ (syntax.IF_option a)))
+    | IF_or, or a an b bn => Return (existT _ _ (existT _ _ (syntax.IF_or a an b bn)))
+    | IF_list, list a => Return (existT _ _ (existT _ _ (syntax.IF_list a)))
+    | _, _ => Failed _ (Typing _ "type_family"%string)
+    end.
+
+  Definition type_branches {self_type} (f : if_family) (t : type)
              (type_instruction :
                 forall (i : untyped_syntax.instruction) A,
                   M (typer_result A))
-             i1 i2 A1 A2 A
-             (IF_instr : forall B tffa tffb,
-                 instruction self_type tffa A1 B ->
-                 instruction self_type tffb A2 B ->
-                 instruction self_type (tffa && tffb) A B)
-    : M (typer_result A) :=
-    let! r1 := type_instruction i1 A1 in
-    let! r2 := type_instruction i2 A2 in
+             i1 i2 A
+    : M (typer_result (self_type := self_type) (t ::: A)) :=
+    let! (existT _ B1 (existT _ B2 f)) := type_if_family f t in
+    let! r1 := type_instruction i1 (B1 ++ A) in
+    let! r2 := type_instruction i2 (B2 ++ A) in
     match r1, r2 with
-    | Inferred_type _ B1 i1, Inferred_type _ B2 i2 =>
-      let! i2 := instruction_cast_range A2 B2 B1 i2 in
+    | Inferred_type _ C1 i1, Inferred_type _ C2 i2 =>
+      let! i2 := instruction_cast_range (B2 ++ A) C2 C1 i2 in
       Return
               (Inferred_type _ _
-                            (IF_instr B1 false false i1 i2))
-    | Inferred_type _ B i1, Any_type _ i2 =>
-      Return (Inferred_type _ _ (IF_instr B false true i1 (i2 B)))
-    | Any_type _ i1, Inferred_type _ B i2 =>
-      Return (Inferred_type _ _ (IF_instr B true false (i1 B) i2))
+                            (syntax.IF_ f i1 i2))
+    | Inferred_type _ C i1, Any_type _ i2 =>
+      Return (Inferred_type _ _ (syntax.IF_ f i1 (i2 C)))
+    | Any_type _ i1, Inferred_type _ C i2 =>
+      Return (Inferred_type _ _ (syntax.IF_ f (i1 C) i2))
     | Any_type _ i1, Any_type _ i2 =>
-      Return (Any_type _ (fun B =>
-                              IF_instr B true true (i1 B) (i2 B)))
+      Return (Any_type _ (fun C =>
+                              syntax.IF_ f (i1 C) (i2 C)))
+    end.
+
+  Definition type_loop_family (f : loop_family) (t : type) :
+    M {A & {B & syntax.loop_family A B t}} :=
+    match f, t with
+    | LOOP_bool, Comparable_type bool => Return (existT _ _ (existT _ _ syntax.LOOP_bool))
+    | LOOP_or, or a an b bn => Return (existT _ _ (existT _ _ (syntax.LOOP_or a an b bn)))
+    | _, _ => Failed _ (Typing _ "type_family"%string)
     end.
 
+  Definition type_loop {self_type} (f : loop_family) (t : type)
+             (type_instruction :
+                forall (i : untyped_syntax.instruction) A,
+                  M (typer_result A))
+             i A
+    : M (typer_result (self_type := self_type) (t ::: A)) :=
+    let! (existT _ B1 (existT _ B2 f)) := type_loop_family f t in
+    let! r := type_check_instruction_no_tail_fail type_instruction i (B1 ++ A) (t ::: A) in
+    Return (Inferred_type _ _ (syntax.LOOP_ f r)).
+
   Definition take_one (S : syntax.stack_type) : M (type * syntax.stack_type) :=
     match S with
     | nil => Failed _ (Typing _ "take_one"%string)
@@ -624,22 +652,10 @@ Qed.
       | Any_type _ i2 =>
         Return (Any_type _ (fun C => syntax.SEQ i1 (i2 C)))
       end
-    | IF_ i1 i2, Comparable_type bool :: A =>
-      type_branches type_instruction i1 i2 _ _ _ (fun B tffa tffb => syntax.IF_)
-    | IF_NONE i1 i2, option a :: A =>
-      type_branches type_instruction i1 i2 _ _ _ (fun B tffa tffb => syntax.IF_NONE)
-    | IF_LEFT i1 i2, or a an b bn :: A =>
-      type_branches type_instruction i1 i2 _ _ _ (fun B tffa tffb => syntax.IF_LEFT)
-    | IF_CONS i1 i2, list a :: A =>
-      type_branches type_instruction i1 i2 _ _ _ (fun B tffa tffb => syntax.IF_CONS)
-    | LOOP i, Comparable_type bool :: A =>
-      let! i := type_check_instruction_no_tail_fail
-        type_instruction i A (bool ::: A) in
-      Return (Inferred_type _ _ (syntax.LOOP i))
-    | LOOP_LEFT i, or a an b bn :: A =>
-      let! i := type_check_instruction_no_tail_fail
-        type_instruction i (a :: A) (or a an b bn :: A) in
-      Return (Inferred_type _ _ (syntax.LOOP_LEFT i))
+    | IF_ f i1 i2, t :: A =>
+      type_branches f t type_instruction i1 i2 A
+    | LOOP_ f i, t :: A =>
+      type_loop f t type_instruction i A
     | EXEC, a :: lambda a' b :: B =>
       let A := a :: lambda a' b :: B in
       let A' := a :: lambda a b :: B in
diff --git a/src/michocoq/untyped_syntax.v b/src/michocoq/untyped_syntax.v
index 47549912..ea36c47a 100644
--- a/src/michocoq/untyped_syntax.v
+++ b/src/michocoq/untyped_syntax.v
@@ -68,20 +68,20 @@ Inductive opcode : Set :=
 | DROP : Datatypes.nat -> opcode
 | CHAIN_ID : opcode.
 
+Inductive if_family : Set := IF_bool | IF_or | IF_option | IF_list.
+
+Inductive loop_family : Set := LOOP_bool | LOOP_or.
+
 Inductive instruction : Set :=
 | NOOP : instruction
 | FAILWITH : instruction
 | SEQ : instruction -> instruction -> instruction
-| IF_ : instruction -> instruction -> instruction
-| LOOP : instruction -> instruction
-| LOOP_LEFT : instruction -> instruction
+| IF_ : if_family -> instruction -> instruction -> instruction
+| LOOP_ : loop_family -> instruction -> instruction
 | PUSH : type -> concrete_data -> instruction
 | LAMBDA : type -> type -> instruction -> instruction
 | ITER : instruction -> instruction
 | MAP : instruction -> instruction
-| IF_NONE : instruction -> instruction -> instruction
-| IF_LEFT : instruction -> instruction -> instruction
-| IF_CONS : instruction -> instruction -> instruction
 | CREATE_CONTRACT : type -> type -> annot_o -> instruction -> instruction
 | DIP : Datatypes.nat -> instruction -> instruction
 | SELF : annot_o -> instruction
@@ -106,6 +106,13 @@ concrete_data : Set :=
 
 Coercion instruction_opcode : opcode >-> instruction.
 
+Notation "'IF'" := (IF_ IF_bool).
+Notation "'IF_LEFT'" := (IF_ IF_or).
+Notation "'IF_NONE'" := (IF_ IF_option).
+Notation "'IF_CONS'" := (IF_ IF_list).
+Notation "'LOOP'" := (LOOP_ LOOP_bool).
+Notation "'LOOP_LEFT'" := (LOOP_ LOOP_or).
+
 (* Some macros *)
 Definition UNPAIR : instruction :=
   SEQ DUP (SEQ CAR (DIP 1 CDR)).
diff --git a/src/michocoq/untyper.v b/src/michocoq/untyper.v
index d5c7f5cb..2c524c79 100644
--- a/src/michocoq/untyper.v
+++ b/src/michocoq/untyper.v
@@ -77,6 +77,20 @@ Require Import String.
     | syntax.CHAIN_ID => CHAIN_ID
     end.
 
+  Definition untype_if_family {A B t} (f : syntax.if_family A B t) : if_family :=
+    match f with
+    | syntax.IF_bool => IF_bool
+    | syntax.IF_or _ _ _ _ => IF_or
+    | syntax.IF_option _ => IF_option
+    | syntax.IF_list _ => IF_list
+    end.
+
+  Definition untype_loop_family {A B t} (f : syntax.loop_family A B t) : loop_family :=
+    match f with
+    | syntax.LOOP_bool => LOOP_bool
+    | syntax.LOOP_or _ _ _ _ => LOOP_or
+    end.
+
   Fixpoint untype_data {a} (d : syntax.concrete_data a) : concrete_data :=
     match d with
     | syntax.Int_constant z => Int_constant z
@@ -112,18 +126,14 @@ Require Import String.
     | syntax.NOOP => NOOP
     | syntax.FAILWITH => FAILWITH
     | syntax.SEQ i1 i2 => SEQ (untype_instruction i1) (untype_instruction i2)
-    | syntax.IF_ i1 i2 => IF_ (untype_instruction i1) (untype_instruction i2)
-    | syntax.LOOP i => LOOP (untype_instruction i)
-    | syntax.LOOP_LEFT i => LOOP_LEFT (untype_instruction i)
+    | syntax.IF_ f i1 i2 => IF_ (untype_if_family f) (untype_instruction i1) (untype_instruction i2)
+    | syntax.LOOP_ f i => LOOP_ (untype_loop_family f) (untype_instruction i)
     | syntax.DIP n _ i => DIP n (untype_instruction i)
     | syntax.EXEC => EXEC
     | syntax.PUSH a x => PUSH a (untype_data x)
     | syntax.LAMBDA a b i => LAMBDA a b (untype_instruction i)
     | syntax.ITER i => ITER (untype_instruction i)
     | syntax.MAP i => MAP (untype_instruction i)
-    | syntax.IF_NONE i1 i2 => IF_NONE (untype_instruction i1) (untype_instruction i2)
-    | syntax.IF_LEFT i1 i2 => IF_LEFT (untype_instruction i1) (untype_instruction i2)
-    | syntax.IF_CONS i1 i2 => IF_CONS (untype_instruction i1) (untype_instruction i2)
     | syntax.CREATE_CONTRACT g p an i => CREATE_CONTRACT g p an (untype_instruction i)
     | syntax.SELF an _ => SELF an
     | syntax.Instruction_opcode o => instruction_opcode (untype_opcode o)
@@ -158,22 +168,10 @@ Require Import String.
         (HSEQ : forall st A B C i1 i2,
             P st B C i2 ->
             P st A C (i1;; i2))
-        (HIF : forall st A B i1 i2,
-            P st A B i1 ->
-            P st A B i2 ->
-            P st (bool ::: A) B (syntax.IF_ i1 i2))
-        (HIF_NONE : forall st a A B i1 i2,
-            P st A B i1 ->
-            P st (a ::: A) B i2 ->
-            P st (option a ::: A) B (syntax.IF_NONE i1 i2))
-        (HIF_LEFT : forall st a b an bn A B i1 i2,
-            P st (a ::: A) B i1 ->
-            P st (b ::: A) B i2 ->
-            P st (or a an b bn ::: A) B (syntax.IF_LEFT i1 i2))
-        (HIF_CONS : forall st a A B i1 i2,
-            P st (a ::: list a ::: A) B i1 ->
-            P st A B i2 ->
-            P st (list a ::: A) B (syntax.IF_CONS i1 i2))
+        (HIF : forall st A B C1 C2 t (f : syntax.if_family C1 C2 t) i1 i2,
+            P st (C1 ++ A) B i1 ->
+            P st (C2 ++ A) B i2 ->
+            P st (t ::: A) B (syntax.IF_ f i1 i2))
     : P self_type A B i :=
     let P' st b A B : syntax.instruction st b A B -> Type :=
         if b return syntax.instruction st b A B -> Type
@@ -190,73 +188,22 @@ Require Import String.
        then
          fun i2 =>
            HSEQ _ _ _ _ i1 i2
-                (tail_fail_induction _ B C i2 P HFAILWITH HSEQ HIF HIF_NONE HIF_LEFT HIF_CONS)
+                (tail_fail_induction _ B C i2 P HFAILWITH HSEQ HIF)
        else fun i2 => I)
         i2
-    | @syntax.IF_ _ A B tffa tffb i1 i2 =>
-      (if tffa as tffa return
-          forall i1, P' _ (tffa && tffb)%bool _ _ (syntax.IF_ i1 i2)
-       then
-         fun i1 =>
-           (if tffb return
-               forall i2,
-                 P' _ tffb _ _ (syntax.IF_ i1 i2)
-            then
-              fun i2 =>
-                HIF _ _ _ i1 i2
-                    (tail_fail_induction _ _ _ i1 P HFAILWITH HSEQ HIF HIF_NONE HIF_LEFT HIF_CONS)
-                    (tail_fail_induction _ _ _ i2 P HFAILWITH HSEQ HIF HIF_NONE HIF_LEFT HIF_CONS)
-            else
-              fun _ => I) i2
-       else
-         fun _ => I) i1
-    | @syntax.IF_NONE _ a A B tffa tffb i1 i2 =>
-      (if tffa as tffa return
-          forall i1, P' _ (tffa && tffb)%bool _ _ (syntax.IF_NONE i1 i2)
-       then
-         fun i1 =>
-           (if tffb return
-               forall i2,
-                 P' _ tffb _ _ (syntax.IF_NONE i1 i2)
-            then
-              fun i2 =>
-                HIF_NONE _ _ _ _ i1 i2
-                    (tail_fail_induction _ _ _ i1 P HFAILWITH HSEQ HIF HIF_NONE HIF_LEFT HIF_CONS)
-                    (tail_fail_induction _ _ _ i2 P HFAILWITH HSEQ HIF HIF_NONE HIF_LEFT HIF_CONS)
-            else
-              fun _ => I) i2
-       else
-         fun _ => I) i1
-    | @syntax.IF_LEFT _ a an b bn A B tffa tffb i1 i2 =>
+    | @syntax.IF_ _ A B tffa tffb _ _ _ f i1 i2 =>
       (if tffa as tffa return
-          forall i1, P' _ (tffa && tffb)%bool _ _ (syntax.IF_LEFT i1 i2)
+          forall i1, P' _ (tffa && tffb)%bool _ _ (syntax.IF_ f i1 i2)
        then
          fun i1 =>
            (if tffb return
                forall i2,
-                 P' _ tffb _ _ (syntax.IF_LEFT i1 i2)
+                 P' _ tffb _ _ (syntax.IF_ f i1 i2)
             then
               fun i2 =>
-                HIF_LEFT _ _ _ _ _ _ _ i1 i2
-                    (tail_fail_induction _ _ _ i1 P HFAILWITH HSEQ HIF HIF_NONE HIF_LEFT HIF_CONS)
-                    (tail_fail_induction _ _ _ i2 P HFAILWITH HSEQ HIF HIF_NONE HIF_LEFT HIF_CONS)
-            else
-              fun _ => I) i2
-       else
-         fun _ => I) i1
-    | @syntax.IF_CONS _ a A B tffa tffb i1 i2 =>
-      (if tffa as tffa return
-          forall i1, P' _ (tffa && tffb)%bool _ _ (syntax.IF_CONS i1 i2)
-       then
-         fun i1 =>
-           (if tffb return
-               forall i2,
-                 P' _ tffb _ _ (syntax.IF_CONS i1 i2)
-            then
-              fun i2 =>
-                HIF_CONS _ _ _ _ i1 i2
-                    (tail_fail_induction _ _ _ i1 P HFAILWITH HSEQ HIF HIF_NONE HIF_LEFT HIF_CONS)
-                    (tail_fail_induction _ _ _ i2 P HFAILWITH HSEQ HIF HIF_NONE HIF_LEFT HIF_CONS)
+                HIF _ _ _ _ _ _ f i1 i2
+                    (tail_fail_induction _ _ _ i1 P HFAILWITH HSEQ HIF)
+                    (tail_fail_induction _ _ _ i2 P HFAILWITH HSEQ HIF)
             else
               fun _ => I) i2
        else
@@ -292,14 +239,8 @@ Require Import String.
       apply syntax.FAILWITH.
     - intros st A B C i1 _ i2.
       apply (syntax.SEQ i1 i2).
-    - intros st A B _ _ i1 i2.
-      apply (syntax.IF_ i1 i2).
-    - intros st a A B _ _ i1 i2.
-      apply (syntax.IF_NONE i1 i2).
-    - intros st a b an bn A B _ _ i1 i2.
-      apply (syntax.IF_LEFT i1 i2).
-    - intros st a A B _ _ i1 i2.
-      apply (syntax.IF_CONS i1 i2).
+    - intros st A B C1 C2 t f _ _ i1 i2.
+      apply (syntax.IF_ f i1 i2).
   Defined.
 
 
@@ -394,57 +335,6 @@ Require Import String.
     reflexivity.
   Qed.
 
-  Inductive IF_instruction : forall (A1 A2 A : Datatypes.list type), Set :=
-  | IF_i A : IF_instruction A A (bool ::: A)
-  | IF_NONE_i a A : IF_instruction A (a ::: A) (option a ::: A)
-  | IF_LEFT_i a b an bn A : IF_instruction (a ::: A) (b ::: A) (or a an b bn ::: A)
-  | IF_CONS_i a A : IF_instruction (a ::: list a ::: A) A (list a ::: A).
-
-  Definition IF_instruction_to_instruction {self_type} A1 A2 A (IFi : IF_instruction A1 A2 A) :
-    forall B tffa tffb,
-      syntax.instruction self_type tffa A1 B ->
-      syntax.instruction self_type tffb A2 B -> syntax.instruction self_type (tffa && tffb) A B :=
-    match IFi with
-    | IF_i A => fun B ttffa tffb i1 i2 => syntax.IF_ i1 i2
-    | IF_NONE_i a A => fun B ttffa tffb i1 i2 => syntax.IF_NONE i1 i2
-    | IF_LEFT_i a b an bn A => fun B ttffa tffb i1 i2 => syntax.IF_LEFT i1 i2
-    | IF_CONS_i a A => fun B ttffa tffb i1 i2 => syntax.IF_CONS i1 i2
-    end.
-
-  Lemma untype_type_branches {self_type} tff1 tff2 A1 A2 A B
-        (i1 : syntax.instruction self_type tff1 A1 B)
-        (i2 : syntax.instruction self_type tff2 A2 B) IF_instr :
-    untype_type_spec _ _ _ i1 ->
-    untype_type_spec _ _ _ i2 ->
-    typer.type_branches typer.type_instruction
-                        (untype_instruction i1)
-                        (untype_instruction i2)
-                        A1 A2 A (IF_instruction_to_instruction A1 A2 A IF_instr) =
-    Return ((if (tff1 && tff2)%bool
-                 as b return syntax.instruction self_type b A B -> typer.typer_result A
-               then
-                 fun i =>
-                   typer.Any_type _ (fun B' => tail_fail_change_range A B B' i)
-               else
-                 typer.Inferred_type _ B) (IF_instruction_to_instruction A1 A2 A IF_instr B tff1 tff2 i1 i2)).
-  Proof.
-    intros IH1 IH2.
-    unfold typer.type_branches.
-    rewrite IH1.
-    rewrite IH2.
-    simpl.
-    destruct tff1; destruct tff2; simpl.
-    - f_equal.
-      f_equal.
-      destruct IF_instr; simpl; unfold tail_fail_change_range; reflexivity.
-    - rewrite tail_fail_change_range_same.
-      reflexivity.
-    - rewrite tail_fail_change_range_same.
-      reflexivity.
-    - rewrite instruction_cast_range_same.
-      reflexivity.
-  Qed.
-
   Ltac trans_refl t := transitivity t; [reflexivity|].
 
   Lemma app_length_inv {A} : forall (l1 l1' l2 l2' : Datatypes.list A),
@@ -662,26 +552,27 @@ Require Import String.
           rewrite untype_type_instruction.
           destruct tff; reflexivity.
         * auto.
-      + simpl.
-        trans_refl
-          (@typer.type_branches self_type
-             typer.type_instruction
-             (untype_instruction i1)
-             (untype_instruction i2) _ _ _
-             (IF_instruction_to_instruction _ _ _ (IF_i A))).
-        rewrite untype_type_branches; auto.
-      + trans_refl (
-          let! i := typer.type_check_instruction_no_tail_fail
-            typer.type_instruction (untype_instruction i) A (bool ::: A) in
-          Return (@typer.Inferred_type self_type _ _ (syntax.LOOP i))
-        ).
-        rewrite untype_type_check_instruction_no_tail_fail; auto.
-      + trans_refl (
-          let! i := typer.type_check_instruction_no_tail_fail
-            typer.type_instruction (untype_instruction i) _ (or a an b bn ::: A) in
-          Return (@typer.Inferred_type self_type _ _ (syntax.LOOP_LEFT i))
-        ).
-        rewrite untype_type_check_instruction_no_tail_fail; auto.
+      + unfold untype_type_spec.
+        simpl.
+        unfold type_branches.
+        assert (type_if_family (untype_if_family i1) t = Return (existT _ C1 (existT _ C2 i1))) as Hi1.
+        * destruct i1; reflexivity.
+        * rewrite Hi1.
+          simpl.
+          rewrite untype_type_instruction; simpl.
+          rewrite untype_type_instruction; simpl.
+          destruct tffa; destruct tffb;
+            try rewrite instruction_cast_range_same; simpl; repeat f_equal; apply tail_fail_change_range_same.
+      + unfold untype_type_spec.
+        simpl.
+        unfold type_loop.
+        assert (type_loop_family (untype_loop_family i) t = Return (existT _ C1 (existT _ C2 i))) as Hi.
+        * destruct i; reflexivity.
+        * rewrite Hi.
+          simpl.
+          rewrite untype_type_check_instruction_no_tail_fail.
+          -- reflexivity.
+          -- apply untype_type_instruction.
       + trans_refl (
           let! d := typer.type_data (untype_data x) a in
           Return (@typer.Inferred_type self_type A _ (syntax.PUSH a d))
@@ -715,27 +606,6 @@ Require Import String.
              rewrite instruction_cast_range_same.
              reflexivity.
           -- auto.
-      + trans_refl
-          (@typer.type_branches self_type
-             typer.type_instruction
-             (untype_instruction i1)
-             (untype_instruction i2) _ _ _
-             (IF_instruction_to_instruction _ _ _ (IF_NONE_i a A))).
-        rewrite untype_type_branches; auto.
-      + trans_refl
-          (@typer.type_branches self_type
-             typer.type_instruction
-             (untype_instruction i1)
-             (untype_instruction i2) _ _ _
-             (IF_instruction_to_instruction _ _ _ (IF_LEFT_i a b an bn A))).
-        rewrite untype_type_branches; auto.
-      + trans_refl
-          (@typer.type_branches self_type
-             typer.type_instruction
-             (untype_instruction i1)
-             (untype_instruction i2) _ _ _
-             (IF_instruction_to_instruction _ _ _ (IF_CONS_i a A))).
-        rewrite untype_type_branches; auto.
       + unfold untype_type_spec; simpl.
         rewrite untype_type_check_instruction.
         -- simpl.
diff --git a/src/michocoq/util.v b/src/michocoq/util.v
index 6a4eac34..7a6e98bd 100644
--- a/src/michocoq/util.v
+++ b/src/michocoq/util.v
@@ -227,3 +227,13 @@ Proof.
   destruct b; intuition congruence.
 Qed.
 
+Lemma match_if_exchange A B (b : Datatypes.bool) (P : A -> Prop) (Q : B -> Prop) u v :
+  match (if b then inl u else inr v) with
+  | inl x => P x
+  | inr y => Q y
+  end =
+  if b then P u else Q v.
+Proof.
+  destruct b; reflexivity.
+Qed.
+
-- 
GitLab


From 5bd885973fe43b8a0e554cb9a521bc3b1540c82e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Tue, 3 Dec 2019 13:19:06 +0100
Subject: [PATCH 22/56] [michocoq] Add a distinction between instructions and
 instruction sequences

---
 src/contracts_coq/boomerang.v        |  72 +++--
 src/contracts_coq/deposit.v          |  28 +-
 src/contracts_coq/generic_multisig.v | 233 ++++++++-------
 src/contracts_coq/manager.v          |  32 +--
 src/contracts_coq/multisig.v         | 318 ++++++++++-----------
 src/contracts_coq/vote.v             |  16 +-
 src/michocoq/macros.v                |  76 +++--
 src/michocoq/main.v                  |   2 +-
 src/michocoq/micheline2michelson.v   | 285 ++++++++++---------
 src/michocoq/michelson2micheline.v   |  47 ++-
 src/michocoq/semantics.v             | 408 +++++++++++++++++++--------
 src/michocoq/syntax.v                | 193 +++++++++++--
 src/michocoq/typer.v                 | 188 ++++++++----
 src/michocoq/untyped_syntax.v        |  37 ++-
 src/michocoq/untyper.v               | 251 ++++++++--------
 15 files changed, 1298 insertions(+), 888 deletions(-)

diff --git a/src/contracts_coq/boomerang.v b/src/contracts_coq/boomerang.v
index 59e5340b..e4f853c7 100644
--- a/src/contracts_coq/boomerang.v
+++ b/src/contracts_coq/boomerang.v
@@ -48,9 +48,9 @@ Definition boomerang : full_contract _ parameter_ty None storage_ty :=
            AMOUNT ;;
            UNIT ;;
            TRANSFER_TOKENS ;;
-           CONS
+           CONS ;; NOOP
          );;
-       PAIR
+       PAIR ;; NOOP
   ).
 
 Lemma eqb_eq a c1 c2 :
@@ -78,7 +78,7 @@ Qed.
 Lemma boomerang_correct :
   forall env (ops : data (list operation)) (fuel : Datatypes.nat),
   fuel >= 42 ->
-  eval env boomerang fuel ((tt, tt), tt) = Return ((ops, tt), tt)
+  eval_seq env boomerang fuel ((tt, tt), tt) = Return ((ops, tt), tt)
   <->
   (amount env = (0 ~Mutez) /\ ops = nil) \/
   (amount env <> (0 ~Mutez) /\
@@ -87,34 +87,46 @@ Lemma boomerang_correct :
 Proof.
   intros env ops fuel Hfuel.
   rewrite return_precond.
-  unfold eval.
-  rewrite eval_precond_correct.
+  rewrite eval_seq_precond_correct.
+  unfold eval_seq_precond.
   unfold ">=" in Hfuel.
-  repeat (more_fuel ; simpl).
-  rewrite match_if_exchange.
-  rewrite destruct_if.
-  apply or_both; apply and_both_0.
-  - rewrite (eqb_eq mutez).
-    intuition.
-  - intuition congruence.
-  - rewrite bool_not_false.
-    rewrite (eqb_eq mutez).
-    intuition.
-  - pose (c := contract_ env None unit (source env)).
-    pose (transfer := transfer_tokens env unit tt (amount env)).
-    fold c.
-    destruct c.
-    + split.
-      * intro H.
-        exists d.
-        intuition congruence.
-      * intros (c, (Hc, Hops)).
-        injection Hc; clear Hc.
-        intro; subst.
-        reflexivity.
-    + split; [contradiction|].
-      intros (c, (Habs, _)).
-      discriminate.
+  more_fuel; simpl.
+  more_fuel; simpl.
+  fold (simple_compare mutez).
+  fold (compare mutez).
+  case_eq ((comparison_to_int (compare mutez (0 ~Mutez) (amount env)) =? 0)%Z).
+  - (* true *)
+    intro Heq.
+    rewrite eqb_eq in Heq.
+    split.
+    + intro Hops.
+      injection Hops.
+      intro; subst ops.
+      intuition.
+    + intros [(Hl, Hops)|(Hr, _)].
+      * simpl.
+        subst; reflexivity.
+      * symmetry in Heq.
+        contradiction.
+  - intro Hneq.
+    rewrite eqb_neq in Hneq.
+    do 7 (more_fuel ; simpl).
+    destruct (contract_ env None unit (source env)).
+    + (* Some *)
+      split.
+      * intro H ; right; split.
+        -- congruence.
+        -- eexists ; intuition ; injection H.
+           symmetry; assumption.
+      * intros [(Habs, _)| (_, (ctr, (He, Hops)))].
+        -- congruence.
+        -- injection He; intro; subst d; subst ops; reflexivity.
+    + (* None *)
+      simpl. split.
+      * intro H; inversion H.
+      * intros [(Habs, _)|(ctr, (He, (Hops, _)))].
+        -- congruence.
+        -- discriminate.
 Qed.
 
 End boomerang.
diff --git a/src/contracts_coq/deposit.v b/src/contracts_coq/deposit.v
index 5b4ff514..5b38563c 100644
--- a/src/contracts_coq/deposit.v
+++ b/src/contracts_coq/deposit.v
@@ -36,16 +36,20 @@ Module deposit(C:ContractContext).
 
 Module semantics := Semantics C. Import semantics.
 
+Open Scope michelson_scope.
+
 Definition deposit : full_contract _ parameter_ty None storage_ty :=
-  ( Instruction_opcode DUP;; Instruction_opcode CAR;; DIP1 (Instruction_opcode CDR);;
+  (
+    DUP;; CAR;; DIP1 ( CDR ;; NOOP );;
     IF_LEFT
-      ( DROP1;; Instruction_opcode (NIL operation) )
-      ( DIP1 ( Instruction_opcode DUP;;
-               Instruction_opcode DUP;; Instruction_opcode SENDER;; Instruction_opcode COMPARE;; Instruction_opcode EQ;; IF NOOP FAILWITH;;
-               Instruction_opcode (CONTRACT None unit);; IF_NONE FAILWITH NOOP);;
-        PUSH unit Unit;; Instruction_opcode TRANSFER_TOKENS;;
-        Instruction_opcode (NIL operation);; Instruction_opcode SWAP;; Instruction_opcode CONS);;
-    Instruction_opcode PAIR ).
+      ( DROP1;; NIL operation;; NOOP )
+      ( DIP1 ( DUP;; DUP;;
+               SENDER;; COMPARE;;
+               EQ;; IF_TRUE NOOP ( FAILWITH ;; NOOP );;
+               (CONTRACT None unit);; IF_NONE (FAILWITH ;; NOOP) NOOP ;; NOOP );;
+        PUSH unit Unit;; TRANSFER_TOKENS;;
+        (NIL operation);; SWAP;; CONS;; NOOP );;
+    PAIR ;; NOOP).
 
 Lemma deposit_correct :
   forall (env : @proto_env (Some (parameter_ty, None)))
@@ -53,7 +57,7 @@ Lemma deposit_correct :
          (ops : data (list operation)) storage_out
          (fuel : Datatypes.nat),
   fuel >= 42 ->
-  eval env deposit fuel ((input, storage_in), tt) = Return ((ops, storage_out), tt)
+  eval_seq env deposit fuel ((input, storage_in), tt) = Return ((ops, storage_out), tt)
   <->
   (storage_in = storage_out /\
    match input with
@@ -66,9 +70,9 @@ Lemma deposit_correct :
 Proof.
   intros env input storage_in ops storage_out fuel Hfuel.
   rewrite return_precond.
-  unfold eval.
-  rewrite eval_precond_correct.
+  rewrite eval_seq_precond_correct.
   unfold ">=" in Hfuel.
+  unfold eval_seq_precond.
   do 5 (more_fuel ; simpl).
   destruct input as [[]|am].
   - do 2 (more_fuel ; simpl).
@@ -79,7 +83,7 @@ Proof.
     rewrite (eqb_eq address).
     remember (contract_ env None unit storage_in) as d.
     match goal with
-      |- context [match ?x with | Some x => _ | None => _ end] =>
+      |- context [match ?x with | Some y => _ | None => _ end] =>
       remember x as d2
     end.
     assert (d = d2) as Hdd2 by (subst; reflexivity).
diff --git a/src/contracts_coq/generic_multisig.v b/src/contracts_coq/generic_multisig.v
index 5573f9b4..7e5d3771 100644
--- a/src/contracts_coq/generic_multisig.v
+++ b/src/contracts_coq/generic_multisig.v
@@ -58,57 +58,57 @@ Definition multisig : full_contract _ parameter_ty None storage_ty :=
   (
     UNPAIR ;;
     IF_LEFT
-    ( DROP1 ;; NIL operation ;; PAIR )
+    ( DROP1 ;; NIL operation ;; PAIR ;; NOOP )
       ( PUSH mutez (0 ~mutez) ;; AMOUNT ;; ASSERT_CMPEQ ;;
-        SWAP ;; DUP ;; DIP1 ( SWAP ) ;;
+        SWAP ;; DUP ;; DIP1 ( SWAP ;; NOOP ) ;;
         DIP1
           (
             UNPAIR ;;
             DUP ;; SELF (self_type := parameter_ty) (self_annot := None) None I ;;
             ADDRESS ;; CHAIN_ID ;; PAIR ;; PAIR ;;
             PACK ;;
-            DIP1 ( UNPAIR ;; DIP1 SWAP ) ;; SWAP
+            DIP1 ( UNPAIR ;; DIP1 (SWAP ;; NOOP) ;; NOOP ) ;; SWAP ;; NOOP
           ) ;;
 
-        UNPAIR ;; DIP1 SWAP ;;
+        UNPAIR ;; DIP1 (SWAP ;; NOOP) ;;
         ASSERT_CMPEQ ;;
 
-        DIP1 SWAP ;; UNPAIR ;;
+        DIP1 (SWAP ;; NOOP) ;; UNPAIR ;;
         DIP1
           (
             PUSH nat (nat_constant 0);; SWAP ;;
             ITER
               (
-                DIP1 SWAP ;; SWAP ;;
+                DIP1 (SWAP ;; NOOP) ;; SWAP ;;
                 IF_CONS
                   (
                     IF_SOME
                       ( SWAP ;;
                         DIP1
                           (
-                            SWAP ;; DIIP ( DUUP ) ;;
-                            ( DUUUP;; DIP1 (CHECK_SIGNATURE);; SWAP;; IF (DROP1) (FAILWITH) );;
-                            PUSH nat (nat_constant 1) ;; ADD_nat ) )
-                      ( SWAP ;; DROP1 )
+                            SWAP ;; DIIP ( DUUP ;; NOOP ) ;;
+                            ( DUUUP;; DIP1 (CHECK_SIGNATURE ;; NOOP);; SWAP;; IF (DROP1 ;; NOOP) (Tail_fail FAILWITH) ;; NOOP );;;
+                            PUSH nat (nat_constant 1) ;; ADD_nat ;; NOOP ) ;; NOOP )
+                      ( SWAP ;; DROP1 ;; NOOP ) ;; NOOP
                   )
                   (
-                    FAIL
+                    FAIL ;; NOOP
                   ) ;;
-                SWAP
-              )
+                SWAP ;; NOOP
+              ) ;; NOOP
           ) ;;
         ASSERT_CMPLE ;;
-        IF_CONS (FAIL) NOOP ;;
+        IF_CONS (FAIL ;; NOOP) NOOP ;;
         DROP1 ;;
 
-        DIP1 ( UNPAIR ;; PUSH nat (nat_constant 1) ;; ADD ;; PAIR) ;;
+        DIP1 ( UNPAIR ;; PUSH nat (nat_constant 1) ;; ADD ;; PAIR ;; NOOP) ;;
 
         IF_LEFT
-          ( UNIT ;; EXEC )
+          ( UNIT ;; EXEC ;; NOOP )
           (
-            DIP1 ( CAR ) ;; SWAP ;; PAIR ;; NIL operation
+            DIP1 ( CAR ;; NOOP ) ;; SWAP ;; PAIR ;; NIL operation ;; NOOP
           );;
-        PAIR )
+        PAIR ;; NOOP ) ;; NOOP
   ).
 
 Fixpoint check_all_signatures (sigs : Datatypes.list (Datatypes.option (data signature)))
@@ -170,7 +170,7 @@ Definition multisig_spec
     new_stored_counter = (1 + stored_counter)%N /\
     match action with
     | inl (existT _ _ lam) =>
-      match (eval (no_self env) lam fuel (tt, tt)) with
+      match (eval_seq (no_self env) lam fuel (tt, tt)) with
       | Return (operations, tt) =>
         new_threshold = threshold /\
         new_keys = keys /\
@@ -184,27 +184,26 @@ Definition multisig_spec
     end
   end.
 
-Definition multisig_head {A} (then_ : instruction (Some (parameter_ty, None)) Datatypes.false (nat ::: list key ::: list (option signature) ::: bytes ::: action_ty ::: storage_ty ::: nil) A) :
-  instruction _ _ (pair (pair nat action_ty) (list (option signature)) ::: pair nat (pair nat (list key)) ::: nil) A
+Definition multisig_head :
+  instruction_seq (Some (parameter_ty, None)) Datatypes.false (pair (pair nat action_ty) (list (option signature)) ::: pair nat (pair nat (list key)) ::: nil) (nat ::: list key ::: list (option signature) ::: bytes ::: action_ty ::: storage_ty ::: nil)
 :=
     PUSH mutez (0 ~mutez);; AMOUNT;; ASSERT_CMPEQ;;
-    SWAP ;; DUP ;; DIP1 SWAP ;;
+    SWAP ;; DUP ;; DIP1 (SWAP ;; NOOP) ;;
     DIP1
       (
         UNPAIR ;;
         DUP ;; SELF (self_type := parameter_ty) (self_annot := None) None I ;;
         ADDRESS ;; CHAIN_ID ;; PAIR ;; PAIR ;;
         PACK ;;
-        DIP1 ( UNPAIR ;; DIP1 SWAP ) ;; SWAP
+        DIP1 ( UNPAIR ;; DIP1 (SWAP ;; NOOP) ;; NOOP ) ;; SWAP ;; NOOP
       ) ;;
 
-    UNPAIR ;; DIP1 SWAP ;;
+    UNPAIR ;; DIP1 (SWAP ;; NOOP) ;;
     ASSERT_CMPEQ ;;
 
-    DIP1 SWAP ;; UNPAIR ;; then_.
+    DIP1 (SWAP ;; NOOP) ;; UNPAIR ;; NOOP.
 
 Definition multisig_head_spec
-           A
            (env : @proto_env (Some (parameter_ty, None)))
            (counter : N)
            (action : data action_ty)
@@ -213,32 +212,23 @@ Definition multisig_head_spec
            (threshold : N)
            (keys : Datatypes.list (data key))
            (fuel : Datatypes.nat)
-           (then_ :
-              instruction _ Datatypes.false
-                (nat ::: list key ::: list (option signature) ::: bytes :::
-                     action_ty ::: storage_ty ::: nil)
-                A)
-           (psi : stack A -> Prop)
+           (psi : stack (nat ::: list key ::: list (option signature) ::: bytes ::: action_ty ::: storage_ty ::: nil) -> Prop)
   :=
   let params := ((counter, action), sigs) in
   let storage : data storage_ty := (stored_counter, (threshold, keys)) in
   amount env = (0 ~Mutez) /\
   counter = stored_counter /\
-  semantics.eval_precond
-       fuel env then_
-       psi
-       (threshold,
-        (keys,
-         (sigs,
-          (pack env pack_ty
-                (chain_id_ env, address_ env unit (self env None I), (counter, action)),
-           (action, (storage, tt)))))).
+  psi (threshold,
+       (keys,
+        (sigs,
+         (pack env pack_ty
+               (chain_id_ env, address_ env unit (self (self_ty := Some (parameter_ty, None)) env None I), (counter, action)),
+          (action, (storage, tt)))))).
 
 Ltac fold_eval_precond :=
   change (@eval_precond_body (@eval_precond ?fuel)) with (@eval_precond (S fuel)).
 
 Lemma multisig_head_correct
-      A
       (env : @proto_env (Some (parameter_ty, None)))
       (counter : N)
       (action : data action_ty)
@@ -246,67 +236,61 @@ Lemma multisig_head_correct
       (stored_counter : N)
       (threshold : N)
       (keys : Datatypes.list (data key))
-      (then_ :
-         instruction _ _
-           (nat ::: list key ::: list (option signature) ::: bytes :::
-                action_ty ::: storage_ty ::: nil)
-           A)
-      (psi : stack A -> Prop) :
+      psi :
   let params := ((counter, action), sigs) in
   let storage : data storage_ty := (stored_counter, (threshold, keys)) in
   forall fuel,
-    12 <= fuel ->
-    (semantics.eval_precond (12 + fuel) env (multisig_head then_) psi (params, (storage, tt)))
+    5 <= fuel ->
+    (semantics.eval_seq_precond fuel env multisig_head psi (params, (storage, tt)))
         <->
-        multisig_head_spec A env counter action sigs stored_counter threshold keys fuel then_ psi.
+        multisig_head_spec env counter action sigs stored_counter threshold keys fuel psi.
 Proof.
   intros params storage fuel Hfuel.
   unfold multisig_head.
   unfold "+", params, storage, multisig_head_spec.
-  do 11 (more_fuel; simpl).
+  unfold eval_seq_precond.
+  repeat (more_fuel; simpl).
   rewrite match_if_exchange.
   rewrite if_false_is_and.
   rewrite (eqb_eq mutez).
   apply and_both.
-  repeat simpl.
   rewrite match_if_exchange.
   rewrite if_false_is_and.
   rewrite (eqb_eq nat).
   rewrite (eq_sym_iff counter stored_counter).
   apply and_both.
-  simpl.
   reflexivity.
 Qed.
 
 Definition multisig_iter_body :
-  instruction _ _
+  instruction_seq _ _
     (key ::: nat ::: list (option signature) ::: bytes ::: action_ty :::
          storage_ty ::: nil)
     (nat ::: list (option signature) ::: bytes ::: action_ty :::
          storage_ty ::: nil)
   :=
-    (DIP1 SWAP ;; SWAP ;;
+    (DIP1 (SWAP ;; NOOP) ;; SWAP ;;
          IF_CONS
          (
            IF_SOME
              ( SWAP ;;
                     DIP1
                     (
-                      SWAP ;; DIIP ( DUUP ) ;;
-                           ( DUUUP;; DIP1 (CHECK_SIGNATURE);; SWAP;; IF (DROP1) (FAILWITH) );;
-                           PUSH nat (nat_constant 1) ;; ADD_nat ) )
-             ( SWAP ;; DROP1 )
+                      SWAP ;; DIIP ( DUUP;; NOOP ) ;;
+                           ( DUUUP;; DIP1 (CHECK_SIGNATURE ;; NOOP);; SWAP;; IF (DROP1 ;; NOOP) (Tail_fail FAILWITH) ;; NOOP );;;
+                           PUSH nat (nat_constant 1) ;; ADD_nat ;; NOOP ) ;; NOOP )
+             ( SWAP ;; DROP1 ;; NOOP ) ;; NOOP
          )
          (
-           FAIL
+           FAIL;; NOOP
          ) ;;
-         SWAP
+         SWAP ;; NOOP
     ).
 
 Lemma multisig_iter_body_correct env k n sigs packed
       (st : stack (action_ty ::: storage_ty ::: nil)) fuel psi :
-    17 <= fuel ->
-    semantics.eval_precond fuel env multisig_iter_body psi (k, (n, (sigs, (packed, st))))
+    7 <= fuel ->
+    semantics.eval_seq_precond fuel env multisig_iter_body psi (k, (n, (sigs, (packed, st))))
     <->
     match sigs with
     | nil => false
@@ -317,15 +301,18 @@ Lemma multisig_iter_body_correct env k n sigs packed
     end.
 Proof.
   intro Hfuel.
-  repeat more_fuel.
-  simpl.
+  unfold eval_seq_precond.
   destruct sigs as [|[sig|] sigs].
-  - reflexivity.
-  - rewrite match_if_exchange.
-    rewrite if_false_is_and.
-    apply and_both.
+  - repeat (more_fuel; simpl).
+    reflexivity.
+  - repeat (more_fuel; simpl).
+    case (check_signature env k sig packed).
+    + tauto.
+    + split.
+      * intro H; inversion H.
+      * intros (H, _); discriminate.
+  - do 3 (more_fuel; simpl).
     reflexivity.
-  - reflexivity.
 Qed.
 
 Definition multisig_iter :
@@ -337,9 +324,16 @@ Definition multisig_iter :
   :=
   ITER multisig_iter_body.
 
+Lemma fold_eval_seq_precond fuel :
+  @eval_seq_precond_body (@semantics.eval_precond fuel) =
+  @semantics.eval_seq_precond fuel.
+Proof.
+  reflexivity.
+Qed.
+
 Lemma multisig_iter_correct env keys n sigs packed
       (st : stack (action_ty ::: storage_ty ::: nil)) fuel psi :
-    length keys * 17 + 1 <= fuel ->
+    length keys + 7 <= fuel ->
     semantics.eval_precond fuel env multisig_iter psi (keys, (n, (sigs, (packed, st)))) <->
     (exists first_sigs remaining_sigs,
         length first_sigs = length keys /\
@@ -368,9 +362,11 @@ Proof.
       exact H.
   - simpl in Hfuel.
     more_fuel.
-    change (16 + (length keys * 17 + 1) <= fuel) in Hfuel.
-    assert (length keys * 17 + 1 <= fuel) as Hfuel2 by (transitivity (16 + (length keys * 17 + 1)); [repeat constructor| apply Hfuel]).
+    unfold multisig_iter.
+    remember multisig_iter_body as mib.
     simpl.
+    subst mib.
+    rewrite fold_eval_seq_precond.
     rewrite multisig_iter_body_correct.
     + destruct sigs as [|[sig|] sigs].
       * split; [intro H; inversion H|].
@@ -383,7 +379,7 @@ Proof.
         discriminate.
       * split.
         -- intros (Hcheck, Hrec).
-           specialize (IHkeys (1 + n)%N sigs packed fuel Hfuel2).
+           specialize (IHkeys (1 + n)%N sigs packed fuel Hfuel).
            rewrite IHkeys in Hrec.
            destruct Hrec as (first_sigs, (remaining_sigs, (Hlen, (Happ, (Hchecks, H))))).
            exists (Some sig :: first_sigs)%list.
@@ -409,7 +405,7 @@ Proof.
               destruct (check_signature env key sig packed).
               ** simpl in Hchecks.
                  split; [reflexivity|].
-                 apply (IHkeys _ _ _ _ Hfuel2).
+                 apply (IHkeys _ _ _ _ Hfuel).
                  exists first_sigs; exists remaining_sigs.
                  simpl in Hlen.
                  apply NPeano.Nat.succ_inj in Hlen.
@@ -423,7 +419,7 @@ Proof.
                  inversion Hchecks.
            ++ simpl in Happ.
               discriminate.
-      * rewrite (IHkeys _ _ _ _ Hfuel2).
+      * rewrite (IHkeys _ _ _ _ Hfuel).
         split;
           intros (first_sigs, (remaining_sigs, (Hlen, (Happ, (Hchecks, H))))).
         -- exists (None :: first_sigs)%list.
@@ -445,39 +441,35 @@ Proof.
               split; [injection Happ; auto|].
               split; [exact Hchecks|].
               exact H.
-    + transitivity (16 + (length keys * 17 + 1)).
-      * destruct (length keys).
-        -- simpl. constructor.
-        -- omega.
-      * assumption.
+    + omega.
 Qed.
 
 Definition multisig_tail :
-  instruction (Some (parameter_ty, None)) _
+  instruction_seq (Some (parameter_ty, None)) _
     (nat ::: nat ::: list (option signature) ::: bytes ::: action_ty :::
          storage_ty ::: nil)
     (pair (list operation) storage_ty ::: nil) :=
 
         ASSERT_CMPLE ;;
-        IF_CONS (FAIL) NOOP ;;
+        IF_CONS (FAIL;; NOOP) NOOP ;;
         DROP1 ;;
 
-        DIP1 ( UNPAIR ;; PUSH nat (nat_constant 1) ;; ADD ;; PAIR) ;;
+        DIP1 ( UNPAIR ;; PUSH nat (nat_constant 1) ;; ADD ;; PAIR ;; NOOP) ;;
 
         IF_LEFT
-          ( UNIT ;; EXEC )
+          ( UNIT ;; EXEC ;; NOOP )
           (
-            DIP1 ( CAR ) ;; SWAP ;; PAIR ;; NIL operation
+            DIP1 ( CAR ;; NOOP ) ;; SWAP ;; PAIR ;; (NIL operation) ;; NOOP
           );;
-        PAIR.
+        PAIR ;; NOOP.
 
 Lemma multisig_split :
   multisig =
   (
     UNPAIR ;;
     IF_LEFT
-      ( DROP1 ;; NIL operation ;; PAIR )
-      ( multisig_head (DIP1 (PUSH nat (nat_constant 0%N);; SWAP;; multisig_iter);; multisig_tail))).
+      ( DROP1 ;; NIL operation ;; PAIR ;; NOOP )
+      ( multisig_head ;;; DIP1 (PUSH nat (nat_constant 0%N);; SWAP;; multisig_iter ;; NOOP);; multisig_tail) ;; NOOP).
 Proof.
   reflexivity.
 Qed.
@@ -485,12 +477,12 @@ Qed.
 Lemma multisig_tail_correct
       env threshold n sigs packed action counter (keys : data (list key)) psi fuel :
   3 <= fuel ->
-  precond (semantics.eval env multisig_tail (10 + fuel) (threshold, (n, (sigs, (packed, (action, ((counter, (threshold, keys)), tt))))))) psi <->
+  precond (semantics.eval_seq env multisig_tail (S (S fuel)) (threshold, (n, (sigs, (packed, (action, ((counter, (threshold, keys)), tt))))))) psi <->
   sigs = nil /\
   ((threshold <= n)%N /\
    match action with
    | inl (existT _ _ lam) =>
-     match eval (no_self env) lam (2 + fuel) (tt, tt) with
+     match eval_seq (no_self env) lam fuel (tt, tt) with
      | Return (operations, tt) =>
        psi ((operations, ((1 + counter)%N, (threshold, keys))), tt)
      | _ => False
@@ -500,10 +492,13 @@ Lemma multisig_tail_correct
    end).
 Proof.
   intro Hfuel.
-  rewrite eval_precond_correct.
+  rewrite eval_seq_precond_correct.
   unfold multisig_tail.
-  change (10 + fuel) with (S (S (S (S (6 + fuel))))).
-  simpl eval_precond.
+  unfold eval_seq_precond.
+  simpl.
+  rewrite match_if_exchange.
+  more_fuel; simpl.
+  more_fuel; simpl.
   case sigs.
   - case_eq (BinInt.Z.leb (comparison_to_int (threshold ?= n)%N) Z0).
     + intro Hle.
@@ -514,10 +509,13 @@ Proof.
       apply (and_right eq_refl).
       apply (and_right Hle).
       destruct action as [(tff, lam)|(new_threshold, new_keys)].
-      * do 2 fold_eval_precond.
-        rewrite <- eval_precond_correct.
-        change (2 + fuel) with (S (S fuel)).
-        reflexivity.
+      * more_fuel; simpl.
+        repeat fold_eval_precond.
+        rewrite fold_eval_seq_precond.
+        rewrite <- eval_seq_precond_correct.
+        case (semantics.eval_seq _ lam (S (S (S fuel))) (tt, tt)).
+        -- intro; split; intro H; simpl in H; inversion H.
+        -- intro s; reflexivity.
       * reflexivity.
     + intro Hle.
       apply (leb_gt nat) in Hle.
@@ -547,8 +545,8 @@ Lemma multisig_correct
       (fuel : Datatypes.nat) :
   let storage : data storage_ty := (stored_counter, (threshold, keys)) in
   let new_storage : data storage_ty := (new_stored_counter, (new_threshold, new_keys)) in
-  17 * length keys + 14 <= fuel ->
-  eval env multisig (23 + fuel) ((params, storage), tt) = Return ((returned_operations, new_storage), tt) <->
+  length keys + 7 <= fuel ->
+  eval_seq env multisig (3 + fuel) ((params, storage), tt) = Return ((returned_operations, new_storage), tt) <->
   multisig_spec env params stored_counter threshold keys new_stored_counter new_threshold new_keys returned_operations fuel.
 Proof.
   intros storage new_storage Hfuel.
@@ -556,7 +554,8 @@ Proof.
   rewrite multisig_split.
   rewrite PeanoNat.Nat.add_comm in Hfuel.
   subst storage. subst new_storage.
-  rewrite eval_precond_correct.
+  rewrite eval_seq_precond_correct.
+  unfold eval_seq_precond.
   destruct params as [()| ((counter, action), sigs)].
   - split; simpl.
     + intro H; injection H. intuition.
@@ -564,28 +563,28 @@ Proof.
       reflexivity.
   - remember multisig_head as mh.
     remember multisig_iter as mi.
-    change (23 + fuel) with (S (S (21 + fuel))).
     simpl.
     repeat fold_eval_precond.
     subst mh.
-    unfold multisig_spec.
-    change (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S fuel))))))))))))))))))))) with (12 + (S (S (S (S (S (S (S (S (S fuel)))))))))).
+    repeat fold_eval_precond.
+    rewrite fold_eval_seq_precond.
+    rewrite eval_seq_assoc.
     rewrite multisig_head_correct; [|omega].
     unfold multisig_head_spec.
     apply and_both.
     apply and_both_2.
     intro; subst counter.
     remember multisig_tail as mt.
+    unfold eval_seq_precond.
     simpl.
-    do 8 fold_eval_precond.
+    repeat fold_eval_precond.
     subst mi.
-    rewrite multisig_iter_correct; [|rewrite Nat.mul_comm; generalize Hfuel; simpl; lia].
+    rewrite multisig_iter_correct; [| rewrite PeanoNat.Nat.add_comm; refine (NPeano.Nat.le_trans _ _ _ Hfuel _); omega].
     split.
     + intros (first_sigs, (remaining_sigs, (Hlen, (Hsigs, (Hcheck, Heval))))).
       subst mt.
-      do 6 more_fuel.
-      rewrite <- eval_precond_correct in Heval.
-      change (S (S (S (S (S (S (S (S (S (S (S (S (S (S fuel)))))))))))))) with (10 + (4 + fuel)) in Heval.
+      rewrite fold_eval_seq_precond in Heval.
+      rewrite <- eval_seq_precond_correct in Heval.
       rewrite multisig_tail_correct in Heval; [|omega].
       destruct Heval as (Hrs, (Hcount, Haction)).
       subst remaining_sigs.
@@ -597,10 +596,8 @@ Proof.
       apply N.le_ge in Hcount.
       split; [assumption|].
       destruct action as [(tff, lam)|(nt, nks)].
-      * change (2 + (4 + fuel)) with (S (S (S (S (S (S fuel)))))) in Haction.
-        destruct (eval _ lam (S (S (S (S (S (S fuel)))))) (tt, tt)) as [|(ops, [])].
-        -- simpl in Haction.
-           inversion Haction.
+      * destruct (eval_seq _ lam fuel (tt, tt)) as [|(ops, [])].
+        -- inversion Haction.
         -- injection Haction; intros; subst. repeat constructor.
       * injection Haction; intros; subst. repeat constructor.
     + intros (Hlen, (Hcheck, (Hcount, Haction))).
@@ -610,9 +607,8 @@ Proof.
       rewrite List.app_nil_r.
       split; [reflexivity|].
       split; [assumption|].
-      rewrite <- eval_precond_correct.
-      do 2 more_fuel.
-      change (S (S (S (S (S (S (S (S (S (S fuel)))))))))) with (10 + fuel).
+      rewrite fold_eval_seq_precond.
+      rewrite <- eval_seq_precond_correct.
       subst mt.
       rewrite multisig_tail_correct; [|omega].
       split; [reflexivity|].
@@ -621,8 +617,7 @@ Proof.
       split; [assumption|].
       destruct Haction as (Hcounter, Haction).
       destruct action as [(tff, lam)|(nt, nks)].
-      * change (2 + fuel) with (S (S fuel)).
-        destruct (eval _ lam (S (S fuel)) (tt, tt)) as [|(ops, [])].
+      * destruct (eval_seq _ lam fuel (tt, tt)) as [|(ops, [])].
         -- inversion Haction.
         -- destruct Haction as (Ht, (Hk, Hops)); subst; reflexivity.
       * destruct Haction as (Ht, (Hk, Hops)); subst; reflexivity.
diff --git a/src/contracts_coq/manager.v b/src/contracts_coq/manager.v
index a632edbc..714b16fb 100644
--- a/src/contracts_coq/manager.v
+++ b/src/contracts_coq/manager.v
@@ -56,13 +56,13 @@ Definition manager : full_contract _ parameter_ty None storage_ty :=
      (* Execute the lambda argument *)
      UNIT ;;
      EXEC ;;
-     PAIR
+     PAIR ;; NOOP
    )
-   ( (* 'default' entrypoint *)
+   ((* 'default' entrypoint *)
      DROP1 ;;
      NIL operation ;;
-     PAIR
-   )
+     PAIR ;; NOOP
+   ) ;; NOOP
   ).
 
 Definition manager_spec
@@ -82,7 +82,7 @@ Definition manager_spec
     amount env = (0 ~Mutez) /\
     sender env = address_ env unit (implicit_account env storage) /\
     new_storage = storage /\
-    eval (no_self env) lam fuel (tt, tt) = Return (returned_operations, tt)
+    eval_seq (no_self env) lam fuel (tt, tt) = Return (returned_operations, tt)
   end.
 
 Lemma eqb_eq a c1 c2 :
@@ -141,33 +141,31 @@ Lemma manager_correct
       (returned_operations : data (list operation))
       (fuel : Datatypes.nat) :
   fuel >= 42 ->
-  eval env manager (13 + fuel) ((param, storage), tt) = Return ((returned_operations, new_storage), tt)
+  eval_seq env manager (2 + fuel) ((param, storage), tt) = Return ((returned_operations, new_storage), tt)
   <-> manager_spec env storage param new_storage returned_operations fuel.
 Proof.
   intro Hfuel.
-  remember (13 + fuel) as fuel2.
-  assert (30 <= fuel2) by lia.
+  unfold ">=" in Hfuel.
   rewrite return_precond.
-  rewrite eval_precond_correct.
+  rewrite eval_seq_precond_correct.
+  unfold eval_seq_precond.
   unfold manager_spec.
-  do 5 (more_fuel; simpl).
+  more_fuel; simpl.
+  more_fuel; simpl.
   destruct param as [(tff, lam)|[]].
-  - do 5 (more_fuel; simpl).
-    simpl.
+  - simpl.
     rewrite match_if_exchange.
+    more_fuel; simpl.
     rewrite if_false_is_and.
     rewrite (eqb_eq mutez).
     apply and_both.
-    do 5 (more_fuel; simpl).
     rewrite match_if_exchange.
     rewrite if_false_is_and.
     rewrite (eqb_eq address).
     apply and_both.
-    simpl in Heqfuel2.
     repeat rewrite fold_eval_precond.
-    assert (fuel = S (S fuel2)) by lia.
-    subst fuel. clear Hfuel.
-    rewrite <- eval_precond_correct.
+    fold (eval_seq_precond (S (S (S fuel))) (self_type := None)).
+    rewrite <- eval_seq_precond_correct.
     rewrite precond_exists.
     unfold precond_ex.
     split.
diff --git a/src/contracts_coq/multisig.v b/src/contracts_coq/multisig.v
index ad31b670..3ccb4d43 100644
--- a/src/contracts_coq/multisig.v
+++ b/src/contracts_coq/multisig.v
@@ -28,6 +28,7 @@ Require Import semantics.
 Require Import util.
 Import error.
 Require List.
+Require Import Lia.
 
 Module annots.
   Import String.
@@ -55,53 +56,53 @@ Definition pack_ty := pair (pair chain_id address) (pair nat action_ty).
 
 Definition multisig : full_contract _ parameter_ty None storage_ty :=
   (
-    UNPAIR ;; SWAP ;; DUP ;; DIP1 SWAP ;;
+    UNPAIR ;; SWAP ;; DUP ;; DIP1 { SWAP } ;;
     DIP1
       (
         UNPAIR ;;
         DUP ;; SELF (self_type := parameter_ty) (self_annot := None) None I ;; ADDRESS ;; CHAIN_ID ;; PAIR ;; PAIR ;;
         PACK ;;
-        DIP1 ( UNPAIR ;; DIP1 SWAP ) ;; SWAP
+        DIP1 ( UNPAIR ;; DIP1 (SWAP ;; NOOP) ;; NOOP) ;; SWAP ;; NOOP
       ) ;;
 
-    UNPAIR ;; DIP1 SWAP ;;
+    UNPAIR ;; DIP1 (SWAP ;; NOOP) ;;
     ASSERT_CMPEQ ;;
 
-    DIP1 SWAP ;; UNPAIR ;;
+    DIP1 (SWAP ;; NOOP) ;; UNPAIR ;;
     DIP1
       (
         PUSH nat (nat_constant 0%N) ;; SWAP ;;
         ITER
           (
-            DIP1 SWAP ;; SWAP ;;
+            DIP1 (SWAP ;; NOOP) ;; (SWAP) ;;
             IF_CONS
               (
                 IF_SOME
                   ( SWAP ;;
                     DIP1
                       (
-                        SWAP ;; DIIP ( DIP1 DUP ;; SWAP ) ;;
+                        SWAP ;; DIIP ( DIP1 (DUP ;; NOOP) ;; SWAP ;; NOOP) ;;
                         CHECK_SIGNATURE ;; ASSERT ;;
-                        PUSH nat (nat_constant 1%N) ;; ADD_nat))
-                  ( SWAP ;; DROP1 )
+                        PUSH nat (nat_constant 1%N) ;; ADD_nat ;; NOOP) ;; NOOP)
+                  ( SWAP ;; DROP1 ;; NOOP ) ;; NOOP
               )
               (
-                FAIL
+                FAIL ;; NOOP
               ) ;;
-            SWAP
-          )
+            SWAP ;; NOOP
+          ) ;; NOOP
       ) ;;
     ASSERT_CMPLE ;;
     DROP1 ;; DROP1 ;;
 
-    DIP1 ( UNPAIR ;; PUSH nat (nat_constant 1%N) ;; ADD ;; PAIR ) ;;
+    DIP1 ( UNPAIR ;; PUSH nat (nat_constant 1%N) ;; ADD ;; PAIR ;; NOOP ) ;;
 
     NIL operation ;; SWAP ;;
     IF_LEFT
-      ( UNPAIR ;; UNIT ;; TRANSFER_TOKENS ;; CONS )
-      ( IF_LEFT (SET_DELEGATE ;; CONS )
-                ( DIP1 ( SWAP ;; CAR ) ;; SWAP ;; PAIR ;; SWAP )) ;;
-    PAIR ).
+      ( UNPAIR ;; UNIT ;; TRANSFER_TOKENS ;; CONS ;; NOOP )
+      ( IF_LEFT (SET_DELEGATE ;; CONS ;; NOOP )
+                ( DIP1 ( SWAP ;; CAR ;; NOOP ) ;; SWAP ;; PAIR ;; SWAP ;; NOOP ) ;; NOOP) ;;
+    PAIR ;; NOOP )%michelson.
 
 Fixpoint check_all_signatures (sigs : Datatypes.list (Datatypes.option (data signature)))
          (keys : Datatypes.list (data key))
@@ -166,24 +167,24 @@ Definition multisig_spec
       returned_operations = nil
     end.
 
-Definition multisig_head (then_ : instruction (Some (parameter_ty, None)) Datatypes.false (nat ::: list key ::: list (option signature) ::: bytes ::: action_ty ::: storage_ty ::: nil) (pair (list operation) storage_ty ::: nil)) :
-  instruction _ _
-              (pair parameter_ty storage_ty ::: nil)
-              (pair (list operation) storage_ty ::: nil)
+Definition multisig_head :
+  instruction_seq _ _
+                  (pair parameter_ty storage_ty ::: nil)
+                  (nat ::: list key ::: list (option signature) ::: bytes ::: action_ty ::: storage_ty ::: nil)
 :=
-    UNPAIR ;; SWAP ;; DUP ;; DIP1 SWAP ;;
+    UNPAIR ;; SWAP ;; DUP ;; DIP1 (SWAP ;; NOOP) ;;
     DIP1
       (
         UNPAIR ;;
         DUP ;; SELF (self_type := parameter_ty) (self_annot := None) None I ;; ADDRESS ;; CHAIN_ID ;; PAIR ;; PAIR ;;
         PACK ;;
-        DIP1 ( UNPAIR ;; DIP1 SWAP ) ;; SWAP
+        DIP1 ( UNPAIR ;; DIP1 (SWAP ;; NOOP) ;; NOOP ) ;; SWAP ;; NOOP
       ) ;;
 
-    UNPAIR ;; DIP1 SWAP ;;
+    UNPAIR ;; DIP1 (SWAP ;; NOOP) ;;
     ASSERT_CMPEQ ;;
 
-    DIP1 SWAP ;; UNPAIR ;; then_.
+    DIP1 (SWAP ;; NOOP) ;; UNPAIR ;; NOOP.
 
 Definition multisig_head_spec
            (env : @proto_env (Some (parameter_ty, None)))
@@ -194,25 +195,17 @@ Definition multisig_head_spec
            (threshold : N)
            (keys : Datatypes.list (data key))
            (fuel : Datatypes.nat)
-           (then_ :
-              instruction _ Datatypes.false
-                (nat ::: list key ::: list (option signature) ::: bytes :::
-                     action_ty ::: storage_ty ::: nil)
-                (pair (list operation) storage_ty ::: nil))
-           (psi : stack (pair (list operation) storage_ty ::: nil) -> Prop)
+           (psi : stack (nat ::: list key ::: list (option signature) ::: bytes ::: action_ty ::: storage_ty ::: nil) -> Prop)
   :=
   let params : data parameter_ty := ((counter, action), sigs) in
   let storage : data storage_ty := (stored_counter, (threshold, keys)) in
   counter = stored_counter /\
-  precond
-    (eval env
-       then_ fuel
-       (threshold,
+  psi (threshold,
         (keys,
          (sigs,
           (pack env pack_ty
                 ((chain_id_ env, address_ env parameter_ty (self env None I)), (counter, action)),
-           (action, (storage, tt))))))) psi.
+           (action, (storage, tt)))))).
 
 Lemma fold_eval_precond fuel :
   eval_precond_body (@semantics.eval_precond fuel) =
@@ -221,6 +214,13 @@ Proof.
   reflexivity.
 Qed.
 
+Lemma fold_eval_seq_precond fuel :
+  eval_seq_precond_body (@semantics.eval_precond fuel) =
+  @semantics.eval_seq_precond fuel (Some (parameter_ty, None)).
+Proof.
+  reflexivity.
+Qed.
+
 Lemma multisig_head_correct
       (env : @proto_env (Some (parameter_ty, None)))
       (counter : N)
@@ -229,26 +229,20 @@ Lemma multisig_head_correct
       (stored_counter : N)
       (threshold : N)
       (keys : Datatypes.list (data key))
-      (then_ :
-         instruction _ _
-           (nat ::: list key ::: list (option signature) ::: bytes :::
-                action_ty ::: storage_ty ::: nil)
-           (pair (list operation) storage_ty ::: nil))
-      (psi : stack (pair (list operation) storage_ty ::: nil) -> Prop) :
+      (psi : stack (nat ::: list key ::: list (option signature) ::: bytes ::: action_ty ::: storage_ty ::: nil) -> Prop) :
   let params : data parameter_ty := ((counter, action), sigs) in
   let storage : data storage_ty := (stored_counter, (threshold, keys)) in
-  forall fuel, 11 <= fuel ->
-    (precond (eval env (multisig_head then_) (10 + fuel) ((params, storage), tt)) psi)
+  forall fuel, 5 <= fuel ->
+    eval_seq_precond fuel env multisig_head psi ((params, storage), tt)
         <->
     multisig_head_spec env counter action sigs stored_counter threshold keys
-                       fuel then_ psi.
+                       fuel psi.
 Proof.
   intros params storage fuel Hfuel.
-  rewrite eval_precond_correct.
   unfold multisig_head.
   unfold "+", params, storage, multisig_head_spec.
-  rewrite eval_precond_correct.
-  repeat (more_fuel; simpl).
+  unfold eval_seq_precond.
+  do 5 (more_fuel; simpl).
   rewrite match_if_exchange.
   rewrite if_false_is_and.
   rewrite (eqb_eq nat).
@@ -256,33 +250,33 @@ Proof.
 Qed.
 
 Definition multisig_iter_body :
-  instruction _ _
+  instruction_seq _ _
     (key ::: nat ::: list (option signature) ::: bytes ::: action_ty :::
          storage_ty ::: nil)
     (nat ::: list (option signature) ::: bytes ::: action_ty :::
          storage_ty ::: nil)
   :=
-  (DIP1 SWAP ;; SWAP ;;
+  (DIP1 (SWAP ;; NOOP) ;; SWAP ;;
        IF_CONS
        (
          IF_SOME
            ( SWAP ;;
                   DIP1
                   (
-                    SWAP ;; DIIP ( DIP1 DUP ;; SWAP ) ;;
+                    SWAP ;; DIIP ( DIP1 (DUP ;; NOOP) ;; SWAP ;; NOOP ) ;;
                          CHECK_SIGNATURE ;; ASSERT ;;
-                         PUSH nat (nat_constant 1%N) ;; ADD_nat))
-           ( SWAP ;; DROP1 )
+                         PUSH nat (nat_constant 1%N) ;; ADD_nat ;; NOOP) ;; NOOP)
+           ( SWAP ;; DROP1 ;; NOOP ) ;; NOOP
        )
        (
-         FAIL
+         FAIL ;; NOOP
        ) ;;
-       SWAP).
+       SWAP ;; NOOP).
 
 Lemma multisig_iter_body_correct env k n sigs packed
       (st : stack (action_ty ::: storage_ty ::: nil)) fuel psi :
-    14 <= fuel ->
-    precond (eval env multisig_iter_body fuel (k, (n, (sigs, (packed, st))))) psi
+    6 <= fuel ->
+    precond (eval_seq env multisig_iter_body fuel (k, (n, (sigs, (packed, st))))) psi
     <->
     match sigs with
     | nil => false
@@ -293,9 +287,9 @@ Lemma multisig_iter_body_correct env k n sigs packed
     end.
 Proof.
   intro Hfuel.
-  rewrite eval_precond_correct.
-  repeat more_fuel.
-  simpl.
+  rewrite eval_seq_precond_correct.
+  unfold eval_seq_precond.
+  repeat (more_fuel; simpl).
   destruct sigs as [|[sig|] sigs].
   - reflexivity.
   - rewrite match_if_exchange.
@@ -319,7 +313,7 @@ Definition multisig_iter :
 
 Lemma multisig_iter_correct env keys n sigs packed
       (st : stack (action_ty ::: storage_ty ::: nil)) fuel psi :
-    length keys * 14 + 1 <= fuel ->
+    length keys + 6 <= fuel ->
     precond (eval env multisig_iter fuel (keys, (n, (sigs, (packed, st))))) psi <->
     (exists first_sigs remaining_sigs,
         length first_sigs = length keys /\
@@ -349,10 +343,12 @@ Proof.
       exact H.
   - simpl in Hfuel.
     more_fuel.
-    change (13 + (length keys * 14 + 1) <= fuel) in Hfuel.
-    assert (length keys * 14 + 1 <= fuel) as Hfuel2 by (transitivity (13 + (length keys * 14 + 1)); [repeat constructor| apply Hfuel]).
+    unfold multisig_iter.
+    remember multisig_iter_body as mib.
     simpl.
-    rewrite <- eval_precond_correct.
+    rewrite fold_eval_seq_precond.
+    rewrite <- eval_seq_precond_correct.
+    subst mib.
     rewrite multisig_iter_body_correct.
     + destruct sigs as [|[sig|] sigs].
       * split; [intro H; inversion H|].
@@ -365,7 +361,7 @@ Proof.
         discriminate.
       * split.
         -- intros (Hcheck, Hrec).
-           specialize (IHkeys (1 + n)%N sigs packed fuel Hfuel2).
+           specialize (IHkeys (1 + n)%N sigs packed fuel Hfuel).
            rewrite IHkeys in Hrec.
            destruct Hrec as (first_sigs, (remaining_sigs, (Hlen, (Happ, (Hchecks, H))))).
            exists (Some sig :: first_sigs)%list.
@@ -391,7 +387,7 @@ Proof.
               destruct (check_signature env key sig packed).
               ** simpl in Hchecks.
                  split; [reflexivity|].
-                 apply (IHkeys _ _ _ _ Hfuel2).
+                 apply (IHkeys _ _ _ _ Hfuel).
                  exists first_sigs; exists remaining_sigs.
                  simpl in Hlen.
                  apply NPeano.Nat.succ_inj in Hlen.
@@ -405,7 +401,7 @@ Proof.
                  inversion Hchecks.
            ++ simpl in Happ.
               discriminate.
-      * rewrite (IHkeys _ _ _ _ Hfuel2).
+      * rewrite (IHkeys _ _ _ _ Hfuel).
         split;
           intros (first_sigs, (remaining_sigs, (Hlen, (Happ, (Hchecks, H))))).
         -- exists (None :: first_sigs)%list.
@@ -427,40 +423,35 @@ Proof.
               split; [injection Happ; auto|].
               split; [exact Hchecks|].
               exact H.
-    + transitivity (13 + (length keys * 14 + 1)).
-      * destruct (length keys).
-        -- simpl. constructor.
-        -- simpl. repeat (apply Le.le_n_S).
-           apply le_0_n.
-      * assumption.
+    + lia.
 Qed.
 
 Definition multisig_tail :
-  instruction _ _
+  instruction_seq _ _
     (nat ::: nat ::: list (option signature) ::: bytes ::: action_ty :::
          storage_ty ::: nil)
     (pair (list operation) storage_ty ::: nil) :=
       ASSERT_CMPLE ;;
     DROP1 ;; DROP1 ;;
 
-    DIP1 ( UNPAIR ;; PUSH nat (nat_constant 1%N) ;; ADD_nat ;; PAIR ) ;;
+    DIP1 ( UNPAIR ;; PUSH nat (nat_constant 1%N) ;; ADD_nat ;; PAIR ;; NOOP ) ;;
 
     NIL operation ;; SWAP ;;
     IF_LEFT
-      ( UNPAIR ;; UNIT ;; TRANSFER_TOKENS ;; CONS )
-      ( IF_LEFT (SET_DELEGATE ;; CONS )
-                ( DIP1 ( SWAP ;; CAR ) ;; SWAP ;; PAIR ;; SWAP )) ;;
-    PAIR.
+      ( UNPAIR ;; UNIT ;; TRANSFER_TOKENS ;; CONS ;; NOOP )
+      ( IF_LEFT (SET_DELEGATE ;; CONS ;; NOOP )
+                ( DIP1 ( SWAP ;; CAR ;; NOOP ) ;; SWAP ;; PAIR ;; SWAP ;; NOOP ) ;; NOOP) ;;
+    PAIR ;; NOOP.
 
-Lemma multisig_split : multisig = multisig_head (DIP1 (PUSH nat (nat_constant 0%N);; SWAP;; multisig_iter);; multisig_tail).
+Lemma multisig_split : multisig = (multisig_head ;;; DIP1 (PUSH nat (nat_constant 0%N);; SWAP;; multisig_iter ;; NOOP);; multisig_tail).
 Proof.
   reflexivity.
 Qed.
 
 Lemma multisig_tail_correct
       env threshold n sigs packed action counter keys psi fuel :
-    13 <= fuel ->
-    precond (eval env multisig_tail fuel (threshold, (n, (sigs, (packed, (action, ((counter, (threshold, keys)), tt))))))) psi <->
+    4 <= fuel ->
+    precond (eval_seq env multisig_tail fuel (threshold, (n, (sigs, (packed, (action, ((counter, (threshold, keys)), tt))))))) psi <->
     ((threshold <= n)%N /\
      match action with
      | inl (amout, contr) =>
@@ -473,9 +464,10 @@ Lemma multisig_tail_correct
 Proof.
   intro Hfuel.
   change (data (list key)) in keys.
-  rewrite eval_precond_correct.
+  rewrite eval_seq_precond_correct.
   unfold multisig_tail.
-  do 6 more_fuel.
+  repeat more_fuel.
+  unfold eval_seq_precond.
   simpl.
   rewrite match_if_exchange.
   rewrite if_false_is_and.
@@ -484,12 +476,11 @@ Proof.
   rewrite N.compare_lt_iff.
   rewrite <- N.le_lteq.
   apply and_both.
-  repeat more_fuel.
-  simpl.
   destruct action as [(amount, contract)|[delegate_key_hash|(new_threshold, new_keys)]];
       reflexivity.
 Qed.
 
+
 Lemma multisig_correct
       (env : @proto_env (Some (parameter_ty, None)))
       (counter : N)
@@ -506,100 +497,81 @@ Lemma multisig_correct
   let params : data parameter_ty := ((counter, action), sigs) in
   let storage : data storage_ty := (stored_counter, (threshold, keys)) in
   let new_storage : data storage_ty := (new_stored_counter, (new_threshold, new_keys)) in
-  14 * length keys + 37 <= fuel ->
-  eval env multisig fuel ((params, storage), tt) = Return ((returned_operations, new_storage), tt) <->
+  length keys + 7 <= fuel ->
+  eval_seq env multisig fuel ((params, storage), tt) = Return ((returned_operations, new_storage), tt) <->
   multisig_spec env counter action sigs stored_counter threshold keys new_stored_counter new_threshold new_keys returned_operations.
 Proof.
   intros params storage new_storage Hfuel.
-  rewrite return_precond.
   rewrite multisig_split.
+  rewrite return_precond.
   rewrite PeanoNat.Nat.add_comm in Hfuel.
-  do 10 more_fuel.
-  change (S (S (S (S (S (S (S (S (S (S fuel)))))))))) with (10 + fuel).
   unfold params, storage.
-  rewrite multisig_head_correct.
-  - unfold multisig_head_spec, multisig_spec.
-    apply and_both_2.
-    intro; subst counter.
-    clear params.
-    unfold eval.
-    rewrite eval_precond_correct.
-    more_fuel; simpl.
-    match goal with
-    | |- eval_precond fuel env ?i ?t ?st <-> ?r =>
-      pose (t) as then_; change (eval_precond fuel env i then_ st <-> r)
-    end.
-    more_fuel; simpl.
-    more_fuel; simpl.
-    more_fuel; simpl.
-    simpl.
-    match goal with
-    | |- eval_precond fuel env ?i ?t ?st <-> ?r =>
-      pose (t) as iter; change (eval_precond fuel env i iter st <-> r)
-    end.
-    more_fuel. simpl.
-    subst iter.
-    rewrite <- eval_precond_correct.
-    rewrite multisig_iter_correct.
-    apply forall_ex; intro first_sigs.
-    apply forall_ex; intro remaining_sigs.
-    rewrite and_comm_3.
-    apply and_both.
-    apply and_both.
-    apply and_both.
-    unfold then_.
-    rewrite <- eval_precond_correct.
-    rewrite multisig_tail_correct.
-    rewrite N.add_0_r.
-    rewrite N.ge_le_iff.
-    apply and_both.
-    destruct action as [(amount, contr)|[delegate_key_hash|(new_t, new_k)]].
-    + split.
-      * intro H.
-        injection H.
-        intro; subst keys.
-        intro; subst threshold.
-        intro; subst new_stored_counter.
-        intro; subst returned_operations.
-        intuition reflexivity.
-      * intros (Hcounter, (Hthreshold, (Hkeys, Hoper))).
-        subst new_stored_counter; subst keys; subst threshold; subst returned_operations.
-        reflexivity.
-    + split.
-      * intros H.
-        injection H.
-        intro; subst keys.
-        intro; subst threshold.
-        intro; subst new_stored_counter.
-        intro; subst returned_operations.
-        intuition reflexivity.
-      * intros (Hcounter, (Hthreshold, (Hkeys, Hoper))).
-        subst new_stored_counter; subst keys; subst threshold; subst returned_operations.
-        reflexivity.
-    + split.
-      * intro H.
-        injection H.
-        intro; subst new_keys.
-        intro; subst new_threshold.
-        intro; subst new_stored_counter.
-        intro; subst returned_operations.
-        intuition reflexivity.
-      * intros (Hcounter, (Hthreshold, (Hkeys, Hoper))).
-        subst new_stored_counter; subst new_keys; subst new_threshold; subst returned_operations.
-        reflexivity.
-    + repeat apply Le.le_n_S.
-      refine (NPeano.Nat.le_trans _ _ _ _ Hfuel).
-      repeat apply Le.le_n_S.
-      apply le_0_n.
-    + rewrite PeanoNat.Nat.add_comm.
-      apply Le.le_n_S.
-      refine (NPeano.Nat.le_trans _ _ _ _ Hfuel).
-      repeat constructor.
-      rewrite PeanoNat.Nat.mul_comm.
-      constructor.
-  - refine (NPeano.Nat.le_trans _ _ _ _ Hfuel).
-    repeat apply Le.le_n_S.
-    apply le_0_n.
+  rewrite eval_seq_precond_correct.
+  rewrite eval_seq_assoc.
+  rewrite multisig_head_correct; [|lia].
+  unfold multisig_head_spec, multisig_spec.
+  apply and_both_2.
+  intro; subst counter.
+  clear params.
+  unfold eval_seq_precond.
+  remember multisig_iter as iter.
+  remember multisig_tail as tail.
+  simpl.
+  more_fuel; simpl.
+  more_fuel; simpl.
+  subst iter.
+  rewrite fold_eval_precond.
+  rewrite <- eval_precond_correct.
+  rewrite multisig_iter_correct; [|rewrite NPeano.Nat.add_comm; apply Le.le_n_S; apply Hfuel].
+  apply forall_ex; intro first_sigs.
+  apply forall_ex; intro remaining_sigs.
+  rewrite and_comm_3.
+  apply and_both.
+  apply and_both.
+  apply and_both.
+  change (@eval_precond_body (@eval_precond fuel)) with (@eval_precond (S fuel)).
+  change (@eval_precond_body (@eval_precond (S fuel))) with (@eval_precond (S (S fuel))).
+  rewrite fold_eval_seq_precond.
+  rewrite <- eval_seq_precond_correct.
+  subst tail.
+  rewrite multisig_tail_correct; [|lia].
+  rewrite N.add_0_r.
+  rewrite N.ge_le_iff.
+  apply and_both.
+  destruct action as [(amount, contr)|[delegate_key_hash|(new_t, new_k)]].
+  - split.
+    + intro H.
+      injection H.
+      intro; subst keys.
+      intro; subst threshold.
+      intro; subst new_stored_counter.
+      intro; subst returned_operations.
+      intuition reflexivity.
+    + intros (Hcounter, (Hthreshold, (Hkeys, Hoper))).
+      subst new_stored_counter; subst keys; subst threshold; subst returned_operations.
+      reflexivity.
+  - split.
+    + intros H.
+      injection H.
+      intro; subst keys.
+      intro; subst threshold.
+      intro; subst new_stored_counter.
+      intro; subst returned_operations.
+      intuition reflexivity.
+    + intros (Hcounter, (Hthreshold, (Hkeys, Hoper))).
+      subst new_stored_counter; subst keys; subst threshold; subst returned_operations.
+      reflexivity.
+  - split.
+    + intro H.
+      injection H.
+      intro; subst new_keys.
+      intro; subst new_threshold.
+      intro; subst new_stored_counter.
+      intro; subst returned_operations.
+      intuition reflexivity.
+    + intros (Hcounter, (Hthreshold, (Hkeys, Hoper))).
+      subst new_stored_counter; subst new_keys; subst new_threshold; subst returned_operations.
+      reflexivity.
 Qed.
 
 End multisig.
diff --git a/src/contracts_coq/vote.v b/src/contracts_coq/vote.v
index 86fa3277..c67bc2b9 100644
--- a/src/contracts_coq/vote.v
+++ b/src/contracts_coq/vote.v
@@ -37,14 +37,14 @@ Definition vote : full_contract _ parameter_ty None storage_ty :=
     AMOUNT ;;
     PUSH mutez (5000000 ~mutez);;
     COMPARE;; GT;;
-    IF ( FAIL ) ( NOOP );;
-    DUP;; DIP1 ( CDR;; DUP );; CAR;; DUP;;
+    IF ( FAIL;; NOOP ) ( NOOP );;
+    DUP;; DIP1 ( CDR;; DUP;; NOOP );; CAR;; DUP;;
     DIP1 (
       GET (i := get_map string int);; ASSERT_SOME;;
-      PUSH int (Int_constant 1%Z);; ADD (s := add_int_int);; SOME
+      PUSH int (Int_constant 1%Z);; ADD (s := add_int_int);; SOME;; NOOP
     );;
     UPDATE (i := Mk_update string (option int) (map string int) (Update_variant_map string int));;
-    NIL operation;; PAIR ).
+    NIL operation;; PAIR;; NOOP ).
 
 Definition vote_spec
            (env : @proto_env (Some (parameter_ty, None)))
@@ -86,14 +86,15 @@ Theorem vote_correct
       (returned_operations : data (list operation))
       (fuel : Datatypes.nat) :
   fuel >= 42 ->
-  eval env vote fuel ((param, storage), tt) = Return ((returned_operations, new_storage), tt)
+  eval_seq env vote fuel ((param, storage), tt) = Return ((returned_operations, new_storage), tt)
   <-> vote_spec env storage param new_storage returned_operations.
 Proof.
   intro Hfuel. unfold ">=" in Hfuel.
   unfold eval.
   rewrite return_precond.
-  rewrite eval_precond_correct.
-  do 15 (more_fuel; simpl).
+  rewrite eval_seq_precond_correct.
+  unfold eval_seq_precond.
+  do 3 (more_fuel; simpl).
   rewrite match_if_exchange.
   rewrite if_false_not.
   apply and_both_0.
@@ -105,7 +106,6 @@ Proof.
   - (* Enough tez sent to contract *)
     destruct (map.get str Z string_compare param storage) eqn:mapget.
     + (* Key is in the map *)
-      more_fuel; simpl.
       split; intros.
       * (* ->  *)
         simpl in *.
diff --git a/src/michocoq/macros.v b/src/michocoq/macros.v
index 67f505cd..116e22b3 100644
--- a/src/michocoq/macros.v
+++ b/src/michocoq/macros.v
@@ -26,7 +26,8 @@ Section macros.
   Context {self_type : self_info}.
 
 Definition CMPop (a : comparable_type) S (op : instruction self_type Datatypes.false (int ::: S) (bool ::: S))
-           : instruction self_type Datatypes.false (a ::: a ::: S) (bool ::: S) := COMPARE ;; op.
+  : instruction self_type Datatypes.false (a ::: a ::: S) (bool ::: S) :=
+  Instruction_seq { COMPARE; op }.
 
 Definition CMPEQ {a S} := CMPop a S EQ.
 Definition CMPNEQ {a S} := CMPop a S NEQ.
@@ -35,10 +36,15 @@ Definition CMPGT {a S} := CMPop a S GT.
 Definition CMPLE {a S} := CMPop a S LE.
 Definition CMPGE {a S} := CMPop a S GE.
 
+Definition wrap_IF {SA SB tffa tffb} (bt : instruction_seq self_type tffa SA SB) (bf : instruction_seq self_type tffb SA SB)
+  : instruction_seq self_type (tffa && tffb)%bool (bool ::: SA) SB :=
+  instruction_wrap (IF_ IF_bool bt bf).
+
 Definition IFop SA SB tffa tffb
-           (bt : instruction self_type tffa SA SB) (bf : instruction self_type tffb SA SB)
-           (op : instruction self_type Datatypes.false (int ::: SA) (bool ::: SA)) :=
-  op ;; IF bt bf.
+           (bt : instruction_seq self_type tffa SA SB) (bf : instruction_seq self_type tffb SA SB)
+           (op : instruction self_type Datatypes.false (int ::: SA) (bool ::: SA))
+  : instruction self_type (tffa && tffb)%bool (int ::: SA) SB :=
+  Instruction_seq (op ;; wrap_IF bt bf).
 
 Definition IFEQ {SA SB tffa tffb} bt bf := IFop SA SB tffa tffb bt bf EQ.
 Definition IFNEQ {SA SB tffa tffb} bt bf := IFop SA SB tffa tffb bt bf NEQ.
@@ -48,10 +54,10 @@ Definition IFLE {SA SB tffa tffb} bt bf := IFop SA SB tffa tffb bt bf LE.
 Definition IFGE {SA SB tffa tffb} bt bf := IFop SA SB tffa tffb bt bf GE.
 
 Definition IFCMPop (a : comparable_type) SA SB tffa tffb
-           (bt : instruction self_type tffa SA SB) (bf : instruction self_type tffb SA SB)
+           (bt : instruction_seq self_type tffa SA SB) (bf : instruction_seq self_type tffb SA SB)
            (op : instruction self_type Datatypes.false (int ::: SA) (bool ::: SA)) :
   instruction self_type (tffa && tffb) (a ::: a ::: SA) SB :=
-  COMPARE ;; op ;; IF bt bf.
+  Instruction_seq (COMPARE ;; op ;; wrap_IF bt bf).
 
 Definition IFCMPEQ {a SA SB tffa tffb} bt bf := IFCMPop a SA SB tffa tffb bt bf EQ.
 Definition IFCMPNEQ {a SA SB tffa tffb} bt bf := IFCMPop a SA SB tffa tffb bt bf NEQ.
@@ -60,12 +66,14 @@ Definition IFCMPGT {a SA SB tffa tffb} bt bf := IFCMPop a SA SB tffa tffb bt bf
 Definition IFCMPLE {a SA SB tffa tffb} bt bf := IFCMPop a SA SB tffa tffb bt bf LE.
 Definition IFCMPGE {a SA SB tffa tffb} bt bf := IFCMPop a SA SB tffa tffb bt bf GE.
 
-Definition FAIL {SA SB} : instruction self_type Datatypes.true SA SB := UNIT ;; FAILWITH.
+Definition FAIL {SA SB} : instruction self_type Datatypes.true SA SB :=
+  Instruction_seq { UNIT; FAILWITH }.
 
-Definition ASSERT {S} : instruction self_type Datatypes.false (bool ::: S) S := (IF_ IF_bool) NOOP FAIL.
+Definition ASSERT {S} : instruction self_type Datatypes.false (bool ::: S) S :=
+  IF_ IF_bool {} { FAIL }.
 
 Definition ASSERT_op S (op : instruction self_type Datatypes.false (int ::: S) (bool ::: S)) : instruction self_type Datatypes.false (int ::: S) S :=
-  IFop _ _ _ _ NOOP FAIL op.
+  IFop _ _ _ _ {} { FAIL } op.
 
 Definition ASSERT_EQ {S} := ASSERT_op S EQ.
 Definition ASSERT_NEQ {S} := ASSERT_op S NEQ.
@@ -75,7 +83,8 @@ Definition ASSERT_LE {S} := ASSERT_op S LE.
 Definition ASSERT_GE {S} := ASSERT_op S GE.
 
 Definition ASSERT_CMPop (a : comparable_type) S (op : instruction self_type Datatypes.false (int ::: S) (bool ::: S))
-  : instruction self_type Datatypes.false (a ::: a ::: S) S := IFCMPop _ _ _ _ _ NOOP FAIL op.
+  : instruction self_type Datatypes.false (a ::: a ::: S) S :=
+  IFCMPop _ _ _ _ _ {} { FAIL } op.
 
 Definition ASSERT_CMPEQ {a S} := ASSERT_CMPop a S EQ.
 Definition ASSERT_CMPNEQ {a S} := ASSERT_CMPop a S NEQ.
@@ -85,15 +94,16 @@ Definition ASSERT_CMPLE {a S} := ASSERT_CMPop a S LE.
 Definition ASSERT_CMPGE {a S} := ASSERT_CMPop a S GE.
 
 Definition ASSERT_NONE {a S} : instruction self_type Datatypes.false (option a ::: S) S :=
-  IF_NONE NOOP FAIL.
+  IF_NONE {} { FAIL }.
 
 Definition ASSERT_SOME {a S} : instruction self_type Datatypes.false (option a ::: S) (a ::: S) :=
-  IF_NONE FAIL NOOP.
+  IF_NONE { FAIL } {}.
 
 Definition ASSERT_LEFT {a b an bn S} : instruction self_type Datatypes.false (or a an b bn ::: S) (a ::: S) :=
-  IF_LEFT NOOP FAIL.
+  IF_LEFT {} { FAIL }.
+
 Definition ASSERT_RIGHT {a b an bn S} : instruction self_type Datatypes.false (or a an b bn ::: S) (b ::: S) :=
-  IF_LEFT FAIL NOOP.
+  IF_LEFT { FAIL } {}.
 
 Definition DROP1 {a SA} : instruction self_type Datatypes.false (a ::: SA) SA :=
   DROP (A := a ::: nil) 1 eq_refl.
@@ -110,10 +120,10 @@ Definition DIIIIP {a b c d SA SB} code :
   DIP (A := (a ::: b ::: c ::: d ::: nil)) 4 eq_refl code.
 
 Definition DUUP {a b S} : instruction self_type Datatypes.false (a ::: b ::: S) (b ::: a ::: b ::: S) :=
-  DIP1 DUP ;; SWAP.
+  Instruction_seq { DIP1 { DUP }; SWAP }.
 
 Definition DUPn {A b C} n (H : length A = n) : instruction self_type Datatypes.false (A +++ b ::: C) (b ::: A +++ b ::: C) :=
-  DIG n H ;; DUP ;; DIP1 (DUG n H).
+  Instruction_seq { DIG n H; DUP; DIP1 { DUG n H }}.
 
 Definition DUUUP {a b c S} : instruction self_type Datatypes.false (a ::: b ::: c ::: S) (c ::: a ::: b ::: c ::: S) :=
   DUPn (A := a ::: b ::: nil) 2 eq_refl.
@@ -124,41 +134,45 @@ Definition DUUUUP {a b c d S} : instruction self_type Datatypes.false (a ::: b :
 (* Missing: PAPPAIIR and such *)
 
 Definition UNPAIR {a b S} : instruction self_type Datatypes.false (pair a b ::: S) (a ::: b ::: S) :=
-  DUP ;; CAR ;; DIP1 CDR.
+  Instruction_seq { DUP; CAR; DIP1 (instruction_wrap CDR) }%michelson.
 
 Definition CAAR {a b c S} : instruction self_type Datatypes.false (pair (pair a b) c ::: S) (a ::: S) :=
-  CAR ;; CAR.
+  Instruction_seq { CAR; CAR }.
 
 Definition CADR {a b c S} : instruction self_type Datatypes.false (pair (pair a b) c ::: S) (b ::: S) :=
-  CAR ;; CDR.
+  Instruction_seq { CAR; CDR}.
 
 Definition CDAR {a b c S} : instruction self_type Datatypes.false (pair a (pair b c) ::: S) (b ::: S) :=
-  CDR ;; CAR.
+  Instruction_seq { CDR; CAR}.
 
 Definition CDDR {a b c S} : instruction self_type Datatypes.false (pair a (pair b c) ::: S) (c ::: S) :=
-  CDR ;; CDR.
+  Instruction_seq { CDR; CDR}.
 
-Definition IF_SOME {a SA SB tffa tffb} (bt : instruction self_type tffa _ _) (bf : instruction self_type tffb _ _) : instruction self_type _ (option a ::: SA) SB :=
+Definition IF_SOME {a SA SB tffa tffb} (bt : instruction_seq self_type tffa _ _) (bf : instruction_seq self_type tffb _ _) : instruction self_type _ (option a ::: SA) SB :=
   IF_NONE bf bt.
 
-Definition IF_RIGHT {a an b bn SA SB tffa tffb} (bt : instruction self_type tffa _ _) (bf : instruction self_type tffb _ _) : instruction self_type _ (or a an b bn ::: SA) SB :=
+Definition IF_RIGHT {a an b bn SA SB tffa tffb} (bt : instruction_seq self_type tffa _ _) (bf : instruction_seq self_type tffb _ _) : instruction self_type _ (or a an b bn ::: SA) SB :=
   IF_LEFT bf bt.
 
 Definition SET_CAR {a b S} : instruction self_type Datatypes.false (pair a b ::: a ::: S) (pair a b ::: S) :=
-  CDR ;; SWAP ;; PAIR.
+  Instruction_seq { CDR; SWAP; PAIR }%michelson.
 
 Definition SET_CDR {a b S} : instruction self_type Datatypes.false (pair a b ::: b ::: S) (pair a b ::: S) :=
-  CAR ;; PAIR.
+  Instruction_seq { CAR; PAIR }%michelson.
 
-Definition MAP_CAR {a1 a2 b S} (code : instruction self_type Datatypes.false (a1 ::: S) (a2 ::: S)) :
+Definition MAP_CAR {a1 a2 b S} (code : instruction_seq self_type Datatypes.false (a1 ::: S) (a2 ::: S)) :
   instruction self_type Datatypes.false (pair a1 b ::: S) (pair a2 b ::: S) :=
-  DUP ;; CDR ;; DIP1 (CAR ;; code) ;; SWAP ;; PAIR.
+  Instruction_seq { DUP; CDR; DIP1 { CAR; Instruction_seq code}; SWAP; PAIR }%michelson.
 
-Definition MAP_CDR {a b1 b2 S} (code : instruction self_type Datatypes.false (b1 ::: pair a b1 ::: S) (b2 ::: pair a b1 ::: S)) :
+Definition MAP_CDR {a b1 b2 S} (code : instruction_seq self_type Datatypes.false (b1 ::: pair a b1 ::: S) (b2 ::: pair a b1 ::: S)) :
   instruction self_type Datatypes.false (pair a b1 ::: S) (pair a b2 ::: S) :=
-  DUP ;; CDR ;; code ;; SWAP ;; CAR ;; PAIR.
+  Instruction_seq { DUP; CDR; Instruction_seq code; SWAP; CAR; PAIR}%michelson.
 
+Definition UNPAPAIR {a b c S} : instruction self_type Datatypes.false (pair a (pair b c) :: S) (a ::: b ::: c ::: S) :=
+  Instruction_seq { UNPAIR; DIP1 { UNPAIR } }.
+
+Definition PAPAIR {a b c S} : instruction self_type Datatypes.false (a ::: b ::: c ::: S) (pair a (pair b c) :: S) :=
+  Instruction_seq { DIP1 { PAIR }; PAIR }.
 
-Definition UNPAPAIR {a b c S} : instruction self_type Datatypes.false (pair a (pair b c) :: S) (a ::: b ::: c ::: S) := UNPAIR ;; DIP1 UNPAIR.
-Definition PAPAIR {a b c S} : instruction self_type Datatypes.false (a ::: b ::: c ::: S) (pair a (pair b c) :: S) := DIP1 PAIR;; PAIR.
 End macros.
+
diff --git a/src/michocoq/main.v b/src/michocoq/main.v
index 23bef48a..609543d5 100644
--- a/src/michocoq/main.v
+++ b/src/michocoq/main.v
@@ -45,7 +45,7 @@ Definition contract_file_M : error.M syntax.contract_file :=
   let! existT _ tff code :=
     let! a := michelson_M in
     let i := a.(micheline2michelson.code) in
-    typer.type_check_instruction typer.type_instruction i _ _ in
+    typer.type_check_instruction_seq typer.type_instruction_seq i _ _ in
   error.Return
     {| contract_file_parameter := self_type;
        contract_file_annotation := None;
diff --git a/src/michocoq/micheline2michelson.v b/src/michocoq/micheline2michelson.v
index 6ad3357c..ee56db51 100644
--- a/src/michocoq/micheline2michelson.v
+++ b/src/michocoq/micheline2michelson.v
@@ -35,6 +35,7 @@ Fixpoint micheline2michelson_ctype (bem : loc_micheline) : M comparable_type :=
   end.
 
 Notation "A ;; B" := (untyped_syntax.SEQ A B) (at level 100, right associativity).
+Notation "A ;;; B" := (untyped_syntax.instruction_app A B) (at level 100, right associativity).
 
 Fixpoint micheline2michelson_type (bem : loc_micheline) : M type :=
   try (let! ty := micheline2michelson_sctype bem in Return (Comparable_type ty))
@@ -130,14 +131,14 @@ Definition op_of_string (s : String.string) b e :=
   | _ => Failed _ (Expansion b e)
   end.
 
-Definition FAIL := UNIT ;; FAILWITH.
+Definition FAIL := UNIT ;; FAILWITH ;; NOOP.
 Definition ASSERT := (IF_ IF_bool) NOOP FAIL.
 
 Definition IF_op_of_string (s : String.string) b e bt bf :=
   match s with
   | String "I" (String "F" s) =>
     let! op := op_of_string s b e in
-    Return (op ;; IF_ IF_bool bt bf)
+    Return (op ;; IF_ IF_bool bt bf ;; NOOP)
   | _ => Failed _ (Expansion b e)
   end.
 
@@ -145,7 +146,7 @@ Definition ASSERT_op_of_string (s : String.string) b e :=
   match s with
   | String "A" (String "S" (String "S" (String "E" (String "R" (String "T" (String "_" s)))))) =>
     let! op := op_of_string s b e in
-    Return (op ;; ASSERT)
+    Return (op ;; ASSERT ;; NOOP)
   | _ => Failed _ (Expansion b e)
   end.
 
@@ -154,16 +155,10 @@ Definition ASSERT_SOME := IF_NONE FAIL NOOP.
 Definition ASSERT_LEFT := IF_LEFT NOOP FAIL.
 Definition ASSERT_RIGHT := IF_LEFT FAIL NOOP.
 
-Fixpoint DIPn n code :=
-  match n with
-  | 0 => code
-  | S n => DIP 1 (DIPn n code)
-  end.
-
 Fixpoint DUP_Sn n :=
   match n with
-  | 0 => instruction_opcode DUP
-  | S n => DIP 1 (DUP_Sn n) ;; instruction_opcode SWAP
+  | 0 => instruction_opcode DUP ;; NOOP
+  | S n => DIP 1 (DUP_Sn n) ;; instruction_opcode SWAP ;; NOOP
   end.
 
 Definition IF_SOME bt bf := IF_NONE bf bt.
@@ -175,36 +170,36 @@ Inductive cadr : Set :=
 | Cadr_CDR : cadr -> cadr
 | Cadr_nil : cadr.
 
-Fixpoint micheline2michelson_cadr (x : cadr) : instruction :=
+Fixpoint micheline2michelson_cadr (x : cadr) : instruction_seq :=
   match x with
   | Cadr_CAR x => CAR ;; micheline2michelson_cadr x
   | Cadr_CDR x => CDR ;; micheline2michelson_cadr x
   | Cadr_nil => NOOP
   end.
 
-Fixpoint micheline2michelson_set_cadr (x : cadr) : instruction :=
+Fixpoint micheline2michelson_set_cadr (x : cadr) : instruction_seq :=
   match x with
   | Cadr_CAR Cadr_nil =>
-    CDR ;; SWAP ;; PAIR
+    CDR ;; SWAP ;; PAIR ;; NOOP
   | Cadr_CDR Cadr_nil =>
-    CAR ;; PAIR
+    CAR ;; PAIR ;; NOOP
   | Cadr_CAR x =>
-    DUP ;; DIP 1 (CAR;; micheline2michelson_set_cadr x) ;; CDR ;; SWAP ;; PAIR
+    DUP ;; DIP 1 (CAR;; micheline2michelson_set_cadr x) ;; CDR ;; SWAP ;; PAIR ;; NOOP
   | Cadr_CDR x =>
-    DUP ;; DIP 1 (CDR;; micheline2michelson_set_cadr x) ;; CAR ;; PAIR
+    DUP ;; DIP 1 (CDR;; micheline2michelson_set_cadr x) ;; CAR ;; PAIR ;; NOOP
   | Cadr_nil => NOOP (* Should not happen *)
   end.
 
-Fixpoint micheline2michelson_map_cadr (x : cadr) (code : instruction) : instruction :=
+Fixpoint micheline2michelson_map_cadr (x : cadr) (code : instruction_seq) : instruction_seq :=
   match x with
   | Cadr_CAR Cadr_nil =>
-    DUP ;; CDR ;; DIP 1 ( CAR ;; code ) ;; SWAP ;; PAIR
+    DUP ;; CDR ;; DIP 1 ( CAR ;; code ) ;; SWAP ;; PAIR ;; NOOP
   | Cadr_CDR Cadr_nil =>
-    DUP ;; CDR ;; code ;; SWAP ;; CAR ;; PAIR
+    DUP ;; CDR ;; code ;;; SWAP ;; CAR ;; PAIR ;; NOOP
   | Cadr_CAR x =>
-    DUP ;; DIP 1 (CAR;; micheline2michelson_map_cadr x code) ;; CDR ;; SWAP ;; PAIR
+    DUP ;; DIP 1 (CAR;; micheline2michelson_map_cadr x code) ;; CDR ;; SWAP ;; PAIR ;; NOOP
   | Cadr_CDR x =>
-    DUP ;; DIP 1 (CDR;; micheline2michelson_map_cadr x code) ;; CAR ;; PAIR
+    DUP ;; DIP 1 (CDR;; micheline2michelson_map_cadr x code) ;; CAR ;; PAIR ;; NOOP
   | Cadr_nil => code (* Should not happen *)
   end.
 
@@ -319,29 +314,30 @@ Next Obligation.
   lia.
 Defined.
 
-Fixpoint micheline2michelson_papair (x : papair) : instruction :=
+Fixpoint micheline2michelson_papair (x : papair) : instruction_seq :=
   match x with
-  | Papair_PAIR => PAIR
-  | Papair_A y => DIP 1 (micheline2michelson_papair y) ;; PAIR
-  | Papair_I x => micheline2michelson_papair x ;; PAIR
-  | Papair_P x y => micheline2michelson_papair x ;;
+  | Papair_PAIR => PAIR ;; NOOP
+  | Papair_A y => DIP 1 (micheline2michelson_papair y) ;; PAIR ;; NOOP
+  | Papair_I x => micheline2michelson_papair x ;;; PAIR ;; NOOP
+  | Papair_P x y => micheline2michelson_papair x ;;;
                     DIP 1 (micheline2michelson_papair y) ;;
-                    PAIR
+                    PAIR ;; NOOP
   end.
 
-Definition UNPAIR := DUP ;; CAR ;; DIP 1 CDR.
+Definition UNPAIR := DUP ;; CAR ;; DIP 1 (CDR ;; NOOP) ;; NOOP.
 
-Fixpoint micheline2michelson_unpapair (x : papair) : instruction :=
+Fixpoint micheline2michelson_unpapair (x : papair) : instruction_seq :=
   match x with
   | Papair_PAIR => UNPAIR
-  | Papair_A y => UNPAIR ;; DIP 1 (micheline2michelson_unpapair y)
-  | Papair_I x => UNPAIR ;; micheline2michelson_unpapair x
-  | Papair_P x y => UNPAIR ;;
+  | Papair_A y => UNPAIR ;;; DIP 1 (micheline2michelson_unpapair y) ;; NOOP
+  | Papair_I x => UNPAIR ;;; micheline2michelson_unpapair x
+  | Papair_P x y => UNPAIR ;;;
                     DIP 1 (micheline2michelson_unpapair y) ;;
                     micheline2michelson_unpapair x
   end.
 
-Definition parse_papair_full (s : String.string) (fail : exception): M instruction :=
+Definition parse_papair_full (s : String.string) (fail : exception) :
+  M instruction_seq :=
   let! toks : Datatypes.list papair_token := lex_papair s fail in
   let! (l, exist _ toks2 Htoks2) := parse_papair Left toks fail (S (List.length toks)) ltac:(simpl; lia) in
   let! (r, exist _ toks3 Htoks3) := parse_papair Right toks2 fail (S (List.length toks2)) ltac:(simpl; lia) in
@@ -354,7 +350,8 @@ Definition parse_papair_full (s : String.string) (fail : exception): M instructi
   | _ => Failed _ fail
   end.
 
-Definition parse_unpapair_full (s : String.string) (fail : exception): M instruction :=
+Definition parse_unpapair_full (s : String.string) (fail : exception)
+  : M instruction_seq :=
   let! toks : Datatypes.list papair_token := lex_papair s fail in
   let! (l, exist _ toks2 Htoks2) := parse_papair Left toks fail (S (List.length toks)) ltac:(simpl; lia) in
   let! (r, exist _ toks3 Htoks3) := parse_papair Right toks2 fail (S (List.length toks2)) ltac:(simpl; lia) in
@@ -367,117 +364,125 @@ Definition parse_unpapair_full (s : String.string) (fail : exception): M instruc
   | _ => Failed _ fail
   end.
 
-Fixpoint micheline2michelson_instruction (m : loc_micheline) : M instruction :=
+
+Definition return_instruction (i : instruction) : M instruction_seq :=
+  Return (i ;; NOOP).
+
+Definition return_opcode (op : opcode) : M instruction_seq :=
+  return_instruction (instruction_opcode op).
+
+Fixpoint micheline2michelson_instruction (m : loc_micheline) : M instruction_seq :=
   match m with
   | Mk_loc_micheline (_, SEQ l) =>
-    (fix micheline2michelson_instr_seq (l : Datatypes.list loc_micheline) : M instruction :=
+    (fix micheline2michelson_instr_seq (l : Datatypes.list loc_micheline) : M instruction_seq :=
        match l with
        | nil => Return NOOP
-       | cons i nil => micheline2michelson_instruction i
-       | i1 :: l =>
+       | i1 :: i2 =>
         let! i1 := micheline2michelson_instruction i1 in
-        let! i2 := micheline2michelson_instr_seq l in
-        Return (i1 ;; i2)
+        let! i2 := micheline2michelson_instr_seq i2 in
+        Return (i1 ;;; i2)
        end) l
-  | Mk_loc_micheline (_, PRIM (_, "FAILWITH") nil) => Return FAILWITH
-  | Mk_loc_micheline (_, PRIM (_, "EXEC") nil) => Return EXEC
-  | Mk_loc_micheline (_, PRIM (_, "APPLY") nil) => Return (instruction_opcode APPLY)
-  | Mk_loc_micheline (_, PRIM (_, "DROP") nil) => Return (instruction_opcode (DROP 1))
+  | Mk_loc_micheline (_, PRIM (_, "FAILWITH") nil) => return_instruction FAILWITH
+  | Mk_loc_micheline (_, PRIM (_, "EXEC") nil) => return_instruction EXEC
+  | Mk_loc_micheline (_, PRIM (_, "APPLY") nil) => return_opcode APPLY
+  | Mk_loc_micheline (_, PRIM (_, "DROP") nil) => return_opcode (DROP 1)
   | Mk_loc_micheline (_, PRIM (_, "DROP")
                               (Mk_loc_micheline (_, NUMBER n) :: nil)) =>
-    Return (instruction_opcode (DROP (BinInt.Z.to_nat n)))
-  | Mk_loc_micheline (_, PRIM (_, "DUP") nil) => Return (instruction_opcode DUP)
-  | Mk_loc_micheline (_, PRIM (_, "SWAP") nil) => Return (instruction_opcode SWAP)
-  | Mk_loc_micheline (_, PRIM (_, "UNIT") nil) => Return (instruction_opcode UNIT)
-  | Mk_loc_micheline (_, PRIM (_, "EQ") nil) => Return (instruction_opcode EQ)
-  | Mk_loc_micheline (_, PRIM (_, "NEQ") nil) => Return (instruction_opcode NEQ)
-  | Mk_loc_micheline (_, PRIM (_, "LT") nil) => Return (instruction_opcode LT)
-  | Mk_loc_micheline (_, PRIM (_, "GT") nil) => Return (instruction_opcode GT)
-  | Mk_loc_micheline (_, PRIM (_, "LE") nil) => Return (instruction_opcode LE)
-  | Mk_loc_micheline (_, PRIM (_, "GE") nil) => Return (instruction_opcode GE)
-  | Mk_loc_micheline (_, PRIM (_, "OR") nil) => Return (instruction_opcode OR)
-  | Mk_loc_micheline (_, PRIM (_, "AND") nil) => Return (instruction_opcode AND)
-  | Mk_loc_micheline (_, PRIM (_, "XOR") nil) => Return (instruction_opcode XOR)
-  | Mk_loc_micheline (_, PRIM (_, "NOT") nil) => Return (instruction_opcode NOT)
-  | Mk_loc_micheline (_, PRIM (_, "NEG") nil) => Return (instruction_opcode NEG)
-  | Mk_loc_micheline (_, PRIM (_, "ABS") nil) => Return (instruction_opcode ABS)
-  | Mk_loc_micheline (_, PRIM (_, "ISNAT") nil) => Return (instruction_opcode ISNAT)
-  | Mk_loc_micheline (_, PRIM (_, "INT") nil) => Return (instruction_opcode INT)
-  | Mk_loc_micheline (_, PRIM (_, "ADD") nil) => Return (instruction_opcode ADD)
-  | Mk_loc_micheline (_, PRIM (_, "SUB") nil) => Return (instruction_opcode SUB)
-  | Mk_loc_micheline (_, PRIM (_, "MUL") nil) => Return (instruction_opcode MUL)
-  | Mk_loc_micheline (_, PRIM (_, "EDIV") nil) => Return (instruction_opcode EDIV)
-  | Mk_loc_micheline (_, PRIM (_, "LSL") nil) => Return (instruction_opcode LSL)
-  | Mk_loc_micheline (_, PRIM (_, "LSR") nil) => Return (instruction_opcode LSR)
-  | Mk_loc_micheline (_, PRIM (_, "COMPARE") nil) => Return (instruction_opcode COMPARE)
-  | Mk_loc_micheline (_, PRIM (_, "CONCAT") nil) => Return (instruction_opcode CONCAT)
-  | Mk_loc_micheline (_, PRIM (_, "SIZE") nil) => Return (instruction_opcode SIZE)
-  | Mk_loc_micheline (_, PRIM (_, "SLICE") nil) => Return (instruction_opcode SLICE)
-  | Mk_loc_micheline (_, PRIM (_, "PAIR") nil) => Return (instruction_opcode PAIR)
-  | Mk_loc_micheline (_, PRIM (_, "CAR") nil) => Return (instruction_opcode CAR)
-  | Mk_loc_micheline (_, PRIM (_, "CDR") nil) => Return (instruction_opcode CDR)
-  | Mk_loc_micheline (_, PRIM (_, "GET") nil) => Return (instruction_opcode GET)
-  | Mk_loc_micheline (_, PRIM (_, "SOME") nil) => Return (instruction_opcode SOME)
+    return_opcode (DROP (BinInt.Z.to_nat n))
+  | Mk_loc_micheline (_, PRIM (_, "DUP") nil) => return_opcode DUP
+  | Mk_loc_micheline (_, PRIM (_, "SWAP") nil) => return_opcode SWAP
+  | Mk_loc_micheline (_, PRIM (_, "UNIT") nil) => return_opcode UNIT
+  | Mk_loc_micheline (_, PRIM (_, "EQ") nil) => return_opcode EQ
+  | Mk_loc_micheline (_, PRIM (_, "NEQ") nil) => return_opcode NEQ
+  | Mk_loc_micheline (_, PRIM (_, "LT") nil) => return_opcode LT
+  | Mk_loc_micheline (_, PRIM (_, "GT") nil) => return_opcode GT
+  | Mk_loc_micheline (_, PRIM (_, "LE") nil) => return_opcode LE
+  | Mk_loc_micheline (_, PRIM (_, "GE") nil) => return_opcode GE
+  | Mk_loc_micheline (_, PRIM (_, "OR") nil) => return_opcode OR
+  | Mk_loc_micheline (_, PRIM (_, "AND") nil) => return_opcode AND
+  | Mk_loc_micheline (_, PRIM (_, "XOR") nil) => return_opcode XOR
+  | Mk_loc_micheline (_, PRIM (_, "NOT") nil) => return_opcode NOT
+  | Mk_loc_micheline (_, PRIM (_, "NEG") nil) => return_opcode NEG
+  | Mk_loc_micheline (_, PRIM (_, "ABS") nil) => return_opcode ABS
+  | Mk_loc_micheline (_, PRIM (_, "ISNAT") nil) => return_opcode ISNAT
+  | Mk_loc_micheline (_, PRIM (_, "INT") nil) => return_opcode INT
+  | Mk_loc_micheline (_, PRIM (_, "ADD") nil) => return_opcode ADD
+  | Mk_loc_micheline (_, PRIM (_, "SUB") nil) => return_opcode SUB
+  | Mk_loc_micheline (_, PRIM (_, "MUL") nil) => return_opcode MUL
+  | Mk_loc_micheline (_, PRIM (_, "EDIV") nil) => return_opcode EDIV
+  | Mk_loc_micheline (_, PRIM (_, "LSL") nil) => return_opcode LSL
+  | Mk_loc_micheline (_, PRIM (_, "LSR") nil) => return_opcode LSR
+  | Mk_loc_micheline (_, PRIM (_, "COMPARE") nil) => return_opcode COMPARE
+  | Mk_loc_micheline (_, PRIM (_, "CONCAT") nil) => return_opcode CONCAT
+  | Mk_loc_micheline (_, PRIM (_, "SIZE") nil) => return_opcode SIZE
+  | Mk_loc_micheline (_, PRIM (_, "SLICE") nil) => return_opcode SLICE
+  | Mk_loc_micheline (_, PRIM (_, "PAIR") nil) => return_opcode PAIR
+  | Mk_loc_micheline (_, PRIM (_, "CAR") nil) => return_opcode CAR
+  | Mk_loc_micheline (_, PRIM (_, "CDR") nil) => return_opcode CDR
+  | Mk_loc_micheline (_, PRIM (_, "GET") nil) => return_opcode GET
+  | Mk_loc_micheline (_, PRIM (_, "SOME") nil) => return_opcode SOME
   | Mk_loc_micheline (_, PRIM (_, "NONE") (ty :: nil)) =>
     let! ty := micheline2michelson_type ty in
-    Return (instruction_opcode (NONE ty))
+    return_opcode (NONE ty)
   | Mk_loc_micheline (_, PRIM (_, "LEFT") (ty :: nil)) =>
     let! ty := micheline2michelson_type ty in
-    Return (instruction_opcode (LEFT ty))
+    return_opcode (LEFT ty)
   | Mk_loc_micheline (_, PRIM (_, "RIGHT") (ty :: nil)) =>
     let! ty := micheline2michelson_type ty in
-    Return (instruction_opcode (RIGHT ty))
-  | Mk_loc_micheline (_, PRIM (_, "CONS") nil) => Return (instruction_opcode CONS)
+    return_opcode (RIGHT ty)
+  | Mk_loc_micheline (_, PRIM (_, "CONS") nil) => return_opcode CONS
   | Mk_loc_micheline (_, PRIM (_, "NIL") (ty :: nil)) =>
     let! ty := micheline2michelson_type ty in
-    Return (instruction_opcode (NIL ty))
-  | Mk_loc_micheline (_, PRIM (_, "TRANSFER_TOKENS") nil) => Return (instruction_opcode TRANSFER_TOKENS)
-  | Mk_loc_micheline (_, PRIM (_, "SET_DELEGATE") nil) => Return (instruction_opcode SET_DELEGATE)
-  | Mk_loc_micheline (_, PRIM (_, "BALANCE") nil) => Return (instruction_opcode BALANCE)
-  | Mk_loc_micheline (_, PRIM (_, "ADDRESS") nil) => Return (instruction_opcode ADDRESS)
+    return_opcode (NIL ty)
+  | Mk_loc_micheline (_, PRIM (_, "TRANSFER_TOKENS") nil) =>
+    return_opcode TRANSFER_TOKENS
+  | Mk_loc_micheline (_, PRIM (_, "SET_DELEGATE") nil) => return_opcode SET_DELEGATE
+  | Mk_loc_micheline (_, PRIM (_, "BALANCE") nil) => return_opcode BALANCE
+  | Mk_loc_micheline (_, PRIM (_, "ADDRESS") nil) => return_opcode ADDRESS
   | Mk_loc_micheline (_, PRIM (_, "CONTRACT") (ty :: nil)) =>
     let! ty := micheline2michelson_type ty in
-    Return (instruction_opcode (CONTRACT None ty))
-  | Mk_loc_micheline (_, PRIM (_, "SOURCE") nil) => Return (instruction_opcode SOURCE)
-  | Mk_loc_micheline (_, PRIM (_, "SENDER") nil) => Return (instruction_opcode SENDER)
-  | Mk_loc_micheline (_, PRIM (_, "SELF") nil) => Return (SELF None)
-  | Mk_loc_micheline (_, PRIM (_, "AMOUNT") nil) => Return (instruction_opcode AMOUNT)
-  | Mk_loc_micheline (_, PRIM (_, "IMPLICIT_ACCOUNT") nil) => Return (instruction_opcode IMPLICIT_ACCOUNT)
-  | Mk_loc_micheline (_, PRIM (_, "NOW") nil) => Return (instruction_opcode NOW)
-  | Mk_loc_micheline (_, PRIM (_, "PACK") nil) => Return (instruction_opcode PACK)
+    return_opcode (CONTRACT None ty)
+  | Mk_loc_micheline (_, PRIM (_, "SOURCE") nil) => return_opcode SOURCE
+  | Mk_loc_micheline (_, PRIM (_, "SENDER") nil) => return_opcode SENDER
+  | Mk_loc_micheline (_, PRIM (_, "SELF") nil) => return_instruction (SELF None)
+  | Mk_loc_micheline (_, PRIM (_, "AMOUNT") nil) => return_opcode AMOUNT
+  | Mk_loc_micheline (_, PRIM (_, "IMPLICIT_ACCOUNT") nil) => return_opcode IMPLICIT_ACCOUNT
+  | Mk_loc_micheline (_, PRIM (_, "NOW") nil) => return_opcode NOW
+  | Mk_loc_micheline (_, PRIM (_, "PACK") nil) => return_opcode PACK
   | Mk_loc_micheline (_, PRIM (_, "UNPACK") (ty :: nil)) =>
     let! ty := micheline2michelson_type ty in
-    Return (instruction_opcode (UNPACK ty))
-  | Mk_loc_micheline (_, PRIM (_, "HASH_KEY") nil) => Return (instruction_opcode HASH_KEY)
-  | Mk_loc_micheline (_, PRIM (_, "BLAKE2B") nil) => Return (instruction_opcode BLAKE2B)
-  | Mk_loc_micheline (_, PRIM (_, "SHA256") nil) => Return (instruction_opcode SHA256)
-  | Mk_loc_micheline (_, PRIM (_, "SHA512") nil) => Return (instruction_opcode SHA512)
-  | Mk_loc_micheline (_, PRIM (_, "CHECK_SIGNATURE") nil) => Return (instruction_opcode CHECK_SIGNATURE)
-  | Mk_loc_micheline (_, PRIM (_, "MEM") nil) => Return (instruction_opcode MEM)
-  | Mk_loc_micheline (_, PRIM (_, "UPDATE") nil) => Return (instruction_opcode UPDATE)
-  | Mk_loc_micheline (_, PRIM (_, "CHAIN_ID") nil) => Return (instruction_opcode CHAIN_ID)
+    return_opcode (UNPACK ty)
+  | Mk_loc_micheline (_, PRIM (_, "HASH_KEY") nil) => return_opcode HASH_KEY
+  | Mk_loc_micheline (_, PRIM (_, "BLAKE2B") nil) => return_opcode BLAKE2B
+  | Mk_loc_micheline (_, PRIM (_, "SHA256") nil) => return_opcode SHA256
+  | Mk_loc_micheline (_, PRIM (_, "SHA512") nil) => return_opcode SHA512
+  | Mk_loc_micheline (_, PRIM (_, "CHECK_SIGNATURE") nil) =>
+    return_opcode CHECK_SIGNATURE
+  | Mk_loc_micheline (_, PRIM (_, "MEM") nil) => return_opcode MEM
+  | Mk_loc_micheline (_, PRIM (_, "UPDATE") nil) => return_opcode UPDATE
+  | Mk_loc_micheline (_, PRIM (_, "CHAIN_ID") nil) => return_opcode CHAIN_ID
   | Mk_loc_micheline (_, PRIM (_, "LOOP") (i :: nil)) =>
     let! i := micheline2michelson_instruction i in
-    Return (LOOP i)
+    return_instruction (LOOP i)
   | Mk_loc_micheline (_, PRIM (_, "LOOP_LEFT") (i :: nil)) =>
     let! i := micheline2michelson_instruction i in
-    Return (LOOP_LEFT i)
+    return_instruction (LOOP_LEFT i)
   | Mk_loc_micheline (_, PRIM (_, "DIP") (i :: nil)) =>
     let! i := micheline2michelson_instruction i in
-    Return (DIP 1 i)
+    return_instruction (DIP 1 i)
   | Mk_loc_micheline (_, PRIM (_, "DIP") (Mk_loc_micheline (_, NUMBER n) :: i :: nil)) =>
     let! i := micheline2michelson_instruction i in
-    Return (DIP (BinInt.Z.to_nat n) i)
+    return_instruction (DIP (BinInt.Z.to_nat n) i)
   | Mk_loc_micheline (_, PRIM (_, "DIG") (Mk_loc_micheline (_, NUMBER n) :: nil)) =>
-    Return (instruction_opcode (DIG (BinInt.Z.to_nat n)))
+    return_opcode (DIG (BinInt.Z.to_nat n))
   | Mk_loc_micheline (_, PRIM (_, "DUG") (Mk_loc_micheline (_, NUMBER n) :: nil)) =>
-    Return (instruction_opcode (DUG (BinInt.Z.to_nat n)))
+    return_opcode (DUG (BinInt.Z.to_nat n))
   | Mk_loc_micheline (_, PRIM (_, "ITER") (i :: nil)) =>
     let! i := micheline2michelson_instruction i in
-    Return (ITER i)
+    return_instruction (ITER i)
   | Mk_loc_micheline (_, PRIM (_, "MAP") (i :: nil)) =>
     let! i := micheline2michelson_instruction i in
-    Return (MAP i)
+    return_instruction (MAP i)
   | Mk_loc_micheline
       (_, PRIM (_, "CREATE_CONTRACT")
                (Mk_loc_micheline
@@ -489,7 +494,7 @@ Fixpoint micheline2michelson_instruction (m : loc_micheline) : M instruction :=
     let! i := micheline2michelson_instruction i in
     let! sty := micheline2michelson_type storage_ty in
     let! pty := micheline2michelson_type params_ty in
-    Return (CREATE_CONTRACT sty pty None i)
+    return_instruction (CREATE_CONTRACT sty pty None i)
   | Mk_loc_micheline
       (_, PRIM (_, "CREATE_CONTRACT")
                (Mk_loc_micheline
@@ -501,39 +506,39 @@ Fixpoint micheline2michelson_instruction (m : loc_micheline) : M instruction :=
     let! i := micheline2michelson_instruction i in
     let! sty := micheline2michelson_type storage_ty in
     let! pty := micheline2michelson_type params_ty in
-    Return (CREATE_CONTRACT sty pty None i)
+    return_instruction (CREATE_CONTRACT sty pty None i)
   | Mk_loc_micheline (_, PRIM (_, "EMPTY_SET") (cty :: nil)) =>
     let! cty := micheline2michelson_ctype cty in
-    Return (instruction_opcode (EMPTY_SET cty))
+    return_opcode (EMPTY_SET cty)
   | Mk_loc_micheline (_, PRIM (_, "EMPTY_MAP") (kty :: vty :: nil)) =>
     let! kty := micheline2michelson_ctype kty in
     let! vty := micheline2michelson_type vty in
-    Return (instruction_opcode (EMPTY_MAP kty vty))
+    return_opcode (EMPTY_MAP kty vty)
   | Mk_loc_micheline (_, PRIM (_, "EMPTY_BIG_MAP") (kty :: vty :: nil)) =>
     let! kty := micheline2michelson_ctype kty in
     let! vty := micheline2michelson_type vty in
-    Return (instruction_opcode (EMPTY_BIG_MAP kty vty))
+    return_opcode (EMPTY_BIG_MAP kty vty)
   | Mk_loc_micheline (_, PRIM (_, "IF") (i1 :: i2 :: nil)) =>
     let! i1 := micheline2michelson_instruction i1 in
     let! i2 := micheline2michelson_instruction i2 in
-    Return (IF_ IF_bool i1 i2)
+    return_instruction (IF_ IF_bool i1 i2)
   | Mk_loc_micheline (_, PRIM (_, "IF_NONE") (i1 :: i2 :: nil)) =>
     let! i1 := micheline2michelson_instruction i1 in
     let! i2 := micheline2michelson_instruction i2 in
-    Return (IF_NONE i1 i2)
+    return_instruction (IF_NONE i1 i2)
   | Mk_loc_micheline (_, PRIM (_, "IF_LEFT") (i1 :: i2 :: nil)) =>
     let! i1 := micheline2michelson_instruction i1 in
     let! i2 := micheline2michelson_instruction i2 in
-    Return (IF_LEFT i1 i2)
+    return_instruction (IF_LEFT i1 i2)
   | Mk_loc_micheline (_, PRIM (_, "IF_CONS") (i1 :: i2 :: nil)) =>
     let! i1 := micheline2michelson_instruction i1 in
     let! i2 := micheline2michelson_instruction i2 in
-    Return (IF_CONS i1 i2)
+    return_instruction (IF_CONS i1 i2)
   | Mk_loc_micheline (_, PRIM (_, "LAMBDA") (a :: b :: i :: nil)) =>
     let! a := micheline2michelson_type a in
     let! b := micheline2michelson_type b in
     let! i := micheline2michelson_instruction i in
-    Return (LAMBDA a b i)
+    return_instruction (LAMBDA a b i)
   | Mk_loc_micheline (_, PRIM (_, "PUSH") (a :: v :: nil)) =>
     let! a := micheline2michelson_type a in
     let! v :=
@@ -543,7 +548,7 @@ Fixpoint micheline2michelson_instruction (m : loc_micheline) : M instruction :=
         Return (Instruction i)
       | _ => micheline2michelson_data v
       end in
-    Return (PUSH a v)
+    return_instruction (PUSH a v)
 
   | Mk_loc_micheline (_, PRIM (_, "RENAME") _) => Return NOOP
   | Mk_loc_micheline (_, PRIM (_, "CAST") _) => Return NOOP
@@ -551,51 +556,51 @@ Fixpoint micheline2michelson_instruction (m : loc_micheline) : M instruction :=
 
   (* Macros *)
   | Mk_loc_micheline ((b, e), PRIM (_, "FAIL") nil) => Return FAIL
-  | Mk_loc_micheline ((b, e), PRIM (_, "ASSERT") nil) => Return ASSERT
-  | Mk_loc_micheline ((b, e), PRIM (_, "ASSERT_NONE") nil) => Return ASSERT_NONE
-  | Mk_loc_micheline ((b, e), PRIM (_, "ASSERT_SOME") nil) => Return ASSERT_SOME
-  | Mk_loc_micheline ((b, e), PRIM (_, "ASSERT_LEFT") nil) => Return ASSERT_LEFT
-  | Mk_loc_micheline ((b, e), PRIM (_, "ASSERT_RIGHT") nil) => Return ASSERT_RIGHT
+  | Mk_loc_micheline ((b, e), PRIM (_, "ASSERT") nil) => return_instruction ASSERT
+  | Mk_loc_micheline ((b, e), PRIM (_, "ASSERT_NONE") nil) => return_instruction ASSERT_NONE
+  | Mk_loc_micheline ((b, e), PRIM (_, "ASSERT_SOME") nil) => return_instruction ASSERT_SOME
+  | Mk_loc_micheline ((b, e), PRIM (_, "ASSERT_LEFT") nil) => return_instruction ASSERT_LEFT
+  | Mk_loc_micheline ((b, e), PRIM (_, "ASSERT_RIGHT") nil) => return_instruction ASSERT_RIGHT
 
   | Mk_loc_micheline (_, PRIM (_, "IF_SOME") (i1 :: i2 :: nil)) =>
     let! i1 := micheline2michelson_instruction i1 in
     let! i2 := micheline2michelson_instruction i2 in
-    Return (IF_SOME i1 i2)
+    return_instruction (IF_SOME i1 i2)
   | Mk_loc_micheline (_, PRIM (_, "IF_RIGHT") (i1 :: i2 :: nil)) =>
     let! i1 := micheline2michelson_instruction i1 in
     let! i2 := micheline2michelson_instruction i2 in
-    Return (IF_RIGHT i1 i2)
+    return_instruction (IF_RIGHT i1 i2)
   | Mk_loc_micheline (_, PRIM (_, "IF_NIL") (i1 :: i2 :: nil)) =>
     let! i1 := micheline2michelson_instruction i1 in
     let! i2 := micheline2michelson_instruction i2 in
-    Return (IF_NIL i1 i2)
+    return_instruction (IF_NIL i1 i2)
 
   | Mk_loc_micheline ((b, e), PRIM (_, String "C" (String "M" (String "P" s))) nil) =>
     let! op := op_of_string s b e in
-    Return (COMPARE ;; op)
+    Return (COMPARE ;; op ;; NOOP)
   | Mk_loc_micheline ((b, e), PRIM (_,
        String "I" (String "F" (String "C" (String "M" (String "P" s))))) (i1 :: i2 :: nil)) =>
     let! i1 := micheline2michelson_instruction i1 in
     let! i2 := micheline2michelson_instruction i2 in
     let! op := op_of_string s b e in
-    Return (COMPARE ;; op ;; IF_ IF_bool i1 i2)
+    Return (COMPARE ;; op ;; IF_ IF_bool i1 i2 ;; NOOP)
   | Mk_loc_micheline ((b, e), PRIM (_,
        String "I" (String "F" s)) (i1 :: i2 :: nil)) =>
     let! i1 := micheline2michelson_instruction i1 in
     let! i2 := micheline2michelson_instruction i2 in
     let! op := op_of_string s b e in
-    Return (op ;; IF_ IF_bool i1 i2)
+    Return (op ;; IF_ IF_bool i1 i2 ;; NOOP)
   | Mk_loc_micheline ((b, e), PRIM (_,
       String "A" (String "S" (String "S" (String "E" (String "R" (String "T"
       (String "_" (String "C" (String "M" (String "P" s)))))))))) nil) =>
     let! op := op_of_string s b e in
-    Return (COMPARE;; op ;; IF_ IF_bool NOOP FAIL)
+    Return (COMPARE ;; op ;; IF_ IF_bool NOOP FAIL ;; NOOP)
 
   | Mk_loc_micheline ((b, e), PRIM (_,
       String "A" (String "S" (String "S" (String "E" (String "R" (String "T"
       (String "_" s))))))) nil) =>
     let! op := op_of_string s b e in
-    Return (op ;; IF_ IF_bool NOOP FAIL)
+    Return (op ;; IF_ IF_bool NOOP FAIL ;; NOOP)
 
   | Mk_loc_micheline ((b, e), PRIM (_, "CR") nil) =>
     Failed _ (Expansion_prim b e "CR")
@@ -667,7 +672,7 @@ Fixpoint micheline2michelson_instruction (m : loc_micheline) : M instruction :=
                      end in
     if is_diip s then
       let! a := micheline2michelson_instruction a in
-      Return (DIPn (String.length s) a)
+      return_instruction (DIP (String.length s) a)
     else Failed _ (Expansion_prim b e (String "D" (String "I" s)))
   | Mk_loc_micheline ((b, e), PRIM (_, "DUP") (Mk_loc_micheline (_, NUMBER n) :: nil)) =>
     match BinInt.Z.to_nat n with
@@ -705,13 +710,13 @@ Record untyped_michelson_file :=
   Mk_untyped_michelson_file
     { parameter : type;
       storage : type;
-      code : instruction }.
+      code : instruction_seq }.
 
 Record untyped_michelson_file_opt :=
   Mk_untyped_michelson_file_opt
     { parameter_opt : Datatypes.option type;
       storage_opt : Datatypes.option type;
-      code_opt : Datatypes.option instruction }.
+      code_opt : Datatypes.option instruction_seq }.
 
 Definition read_parameter (ty : type) (f : untyped_michelson_file_opt) :=
   match f.(parameter_opt) with
@@ -729,7 +734,7 @@ Definition read_storage (ty : type) (f : untyped_michelson_file_opt) :=
   | Some _ => Failed _ Parsing
   end.
 
-Definition read_code (c : instruction) (f : untyped_michelson_file_opt) :=
+Definition read_code (c : instruction_seq) (f : untyped_michelson_file_opt) :=
   match f.(code_opt) with
   | None => Return {| parameter_opt := f.(parameter_opt);
                         storage_opt := f.(storage_opt);
diff --git a/src/michocoq/michelson2micheline.v b/src/michocoq/michelson2micheline.v
index 4c2465b3..08b38135 100644
--- a/src/michocoq/michelson2micheline.v
+++ b/src/michocoq/michelson2micheline.v
@@ -164,29 +164,16 @@ Definition michelson2micheline_opcode (o : opcode) : loc_micheline :=
   | CHAIN_ID => dummy_prim "CHAIN_ID" []
   end.
 
-Fixpoint michelson2micheline_ins (i : instruction) : loc_micheline :=
+Fixpoint michelson2micheline_instruction (i : instruction) : loc_micheline :=
   match i with
-  | NOOP => dummy_mich (SEQ [])
-  | untyped_syntax.SEQ i1 i2 =>
-    let m1 := michelson2micheline_ins i1 in
-    let m2 := michelson2micheline_ins i2 in
-    let ls1 :=
-        match m1 with
-        | Mk_loc_micheline (_, _, (SEQ ls1)) => ls1
-        | _ => [m1]%list
-        end in
-    let ls2 :=
-        match m2 with
-        | Mk_loc_micheline (_, _, (SEQ ls2)) => ls2
-        | _ => [m2]%list
-        end in
-    dummy_mich (SEQ (List.app ls1 ls2))
+  | Instruction_seq i =>
+    dummy_mich (SEQ (michelson2micheline_ins_seq i))
   | FAILWITH => dummy_prim "FAILWITH" []
   | CREATE_CONTRACT t1 t2 an i => dummy_prim "CREATE_CONTRACT"
                                           [michelson2micheline_type t1;
                                              michelson2micheline_atype
                                                michelson2micheline_type t2 an;
-                                             michelson2micheline_ins i]
+                                             dummy_mich (SEQ (michelson2micheline_ins_seq i))]
   | IF_ f i1 i2 =>
     let s := match f with
              | IF_bool => "IF"
@@ -194,34 +181,41 @@ Fixpoint michelson2micheline_ins (i : instruction) : loc_micheline :=
              | IF_option => "IF_NONE"
              | IF_list => "IF_CONS"
              end in
-    dummy_prim s [dummy_seq (michelson2micheline_ins i1);
-                    dummy_seq (michelson2micheline_ins i2)]
+    dummy_prim s [dummy_mich (SEQ (michelson2micheline_ins_seq i1));
+                    dummy_mich (SEQ (michelson2micheline_ins_seq i2))]
   | LOOP_ f i =>
     let s := match f with LOOP_bool => "LOOP" | LOOP_or => "LOOP_LEFT" end in
-    dummy_prim s [dummy_seq (michelson2micheline_ins i)]
+    dummy_prim s [dummy_mich (SEQ (michelson2micheline_ins_seq i))]
   | ITER i =>
-    dummy_prim "ITER" [dummy_seq (michelson2micheline_ins i)]
+    dummy_prim "ITER" [dummy_mich (SEQ (michelson2micheline_ins_seq i))]
   | MAP i =>
-    dummy_prim "MAP" [dummy_seq (michelson2micheline_ins i)]
+    dummy_prim "MAP" [dummy_mich (SEQ (michelson2micheline_ins_seq i))]
   | PUSH t d =>
     let t' := (michelson2micheline_type t) in
     match d with
     | Instruction d' =>
-      dummy_prim "PUSH" [t'; dummy_seq (michelson2micheline_ins d')]
+      dummy_prim "PUSH" [t'; dummy_mich (SEQ (michelson2micheline_ins_seq d'))]
     | _ =>
       dummy_prim "PUSH" [t'; michelson2micheline_data d]
     end
   | LAMBDA t1 t2 i =>
     dummy_prim "LAMBDA" [ michelson2micheline_type t1;
                             michelson2micheline_type t2;
-                            dummy_seq (michelson2micheline_ins i)]
+                            dummy_mich (SEQ (michelson2micheline_ins_seq i))]
   | DIP n i => dummy_prim "DIP" [dummy_mich (NUMBER (BinInt.Z.of_nat n));
-                                   dummy_seq (michelson2micheline_ins i)]
+                                   dummy_mich (SEQ (michelson2micheline_ins_seq i))]
   | SELF None => dummy_prim "SELF" []
   | SELF (Some an) => dummy_prim "SELF" [dummy_prim an []]
   | EXEC => dummy_prim "EXEC" []
   | instruction_opcode o =>
     michelson2micheline_opcode o
+  end
+with
+michelson2micheline_ins_seq (i : instruction_seq) : Datatypes.list loc_micheline :=
+  match i with
+  | NOOP => []
+  | untyped_syntax.SEQ i1 i2 =>
+    michelson2micheline_instruction i1 :: michelson2micheline_ins_seq i2
   end.
 
 Definition eqb_ascii (a b : ascii) : Datatypes.bool :=
@@ -238,6 +232,3 @@ Fixpoint eqb_string (s1 s2 : String.string) : Datatypes.bool :=
   | String a1 s1, String a2 s2 => andb (eqb_ascii a1 a2) (eqb_string s1 s2)
   | _, _ => false
   end.
-
-Definition michelson2micheline_instruction (i : instruction) : loc_micheline :=
-  dummy_seq (michelson2micheline_ins i).
diff --git a/src/michocoq/semantics.v b/src/michocoq/semantics.v
index ec909b60..e2056c97 100644
--- a/src/michocoq/semantics.v
+++ b/src/michocoq/semantics.v
@@ -52,9 +52,9 @@ Module Semantics(C : ContractContext).
     | map a b => map.map (comparable_data a) (data b) (compare a)
     | big_map a b => map.map (comparable_data a) (data b) (compare a)
     | lambda a b =>
-      {tff : Datatypes.bool &
-             instruction None tff (a ::: nil) (b ::: nil)}
-    | contract a => {s : contract_constant | get_contract_type s = Some a }
+      sigT (fun tff : Datatypes.bool =>
+             instruction_seq None tff (a ::: nil) (b ::: nil))
+    | contract a => sig (fun s : contract_constant => get_contract_type s = Some a )
     | chain_id => chain_id_constant
     end.
 
@@ -64,7 +64,7 @@ Module Semantics(C : ContractContext).
         create_contract : forall g p annot tff,
           Datatypes.option (comparable_data key_hash) ->
           tez.mutez ->
-          syntax.instruction (Some (p, annot)) tff
+          syntax.instruction_seq (Some (p, annot)) tff
                              (pair p g ::: nil)
                              (pair (list operation) g ::: nil) ->
           data g -> data (pair operation address);
@@ -673,12 +673,30 @@ Module Semantics(C : ContractContext).
     | LOOP_or _ _ _ _, inr x => inr (x, tt)
     end.
 
+  Fixpoint eval_seq_body
+           (eval : forall param_ty tff0 (env : @proto_env param_ty) A B, instruction param_ty tff0 A B -> stack A -> M (stack B))
+           {param_ty : self_info} {tff0} (env : @proto_env param_ty) {A : stack_type} {B : stack_type}
+           (i : instruction_seq param_ty tff0 A B) (SA : stack A) {struct i} : M (stack B) :=
+    match i, SA, env with
+    | NOOP, SA, _ => Return SA
+    | Tail_fail i, SA, env => eval _ _ env _ _ i SA
+    | SEQ B C, SA, env =>
+      let! r := eval _ _ env _ _ B SA in
+      eval_seq_body eval env C r
+    end.
+
   Fixpoint eval {param_ty : self_info} {tff0} (env : @proto_env param_ty) {A : stack_type} {B : stack_type}
            (i : instruction param_ty tff0 A B) (fuel : Datatypes.nat) (SA : stack A) {struct fuel} : M (stack B) :=
     match fuel with
     | O => Failed _ Out_of_fuel
     | S n =>
+      let eval_n {param_ty : self_info} {tff0} (env : @proto_env param_ty)
+                 {A : stack_type} {B : stack_type} (i : instruction param_ty tff0 A B)
+                 (SA : stack A) : M (stack B) :=
+          eval env i n SA in
       match i, SA, env with
+      | Instruction_seq i, SA, env =>
+        eval_seq_body (@eval_n) env i SA
       | FAILWITH, (x, _), _ =>
         Failed _ (Assertion_Failure _ x)
 
@@ -687,139 +705,189 @@ Module Semantics(C : ContractContext).
          whole point of this instruction (compared to the FAIL macro)
          is to report the argument to the user. *)
 
-      | NOOP, SA, _ => Return SA
-      | SEQ B C, SA, env =>
-        let! r := eval env B n SA in
-        eval env C n r
       | IF_ f bt bf, (x, SA), env =>
         match if_family_destruct f x with
-        | inl SB => eval env bt n (stack_app SB SA)
-        | inr SB => eval env bf n (stack_app SB SA)
+        | inl SB => eval_seq_body (@eval_n) env bt (stack_app SB SA)
+        | inr SB => eval_seq_body (@eval_n) env bf (stack_app SB SA)
         end
       | LOOP_ f body, (ab, SA), env =>
         match loop_family_destruct f ab with
-        | inl SB => eval env (body;; LOOP_ f body) n (stack_app SB SA)
+        | inl SB =>
+          let! SC := eval_seq_body (@eval_n) env body (stack_app SB SA) in
+          eval_n env (LOOP_ f body) SC
         | inr SB => Return (stack_app SB SA)
         end
       | PUSH a x, SA, _ => Return (concrete_data_to_data _ x, SA)
       | LAMBDA a b code, SA, _ => Return (existT _ _ code, SA)
-      | EXEC, (x, (existT _ tff f, SA)), env =>
-        let! (y, tt) := eval (no_self env) f n (x, tt) in
-        Return (y, SA)
       | @ITER _ _ s _ body, (x, SA), env =>
         match iter_destruct _ _ (iter_variant_field _ s) x with
         | None => Return SA
         | Some (a, y) =>
-          let! SB := eval env body n (a, SA) in
-          eval env (ITER body) n (y, SB)
+          let! SB := eval_seq_body (@eval_n) env body (a, SA) in
+          eval_n env (ITER body) (y, SB)
         end
       | @MAP _ _ _ s _ body, (x, SA), env =>
         let v := (map_variant_field _ _ s) in
         match map_destruct _ _ _ _ v x with
         | None => Return (map_empty _ _ _ _ v, SA)
         | Some (a, y) =>
-          let! (b, SB) := eval env body n (a, SA) in
-          let! (c, SC) := eval env (MAP body) n (y, SB) in
+          let! (b, SB) := eval_seq_body (@eval_n) env body (a, SA) in
+          let! (c, SC) := eval_n env (MAP body) (y, SB) in
           Return (map_insert _ _ _ _ v a b c, SC)
         end
       | CREATE_CONTRACT g p an f, (a, (b, (c, SA))), env =>
         let (oper, addr) := create_contract env g p an _ a b f c in
         Return (oper, (addr, SA))
       | SELF ao H, SA, env => Return (self env ao H, SA)
+      | EXEC, (x, (existT _ tff f, SA)), env =>
+        let! (y, tt) := eval_seq_body (@eval_n) (no_self env) f (x, tt) in
+        Return (y, SA)
       | DIP nl Hlen i, SA, env =>
         let (S1, S2) := stack_split SA in
-        let! S3 := eval env i n S2 in
+        let! S3 := eval_seq_body (@eval_n) env i S2 in
         Return (stack_app S1 S3)
       | Instruction_opcode o, SA, env =>
         eval_opcode _ env o SA
       end
     end.
 
+  Definition eval_seq
+             {param_ty : self_info} {tff0} (env : @proto_env param_ty) {A : stack_type} {B : stack_type}
+             (i : instruction_seq param_ty tff0 A B) (fuel : Datatypes.nat) (SA : stack A) : M (stack B) :=
+    eval_seq_body (fun param_ty tff env A B i SA => eval env i fuel SA) env i SA.
+
+  Lemma eval_seq_deterministic_le_aux
+             (eval1 eval2 : forall param_ty tff (env : @proto_env param_ty) A B, instruction param_ty tff A B -> stack A -> M (stack B))
+             (H : forall param_ty env tff A B (i : instruction param_ty tff A B) st,
+                 success (eval1 param_ty tff env A B i st) ->
+                 eval1 param_ty tff env A B i st = eval2 param_ty tff env A B i st) :
+             forall param_ty env tff A B (i : instruction_seq param_ty tff A B) st,
+                 success (eval_seq_body eval1 env i st) ->
+                 eval_seq_body eval1 env i st =
+                 eval_seq_body eval2 env i st.
+  Proof.
+    intros param_ty env tff A B i.
+    induction i; simpl; auto.
+    intros st Hsucc.
+    destruct (success_bind _ _ Hsucc) as (x, (H1, H2)).
+    rewrite <- H.
+    - rewrite H1.
+      simpl.
+      apply IHi.
+      exact H2.
+    - rewrite H1.
+      constructor.
+  Qed.
+
   (* The evaluator does not depend on the amount of fuel provided *)
-  Lemma eval_deterministic_le :
-    forall fuel1 fuel2,
+  Fixpoint eval_deterministic_le fuel1 :
+    forall fuel2,
       fuel1 <= fuel2 ->
       forall {self_type env tff0 A B} (i : instruction self_type tff0 A B) st,
         success (eval env i fuel1 st) ->
         eval env i fuel1 st = eval env i fuel2 st.
   Proof.
-    induction fuel1; intros fuel2 Hle self_type env tff0 A B i st Hsucc.
-    - contradiction.
-    - destruct fuel2.
-      + inversion Hle.
-      + apply le_S_n in Hle.
-        specialize (IHfuel1 fuel2 Hle).
-        simpl.
-        destruct i; try reflexivity.
-        * simpl in Hsucc.
-          destruct (success_bind _ _ Hsucc) as (x, (H1, H2)).
-          rewrite <- IHfuel1.
-          -- rewrite H1.
-             simpl.
-             apply IHfuel1.
-             assumption.
-          -- apply success_eq_return in H1.
-             exact H1.
-        * simpl in Hsucc.
-          destruct st as (x, st); destruct (if_family_destruct _ x) as [SB|SB];
-            rewrite IHfuel1; try assumption; reflexivity.
-        * simpl in Hsucc.
-          destruct st as (x, st); destruct (loop_family_destruct _ x) as [SB|SB].
-          -- rewrite IHfuel1; try assumption; reflexivity.
-          -- reflexivity.
-        * destruct st as (x, SA).
-          generalize Hsucc; clear Hsucc.
+    {
+      destruct fuel1; intros fuel2 Hle self_type env tff0 A B i st Hsucc.
+      - contradiction.
+      - destruct fuel2.
+        + inversion Hle.
+        + apply le_S_n in Hle.
+          pose (eval1 := fun param_ty tff env A B (i : instruction param_ty tff A B) st => eval env i fuel1 st).
+          pose (eval2 := fun param_ty tff env A B (i : instruction param_ty tff A B) st => eval env i fuel2 st).
+          assert (forall param_ty env tff A B (i : instruction param_ty tff A B) st,
+                 success (eval1 param_ty tff env A B i st) ->
+                 eval1 param_ty tff env A B i st = eval2 param_ty tff env A B i st) as Heval12 by (apply eval_deterministic_le; assumption).
+          specialize (eval_seq_deterministic_le_aux eval1 eval2 Heval12); intro Haux.
           simpl.
-          destruct (iter_destruct (iter_elt_type collection i) collection
-                                  (iter_variant_field collection i) x).
-          -- destruct d.
-             fold stack.
-             intro Hsucc.
-             rewrite <- IHfuel1.
-             ++ destruct (success_bind _ _ Hsucc) as (SB, (Ha, Hb)).
-                rewrite Ha.
-                simpl.
-                apply IHfuel1.
-                assumption.
-             ++ apply success_bind_arg in Hsucc.
-                assumption.
-          -- reflexivity.
-        * destruct st as (x, SA).
-          generalize Hsucc; clear Hsucc.
-          simpl.
-          fold stack.
-          destruct (map_destruct (map_in_type collection b i)
-                                 b
-                                 collection
-                                 (map_out_collection_type collection b i)
-                                 (map_variant_field collection b i) x).
-          -- destruct d.
-             intro Hsucc.
-             rewrite <- IHfuel1.
-             ++ destruct (success_bind _ _ Hsucc) as ((c, SC), (Ha, Hb)).
-                destruct (success_bind _ _ Hb) as ((dd, SD), (Hm, _)).
-                rewrite Ha.
-                simpl.
-                rewrite <- IHfuel1.
-                ** reflexivity.
-                ** rewrite Hm.
-                   constructor.
-             ++ apply success_bind_arg in Hsucc.
-                assumption.
-          -- reflexivity.
-        * destruct st as (x, ((tff, f), SA)).
-          f_equal.
-          rewrite IHfuel1.
-          -- reflexivity.
-          -- simpl in Hsucc.
-             apply success_bind_arg in Hsucc.
-             assumption.
-        * simpl in Hsucc.
-          destruct (stack_split st); rewrite IHfuel1.
-          -- reflexivity.
-          -- destruct (success_bind _ _ Hsucc) as (x, (H1, H2)).
-             apply success_eq_return in H1.
-             exact H1.
+          destruct i; try reflexivity.
+          * apply Haux; assumption.
+          * simpl in Hsucc.
+            destruct st as (x, st); destruct (if_family_destruct _ x) as [SB|SB];
+              rewrite Haux; try assumption; reflexivity.
+          * simpl in Hsucc.
+            destruct st as (x, st); destruct (loop_family_destruct _ x) as [SB|SB]; clear x.
+            -- apply success_bind in Hsucc.
+               destruct Hsucc as ((x, stA), (H1, H2)).
+               change (fun param_ty tff0 env A B i SA => eval env i fuel1 SA) with eval1 in H1.
+               change (fun param_ty tff0 env A B i SA => eval env i fuel1 SA) with eval1.
+               change (fun param_ty tff0 env A B i SA => eval env i fuel2 SA) with eval2.
+               rewrite <- Haux; try assumption.
+               ++ rewrite H1.
+                  simpl.
+                  apply eval_deterministic_le; assumption.
+               ++ rewrite H1.
+                  constructor.
+            -- reflexivity.
+          * destruct st as (x, SA).
+            generalize Hsucc; clear Hsucc.
+            simpl.
+            destruct (iter_destruct (iter_elt_type collection i) collection
+                                    (iter_variant_field collection i) x).
+            -- destruct d.
+               change (fun param_ty tff0 env A B i SA => eval env i fuel1 SA) with eval1.
+               change (fun param_ty tff0 env A B i SA => eval env i fuel2 SA) with eval2.
+               intro Hsucc.
+               rewrite <- Haux.
+               ++ destruct (success_bind _ _ Hsucc) as (SB, (Ha, Hb)).
+                  rewrite Ha.
+                  simpl.
+                  apply eval_deterministic_le; assumption.
+               ++ apply success_bind_arg in Hsucc.
+                  assumption.
+            -- reflexivity.
+          * destruct st as (x, SA).
+            generalize Hsucc; clear Hsucc.
+            simpl.
+            fold stack.
+            destruct (map_destruct (map_in_type collection b i)
+                                   b
+                                   collection
+                                   (map_out_collection_type collection b i)
+                                   (map_variant_field collection b i) x).
+            -- destruct d.
+               change (fun param_ty tff0 env A B i SA => eval env i fuel1 SA) with eval1.
+               change (fun param_ty tff0 env A B i SA => eval env i fuel2 SA) with eval2.
+               intro Hsucc.
+               rewrite <- Haux; try assumption.
+               ++ destruct (success_bind _ _ Hsucc) as ((c, SC), (Ha, Hb)).
+                  destruct (success_bind _ _ Hb) as ((dd, SD), (Hm, _)).
+                  rewrite Ha.
+                  simpl.
+                  rewrite <- (eval_deterministic_le fuel1 fuel2); try assumption.
+                  ** reflexivity.
+                  ** rewrite Hm.
+                     constructor.
+               ++ apply success_bind_arg in Hsucc.
+                  assumption.
+            -- reflexivity.
+          * destruct st as (x, ((tff, f), SA)).
+            f_equal.
+            rewrite Haux; try assumption.
+            -- reflexivity.
+            -- simpl in Hsucc.
+               apply success_bind_arg in Hsucc.
+               assumption.
+          * simpl in Hsucc.
+            destruct (stack_split st); rewrite Haux; try assumption.
+            -- reflexivity.
+            -- destruct (success_bind _ _ Hsucc) as (x, (H1, H2)).
+               apply success_eq_return in H1.
+               exact H1.
+    }
+  Qed.
+
+  Lemma eval_seq_deterministic_le fuel1 fuel2 :
+      fuel1 <= fuel2 ->
+      forall {self_type env tff0 A B} (i : instruction_seq self_type tff0 A B) st,
+        success (eval_seq env i fuel1 st) ->
+        eval_seq env i fuel1 st = eval_seq env i fuel2 st.
+  Proof.
+    pose (eval1 := fun param_ty tff env A B (i : instruction param_ty tff A B) st => eval env i fuel1 st).
+    pose (eval2 := fun param_ty tff env A B (i : instruction param_ty tff A B) st => eval env i fuel2 st).
+    intro H.
+    apply (eval_seq_deterministic_le_aux eval1 eval2).
+    apply eval_deterministic_le; assumption.
   Qed.
 
   Lemma eval_deterministic_success_both {self_type env} fuel1 fuel2 {A B tff0} (i : instruction self_type tff0 A B) S :
@@ -920,6 +988,24 @@ Module Semantics(C : ContractContext).
     | CHAIN_ID, env, psi, SA => psi (chain_id_ env, SA)
     end.
 
+  Fixpoint eval_seq_precond_body
+           (eval_precond_n : forall {self_type},
+               @proto_env self_type ->
+               forall {tff0 A B},
+                 instruction self_type tff0 A B ->
+                 (stack B -> Prop) -> stack A -> Prop)
+           {self_type} env tff0 A B
+           (i : instruction_seq self_type tff0 A B)
+           (psi : stack B -> Prop)
+           (SA : stack A) : Prop :=
+    match i, env, psi, SA with
+    | NOOP, env, psi, st => psi st
+    | SEQ B C, env, psi, st =>
+      eval_precond_n env B (@eval_seq_precond_body (@eval_precond_n) _ env _ _ _ C psi) st
+    | Tail_fail i, env, psi, st =>
+      eval_precond_n env i psi st
+    end.
+
   Definition eval_precond_body
              (eval_precond_n : forall {self_type},
                  @proto_env self_type ->
@@ -931,30 +1017,32 @@ Module Semantics(C : ContractContext).
              (psi : stack B -> Prop)
              (SA : stack A) : Prop :=
     match i, env, psi, SA with
+    | Instruction_seq i, env, psi, SA =>
+      eval_seq_precond_body (@eval_precond_n) env _ _ _ i psi SA
     | FAILWITH, _, _, _ => false
-    | NOOP, env, psi, st => psi st
-    | SEQ B C, env, psi, st =>
-      eval_precond_n env B (eval_precond_n env C psi) st
     | IF_ f bt bf, env, psi, (x, SA) =>
       match (if_family_destruct f x) with
-      | inl SB => eval_precond_n env bt psi (stack_app SB SA)
-      | inr SB => eval_precond_n env bf psi (stack_app SB SA)
+      | inl SB => eval_seq_precond_body (@eval_precond_n) env _ _ _ bt psi (stack_app SB SA)
+      | inr SB => eval_seq_precond_body (@eval_precond_n) env _ _ _ bf psi (stack_app SB SA)
       end
     | LOOP_ f body, env, psi, (x, SA) =>
       match (loop_family_destruct f x) with
-      | inl SB => eval_precond_n env (body;; LOOP_ f body) psi (stack_app SB SA)
+      | inl SB =>
+        eval_seq_precond_body (@eval_precond_n) env _ _ _ body
+                           (eval_precond_n env (LOOP_ f body) psi)
+                           (stack_app SB SA)
       | inr SB => psi (stack_app SB SA)
       end
     | EXEC, env, psi, (x, (existT _ _ f, SA)) =>
-      eval_precond_n (no_self env) f (fun '(y, tt) => psi (y, SA)) (x, tt)
+      eval_seq_precond_body (@eval_precond_n) (no_self env) _ _ _ f (fun '(y, tt) => psi (y, SA)) (x, tt)
     | PUSH a x, env, psi, SA => psi (concrete_data_to_data _ x, SA)
     | LAMBDA a b code, env, psi, SA => psi (existT _ _ code, SA)
     | @ITER _ _ s _ body, env, psi, (x, SA) =>
       match iter_destruct _ _ (iter_variant_field _ s) x with
       | None => psi SA
       | Some (a, y) =>
-        eval_precond_n
-          env body
+        eval_seq_precond_body (@eval_precond_n)
+          env _ _ _ body
           (fun SB => eval_precond_n env (ITER body) psi (y, SB))
           (a, SA)
       end
@@ -963,8 +1051,8 @@ Module Semantics(C : ContractContext).
       match map_destruct _ _ _ _ v x with
       | None => psi (map_empty _ _ _ _ v, SA)
       | Some (a, y) =>
-        eval_precond_n
-          env body
+        eval_seq_precond_body (@eval_precond_n)
+          env _ _ _ body
           (fun '(b, SB) =>
              eval_precond_n
                env (MAP body)
@@ -978,7 +1066,7 @@ Module Semantics(C : ContractContext).
     | SELF ao H, env, psi, SA => psi (self env ao H, SA)
     | DIP n Hlen i, env, psi, SA =>
       let (S1, S2) := stack_split SA in
-      eval_precond_n env i (fun SB => psi (stack_app S1 SB)) S2
+      eval_seq_precond_body (@eval_precond_n) env _ _ _ i (fun SB => psi (stack_app S1 SB)) S2
     | Instruction_opcode o, env, psi, SA =>
       eval_precond_opcode env _ _ o psi SA
     end.
@@ -993,6 +1081,12 @@ Module Semantics(C : ContractContext).
       @eval_precond_body (@eval_precond n)
     end.
 
+  Definition eval_seq_precond (fuel : Datatypes.nat) :
+    forall {self_type} env {tff0 A B},
+      instruction_seq self_type tff0 A B ->
+      (stack B -> Prop) -> (stack A -> Prop) :=
+      @eval_seq_precond_body (@eval_precond fuel).
+
   Lemma eval_precond_opcode_correct {sty env A B} (o : opcode A B) st psi :
     precond (eval_opcode sty env o st) psi <-> eval_precond_opcode env _ _ o psi st.
   Proof.
@@ -1007,22 +1101,44 @@ Module Semantics(C : ContractContext).
     - destruct (stack_split st); reflexivity.
   Qed.
 
+  Lemma eval_seq_precond_correct_aux n
+        (eval_precond_correct : forall sty env tff0 A B (i : instruction sty tff0 A B) st psi,
+            precond (eval env i n st) psi <-> eval_precond n env i psi st)
+        {sty env tff0 A B} (i : instruction_seq sty tff0 A B) st psi :
+    precond (eval_seq env i n st) psi <-> eval_seq_precond n env i psi st.
+  Proof.
+    unfold eval_seq_precond in *.
+    induction i; simpl; fold data stack.
+     - reflexivity.
+     - apply eval_precond_correct.
+     - unfold eval_seq.
+       simpl.
+       rewrite precond_bind.
+       rewrite <- eval_precond_correct.
+       apply precond_eqv.
+       intro SB.
+       apply IHi.
+  Qed.
+
   Lemma eval_precond_correct {sty env tff0 A B} (i : instruction sty tff0 A B) n st psi :
     precond (eval env i n st) psi <-> eval_precond n env i psi st.
   Proof.
     generalize sty env tff0 A B i st psi; clear sty env tff0 A B i st psi.
     induction n; intros sty env tff0 A B i st psi; [simpl; intuition|].
+    specialize (@eval_seq_precond_correct_aux n IHn).
+    intro eval_seq_precond_correct.
+    unfold eval_seq_precond in *.
+
     destruct i; simpl; fold data stack.
-    - reflexivity.
+    - apply eval_seq_precond_correct.
     - destruct st; reflexivity.
-    - rewrite precond_bind.
-      rewrite <- IHn.
-      apply precond_eqv.
-      intro SB.
-      apply IHn.
-    - destruct st as (x, st); destruct (if_family_destruct _ x); auto.
+    - destruct st as (x, st); destruct (if_family_destruct _ x); apply eval_seq_precond_correct.
     - destruct st as (x, st); destruct (loop_family_destruct _ x).
-      + apply IHn.
+      + rewrite precond_bind.
+        rewrite <- eval_seq_precond_correct.
+        apply precond_eqv.
+        intro st'.
+        apply IHn.
       + simpl. reflexivity.
     - reflexivity.
     - reflexivity.
@@ -1030,7 +1146,7 @@ Module Semantics(C : ContractContext).
       destruct (iter_destruct (iter_elt_type collection i) collection
                               (iter_variant_field collection i) x) as [(hd, tl)|].
       + rewrite precond_bind.
-        rewrite <- IHn.
+        rewrite <- eval_seq_precond_correct.
         apply precond_eqv.
         intro SA.
         apply IHn.
@@ -1040,7 +1156,7 @@ Module Semantics(C : ContractContext).
                              (map_out_collection_type collection b i)
                              (map_variant_field collection b i) x) as [(hd, tl)|].
       + rewrite precond_bind.
-        rewrite <- IHn.
+        rewrite <- eval_seq_precond_correct.
         apply precond_eqv.
         intros (bb, SA).
         rewrite precond_bind.
@@ -1055,15 +1171,65 @@ Module Semantics(C : ContractContext).
     - reflexivity.
     - destruct st as (x, ((tff, f), st)).
       rewrite precond_bind.
-      rewrite <- (IHn _ _ _ _ _ f (x, tt) (fun '(y, tt) => psi (y, st))).
+      rewrite <- (eval_seq_precond_correct _ _ _ _ _ f (x, tt) (fun '(y, tt) => psi (y, st))).
       apply precond_eqv.
       intros (y, []).
       simpl.
       reflexivity.
     - destruct (stack_split st).
       rewrite precond_bind.
-      apply IHn.
+      apply eval_seq_precond_correct.
     - apply eval_precond_opcode_correct.
   Qed.
 
+  Lemma eval_precond_eqv self_type env tff A B (i : instruction self_type tff A B) n st phi psi :
+    (forall st, phi st <-> psi st) ->
+    eval_precond n env i phi st <-> eval_precond n env i psi st.
+  Proof.
+    intro H.
+    do 2 rewrite <- eval_precond_correct.
+    apply precond_eqv.
+    assumption.
+  Qed.
+
+  Lemma eval_seq_precond_correct {sty env tff0 A B} (i : instruction_seq sty tff0 A B) n st psi :
+    precond (eval_seq env i n st) psi <-> eval_seq_precond n env i psi st.
+  Proof.
+    apply eval_seq_precond_correct_aux.
+    intros; apply eval_precond_correct.
+  Qed.
+
+  Lemma eval_seq_precond_eqv self_type env tff A B (i : instruction_seq self_type tff A B) n st phi psi :
+    (forall st, phi st <-> psi st) ->
+    eval_seq_precond n env i phi st <-> eval_seq_precond n env i psi st.
+  Proof.
+    intro H.
+    do 2 rewrite <- eval_seq_precond_correct.
+    apply precond_eqv.
+    assumption.
+  Qed.
+
+  Lemma eval_seq_assoc_aux {sty env tffa tffb A B C}
+        (i1 : instruction_seq sty tffa A B)
+        (i2 : instruction_seq sty tffb B C) H n st psi :
+    eval_seq_precond n env (instruction_app_aux i1 H i2) psi st <->
+    eval_seq_precond n env i1 (eval_seq_precond n env i2 psi) st.
+  Proof.
+    induction i1; unfold eval_seq_precond; simpl.
+    - reflexivity.
+    - discriminate.
+    - apply eval_precond_eqv.
+      intro stB.
+      apply (IHi1 _ _ _ _).
+  Qed.
+
+  Lemma eval_seq_assoc {sty env tff0 A B C}
+        (i1 : instruction_seq sty Datatypes.false A B)
+        (i2 : instruction_seq sty tff0 B C) n st psi :
+    eval_seq_precond n env (instruction_app i1 i2) psi st <->
+    eval_seq_precond n env i1 (eval_seq_precond n env i2 psi) st.
+  Proof.
+    apply eval_seq_assoc_aux.
+  Qed.
+
 End Semantics.
diff --git a/src/michocoq/syntax.v b/src/michocoq/syntax.v
index 79610b1b..30f90044 100644
--- a/src/michocoq/syntax.v
+++ b/src/michocoq/syntax.v
@@ -450,28 +450,28 @@ Inductive loop_family : forall (A B : Datatypes.list type) (a : type), Set :=
 | LOOP_or a an b bn : loop_family (a :: nil) (b :: nil) (or a an b bn).
 
 Inductive instruction :
-  forall (self_i : self_info) (tail_fail_flag : Datatypes.bool) (A B : Datatypes.list type), Set :=
-| NOOP {self_type A} : instruction self_type Datatypes.false A A    (* Undocumented *)
+  forall (self_type : self_info) (tail_fail_flag : Datatypes.bool) (A B : Datatypes.list type), Set :=
+| Instruction_seq {self_type tff A B} :
+    instruction_seq self_type tff A B ->
+    instruction self_type tff A B
 | FAILWITH {self_type A B a} : instruction self_type Datatypes.true (a ::: A) B
-| SEQ {self_type A B C tff} : instruction self_type Datatypes.false A B -> instruction self_type tff B C -> instruction self_type tff A C
-(* The instruction self_type SEQ I C is written "{ I ; C }" in Michelson *)
 | IF_ {self_type A B tffa tffb C1 C2 t} (i : if_family C1 C2 t) :
-    instruction self_type tffa (C1 ++ A) B -> instruction self_type tffb (C2 ++ A) B ->
+    instruction_seq self_type tffa (C1 ++ A) B -> instruction_seq self_type tffb (C2 ++ A) B ->
     instruction self_type (tffa && tffb) (t ::: A) B
 | LOOP_ {self_type C1 C2 t A} (i : loop_family C1 C2 t) :
-    instruction self_type Datatypes.false (C1 ++ A) (t :: A) ->
+    instruction_seq self_type Datatypes.false (C1 ++ A) (t :: A) ->
     instruction self_type Datatypes.false (t :: A) (C2 ++ A)
 | PUSH (a : type) (x : concrete_data a) {self_type A} : instruction self_type Datatypes.false A (a :: A)
 | LAMBDA (a b : type) {self_type A tff} :
-    instruction None tff (a :: nil) (b :: nil) ->
+    instruction_seq None tff (a :: nil) (b :: nil) ->
     instruction self_type Datatypes.false A (lambda a b :: A)
 | ITER {self_type collection} {i : iter_struct collection} {A} :
-    instruction self_type Datatypes.false (iter_elt_type _ i ::: A) A -> instruction self_type Datatypes.false (collection :: A) A
+    instruction_seq self_type Datatypes.false (iter_elt_type _ i ::: A) A -> instruction self_type Datatypes.false (collection :: A) A
 | MAP {self_type collection b} {i : map_struct collection b} {A} :
-    instruction self_type Datatypes.false (map_in_type _ _ i :: A) (b :: A) ->
+    instruction_seq self_type Datatypes.false (map_in_type _ _ i :: A) (b :: A) ->
     instruction self_type Datatypes.false (collection :: A) (map_out_collection_type _ _ i :: A)
 | CREATE_CONTRACT {self_type S tff} (g p : type) (an : annot_o) :
-    instruction (Some (p, an)) tff (pair p g :: nil) (pair (list operation) g :: nil) ->
+    instruction_seq (Some (p, an)) tff (pair p g :: nil) (pair (list operation) g :: nil) ->
     instruction self_type Datatypes.false
                 (option key_hash ::: mutez ::: g ::: S)
                 (operation ::: address ::: S)
@@ -481,11 +481,16 @@ Inductive instruction :
                                        (a ::: lambda a b ::: C) (b :: C)
 | DIP (n : Datatypes.nat) {self_type A B C} :
     length A = n ->
-    instruction self_type Datatypes.false B C ->
+    instruction_seq self_type Datatypes.false B C ->
     instruction self_type Datatypes.false (A +++ B) (A +++ C)
 | Instruction_opcode {self_type A B} : opcode (self_type := self_type) A B -> instruction self_type Datatypes.false A B
-with
-concrete_data : type -> Set :=
+with instruction_seq :
+       forall (self_type : self_info) (tail_fail_flag : Datatypes.bool) (A B : Datatypes.list type), Set :=
+| NOOP {self_type A} : instruction_seq self_type Datatypes.false A A
+| Tail_fail {self_type A B} : instruction self_type Datatypes.true A B -> instruction_seq self_type Datatypes.true A B
+(* The instruction self_type SEQ I C is written "{ I ; C }" in Michelson *)
+| SEQ {self_type A B C tff} : instruction self_type Datatypes.false A B -> instruction_seq self_type tff B C -> instruction_seq self_type tff A C
+with concrete_data : type -> Set :=
 | Int_constant : Z -> concrete_data int
 | Nat_constant : N -> concrete_data nat
 | String_constant : String.string -> concrete_data string
@@ -510,19 +515,126 @@ concrete_data : type -> Set :=
 | Concrete_map {a : comparable_type} {b} :
     Datatypes.list (elt_pair (concrete_data a) (concrete_data b)) ->
     concrete_data (map a b)
-| Instruction {a b} tff : instruction (None) tff (a ::: nil) (b ::: nil) ->
+| Instruction {a b} tff : instruction_seq None tff (a ::: nil) (b ::: nil) ->
                           concrete_data (lambda a b)
 | Chain_id_constant : chain_id_constant -> concrete_data chain_id.
 
 Coercion Instruction_opcode : opcode >-> instruction.
 
+Fixpoint tail_fail_induction self_type A B
+         (i : instruction self_type true A B)
+         (P : forall self_type A B, instruction self_type true A B -> Type)
+         (Q : forall self_type A B, instruction_seq self_type true A B -> Type)
+         (HFAILWITH : forall st a A B, P st (a ::: A) B FAILWITH)
+         (HIF : forall st A B C1 C2 t (f : if_family C1 C2 t) i1 i2,
+             Q st (C1 ++ A)%list B i1 ->
+             Q st (C2 ++ A)%list B i2 ->
+             P st (t ::: A) B (IF_ f i1 i2))
+         (HSEQ : forall st A B C i1 i2,
+             Q st B C i2 -> Q st A C (SEQ i1 i2))
+         (HTF : forall st A B i, P st A B i -> Q st A B (Tail_fail i))
+         (HIS : forall st A B i, Q st A B i -> P st A B (Instruction_seq i))
+  : P self_type A B i :=
+  let P' st b A B : instruction st b A B -> Type :=
+      if b return instruction st b A B -> Type
+      then P st A B
+      else fun i => True
+  in
+  match i as i0 in instruction st b A B return P' st b A B i0
+  with
+  | FAILWITH => HFAILWITH _ _ _ _
+  | @IF_ _ A B tffa tffb _ _ _ f i1 i2 =>
+    (if tffa as tffa return
+        forall i1, P' _ (tffa && tffb)%bool _ _ (IF_ f i1 i2)
+     then
+       fun i1 =>
+         (if tffb return
+             forall i2,
+               P' _ tffb _ _ (IF_ f i1 i2)
+          then
+            fun i2 =>
+              HIF _ _ _ _ _ _ f i1 i2
+                  (tail_fail_induction_seq _ _ _ i1 P Q HFAILWITH HIF HSEQ HTF HIS)
+                  (tail_fail_induction_seq _ _ _ i2 P Q HFAILWITH HIF HSEQ HTF HIS)
+          else
+            fun _ => I) i2
+     else
+       fun _ => I) i1
+  | @Instruction_seq _ true _ _ i =>
+    HIS _ _ _ _ (tail_fail_induction_seq _ _ _ i P Q HFAILWITH HIF HSEQ HTF HIS)
+  | _ => I
+  end
+with tail_fail_induction_seq self_type A B
+                             (i : instruction_seq self_type true A B)
+                             (P : forall self_type A B, instruction self_type true A B -> Type)
+                             (Q : forall self_type A B, instruction_seq self_type true A B -> Type)
+                             (HFAILWITH : forall st a A B, P st (a ::: A) B FAILWITH)
+                             (HIF : forall st A B C1 C2 t (f : if_family C1 C2 t) i1 i2,
+                                 Q st (C1 ++ A)%list B i1 ->
+                                 Q st (C2 ++ A)%list B i2 ->
+                                 P st (t ::: A) B (IF_ f i1 i2))
+                             (HSEQ : forall st A B C i1 i2,
+                                 Q st B C i2 -> Q st A C (SEQ i1 i2))
+                             (HTF : forall st A B i, P st A B i -> Q st A B (Tail_fail i))
+                             (HIS : forall st A B i, Q st A B i -> P st A B (Instruction_seq i))
+     : Q self_type A B i  :=
+       let Q' st b A B : instruction_seq st b A B -> Type :=
+           if b return instruction_seq st b A B -> Type
+           then Q st A B
+           else fun i => True
+       in
+       match i as i0 in instruction_seq st b A B return Q' st b A B i0
+       with
+       | @SEQ _ A B C tff i1 i2 =>
+         (if tff return
+             forall i2 : instruction_seq _ tff B C,
+               Q' _ tff A C (SEQ i1 i2)
+          then
+            fun i2 =>
+              HSEQ _ _ _ _ i1 i2
+                   (tail_fail_induction_seq _ B C i2 P Q HFAILWITH HIF HSEQ HTF HIS)
+          else fun i2 => I)
+           i2
+       | @Tail_fail _ A B i => HTF _ _ _ i (tail_fail_induction _ A B i P Q HFAILWITH HIF HSEQ HTF HIS)
+       | _ => I
+       end .
+
+Definition tail_fail_change_range {self_type} A B B' (i : instruction self_type true A B) :
+  instruction self_type true A B'.
+Proof.
+  apply (tail_fail_induction self_type A B i (fun self_type A B i => instruction self_type true A B')
+                             (fun self_type A B i => instruction_seq self_type true A B')); clear A B i.
+  - intros st a A _.
+    apply FAILWITH.
+  - intros st A B C1 C2 t f _ _ i1 i2.
+    apply (IF_ f i1 i2).
+  - intros st A B C i1 _ i2.
+    apply (SEQ i1 i2).
+  - intros st A B _ i.
+    apply (Tail_fail i).
+  - intros st A B _ i.
+    apply (Instruction_seq i).
+Defined.
+
+Definition seq_aux {self_type A B C tffa tffb} :
+  instruction self_type tffa A B ->
+  instruction_seq self_type tffb B C ->
+  instruction_seq self_type (tffa || tffb)%bool A C :=
+  if tffa
+     return
+     (instruction self_type tffa A B ->
+      instruction_seq self_type tffb B C ->
+      instruction_seq self_type (tffa || tffb) A C)
+  then
+    fun i _ => Tail_fail (tail_fail_change_range A B C i)
+  else SEQ.
 
 Coercion int_constant := Int_constant.
 Coercion nat_constant := Nat_constant.
 Coercion string_constant := String_constant.
 
 Definition full_contract tff param annot storage :=
-  instruction (Some (param, annot)) tff
+  instruction_seq (Some (param, annot)) tff
     ((pair param storage) ::: nil)
     ((pair (list operation) storage) ::: nil).
 
@@ -541,14 +653,51 @@ Record contract_file : Set :=
           contract_file_storage;
     }.
 
-Notation "'IF'" := (IF_ IF_bool).
-Notation "'IF_LEFT'" := (IF_ (IF_or _ _ _ _)).
-Notation "'IF_NONE'" := (IF_ (IF_option _)).
-Notation "'IF_CONS'" := (IF_ (IF_list _)).
-Notation "'LOOP'" := (LOOP_ LOOP_bool).
-Notation "'LOOP_LEFT'" := (LOOP_ (LOOP_or _ _)).
+Notation "'IF'" := (IF_ IF_bool) : michelson_scope.
+Notation "'IF_TRUE'" := (IF_ IF_bool) : michelson_scope.
+Notation "'IF_LEFT'" := (IF_ (IF_or _ _ _ _)) : michelson_scope.
+Notation "'IF_NONE'" := (IF_ (IF_option _)) : michelson_scope.
+Notation "'IF_CONS'" := (IF_ (IF_list _)) : michelson_scope.
+Notation "'LOOP'" := (LOOP_ LOOP_bool) : michelson_scope.
+Notation "'LOOP_LEFT'" := (LOOP_ (LOOP_or _ _)) : michelson_scope.
+
+Delimit Scope michelson_scope with michelson.
+Bind Scope michelson_scope with instruction.
+Bind Scope michelson_scope with instruction_seq.
+Bind Scope michelson_scope with full_contract.
+
+Definition instruction_wrap {A B : stack_type} {self_type tff}
+  : instruction self_type tff A B ->
+    instruction_seq self_type tff A B :=
+  if tff return instruction self_type tff A B -> instruction_seq self_type tff A B then
+    Tail_fail
+  else fun i => SEQ i NOOP.
+
+Fixpoint instruction_app_aux
+         {A B C : stack_type} {self_type tff1 tff2}
+         (i1 : instruction_seq self_type tff1 A B) :
+  tff1 = false -> instruction_seq self_type tff2 B C -> instruction_seq self_type tff2 A C :=
+  match i1 with
+  | NOOP => fun _ i2 => i2
+  | SEQ i11 i12 =>
+    fun H i2 => SEQ i11 (instruction_app_aux i12 H i2)
+  | Tail_fail i =>
+    fun H => False_rec _ (Bool.diff_true_false H)
+  end.
+
+Definition instruction_app {A B C : stack_type} {self_type tff}
+           (i1 : instruction_seq self_type false A B)
+           (i2 : instruction_seq self_type tff B C) :
+  instruction_seq self_type tff A C :=
+  instruction_app_aux i1 eq_refl i2.
+
+Notation "A ;;; B" := (instruction_app A B) (at level 100, right associativity).
+
+Notation "A ;; B" := (seq_aux A B) (at level 100, right associativity).
+
+Notation "{ }" := NOOP : michelson_scope.
 
-Notation "A ;; B" := (SEQ A B) (at level 100, right associativity).
+Notation "{ A ; .. ; B }" := (seq_aux A .. (seq_aux B NOOP) ..) : michelson_scope.
 
 Notation "n ~Mutez" := (exist _ (int64bv.of_Z n) eq_refl) (at level 100).
 
diff --git a/src/michocoq/typer.v b/src/michocoq/typer.v
index e9ead4f2..b4200b39 100644
--- a/src/michocoq/typer.v
+++ b/src/michocoq/typer.v
@@ -16,6 +16,16 @@ Qed.
 
   Definition instruction := syntax.instruction.
 
+  Definition instruction_seq := syntax.instruction_seq.
+
+  Definition safe_opcode_cast {self_type} A A' B B' :
+    syntax.opcode (self_type := self_type) A B -> A = A' -> B = B' ->
+    syntax.opcode (self_type := self_type) A' B'.
+  Proof.
+    intros o [] [].
+    exact o.
+  Defined.
+
   Definition safe_instruction_cast {self_type tff} A A' B B' :
     instruction self_type tff A B -> A = A' -> B = B' -> instruction self_type tff A' B'.
   Proof.
@@ -23,12 +33,11 @@ Qed.
     exact i.
   Defined.
 
-  Definition safe_opcode_cast {self_type} A A' B B' :
-    syntax.opcode (self_type := self_type) A B -> A = A' -> B = B' ->
-    syntax.opcode (self_type := self_type) A' B'.
+  Definition safe_instruction_seq_cast {self_type tff} A A' B B' :
+    instruction_seq self_type tff A B -> A = A' -> B = B' -> instruction_seq self_type tff A' B'.
   Proof.
-    intros o [] [].
-    exact o.
+    intros i [] [].
+    exact i.
   Defined.
 
   Record cast_error :=
@@ -40,27 +49,37 @@ Qed.
         expected_output : Datatypes.list type;
         tff : Datatypes.bool;
         self_type_ : syntax.self_info;
-        i : instruction self_type_ tff input output;
+        i : instruction_seq self_type_ tff input output;
       }.
 
-  Definition instruction_cast {self_type tff} A A' B B' i : M (instruction self_type tff A' B') :=
-    match stype_dec A A', stype_dec B B' with
-    | left HA, left HB => Return (safe_instruction_cast A A' B B' i HA HB)
-    | _, _ => Failed _ (Typing cast_error (Mk_cast_error A B A' B' tff _ i))
-    end.
-
   Definition opcode_cast {self_type} A A' B B' o : M (syntax.opcode A' B') :=
     match stype_dec A A', stype_dec B B' with
     | left HA, left HB => Return (safe_opcode_cast A A' B B' o HA HB)
     | _, _ =>
       Failed _ (Typing cast_error
                        (Mk_cast_error A B A' B' Datatypes.false self_type
-                                      (syntax.Instruction_opcode o)))
+                                      (syntax.instruction_wrap
+                                         (syntax.Instruction_opcode o))))
+    end.
+
+  Definition instruction_cast {self_type tff} A A' B B' i : M (instruction self_type tff A' B') :=
+    match stype_dec A A', stype_dec B B' with
+    | left HA, left HB => Return (safe_instruction_cast A A' B B' i HA HB)
+    | _, _ => Failed _ (Typing cast_error (Mk_cast_error A B A' B' tff _ (syntax.instruction_wrap i)))
+    end.
+
+  Definition instruction_seq_cast {self_type tff} A A' B B' i : M (instruction_seq self_type tff A' B') :=
+    match stype_dec A A', stype_dec B B' with
+    | left HA, left HB => Return (safe_instruction_seq_cast A A' B B' i HA HB)
+    | _, _ => Failed _ (Typing cast_error (Mk_cast_error A B A' B' tff _ i))
     end.
 
   Definition instruction_cast_range {self_type tff} A B B' (i : instruction self_type tff A B)
     : M (instruction self_type tff A B') := instruction_cast A A B B' i.
 
+  Definition instruction_seq_cast_range {self_type tff} A B B' (i : instruction_seq self_type tff A B)
+    : M (instruction_seq self_type tff A B') := instruction_seq_cast A A B B' i.
+
   Definition instruction_cast_domain {self_type tff} A A' B (i : instruction self_type tff A B)
     : M (instruction self_type tff A' B) := instruction_cast A A' B B i.
 
@@ -71,6 +90,10 @@ Qed.
   | Inferred_type B : instruction self_type false A B -> typer_result A
   | Any_type : (forall B, instruction self_type true A B) -> typer_result A.
 
+  Inductive typer_result_seq {self_type} A : Set :=
+  | Inferred_type_seq B : instruction_seq self_type false A B -> typer_result_seq A
+  | Any_type_seq : (forall B, instruction_seq self_type true A B) -> typer_result_seq A.
+
   Definition type_check_instruction {self_type}
              (type_instruction :
                 forall (i : untyped_syntax.instruction) A,
@@ -84,15 +107,28 @@ Qed.
     | Any_type _ i => Return (existT _ true (i B))
     end.
 
-  Definition type_check_instruction_no_tail_fail {self_type}
-             (type_instruction :
-                forall (i : untyped_syntax.instruction) A,
-                  M (typer_result A))
-             i A B : M (instruction self_type Datatypes.false A B) :=
-    let! r1 := type_instruction i A in
+  Definition type_check_instruction_seq {self_type}
+             (type_instruction_seq :
+                forall (i : untyped_syntax.instruction_seq) A,
+                  M (typer_result_seq A))
+             i A B : M {b : Datatypes.bool & instruction_seq self_type b A B} :=
+    let! r1 := type_instruction_seq i A in
     match r1 with
-    | Inferred_type _ B' i => instruction_cast_range A B' B i
-    | Any_type _ i => Failed _ (Typing _ tt)
+    | Inferred_type_seq _ B' i =>
+      let! i := instruction_seq_cast_range A B' B i in
+      Return (existT _ false i)
+    | Any_type_seq _ i => Return (existT _ true (i B))
+    end.
+
+  Definition type_check_instruction_seq_no_tail_fail {self_type}
+             (type_instruction_seq :
+                forall (i : untyped_syntax.instruction_seq) A,
+                  M (typer_result_seq A))
+             i A B : M (instruction_seq self_type Datatypes.false A B) :=
+    let! r1 := type_instruction_seq i A in
+    match r1 with
+    | Inferred_type_seq _ B' i => instruction_seq_cast_range A B' B i
+    | Any_type_seq _ i => Failed _ (Typing _ tt)
     end.
 
   Definition assert_not_tail_fail {self_type} A (r : typer_result A) :
@@ -110,6 +146,21 @@ Qed.
     let! r := type_instruction i A in
     assert_not_tail_fail A r.
 
+  Definition assert_not_tail_fail_seq {self_type} A (r : typer_result_seq A) :
+    M {B & instruction_seq self_type Datatypes.false A B} :=
+    match r with
+    | Inferred_type_seq _ B i => Return (existT _ B i)
+    | Any_type_seq _ _ => Failed _ (Typing _ tt)
+    end.
+
+  Definition type_instruction_seq_no_tail_fail {self_type}
+             (type_instruction_seq :
+                forall (i : untyped_syntax.instruction_seq) A,
+                  M (typer_result_seq A))
+             i A : M {B & instruction_seq self_type Datatypes.false A B} :=
+    let! r := type_instruction_seq i A in
+    assert_not_tail_fail_seq A r.
+
   Definition type_if_family (f : if_family) (t : type) :
     M {A & {B & syntax.if_family A B t}} :=
     match f, t with
@@ -121,25 +172,25 @@ Qed.
     end.
 
   Definition type_branches {self_type} (f : if_family) (t : type)
-             (type_instruction :
-                forall (i : untyped_syntax.instruction) A,
-                  M (typer_result A))
+             (type_instruction_seq :
+                forall (i : untyped_syntax.instruction_seq) A,
+                  M (typer_result_seq A))
              i1 i2 A
     : M (typer_result (self_type := self_type) (t ::: A)) :=
     let! (existT _ B1 (existT _ B2 f)) := type_if_family f t in
-    let! r1 := type_instruction i1 (B1 ++ A) in
-    let! r2 := type_instruction i2 (B2 ++ A) in
+    let! r1 := type_instruction_seq i1 (B1 ++ A) in
+    let! r2 := type_instruction_seq i2 (B2 ++ A) in
     match r1, r2 with
-    | Inferred_type _ C1 i1, Inferred_type _ C2 i2 =>
-      let! i2 := instruction_cast_range (B2 ++ A) C2 C1 i2 in
+    | Inferred_type_seq _ C1 i1, Inferred_type_seq _ C2 i2 =>
+      let! i2 := instruction_seq_cast_range (B2 ++ A) C2 C1 i2 in
       Return
               (Inferred_type _ _
                             (syntax.IF_ f i1 i2))
-    | Inferred_type _ C i1, Any_type _ i2 =>
+    | Inferred_type_seq _ C i1, Any_type_seq _ i2 =>
       Return (Inferred_type _ _ (syntax.IF_ f i1 (i2 C)))
-    | Any_type _ i1, Inferred_type _ C i2 =>
+    | Any_type_seq _ i1, Inferred_type_seq _ C i2 =>
       Return (Inferred_type _ _ (syntax.IF_ f (i1 C) i2))
-    | Any_type _ i1, Any_type _ i2 =>
+    | Any_type_seq _ i1, Any_type_seq _ i2 =>
       Return (Any_type _ (fun C =>
                               syntax.IF_ f (i1 C) (i2 C)))
     end.
@@ -153,13 +204,13 @@ Qed.
     end.
 
   Definition type_loop {self_type} (f : loop_family) (t : type)
-             (type_instruction :
-                forall (i : untyped_syntax.instruction) A,
-                  M (typer_result A))
-             i A
+             (type_instruction_seq :
+                forall (i : untyped_syntax.instruction_seq) A,
+                  M (typer_result_seq A))
+             (i : untyped_syntax.instruction_seq) A
     : M (typer_result (self_type := self_type) (t ::: A)) :=
     let! (existT _ B1 (existT _ B2 f)) := type_loop_family f t in
-    let! r := type_check_instruction_no_tail_fail type_instruction i (B1 ++ A) (t ::: A) in
+    let! r := type_check_instruction_seq_no_tail_fail type_instruction_seq i (B1 ++ A) (t ::: A) in
     Return (Inferred_type _ _ (syntax.LOOP_ f r)).
 
   Definition take_one (S : syntax.stack_type) : M (type * syntax.stack_type) :=
@@ -631,7 +682,7 @@ Qed.
       fun ty =>
         match ty with
         | lambda a b =>
-          let! existT _ tff i := type_check_instruction type_instruction i (cons a nil) (cons b nil) in
+          let! existT _ tff i := type_check_instruction_seq type_instruction_seq i (cons a nil) (cons b nil) in
           Return (syntax.Instruction _ i)
         | _ => Failed _ (Typing _ (d, ty))
         end
@@ -641,21 +692,17 @@ Qed.
   with
   type_instruction {self_type} i A {struct i} : M (typer_result (self_type := self_type) A) :=
     match i, A with
-    | NOOP, A => Return (Inferred_type _ _ syntax.NOOP)
-    | FAILWITH, a :: A => Return (Any_type _ (fun B => syntax.FAILWITH))
-    | SEQ i1 i2, A =>
-      let! existT _ B i1 := type_instruction_no_tail_fail type_instruction i1 A in
-      let! r2 := type_instruction i2 B in
-      match r2 with
-      | Inferred_type _ C i2 =>
-        Return (Inferred_type _ _ (syntax.SEQ i1 i2))
-      | Any_type _ i2 =>
-        Return (Any_type _ (fun C => syntax.SEQ i1 (i2 C)))
+    | Instruction_seq i, _ =>
+      let! i := type_instruction_seq i A in
+      match i with
+      | Any_type_seq _ i => Return (Any_type _ (fun B => syntax.Instruction_seq (i B)))
+      | Inferred_type_seq _ _ i => Return (Inferred_type _ _ (syntax.Instruction_seq i))
       end
+    | FAILWITH, a :: A => Return (Any_type _ (fun B => syntax.FAILWITH))
     | IF_ f i1 i2, t :: A =>
-      type_branches f t type_instruction i1 i2 A
+      type_branches f t type_instruction_seq i1 i2 A
     | LOOP_ f i, t :: A =>
-      type_loop f t type_instruction i A
+      type_loop f t type_instruction_seq i A
     | EXEC, a :: lambda a' b :: B =>
       let A := a :: lambda a' b :: B in
       let A' := a :: lambda a b :: B in
@@ -666,30 +713,30 @@ Qed.
       Return (Inferred_type _ _ (syntax.PUSH a d))
     | LAMBDA a b i, A =>
       let! existT _ tff i :=
-        type_check_instruction type_instruction i (a :: nil) (b :: nil) in
+        type_check_instruction_seq type_instruction_seq i (a :: nil) (b :: nil) in
       Return (Inferred_type _ _ (syntax.LAMBDA a b i))
     | ITER i, list a :: A =>
-      let! i := type_check_instruction_no_tail_fail type_instruction i (a :: A) A in
+      let! i := type_check_instruction_seq_no_tail_fail type_instruction_seq i (a :: A) A in
       Return (Inferred_type _ _ (syntax.ITER (i := syntax.iter_list _) i))
     | ITER i, set a :: A =>
-      let! i := type_check_instruction_no_tail_fail type_instruction i (a ::: A) A in
+      let! i := type_check_instruction_seq_no_tail_fail type_instruction_seq i (a ::: A) A in
       Return (Inferred_type _ _ (syntax.ITER (i := syntax.iter_set _)i))
     | ITER i, map kty vty :: A =>
-      let! i := type_check_instruction_no_tail_fail type_instruction i (pair kty vty :: A) A in
+      let! i := type_check_instruction_seq_no_tail_fail type_instruction_seq i (pair kty vty :: A) A in
       Return (Inferred_type _ _ (syntax.ITER (i := syntax.iter_map _ _) i))
     | MAP i, list a :: A =>
-      let! r := type_instruction_no_tail_fail type_instruction i (a :: A) in
+      let! r := type_instruction_seq_no_tail_fail type_instruction_seq i (a :: A) in
       match r with
       | existT _ (b :: A') i =>
-        let! i := instruction_cast_range (a :: A) (b :: A') (b :: A) i in
+        let! i := instruction_seq_cast_range (a :: A) (b :: A') (b :: A) i in
         Return (Inferred_type _ _ (syntax.MAP (i := syntax.map_list _ _) i))
       | _ => Failed _ (Typing _ tt)
       end
     | MAP i, map kty vty :: A =>
-      let! r := type_instruction_no_tail_fail type_instruction i (pair kty vty ::: A) in
+      let! r := type_instruction_seq_no_tail_fail type_instruction_seq i (pair kty vty ::: A) in
       match r with
       | existT _ (b :: A') i =>
-        let! i := instruction_cast_range (pair kty vty :: A) (b :: A') (b :: A) i in
+        let! i := instruction_seq_cast_range (pair kty vty :: A) (b :: A') (b :: A) i in
         Return (Inferred_type _ _ (syntax.MAP (i := syntax.map_map _ _ _) i))
       | _ => Failed _ (Typing _ tt)
       end
@@ -700,7 +747,7 @@ Qed.
       let A' :=
           option key_hash ::: mutez ::: g ::: B in
       let! existT _ tff i :=
-        type_check_instruction (self_type := (Some (p, an))) type_instruction i (pair p g :: nil) (pair (list operation) g :: nil) in
+        type_check_instruction_seq (self_type := (Some (p, an))) type_instruction_seq i (pair p g :: nil) (pair (list operation) g :: nil) in
       let! i := instruction_cast_domain A' A _ (syntax.CREATE_CONTRACT g p an i) in
       Return (Inferred_type _ _ i)
     | SELF an, A =>
@@ -713,11 +760,34 @@ Qed.
       end
     | DIP n i, S12 =>
       let! (exist _ S1 H1, S2) := take_n S12 n in
-      let! existT _ B i := type_instruction_no_tail_fail type_instruction i S2 in
+      let! existT _ B i := type_instruction_seq_no_tail_fail type_instruction_seq i S2 in
       let! i := instruction_cast_domain (S1 +++ S2) S12 _ (syntax.DIP n H1 i) in
       Return (Inferred_type S12 (S1 +++ B) i)
     | instruction_opcode o, A =>
       let! (existT _ B o) := type_opcode o A in
       Return (Inferred_type A B (syntax.Instruction_opcode o))
     | _, _ => Failed _ (Typing _ (i, A))
+    end
+  with
+  type_instruction_seq {self_type} i A {struct i} : M (typer_result_seq (self_type := self_type) A) :=
+    match i, A with
+    | NOOP, A => Return (Inferred_type_seq _ _ syntax.NOOP)
+    | SEQ i1 i2, A =>
+      let! r1 := type_instruction i1 A in
+      match r1, i2 with
+      | Inferred_type _ B i1, i2 =>
+        let! r2 := type_instruction_seq i2 B in
+        match r2 with
+        | Inferred_type_seq _ C i2 =>
+          Return (Inferred_type_seq _ _ (syntax.SEQ i1 i2))
+        | Any_type_seq _ i2 =>
+          Return (Any_type_seq _ (fun C => syntax.SEQ i1 (i2 C)))
+        end
+      | Any_type _ i1, NOOP =>
+        Return (Any_type_seq _ (fun C => syntax.Tail_fail (i1 C)))
+      | Any_type _ _, _ =>
+        Failed _ (Typing _
+                         "FAILWITH instruction can only appear at the tail of application sequences"%string)
+      end
     end.
+
diff --git a/src/michocoq/untyped_syntax.v b/src/michocoq/untyped_syntax.v
index ea36c47a..914799eb 100644
--- a/src/michocoq/untyped_syntax.v
+++ b/src/michocoq/untyped_syntax.v
@@ -73,20 +73,22 @@ Inductive if_family : Set := IF_bool | IF_or | IF_option | IF_list.
 Inductive loop_family : Set := LOOP_bool | LOOP_or.
 
 Inductive instruction : Set :=
-| NOOP : instruction
+| Instruction_seq : instruction_seq -> instruction
 | FAILWITH : instruction
-| SEQ : instruction -> instruction -> instruction
-| IF_ : if_family -> instruction -> instruction -> instruction
-| LOOP_ : loop_family -> instruction -> instruction
+| IF_ : if_family -> instruction_seq -> instruction_seq -> instruction
+| LOOP_ : loop_family -> instruction_seq -> instruction
 | PUSH : type -> concrete_data -> instruction
-| LAMBDA : type -> type -> instruction -> instruction
-| ITER : instruction -> instruction
-| MAP : instruction -> instruction
-| CREATE_CONTRACT : type -> type -> annot_o -> instruction -> instruction
-| DIP : Datatypes.nat -> instruction -> instruction
+| LAMBDA : type -> type -> instruction_seq -> instruction
+| ITER : instruction_seq -> instruction
+| MAP : instruction_seq -> instruction
+| CREATE_CONTRACT : type -> type -> annot_o -> instruction_seq -> instruction
+| DIP : Datatypes.nat -> instruction_seq -> instruction
 | SELF : annot_o -> instruction
 | EXEC : instruction
 | instruction_opcode : opcode -> instruction
+with instruction_seq : Set :=
+| NOOP : instruction_seq
+| SEQ : instruction -> instruction_seq -> instruction_seq
 with
 concrete_data : Set :=
 | Int_constant : Z -> concrete_data
@@ -102,7 +104,8 @@ concrete_data : Set :=
 | None_ : concrete_data
 | Elt : concrete_data -> concrete_data -> concrete_data
 | Concrete_seq : Datatypes.list concrete_data -> concrete_data
-| Instruction : instruction -> concrete_data.
+| Instruction : instruction_seq -> concrete_data.
+
 
 Coercion instruction_opcode : opcode >-> instruction.
 
@@ -113,8 +116,14 @@ Notation "'IF_CONS'" := (IF_ IF_list).
 Notation "'LOOP'" := (LOOP_ LOOP_bool).
 Notation "'LOOP_LEFT'" := (LOOP_ LOOP_or).
 
+Fixpoint instruction_app i1 i2 :=
+  match i1 with
+  | NOOP => i2
+  | SEQ i11 i12 => SEQ i11 (instruction_app i12 i2)
+  end.
+
 (* Some macros *)
-Definition UNPAIR : instruction :=
-  SEQ DUP (SEQ CAR (DIP 1 CDR)).
-Definition UNPAPAIR : instruction :=
-  SEQ UNPAIR (DIP 1 UNPAIR).
+Definition UNPAIR : instruction_seq :=
+  SEQ DUP (SEQ CAR (SEQ (DIP 1 (SEQ CDR NOOP)) NOOP)).
+Definition UNPAPAIR : instruction_seq :=
+  instruction_app UNPAIR (SEQ (DIP 1 UNPAIR) NOOP).
diff --git a/src/michocoq/untyper.v b/src/michocoq/untyper.v
index 2c524c79..6aaa273d 100644
--- a/src/michocoq/untyper.v
+++ b/src/michocoq/untyper.v
@@ -117,27 +117,33 @@ Require Import String.
       Concrete_seq (List.map
                       (fun '(syntax.Elt _ _ x y) => Elt (untype_data x) (untype_data y))
                       l)
-    | syntax.Instruction _ i => Instruction (untype_instruction i)
+    | syntax.Instruction _ i => Instruction (untype_instruction_seq i)
     | syntax.Chain_id_constant (Mk_chain_id c) => String_constant c
     end
   with
   untype_instruction {self_type tff0 A B} (i : syntax.instruction self_type tff0 A B) : instruction :=
     match i with
-    | syntax.NOOP => NOOP
+    | syntax.Instruction_seq i =>
+      Instruction_seq (untype_instruction_seq i)
     | syntax.FAILWITH => FAILWITH
-    | syntax.SEQ i1 i2 => SEQ (untype_instruction i1) (untype_instruction i2)
-    | syntax.IF_ f i1 i2 => IF_ (untype_if_family f) (untype_instruction i1) (untype_instruction i2)
-    | syntax.LOOP_ f i => LOOP_ (untype_loop_family f) (untype_instruction i)
-    | syntax.DIP n _ i => DIP n (untype_instruction i)
+    | syntax.IF_ f i1 i2 => IF_ (untype_if_family f) (untype_instruction_seq i1) (untype_instruction_seq i2)
+    | syntax.LOOP_ f i => LOOP_ (untype_loop_family f) (untype_instruction_seq i)
+    | syntax.DIP n _ i => DIP n (untype_instruction_seq i)
     | syntax.EXEC => EXEC
     | syntax.PUSH a x => PUSH a (untype_data x)
-    | syntax.LAMBDA a b i => LAMBDA a b (untype_instruction i)
-    | syntax.ITER i => ITER (untype_instruction i)
-    | syntax.MAP i => MAP (untype_instruction i)
-    | syntax.CREATE_CONTRACT g p an i => CREATE_CONTRACT g p an (untype_instruction i)
+    | syntax.LAMBDA a b i => LAMBDA a b (untype_instruction_seq i)
+    | syntax.ITER i => ITER (untype_instruction_seq i)
+    | syntax.MAP i => MAP (untype_instruction_seq i)
+    | syntax.CREATE_CONTRACT g p an i => CREATE_CONTRACT g p an (untype_instruction_seq i)
     | syntax.SELF an _ => SELF an
     | syntax.Instruction_opcode o => instruction_opcode (untype_opcode o)
-    end.
+    end
+  with untype_instruction_seq {self_type tff0 A B} (i : syntax.instruction_seq self_type tff0 A B) : instruction_seq :=
+    match i with
+    | syntax.NOOP => NOOP
+    | syntax.SEQ i1 i2 => SEQ (untype_instruction i1) (untype_instruction_seq i2)
+    | syntax.Tail_fail i => SEQ (untype_instruction i) NOOP
+  end.
 
   Lemma stype_dec_same A : stype_dec A A = left eq_refl.
   Proof.
@@ -162,55 +168,6 @@ Require Import String.
       try (right; intro contra; discriminate contra).
   Qed.
 
-  Fixpoint tail_fail_induction self_type A B (i : syntax.instruction self_type true A B)
-        (P : forall self_type A B, syntax.instruction self_type true A B -> Type)
-        (HFAILWITH : forall st a A B, P st (a ::: A) B syntax.FAILWITH)
-        (HSEQ : forall st A B C i1 i2,
-            P st B C i2 ->
-            P st A C (i1;; i2))
-        (HIF : forall st A B C1 C2 t (f : syntax.if_family C1 C2 t) i1 i2,
-            P st (C1 ++ A) B i1 ->
-            P st (C2 ++ A) B i2 ->
-            P st (t ::: A) B (syntax.IF_ f i1 i2))
-    : P self_type A B i :=
-    let P' st b A B : syntax.instruction st b A B -> Type :=
-        if b return syntax.instruction st b A B -> Type
-        then P st A B
-        else fun i => True
-    in
-    match i as i0 in syntax.instruction st b A B return P' st b A B i0
-    with
-    | syntax.FAILWITH => HFAILWITH _ _ _ _
-    | @syntax.SEQ _ A B C tff i1 i2 =>
-      (if tff return
-          forall i2 : syntax.instruction _ tff B C,
-            P' _ tff A C (syntax.SEQ i1 i2)
-       then
-         fun i2 =>
-           HSEQ _ _ _ _ i1 i2
-                (tail_fail_induction _ B C i2 P HFAILWITH HSEQ HIF)
-       else fun i2 => I)
-        i2
-    | @syntax.IF_ _ A B tffa tffb _ _ _ f i1 i2 =>
-      (if tffa as tffa return
-          forall i1, P' _ (tffa && tffb)%bool _ _ (syntax.IF_ f i1 i2)
-       then
-         fun i1 =>
-           (if tffb return
-               forall i2,
-                 P' _ tffb _ _ (syntax.IF_ f i1 i2)
-            then
-              fun i2 =>
-                HIF _ _ _ _ _ _ f i1 i2
-                    (tail_fail_induction _ _ _ i1 P HFAILWITH HSEQ HIF)
-                    (tail_fail_induction _ _ _ i2 P HFAILWITH HSEQ HIF)
-            else
-              fun _ => I) i2
-       else
-         fun _ => I) i1
-    | _ => I
-    end.
-
   Lemma bool_dec_same2 (x y : Datatypes.bool) (H1 H2 : x = y) (HH1 HH2 : H1 = H2) : HH1 = HH2.
   Proof.
     apply Eqdep_dec.UIP_dec.
@@ -231,24 +188,39 @@ Require Import String.
     f_equal; apply bool_dec_same.
   Qed.
 
-  Definition tail_fail_change_range {self_type} A B B' (i : syntax.instruction self_type true A B) :
-    syntax.instruction self_type true A B'.
+  Definition tail_fail_change_range_seq {self_type} A B B' (i : syntax.instruction_seq self_type true A B) :
+    syntax.instruction_seq self_type true A B'.
   Proof.
-    apply (tail_fail_induction self_type A B i (fun self_type A B i => syntax.instruction self_type true A B')); clear A B i.
+    apply (tail_fail_induction_seq self_type A B i (fun self_type A B i => syntax.instruction self_type true A B')
+                                   (fun self_type A B i => syntax.instruction_seq self_type true A B')); clear A B i.
     - intros st a A _.
       apply syntax.FAILWITH.
-    - intros st A B C i1 _ i2.
-      apply (syntax.SEQ i1 i2).
     - intros st A B C1 C2 t f _ _ i1 i2.
       apply (syntax.IF_ f i1 i2).
+    - intros st A B C i1 _ i2.
+      apply (syntax.SEQ i1 i2).
+    - intros st A B _ i.
+      apply (syntax.Tail_fail i).
+    - intros st A B _ i.
+      apply (syntax.Instruction_seq i).
   Defined.
 
-
   Lemma tail_fail_change_range_same {self_type} A B (i : syntax.instruction self_type true A B) :
     tail_fail_change_range A B B i = i.
   Proof.
-    apply (tail_fail_induction _ A B i); clear A B i;
-      intros; unfold tail_fail_change_range; simpl; f_equal; assumption.
+    apply (tail_fail_induction _ A B i
+                               (fun st A B i => tail_fail_change_range A B B i = i)
+                               (fun st A B i => tail_fail_change_range_seq A B B i = i)); clear A B i;
+      intros; unfold tail_fail_change_range, tail_fail_change_range_seq; simpl; f_equal; assumption.
+  Qed.
+
+  Lemma tail_fail_change_range_same_seq {self_type} A B (i : syntax.instruction_seq self_type true A B) :
+    tail_fail_change_range_seq A B B i = i.
+  Proof.
+    apply (tail_fail_induction_seq _ A B i
+                                   (fun st A B i => tail_fail_change_range A B B i = i)
+                                   (fun st A B i => tail_fail_change_range_seq A B B i = i)); clear A B i;
+      intros; unfold tail_fail_change_range, tail_fail_change_range_seq; simpl; f_equal; assumption.
   Qed.
 
   Definition untype_type_spec {self_type} tffi A B (i : syntax.instruction self_type tffi A B) :=
@@ -260,6 +232,15 @@ Require Import String.
                else
                  typer.Inferred_type _ B) i).
 
+  Definition untype_type_spec_seq {self_type} tffi A B (i : syntax.instruction_seq self_type tffi A B) :=
+    typer.type_instruction_seq (untype_instruction_seq i) A =
+    Return ((if tffi return syntax.instruction_seq self_type tffi A B -> typer.typer_result_seq A
+               then
+                 fun i =>
+                   typer.Any_type_seq _ (fun B' => tail_fail_change_range_seq A B B' i)
+               else
+                 typer.Inferred_type_seq _ B) i).
+
   Lemma instruction_cast_same {self_type} tffi A B (i : syntax.instruction self_type tffi A B) :
     typer.instruction_cast A A B B i = Return i.
   Proof.
@@ -269,6 +250,15 @@ Require Import String.
     reflexivity.
   Qed.
 
+  Lemma instruction_seq_cast_same {self_type} tffi A B (i : syntax.instruction_seq self_type tffi A B) :
+    typer.instruction_seq_cast A A B B i = Return i.
+  Proof.
+    unfold typer.instruction_seq_cast.
+    rewrite stype_dec_same.
+    rewrite stype_dec_same.
+    reflexivity.
+  Qed.
+
   Lemma opcode_cast_same {self_type} A B
         (o : syntax.opcode (self_type := self_type) A B) :
     typer.opcode_cast A A B B o = Return o.
@@ -285,6 +275,12 @@ Require Import String.
     apply instruction_cast_same.
   Qed.
 
+  Lemma instruction_seq_cast_range_same {self_type} tffi A B (i : syntax.instruction_seq self_type tffi A B) :
+    typer.instruction_seq_cast_range A B B i = Return i.
+  Proof.
+    apply instruction_seq_cast_same.
+  Qed.
+
   Lemma instruction_cast_domain_same {self_type} tffi A B (i : syntax.instruction self_type tffi A B) :
     typer.instruction_cast_domain A A B i = Return i.
   Proof.
@@ -313,16 +309,32 @@ Require Import String.
       reflexivity.
   Qed.
 
-  Lemma untype_type_check_instruction_no_tail_fail {self_type} A B (i : syntax.instruction self_type false A B) :
-    untype_type_spec _ _ _ i ->
-    typer.type_check_instruction_no_tail_fail typer.type_instruction (untype_instruction i) A B =
+  Lemma untype_type_check_instruction_seq {self_type} tffi A B (i : syntax.instruction_seq self_type tffi A B) :
+    untype_type_spec_seq _ _ _ i ->
+    typer.type_check_instruction_seq typer.type_instruction_seq (untype_instruction_seq i) A B =
+    Return (existT _ tffi i).
+  Proof.
+    intro IH.
+    unfold typer.type_check_instruction_seq.
+    rewrite IH.
+    simpl.
+    destruct tffi.
+    - rewrite tail_fail_change_range_same_seq.
+      reflexivity.
+    - rewrite instruction_seq_cast_range_same.
+      reflexivity.
+  Qed.
+
+  Lemma untype_type_check_instruction_seq_no_tail_fail {self_type} A B (i : syntax.instruction_seq self_type false A B) :
+    untype_type_spec_seq _ _ _ i ->
+    typer.type_check_instruction_seq_no_tail_fail typer.type_instruction_seq (untype_instruction_seq i) A B =
     Return i.
   Proof.
     intro IH.
-    unfold typer.type_check_instruction_no_tail_fail.
+    unfold typer.type_check_instruction_seq_no_tail_fail.
     rewrite IH.
     simpl.
-    apply instruction_cast_range_same.
+    apply instruction_seq_cast_range_same.
   Qed.
 
   Lemma untype_type_instruction_no_tail_fail {self_type} A B (i : syntax.instruction self_type false A B) :
@@ -335,6 +347,16 @@ Require Import String.
     reflexivity.
   Qed.
 
+  Lemma untype_type_instruction_seq_no_tail_fail {self_type} A B (i : syntax.instruction_seq self_type false A B) :
+    untype_type_spec_seq _ _ _ i ->
+    typer.type_instruction_seq_no_tail_fail typer.type_instruction_seq (untype_instruction_seq i) A = Return (existT _ _ i).
+  Proof.
+    intro IH.
+    unfold typer.type_instruction_seq_no_tail_fail.
+    rewrite IH.
+    reflexivity.
+  Qed.
+
   Ltac trans_refl t := transitivity t; [reflexivity|].
 
   Lemma app_length_inv {A} : forall (l1 l1' l2 l2' : Datatypes.list A),
@@ -411,7 +433,10 @@ Require Import String.
     typer.type_data (untype_data d) a = Return d
   with
   untype_type_instruction {self_type} tffi A B (i : syntax.instruction self_type tffi A B) :
-    untype_type_spec _ _ _ i.
+    untype_type_spec _ _ _ i
+  with
+  untype_type_instruction_seq {self_type} tffi A B (i : syntax.instruction_seq self_type tffi A B) :
+    untype_type_spec_seq _ _ _ i.
   Proof.
     - destruct d; try reflexivity.
       + simpl.
@@ -529,40 +554,27 @@ Require Import String.
           rewrite H.
           reflexivity.
       + simpl.
-        rewrite untype_type_check_instruction; auto.
+        rewrite untype_type_check_instruction_seq; auto.
       + simpl.
         destruct c.
         simpl.
         reflexivity.
     - destruct i; try reflexivity; simpl.
-      + trans_refl (
-          let! existT _ B i1 :=
-            typer.type_instruction_no_tail_fail typer.type_instruction
-              (untype_instruction i1) A in
-          let! r2 := typer.type_instruction (untype_instruction i2) B in
-          match r2 with
-          | typer.Inferred_type _ C i2 =>
-            Return (typer.Inferred_type _ _ (syntax.SEQ (i1 : syntax.instruction self_type _ _ _) i2))
-          | typer.Any_type _ i2 =>
-            Return (typer.Any_type _ (fun C => syntax.SEQ i1 (i2 C)))
-          end
-        ).
-        rewrite untype_type_instruction_no_tail_fail.
-        * simpl.
-          rewrite untype_type_instruction.
-          destruct tff; reflexivity.
-        * auto.
+      + unfold untype_type_spec.
+        simpl.
+        rewrite untype_type_instruction_seq.
+        destruct tff; reflexivity.
       + unfold untype_type_spec.
         simpl.
         unfold type_branches.
-        assert (type_if_family (untype_if_family i1) t = Return (existT _ C1 (existT _ C2 i1))) as Hi1.
-        * destruct i1; reflexivity.
-        * rewrite Hi1.
+        assert (type_if_family (untype_if_family i) t = Return (existT _ C1 (existT _ C2 i))) as Hi.
+        * destruct i; reflexivity.
+        * rewrite Hi.
           simpl.
-          rewrite untype_type_instruction; simpl.
-          rewrite untype_type_instruction; simpl.
+          rewrite untype_type_instruction_seq; simpl.
+          rewrite untype_type_instruction_seq; simpl.
           destruct tffa; destruct tffb;
-            try rewrite instruction_cast_range_same; simpl; repeat f_equal; apply tail_fail_change_range_same.
+            try rewrite instruction_seq_cast_range_same; simpl; repeat f_equal; apply tail_fail_change_range_same_seq.
       + unfold untype_type_spec.
         simpl.
         unfold type_loop.
@@ -570,9 +582,9 @@ Require Import String.
         * destruct i; reflexivity.
         * rewrite Hi.
           simpl.
-          rewrite untype_type_check_instruction_no_tail_fail.
+          rewrite untype_type_check_instruction_seq_no_tail_fail.
           -- reflexivity.
-          -- apply untype_type_instruction.
+          -- apply untype_type_instruction_seq.
       + trans_refl (
           let! d := typer.type_data (untype_data x) a in
           Return (@typer.Inferred_type self_type A _ (syntax.PUSH a d))
@@ -581,33 +593,33 @@ Require Import String.
         reflexivity.
       + trans_refl (
           let! existT _ tff i :=
-            typer.type_check_instruction
-              typer.type_instruction (untype_instruction i) (a :: nil) (b :: nil) in
+            typer.type_check_instruction_seq
+              typer.type_instruction_seq (untype_instruction_seq i) (a :: nil) (b :: nil) in
           Return (@typer.Inferred_type self_type _ (lambda a b ::: A) (syntax.LAMBDA a b i))
         ).
-        rewrite untype_type_check_instruction; auto.
+        rewrite untype_type_check_instruction_seq; auto.
       + destruct i as [c v]; destruct v.
         * unfold untype_type_spec; simpl.
-          rewrite untype_type_check_instruction_no_tail_fail; auto.
+          rewrite untype_type_check_instruction_seq_no_tail_fail; auto.
         * unfold untype_type_spec; simpl.
-          rewrite untype_type_check_instruction_no_tail_fail; auto.
+          rewrite untype_type_check_instruction_seq_no_tail_fail; auto.
         * unfold untype_type_spec; simpl.
-          rewrite untype_type_check_instruction_no_tail_fail; auto.
+          rewrite untype_type_check_instruction_seq_no_tail_fail; auto.
       + destruct i as [a c v]; destruct v.
         * unfold untype_type_spec; simpl.
-          rewrite untype_type_instruction_no_tail_fail.
+          rewrite untype_type_instruction_seq_no_tail_fail.
           -- simpl.
-             rewrite instruction_cast_range_same.
+             rewrite instruction_seq_cast_range_same.
              reflexivity.
           -- auto.
         * unfold untype_type_spec; simpl.
-          rewrite untype_type_instruction_no_tail_fail.
+          rewrite untype_type_instruction_seq_no_tail_fail.
           -- simpl.
-             rewrite instruction_cast_range_same.
+             rewrite instruction_seq_cast_range_same.
              reflexivity.
           -- auto.
       + unfold untype_type_spec; simpl.
-        rewrite untype_type_check_instruction.
+        rewrite untype_type_check_instruction_seq.
         -- simpl.
            rewrite instruction_cast_domain_same.
            reflexivity.
@@ -629,13 +641,26 @@ Require Import String.
         simpl.
         rewrite (take_n_length n A B e).
         simpl.
-        rewrite untype_type_instruction_no_tail_fail.
+        rewrite untype_type_instruction_seq_no_tail_fail.
         * simpl.
           rewrite instruction_cast_domain_same.
           reflexivity.
-        * apply untype_type_instruction.
+        * apply untype_type_instruction_seq.
       + unfold untype_type_spec.
         simpl.
         rewrite untype_type_opcode.
         reflexivity.
+    - destruct i; try reflexivity; simpl.
+      + unfold untype_type_spec_seq.
+        simpl.
+        rewrite untype_type_instruction.
+        simpl.
+        reflexivity.
+      + unfold untype_type_spec_seq.
+        simpl.
+        rewrite untype_type_instruction.
+        simpl.
+        rewrite untype_type_instruction_seq.
+        simpl.
+        destruct tff; reflexivity.
   Qed.
-- 
GitLab


From 34a1022f2194a7009133abfecd741e4d5dcc57f1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Thu, 5 Dec 2019 12:08:19 +0100
Subject: [PATCH 23/56] [michocoq] Use frienly notations in all verified
 scripts

---
 src/contracts_coq/boomerang.v        |  34 ++---
 src/contracts_coq/deposit.v          |  20 +--
 src/contracts_coq/generic_multisig.v | 197 ++++++++++++++-------------
 src/contracts_coq/manager.v          |  50 +++----
 src/contracts_coq/multisig.v         | 185 ++++++++++++++-----------
 src/contracts_coq/vote.v             |  24 ++--
 6 files changed, 275 insertions(+), 235 deletions(-)

diff --git a/src/contracts_coq/boomerang.v b/src/contracts_coq/boomerang.v
index e4f853c7..ca1b79cf 100644
--- a/src/contracts_coq/boomerang.v
+++ b/src/contracts_coq/boomerang.v
@@ -35,23 +35,23 @@ Module boomerang(C:ContractContext).
 Module semantics := Semantics C. Import semantics.
 
 Definition boomerang : full_contract _ parameter_ty None storage_ty :=
-  (
-    CDR ;;
-    NIL operation ;;
-       AMOUNT;;
-       PUSH mutez (0 ~mutez);;
-       IFCMPEQ NOOP
-         (
-           SOURCE ;;
-           CONTRACT None unit ;;
-           ASSERT_SOME ;;
-           AMOUNT ;;
-           UNIT ;;
-           TRANSFER_TOKENS ;;
-           CONS ;; NOOP
-         );;
-       PAIR ;; NOOP
-  ).
+  {
+    CDR;
+    NIL operation;
+    AMOUNT;
+    PUSH mutez (0 ~mutez);
+    IFCMPEQ {}
+    {
+      SOURCE ;
+      CONTRACT None unit ;
+      ASSERT_SOME ;
+      AMOUNT ;
+      UNIT ;
+      TRANSFER_TOKENS ;
+      CONS
+    };
+    PAIR
+  }.
 
 Lemma eqb_eq a c1 c2 :
   BinInt.Z.eqb (comparison_to_int (compare a c1 c2)) Z0 = true <->
diff --git a/src/contracts_coq/deposit.v b/src/contracts_coq/deposit.v
index 5b38563c..34edd4b3 100644
--- a/src/contracts_coq/deposit.v
+++ b/src/contracts_coq/deposit.v
@@ -39,17 +39,17 @@ Module semantics := Semantics C. Import semantics.
 Open Scope michelson_scope.
 
 Definition deposit : full_contract _ parameter_ty None storage_ty :=
-  (
-    DUP;; CAR;; DIP1 ( CDR ;; NOOP );;
+  {
+    DUP; CAR; DIP1 { CDR };
     IF_LEFT
-      ( DROP1;; NIL operation;; NOOP )
-      ( DIP1 ( DUP;; DUP;;
-               SENDER;; COMPARE;;
-               EQ;; IF_TRUE NOOP ( FAILWITH ;; NOOP );;
-               (CONTRACT None unit);; IF_NONE (FAILWITH ;; NOOP) NOOP ;; NOOP );;
-        PUSH unit Unit;; TRANSFER_TOKENS;;
-        (NIL operation);; SWAP;; CONS;; NOOP );;
-    PAIR ;; NOOP).
+      { DROP1; (NIL operation) }
+      { DIP1 { DUP; DUP;
+               SENDER; COMPARE;
+               EQ; IF_TRUE {} { FAILWITH };
+               (CONTRACT None unit); IF_NONE { FAILWITH } {} };
+        PUSH unit Unit; TRANSFER_TOKENS;
+        (NIL operation); SWAP; CONS };
+    PAIR }.
 
 Lemma deposit_correct :
   forall (env : @proto_env (Some (parameter_ty, None)))
diff --git a/src/contracts_coq/generic_multisig.v b/src/contracts_coq/generic_multisig.v
index 7e5d3771..fc6b1766 100644
--- a/src/contracts_coq/generic_multisig.v
+++ b/src/contracts_coq/generic_multisig.v
@@ -55,61 +55,64 @@ Module semantics := Semantics C. Import semantics.
 Definition ADD_nat {S} : instruction (Some (parameter_ty, None)) _ (nat ::: nat ::: S) (nat ::: S) := ADD.
 
 Definition multisig : full_contract _ parameter_ty None storage_ty :=
-  (
-    UNPAIR ;;
+  {
+    UNPAIR;
     IF_LEFT
-    ( DROP1 ;; NIL operation ;; PAIR ;; NOOP )
-      ( PUSH mutez (0 ~mutez) ;; AMOUNT ;; ASSERT_CMPEQ ;;
-        SWAP ;; DUP ;; DIP1 ( SWAP ;; NOOP ) ;;
+      { DROP1; (NIL operation); PAIR }
+      { PUSH mutez (0 ~mutez); AMOUNT; ASSERT_CMPEQ;
+        SWAP; DUP; DIP1 { SWAP };
         DIP1
-          (
-            UNPAIR ;;
-            DUP ;; SELF (self_type := parameter_ty) (self_annot := None) None I ;;
-            ADDRESS ;; CHAIN_ID ;; PAIR ;; PAIR ;;
-            PACK ;;
-            DIP1 ( UNPAIR ;; DIP1 (SWAP ;; NOOP) ;; NOOP ) ;; SWAP ;; NOOP
-          ) ;;
-
-        UNPAIR ;; DIP1 (SWAP ;; NOOP) ;;
-        ASSERT_CMPEQ ;;
-
-        DIP1 (SWAP ;; NOOP) ;; UNPAIR ;;
+          {
+            UNPAIR;
+            DUP; SELF (self_type := parameter_ty) (self_annot := None) None I;
+            ADDRESS; CHAIN_ID;
+            PAIR; PAIR;
+            PACK;
+            DIP1 { UNPAIR; DIP1 { SWAP } }; SWAP
+          };
+
+        UNPAIR; DIP1 { SWAP };
+        ASSERT_CMPEQ;
+
+        DIP1 { SWAP }; UNPAIR;
         DIP1
-          (
-            PUSH nat (nat_constant 0);; SWAP ;;
+          {
+            PUSH nat (nat_constant 0); SWAP;
             ITER
-              (
-                DIP1 (SWAP ;; NOOP) ;; SWAP ;;
+              {
+                DIP1 { SWAP }; SWAP;
                 IF_CONS
-                  (
+                  {
                     IF_SOME
-                      ( SWAP ;;
+                      { SWAP;
                         DIP1
-                          (
-                            SWAP ;; DIIP ( DUUP ;; NOOP ) ;;
-                            ( DUUUP;; DIP1 (CHECK_SIGNATURE ;; NOOP);; SWAP;; IF (DROP1 ;; NOOP) (Tail_fail FAILWITH) ;; NOOP );;;
-                            PUSH nat (nat_constant 1) ;; ADD_nat ;; NOOP ) ;; NOOP )
-                      ( SWAP ;; DROP1 ;; NOOP ) ;; NOOP
-                  )
-                  (
-                    FAIL ;; NOOP
-                  ) ;;
-                SWAP ;; NOOP
-              ) ;; NOOP
-          ) ;;
-        ASSERT_CMPLE ;;
-        IF_CONS (FAIL ;; NOOP) NOOP ;;
-        DROP1 ;;
-
-        DIP1 ( UNPAIR ;; PUSH nat (nat_constant 1) ;; ADD ;; PAIR ;; NOOP) ;;
+                          {
+                            SWAP; DIIP { DUUP };
+                            DUUUP; DIP1 { CHECK_SIGNATURE };
+                            SWAP; IF_TRUE { DROP1 } { FAILWITH };
+                            PUSH nat (nat_constant 1); ADD_nat }}
+                      { SWAP; DROP1 }
+                  }
+                  {
+                    FAIL
+                  };
+                SWAP
+              }
+          };
+        ASSERT_CMPLE;
+        IF_CONS { FAIL } {};
+        DROP1;
+
+        DIP1 { UNPAIR; PUSH nat (nat_constant 1); ADD; PAIR };
 
         IF_LEFT
-          ( UNIT ;; EXEC ;; NOOP )
-          (
-            DIP1 ( CAR ;; NOOP ) ;; SWAP ;; PAIR ;; NIL operation ;; NOOP
-          );;
-        PAIR ;; NOOP ) ;; NOOP
-  ).
+          { UNIT; EXEC }
+          {
+            DIP1 { CAR }; SWAP;
+            PAIR; (NIL operation)
+          };
+        PAIR }
+  }.
 
 Fixpoint check_all_signatures (sigs : Datatypes.list (Datatypes.option (data signature)))
          (keys : Datatypes.list (data key))
@@ -187,21 +190,23 @@ Definition multisig_spec
 Definition multisig_head :
   instruction_seq (Some (parameter_ty, None)) Datatypes.false (pair (pair nat action_ty) (list (option signature)) ::: pair nat (pair nat (list key)) ::: nil) (nat ::: list key ::: list (option signature) ::: bytes ::: action_ty ::: storage_ty ::: nil)
 :=
-    PUSH mutez (0 ~mutez);; AMOUNT;; ASSERT_CMPEQ;;
-    SWAP ;; DUP ;; DIP1 (SWAP ;; NOOP) ;;
-    DIP1
-      (
-        UNPAIR ;;
-        DUP ;; SELF (self_type := parameter_ty) (self_annot := None) None I ;;
-        ADDRESS ;; CHAIN_ID ;; PAIR ;; PAIR ;;
-        PACK ;;
-        DIP1 ( UNPAIR ;; DIP1 (SWAP ;; NOOP) ;; NOOP ) ;; SWAP ;; NOOP
-      ) ;;
-
-    UNPAIR ;; DIP1 (SWAP ;; NOOP) ;;
-    ASSERT_CMPEQ ;;
-
-    DIP1 (SWAP ;; NOOP) ;; UNPAIR ;; NOOP.
+    {
+      PUSH mutez (0 ~mutez); AMOUNT; ASSERT_CMPEQ;
+      SWAP; DUP; DIP1 { SWAP };
+      DIP1
+        {
+          UNPAIR;
+          DUP; SELF (self_type := parameter_ty) (self_annot := None) None I ;
+          ADDRESS; CHAIN_ID;
+          PAIR; PAIR;
+          PACK;
+          DIP1 { UNPAIR; DIP1 { SWAP }}; SWAP
+        };
+
+      UNPAIR; DIP1 { SWAP };
+      ASSERT_CMPEQ;
+
+      DIP1 { SWAP }; UNPAIR }.
 
 Definition multisig_head_spec
            (env : @proto_env (Some (parameter_ty, None)))
@@ -269,23 +274,25 @@ Definition multisig_iter_body :
     (nat ::: list (option signature) ::: bytes ::: action_ty :::
          storage_ty ::: nil)
   :=
-    (DIP1 (SWAP ;; NOOP) ;; SWAP ;;
-         IF_CONS
-         (
-           IF_SOME
-             ( SWAP ;;
-                    DIP1
-                    (
-                      SWAP ;; DIIP ( DUUP;; NOOP ) ;;
-                           ( DUUUP;; DIP1 (CHECK_SIGNATURE ;; NOOP);; SWAP;; IF (DROP1 ;; NOOP) (Tail_fail FAILWITH) ;; NOOP );;;
-                           PUSH nat (nat_constant 1) ;; ADD_nat ;; NOOP ) ;; NOOP )
-             ( SWAP ;; DROP1 ;; NOOP ) ;; NOOP
-         )
-         (
-           FAIL;; NOOP
-         ) ;;
-         SWAP ;; NOOP
-    ).
+    {
+      DIP1 { SWAP }; SWAP;
+      IF_CONS
+          {
+            IF_SOME
+              { SWAP;
+                DIP1
+                  {
+                    SWAP; DIIP { DUUP };
+                    DUUUP; DIP1 { CHECK_SIGNATURE };
+                    SWAP; IF_TRUE { DROP1 } { FAILWITH };
+                    PUSH nat (nat_constant 1); ADD_nat }}
+              { SWAP; DROP1 }
+          }
+          {
+            FAIL
+          };
+      SWAP
+    }.
 
 Lemma multisig_iter_body_correct env k n sigs packed
       (st : stack (action_ty ::: storage_ty ::: nil)) fuel psi :
@@ -449,27 +456,31 @@ Definition multisig_tail :
     (nat ::: nat ::: list (option signature) ::: bytes ::: action_ty :::
          storage_ty ::: nil)
     (pair (list operation) storage_ty ::: nil) :=
+  {
+    ASSERT_CMPLE;
+    IF_CONS { FAIL } {};
+    DROP1;
 
-        ASSERT_CMPLE ;;
-        IF_CONS (FAIL;; NOOP) NOOP ;;
-        DROP1 ;;
+    DIP1 { UNPAIR; PUSH nat (nat_constant 1); ADD; PAIR };
 
-        DIP1 ( UNPAIR ;; PUSH nat (nat_constant 1) ;; ADD ;; PAIR ;; NOOP) ;;
-
-        IF_LEFT
-          ( UNIT ;; EXEC ;; NOOP )
-          (
-            DIP1 ( CAR ;; NOOP ) ;; SWAP ;; PAIR ;; (NIL operation) ;; NOOP
-          );;
-        PAIR ;; NOOP.
+    IF_LEFT
+      { UNIT; EXEC }
+      {
+        DIP1 { CAR }; SWAP;
+        PAIR; (NIL operation)
+      };
+    PAIR }.
 
 Lemma multisig_split :
   multisig =
-  (
-    UNPAIR ;;
+  {
+    UNPAIR;
     IF_LEFT
-      ( DROP1 ;; NIL operation ;; PAIR ;; NOOP )
-      ( multisig_head ;;; DIP1 (PUSH nat (nat_constant 0%N);; SWAP;; multisig_iter ;; NOOP);; multisig_tail) ;; NOOP).
+      { DROP1; NIL operation; PAIR }
+      ( multisig_head ;;;
+        DIP1 { PUSH nat (nat_constant 0%N); SWAP; multisig_iter };;
+        multisig_tail)
+  }%michelson.
 Proof.
   reflexivity.
 Qed.
diff --git a/src/contracts_coq/manager.v b/src/contracts_coq/manager.v
index 714b16fb..9fbf9183 100644
--- a/src/contracts_coq/manager.v
+++ b/src/contracts_coq/manager.v
@@ -39,31 +39,31 @@ Module manager(C:ContractContext).
 Module semantics := Semantics C. Import semantics.
 
 Definition manager : full_contract _ parameter_ty None storage_ty :=
-  (UNPAIR ;;
-   IF_LEFT
-   ( (* 'do' entrypoint *)
-     (* Assert no token was sent: *)
-     (* to send tokens, the default entry point should be used *)
-     PUSH mutez (0 ~mutez) ;;
-     AMOUNT ;;
-     ASSERT_CMPEQ ;;
-     (* Assert that the sender is the manager *)
-     DUUP ;;
-     IMPLICIT_ACCOUNT ;;
-     ADDRESS ;;
-     SENDER ;;
-     ASSERT_CMPEQ ;;
-     (* Execute the lambda argument *)
-     UNIT ;;
-     EXEC ;;
-     PAIR ;; NOOP
-   )
-   ((* 'default' entrypoint *)
-     DROP1 ;;
-     NIL operation ;;
-     PAIR ;; NOOP
-   ) ;; NOOP
-  ).
+  { UNPAIR;
+    IF_LEFT
+      { (* 'do' entrypoint *)
+        (* Assert no token was sent: *)
+        (* to send tokens, the default entry point should be used *)
+        PUSH mutez (0 ~mutez);
+        AMOUNT;
+        ASSERT_CMPEQ;
+        (* Assert that the sender is the manager *)
+        DUUP;
+        IMPLICIT_ACCOUNT;
+        ADDRESS;
+        SENDER;
+        ASSERT_CMPEQ;
+        (* Execute the lambda argument *)
+        UNIT;
+        EXEC;
+        PAIR
+      }
+      { (* 'default' entrypoint *)
+        DROP1 ;
+        NIL operation ;
+        PAIR
+      }
+  }.
 
 Definition manager_spec
            (env : @proto_env (Some (parameter_ty, None)))
diff --git a/src/contracts_coq/multisig.v b/src/contracts_coq/multisig.v
index 3ccb4d43..31b650fc 100644
--- a/src/contracts_coq/multisig.v
+++ b/src/contracts_coq/multisig.v
@@ -54,55 +54,66 @@ Definition ADD_nat {S} : instruction (Some (parameter_ty, None)) _ (nat ::: nat
 
 Definition pack_ty := pair (pair chain_id address) (pair nat action_ty).
 
-Definition multisig : full_contract _ parameter_ty None storage_ty :=
-  (
-    UNPAIR ;; SWAP ;; DUP ;; DIP1 { SWAP } ;;
+Definition multisig : full_contract false parameter_ty None storage_ty :=
+  {
+    UNPAIR; SWAP; DUP; DIP1 { SWAP};
     DIP1
-      (
-        UNPAIR ;;
-        DUP ;; SELF (self_type := parameter_ty) (self_annot := None) None I ;; ADDRESS ;; CHAIN_ID ;; PAIR ;; PAIR ;;
-        PACK ;;
-        DIP1 ( UNPAIR ;; DIP1 (SWAP ;; NOOP) ;; NOOP) ;; SWAP ;; NOOP
-      ) ;;
-
-    UNPAIR ;; DIP1 (SWAP ;; NOOP) ;;
-    ASSERT_CMPEQ ;;
-
-    DIP1 (SWAP ;; NOOP) ;; UNPAIR ;;
+      {
+        UNPAIR;
+        DUP; SELF (self_type := parameter_ty) (self_annot := None) None I;
+        ADDRESS;
+        CHAIN_ID;
+        PAIR;
+        PAIR;
+        PACK;
+        DIP1 { UNPAIR; DIP1 { SWAP }};
+        SWAP
+      };
+
+    UNPAIR; DIP1 { SWAP };
+    ASSERT_CMPEQ;
+
+    DIP1 { SWAP }; UNPAIR;
     DIP1
-      (
-        PUSH nat (nat_constant 0%N) ;; SWAP ;;
+      {
+        PUSH nat (nat_constant 0%N);
+        SWAP;
         ITER
-          (
-            DIP1 (SWAP ;; NOOP) ;; (SWAP) ;;
+          {
+            DIP1 { SWAP }; SWAP;
             IF_CONS
-              (
+              {
                 IF_SOME
-                  ( SWAP ;;
+                  { SWAP;
                     DIP1
-                      (
-                        SWAP ;; DIIP ( DIP1 (DUP ;; NOOP) ;; SWAP ;; NOOP) ;;
-                        CHECK_SIGNATURE ;; ASSERT ;;
-                        PUSH nat (nat_constant 1%N) ;; ADD_nat ;; NOOP) ;; NOOP)
-                  ( SWAP ;; DROP1 ;; NOOP ) ;; NOOP
-              )
-              (
-                FAIL ;; NOOP
-              ) ;;
-            SWAP ;; NOOP
-          ) ;; NOOP
-      ) ;;
-    ASSERT_CMPLE ;;
-    DROP1 ;; DROP1 ;;
-
-    DIP1 ( UNPAIR ;; PUSH nat (nat_constant 1%N) ;; ADD ;; PAIR ;; NOOP ) ;;
-
-    NIL operation ;; SWAP ;;
+                      {
+                        SWAP;
+                        DIIP { DIP1 { DUP };
+                               SWAP };
+                        CHECK_SIGNATURE; ASSERT;
+                        PUSH nat (nat_constant 1%N); ADD_nat}}
+                  { SWAP; DROP1 }
+              }
+              {
+                FAIL
+              };
+            SWAP
+          }
+      };
+    ASSERT_CMPLE;
+    DROP1; DROP1;
+
+    DIP1 { UNPAIR; PUSH nat (nat_constant 1%N); ADD; PAIR };
+
+    NIL operation; SWAP;
     IF_LEFT
-      ( UNPAIR ;; UNIT ;; TRANSFER_TOKENS ;; CONS ;; NOOP )
-      ( IF_LEFT (SET_DELEGATE ;; CONS ;; NOOP )
-                ( DIP1 ( SWAP ;; CAR ;; NOOP ) ;; SWAP ;; PAIR ;; SWAP ;; NOOP ) ;; NOOP) ;;
-    PAIR ;; NOOP )%michelson.
+      { UNPAIR; UNIT; TRANSFER_TOKENS;
+        CONS }
+      { IF_LEFT { SET_DELEGATE; CONS }
+                { DIP1 { SWAP; CAR };
+                  SWAP; PAIR;
+                  SWAP }};
+    PAIR }.
 
 Fixpoint check_all_signatures (sigs : Datatypes.list (Datatypes.option (data signature)))
          (keys : Datatypes.list (data key))
@@ -172,19 +183,24 @@ Definition multisig_head :
                   (pair parameter_ty storage_ty ::: nil)
                   (nat ::: list key ::: list (option signature) ::: bytes ::: action_ty ::: storage_ty ::: nil)
 :=
-    UNPAIR ;; SWAP ;; DUP ;; DIP1 (SWAP ;; NOOP) ;;
+  {
+    UNPAIR; SWAP; DUP;
+    DIP1 { SWAP };
     DIP1
-      (
-        UNPAIR ;;
-        DUP ;; SELF (self_type := parameter_ty) (self_annot := None) None I ;; ADDRESS ;; CHAIN_ID ;; PAIR ;; PAIR ;;
-        PACK ;;
-        DIP1 ( UNPAIR ;; DIP1 (SWAP ;; NOOP) ;; NOOP ) ;; SWAP ;; NOOP
-      ) ;;
+      {
+        UNPAIR;
+        DUP; SELF (self_type := parameter_ty) (self_annot := None) None I;
+        ADDRESS; CHAIN_ID;
+        PAIR; PAIR;
+        PACK;
+        DIP1 { UNPAIR; DIP1 { SWAP } };
+        SWAP
+      };
 
-    UNPAIR ;; DIP1 (SWAP ;; NOOP) ;;
-    ASSERT_CMPEQ ;;
+    UNPAIR; DIP1 { SWAP };
+    ASSERT_CMPEQ;
 
-    DIP1 (SWAP ;; NOOP) ;; UNPAIR ;; NOOP.
+    DIP1 { SWAP }; UNPAIR}.
 
 Definition multisig_head_spec
            (env : @proto_env (Some (parameter_ty, None)))
@@ -256,22 +272,28 @@ Definition multisig_iter_body :
     (nat ::: list (option signature) ::: bytes ::: action_ty :::
          storage_ty ::: nil)
   :=
-  (DIP1 (SWAP ;; NOOP) ;; SWAP ;;
-       IF_CONS
-       (
-         IF_SOME
-           ( SWAP ;;
-                  DIP1
-                  (
-                    SWAP ;; DIIP ( DIP1 (DUP ;; NOOP) ;; SWAP ;; NOOP ) ;;
-                         CHECK_SIGNATURE ;; ASSERT ;;
-                         PUSH nat (nat_constant 1%N) ;; ADD_nat ;; NOOP) ;; NOOP)
-           ( SWAP ;; DROP1 ;; NOOP ) ;; NOOP
-       )
-       (
-         FAIL ;; NOOP
-       ) ;;
-       SWAP ;; NOOP).
+    {
+      DIP1 { SWAP }; SWAP;
+      IF_CONS
+        {
+          IF_SOME
+            {
+              SWAP;
+              DIP1
+                {
+                  SWAP;
+                  DIIP { DIP1 { DUP }; SWAP };
+                  CHECK_SIGNATURE; ASSERT;
+                  PUSH nat (nat_constant 1%N); ADD_nat
+                }
+            }
+            { SWAP; DROP1 }
+        }
+        {
+          FAIL
+        };
+        SWAP
+    }.
 
 Lemma multisig_iter_body_correct env k n sigs packed
       (st : stack (action_ty ::: storage_ty ::: nil)) fuel psi :
@@ -431,19 +453,26 @@ Definition multisig_tail :
     (nat ::: nat ::: list (option signature) ::: bytes ::: action_ty :::
          storage_ty ::: nil)
     (pair (list operation) storage_ty ::: nil) :=
-      ASSERT_CMPLE ;;
-    DROP1 ;; DROP1 ;;
+  {
+    ASSERT_CMPLE;
+    DROP1; DROP1;
 
-    DIP1 ( UNPAIR ;; PUSH nat (nat_constant 1%N) ;; ADD_nat ;; PAIR ;; NOOP ) ;;
+    DIP1 { UNPAIR; PUSH nat (nat_constant 1%N); ADD_nat; PAIR };
 
-    NIL operation ;; SWAP ;;
+    NIL operation; SWAP;
     IF_LEFT
-      ( UNPAIR ;; UNIT ;; TRANSFER_TOKENS ;; CONS ;; NOOP )
-      ( IF_LEFT (SET_DELEGATE ;; CONS ;; NOOP )
-                ( DIP1 ( SWAP ;; CAR ;; NOOP ) ;; SWAP ;; PAIR ;; SWAP ;; NOOP ) ;; NOOP) ;;
-    PAIR ;; NOOP.
-
-Lemma multisig_split : multisig = (multisig_head ;;; DIP1 (PUSH nat (nat_constant 0%N);; SWAP;; multisig_iter ;; NOOP);; multisig_tail).
+      { UNPAIR; UNIT; TRANSFER_TOKENS;
+        CONS }
+      { IF_LEFT { SET_DELEGATE; CONS }
+                { DIP1 { SWAP; CAR };
+                  SWAP; PAIR;
+                  SWAP } };
+    PAIR }.
+
+Lemma multisig_split : multisig =
+                       (multisig_head ;;;
+                        DIP1 { PUSH nat (nat_constant 0%N); SWAP; multisig_iter };;
+                        multisig_tail).
 Proof.
   reflexivity.
 Qed.
diff --git a/src/contracts_coq/vote.v b/src/contracts_coq/vote.v
index c67bc2b9..64d9c561 100644
--- a/src/contracts_coq/vote.v
+++ b/src/contracts_coq/vote.v
@@ -33,18 +33,18 @@ Module vote(C:ContractContext).
 Module semantics := Semantics C. Import semantics.
 
 Definition vote : full_contract _ parameter_ty None storage_ty :=
-  (
-    AMOUNT ;;
-    PUSH mutez (5000000 ~mutez);;
-    COMPARE;; GT;;
-    IF ( FAIL;; NOOP ) ( NOOP );;
-    DUP;; DIP1 ( CDR;; DUP;; NOOP );; CAR;; DUP;;
-    DIP1 (
-      GET (i := get_map string int);; ASSERT_SOME;;
-      PUSH int (Int_constant 1%Z);; ADD (s := add_int_int);; SOME;; NOOP
-    );;
-    UPDATE (i := Mk_update string (option int) (map string int) (Update_variant_map string int));;
-    NIL operation;; PAIR;; NOOP ).
+  {
+    AMOUNT ;
+    PUSH mutez (5000000 ~mutez);
+    COMPARE; GT;
+    IF_TRUE { FAIL } {};
+    DUP; DIP1 { CDR; DUP }; CAR; DUP;
+    DIP1 {
+      (GET (i := get_map string int)); ASSERT_SOME;
+      PUSH int (Int_constant 1%Z); (ADD (s := add_int_int)); SOME
+    };
+    (UPDATE (i := Mk_update string (option int) (map string int) (Update_variant_map string int)));
+    (NIL operation); PAIR }.
 
 Definition vote_spec
            (env : @proto_env (Some (parameter_ty, None)))
-- 
GitLab


From ac659ab02567bcd93a065f5031e4d6a00930e398 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Thu, 7 May 2020 21:22:44 +0200
Subject: [PATCH 24/56] [build|ignore] Also ignore the cache of the `nia`
 tactic

---
 .gitignore | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.gitignore b/.gitignore
index 07a45784..d59b750b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -8,7 +8,7 @@
 *.vo
 *.vok
 *.vos
-*.lia.cache
+*.cache
 # Generated by configure and coq_makefile
 _CoqProject
 Makefile
-- 
GitLab


From 8591d768e374959f7a1093b9ffb89830471b4889 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Sat, 21 Dec 2019 22:53:16 +0100
Subject: [PATCH 25/56] [michocoq] Fix a bug in the typer

Type-checking a mutez literal now fails in case of overflow.
---
 src/contracts_coq/boomerang.v        |   3 +-
 src/michocoq/error.v                 |   2 +-
 src/michocoq/extraction/extraction.v |   2 +-
 src/michocoq/int64bv.v               | 139 +++++++++++++++++++++++++--
 src/michocoq/syntax.v                |   2 +-
 src/michocoq/tez.v                   |  59 ++++++++++--
 src/michocoq/untyper.v               |   5 +-
 7 files changed, 189 insertions(+), 23 deletions(-)

diff --git a/src/contracts_coq/boomerang.v b/src/contracts_coq/boomerang.v
index ca1b79cf..0d3b45ae 100644
--- a/src/contracts_coq/boomerang.v
+++ b/src/contracts_coq/boomerang.v
@@ -94,7 +94,8 @@ Proof.
   more_fuel; simpl.
   fold (simple_compare mutez).
   fold (compare mutez).
-  case_eq ((comparison_to_int (compare mutez (0 ~Mutez) (amount env)) =? 0)%Z).
+  rewrite match_if_exchange.
+  match goal with | |- (if ?b then _ else _) <-> _ => case_eq b end.
   - (* true *)
     intro Heq.
     rewrite eqb_eq in Heq.
diff --git a/src/michocoq/error.v b/src/michocoq/error.v
index b93073b2..ec242605 100644
--- a/src/michocoq/error.v
+++ b/src/michocoq/error.v
@@ -177,7 +177,7 @@ Proof.
     reflexivity.
 Qed.
 
-Lemma bind_eq_return {A B : Set} f (m : M A) (b : M B) :
+Lemma bind_eq_return {A B : Set} f (m : M A) (b : B) :
   (let! x := m in f x) = Return b ->
   exists a : A, m = Return a /\ f a = Return b.
 Proof.
diff --git a/src/michocoq/extraction/extraction.v b/src/michocoq/extraction/extraction.v
index f37a6e36..a9b8699e 100644
--- a/src/michocoq/extraction/extraction.v
+++ b/src/michocoq/extraction/extraction.v
@@ -95,7 +95,7 @@ Extract Constant Zdigits.Zmod2 => "fun x -> Zarith.ediv x (Zarith.add Zarith.one
 Extract Inlined Constant int64 => "int64".
 Extract Inlined Constant sign => "(fun x -> Int64.compare x 0L < 0)".
 Extract Inlined Constant to_Z => "Zarith.of_int64".
-Extract Inlined Constant of_Z => "Zarith.to_int64".
+Extract Inlined Constant of_Z_unsafe => "Zarith.to_int64".
 
 (* Avoid a name collision for the module [Char] from the [coq-list-string]
    library. *)
diff --git a/src/michocoq/int64bv.v b/src/michocoq/int64bv.v
index aa251092..89c7d0e0 100644
--- a/src/michocoq/int64bv.v
+++ b/src/michocoq/int64bv.v
@@ -25,6 +25,8 @@
 Require Import Bvector.
 Require Import ZArith.
 Require Import Zdigits.
+Require Import Lia.
+Require error.
 
 Definition int64 := Bvector 64.
 
@@ -32,18 +34,142 @@ Definition sign : int64 -> bool := Bsign 63.
 
 Definition to_Z : int64 -> Z := two_compl_value 63.
 
-Definition of_Z : Z -> int64 := Z_to_two_compl 63.
+Lemma to_Z_lower_bound : forall b : int64, (- two_power_nat 63 <= to_Z b)%Z.
+Proof.
+  unfold int64, to_Z.
+  generalize 63.
+  intros n b.
+  refine (@VectorDef.caseS
+            _
+            (fun n b => - two_power_nat n <= two_compl_value n b)%Z
+            _ n b).
+  clear n b.
+  intros b n t.
+  simpl.
+  generalize b; clear b.
+  induction t.
+  + simpl.
+    unfold eq_rec_r.
+    simpl.
+    intro b; destruct b; simpl; omega.
+  + simpl two_compl_value.
+    unfold eq_rec_r.
+    simpl.
+    specialize (IHt h).
+    generalize IHt; clear IHt.
+    destruct (two_compl_value n (h :: t)).
+    * destruct b; simpl; nia.
+    * destruct b; simpl; nia.
+    * generalize (shift_nat n 1); intro p0; simpl.
+      destruct b; simpl; try nia.
+      apply Pos2Z.neg_le_neg.
+      unfold "<="%Z in IHt.
+      unfold "?="%Z in IHt.
+      rewrite <- Pos.compare_antisym in IHt.
+      change (p <= p0)%positive in IHt.
+      transitivity (p~0)%positive.
+      -- rewrite <- Pos.succ_pred_double.
+         lia.
+      -- nia.
+Qed.
+
+Lemma to_Z_upper_bound : forall b : int64, (to_Z b < two_power_nat 63)%Z.
+  unfold int64, to_Z.
+  generalize 63.
+  intros n b.
+  refine (@VectorDef.caseS
+            _
+            (fun n b => two_compl_value n b < two_power_nat n)%Z
+            _ n b).
+  clear n b.
+  intros b n t.
+  generalize b; clear b.
+  induction t.
+  + unfold two_power_nat.
+    simpl.
+    unfold eq_rec_r.
+    simpl.
+    intro b; destruct b; simpl; omega.
+  + simpl two_compl_value.
+    unfold eq_rec_r.
+    simpl.
+    specialize (IHt h).
+    generalize IHt; clear IHt.
+    unfold two_power_nat.
+    destruct (two_compl_value n (h :: t)).
+    * destruct b; simpl; nia.
+    * destruct b; simpl; nia.
+    * generalize (shift_nat n 1); intro p0; simpl.
+      destruct b; simpl; nia.
+Qed.
+
+Definition of_Z_unsafe : Z -> int64 := Z_to_two_compl 63.
+
+Definition of_Z_safe (z : Z) :
+  ((z >=? - two_power_nat 63) && (z <? two_power_nat 63))%Z = true -> int64 :=
+  fun _ => of_Z_unsafe z.
+
+Definition of_Z (z : Z) : error.M int64 :=
+  if ((z >=? - two_power_nat 63) && (z <? two_power_nat 63))%bool%Z
+  then
+    error.Return (of_Z_unsafe z)
+  else
+    error.Failed _ error.Overflow.
+
+Lemma of_Z_safe_is_of_Z z H : of_Z z = error.Return (of_Z_safe z H).
+Proof.
+  unfold of_Z, of_Z_safe.
+  rewrite H.
+  reflexivity.
+Qed.
 
 Definition int64_inversion (b : int64) : exists a v, b = Bcons a 63 v :=
   match b in Vector.t _ (S _) return exists a v, b = Bcons a _ v with
   | Vector.cons _ a _ v => ex_intro _ a (ex_intro _ v eq_refl)
   end.
 
-Lemma of_Z_to_Z b : of_Z (to_Z b) = b.
+Lemma of_Z_to_Z_eqv z b : to_Z b = z <-> of_Z z = error.Return b.
 Proof.
-  destruct (int64_inversion b) as (a, (v, H)).
-  rewrite H.
-  apply two_compl_to_Z_to_two_compl.
+  unfold of_Z, to_Z.
+  split.
+  - intro; subst z.
+    destruct (int64_inversion b) as (a, (v, H)).
+    rewrite H.
+    unfold of_Z_unsafe.
+    rewrite two_compl_to_Z_to_two_compl.
+    rewrite <- H; clear H.
+    assert ((two_compl_value 63 b >=? - two_power_nat 63)%Z = true) as Hlow.
+    + rewrite Z.geb_le.
+      apply to_Z_lower_bound.
+    + rewrite Hlow; clear Hlow.
+      assert ((two_compl_value 63 b <? two_power_nat 63)%Z = true) as Hhigh.
+      * rewrite Z.ltb_lt.
+        apply to_Z_upper_bound.
+      * rewrite Hhigh; clear Hhigh.
+        reflexivity.
+  - intro H.
+    case_eq ((z >=? - two_power_nat 63) && (z <? two_power_nat 63))%Z.
+    + intro Hcond.
+      rewrite Hcond in H.
+      apply (f_equal (fun o => match o with error.Return x => x | _ => b end)) in H.
+      subst b.
+      apply andb_prop in Hcond.
+      destruct Hcond as (H1, H2).
+      apply Z_to_two_compl_to_Z.
+      * apply Z.le_ge.
+        apply Z.geb_le.
+        assumption.
+      * apply Z.ltb_lt.
+        assumption.
+    + intro Hcond.
+      rewrite Hcond in H.
+      discriminate.
+Qed.
+
+Lemma of_Z_to_Z b : of_Z (to_Z b) = error.Return b.
+Proof.
+  rewrite <- of_Z_to_Z_eqv.
+  reflexivity.
 Qed.
 
 Definition compare (a b : int64) : comparison :=
@@ -61,6 +187,7 @@ Proof.
     apply (f_equal of_Z) in H.
     rewrite of_Z_to_Z in H.
     rewrite of_Z_to_Z in H.
-    assumption.
+    injection H.
+    auto.
   - apply f_equal.
 Qed.
diff --git a/src/michocoq/syntax.v b/src/michocoq/syntax.v
index 30f90044..8abf2084 100644
--- a/src/michocoq/syntax.v
+++ b/src/michocoq/syntax.v
@@ -699,7 +699,7 @@ Notation "{ }" := NOOP : michelson_scope.
 
 Notation "{ A ; .. ; B }" := (seq_aux A .. (seq_aux B NOOP) ..) : michelson_scope.
 
-Notation "n ~Mutez" := (exist _ (int64bv.of_Z n) eq_refl) (at level 100).
+Notation "n ~Mutez" := (exist _ (int64bv.of_Z_safe n eq_refl) eq_refl) (at level 100).
 
 Notation "n ~mutez" := (Mutez_constant (Mk_mutez (n ~Mutez))) (at level 100).
 
diff --git a/src/michocoq/tez.v b/src/michocoq/tez.v
index 9951321a..f0f5f012 100644
--- a/src/michocoq/tez.v
+++ b/src/michocoq/tez.v
@@ -26,6 +26,7 @@ Require Import ZArith.
 Require int64bv.
 Require Eqdep_dec.
 Require error.
+Import error.Notations.
 
 Definition mutez : Set := {t : int64bv.int64 | int64bv.sign t = false }.
 
@@ -46,9 +47,7 @@ Proof.
   destruct (Bool.bool_dec x y); tauto.
 Qed.
 
-Coercion to_int64 : mutez >-> int64bv.int64.
-
-Definition to_Z (t : mutez) : Z := int64bv.to_Z t.
+Definition to_Z (t : mutez) : Z := int64bv.to_Z (to_int64 t).
 
 Definition of_int64_aux (t : int64bv.int64) (sign : bool) :
   int64bv.sign t = sign -> error.M mutez :=
@@ -75,16 +74,58 @@ Proof.
       reflexivity.
 Qed.
 
+Lemma of_int64_aux_sign (t : int64bv.int64) sign (e : int64bv.sign t = sign) (b : mutez) :
+  of_int64_aux t sign e = error.Return b ->
+  sign = false.
+Proof.
+  unfold of_int64_aux.
+  destruct sign.
+  - discriminate.
+  - reflexivity.
+Qed.
+
+Lemma of_int64_sign (t : int64bv.int64) (b : mutez) :
+  of_int64 t = error.Return b ->
+  int64bv.sign t = false.
+Proof.
+  destruct b.
+  unfold of_int64.
+  apply of_int64_aux_sign.
+Qed.
+
 Definition of_Z (t : Z) : error.M mutez :=
-  of_int64 (int64bv.of_Z t).
+  let! b := int64bv.of_Z t in
+  of_int64 b.
 
-Lemma of_Z_to_Z (t : mutez) : of_Z (to_Z t) = error.Return t.
+Lemma of_Z_to_Z_eqv (z : Z) (t : mutez) : to_Z t = z <-> of_Z z = error.Return t.
 Proof.
   unfold of_Z, to_Z.
-  rewrite int64bv.of_Z_to_Z.
-  destruct t.
-  simpl.
-  apply of_int64_return.
+  split.
+  - intro; subst z.
+    rewrite int64bv.of_Z_to_Z.
+    destruct t.
+    simpl.
+    apply of_int64_return.
+  - intro H.
+    apply (error.bind_eq_return of_int64) in H.
+    destruct H as (b, (Hz, Hb)).
+    rewrite <- int64bv.of_Z_to_Z_eqv in Hz.
+    subst z.
+    f_equal.
+    destruct t as (b', e').
+    simpl.
+    assert (int64bv.sign b = false) as e.
+    + apply of_int64_sign in Hb.
+      assumption.
+    + rewrite (of_int64_return _ e) in Hb.
+      injection Hb.
+      auto.
+Qed.
+
+Lemma of_Z_to_Z (t : mutez) : of_Z (to_Z t) = error.Return t.
+Proof.
+  rewrite <- of_Z_to_Z_eqv.
+  reflexivity.
 Qed.
 
 Definition compare (t1 t2 : mutez) : comparison :=
diff --git a/src/michocoq/untyper.v b/src/michocoq/untyper.v
index 6aaa273d..a00e385e 100644
--- a/src/michocoq/untyper.v
+++ b/src/michocoq/untyper.v
@@ -447,10 +447,7 @@ Require Import String.
         reflexivity.
       + simpl.
         destruct m.
-        trans_refl (
-          let! m := tez.of_Z (tez.to_Z m) in
-          Return (syntax.Mutez_constant (Mk_mutez m))
-        ).
+        unfold type_data.
         rewrite tez.of_Z_to_Z.
         reflexivity.
       + simpl.
-- 
GitLab


From daec052f29f13fb492f93cdc55bb604669c722db Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Sat, 25 Apr 2020 15:33:49 +0200
Subject: [PATCH 26/56] [michocoq] Typing and untyping mode (Readable or
 Optimized)

Since the introduction of timestamp literals, the typer is not
injective anymore so the converse of untyper.untype_type is not true.

By introducing a typing and an untyping mode, we get back injectivity
at least in optimized mode.
---
 src/michocoq/error.v   |  15 +++--
 src/michocoq/main.v    |   2 +-
 src/michocoq/typer.v   |  79 ++++++++++++----------
 src/michocoq/untyper.v | 149 +++++++++++++++++------------------------
 4 files changed, 115 insertions(+), 130 deletions(-)

diff --git a/src/michocoq/error.v b/src/michocoq/error.v
index ec242605..02effec0 100644
--- a/src/michocoq/error.v
+++ b/src/michocoq/error.v
@@ -178,14 +178,17 @@ Proof.
 Qed.
 
 Lemma bind_eq_return {A B : Set} f (m : M A) (b : B) :
-  (let! x := m in f x) = Return b ->
+  (let! x := m in f x) = Return b <->
   exists a : A, m = Return a /\ f a = Return b.
 Proof.
-  destruct m.
-  - discriminate.
-  - simpl.
-    exists a.
-    auto.
+  split.
+  - destruct m.
+    + discriminate.
+    + simpl.
+      exists a.
+      auto.
+  - intros (a, (Hm, Hb)).
+    subst m; exact Hb.
 Qed.
 
 
diff --git a/src/michocoq/main.v b/src/michocoq/main.v
index 609543d5..56f6e73a 100644
--- a/src/michocoq/main.v
+++ b/src/michocoq/main.v
@@ -45,7 +45,7 @@ Definition contract_file_M : error.M syntax.contract_file :=
   let! existT _ tff code :=
     let! a := michelson_M in
     let i := a.(micheline2michelson.code) in
-    typer.type_check_instruction_seq typer.type_instruction_seq i _ _ in
+    typer.type_check_instruction_seq (typer.type_instruction_seq typer.Any) i _ _ in
   error.Return
     {| contract_file_parameter := self_type;
        contract_file_annotation := None;
diff --git a/src/michocoq/typer.v b/src/michocoq/typer.v
index b4200b39..df1a5509 100644
--- a/src/michocoq/typer.v
+++ b/src/michocoq/typer.v
@@ -6,6 +6,8 @@ Require Import syntax_type.
 Require Import untyped_syntax error.
 Import error.Notations.
 
+Inductive type_mode := Readable | Optimized | Any.
+
 
 Lemma andb_and a b : (a && b)%bool <-> a /\ b.
 Proof.
@@ -537,7 +539,7 @@ Qed.
     | _, _ => Failed _ (Typing _ (instruction_opcode o, A))
     end.
 
-  Fixpoint type_data (d : concrete_data) {struct d}
+  Fixpoint type_data (tm : type_mode) (d : concrete_data) {struct d}
     : forall ty, M (syntax.concrete_data ty) :=
     match d with
     | Int_constant z =>
@@ -550,7 +552,11 @@ Qed.
         | Comparable_type mutez =>
           let! m := tez.of_Z z in
           Return (syntax.Mutez_constant (syntax.Mk_mutez m))
-        | Comparable_type timestamp => Return (syntax.Timestamp_constant z)
+        | Comparable_type timestamp =>
+          match tm with
+          | Optimized | Any => Return (syntax.Timestamp_constant z)
+          | Readable => Failed _ (Typing _ ("Not readable"%string, (d, ty)))
+          end
         | _ => Failed _ (Typing _ (d, ty))
         end
     | String_constant s =>
@@ -562,12 +568,17 @@ Qed.
         | Comparable_type key_hash => Return (syntax.Key_hash_constant s)
         | Comparable_type address => Return (syntax.Address_constant (syntax.Mk_address s))
         | Comparable_type timestamp =>
-          match Moment.Parse.rfc3339_non_strict (LString.s s) with
-          | Some (moment, nil) =>
-            let z := Moment.to_epoch moment in
-            Return (syntax.Timestamp_constant z)
-          | _ =>
-            Failed _ (Typing _ ("Cannot parse timestamp according to rfc3339"%string, s))
+          match tm with
+          | Optimized => Failed _ (Typing _ ("Not optimized"%string, (d, ty)))
+          | Readable
+          | Any =>
+            match Moment.Parse.rfc3339_non_strict (LString.s s) with
+            | Some (moment, nil) =>
+              let z := Moment.to_epoch moment in
+              Return (syntax.Timestamp_constant z)
+            | _ =>
+              Failed _ (Typing _ ("Cannot parse timestamp according to rfc3339"%string, s))
+            end
           end
         | chain_id => Return (syntax.Chain_id_constant (syntax.Mk_chain_id s))
         | _ => Failed _ (Typing _ (d, ty))
@@ -600,8 +611,8 @@ Qed.
       fun ty =>
         match ty with
         | pair a b =>
-          let! x := type_data x a in
-          let! y := type_data y b in
+          let! x := type_data tm x a in
+          let! y := type_data tm y b in
           Return (syntax.Pair x y)
         | _ => Failed _ (Typing _ (d, ty))
         end
@@ -609,7 +620,7 @@ Qed.
       fun ty =>
         match ty with
         | or a an b bn =>
-          let! x := type_data x a in
+          let! x := type_data tm x a in
           Return (syntax.Left x an bn)
         | _ => Failed _ (Typing _ (d, ty))
         end
@@ -617,7 +628,7 @@ Qed.
       fun ty =>
         match ty with
         | or a an b bn =>
-          let! y := type_data y b in
+          let! y := type_data tm y b in
           Return (syntax.Right y an bn)
         | _ => Failed _ (Typing _ (d, ty))
         end
@@ -625,7 +636,7 @@ Qed.
       fun ty =>
         match ty with
         | option a =>
-          let! x := type_data x a in
+          let! x := type_data tm x a in
           Return (syntax.Some_ x)
         | _ => Failed _ (Typing _ (d, ty))
         end
@@ -644,7 +655,7 @@ Qed.
               match l with
               | nil => Return nil
               | cons x l =>
-                let! x := type_data x a in
+                let! x := type_data tm x a in
                 let! l := type_data_list l in
                 Return (cons x l)
               end
@@ -656,7 +667,7 @@ Qed.
               match l with
               | nil => Return nil
               | cons x l =>
-                let! x := type_data x a in
+                let! x := type_data tm x a in
                 let! l := type_data_list l in
                 Return (cons x l)
               end
@@ -668,8 +679,8 @@ Qed.
               match l with
               | nil => Return nil
               | cons (Elt x y) l =>
-                let! x := type_data x a in
-                let! y := type_data y b in
+                let! x := type_data tm x a in
+                let! y := type_data tm y b in
                 let! l := type_data_list l in
                 Return (cons (syntax.Elt _ _ x y) l)
               | _ => Failed _ (Typing _ (d, ty))
@@ -682,7 +693,7 @@ Qed.
       fun ty =>
         match ty with
         | lambda a b =>
-          let! existT _ tff i := type_check_instruction_seq type_instruction_seq i (cons a nil) (cons b nil) in
+          let! existT _ tff i := type_check_instruction_seq (type_instruction_seq tm) i (cons a nil) (cons b nil) in
           Return (syntax.Instruction _ i)
         | _ => Failed _ (Typing _ (d, ty))
         end
@@ -690,42 +701,42 @@ Qed.
     end
 
   with
-  type_instruction {self_type} i A {struct i} : M (typer_result (self_type := self_type) A) :=
+  type_instruction {self_type} tm i A {struct i} : M (typer_result (self_type := self_type) A) :=
     match i, A with
     | Instruction_seq i, _ =>
-      let! i := type_instruction_seq i A in
+      let! i := type_instruction_seq tm i A in
       match i with
       | Any_type_seq _ i => Return (Any_type _ (fun B => syntax.Instruction_seq (i B)))
       | Inferred_type_seq _ _ i => Return (Inferred_type _ _ (syntax.Instruction_seq i))
       end
     | FAILWITH, a :: A => Return (Any_type _ (fun B => syntax.FAILWITH))
     | IF_ f i1 i2, t :: A =>
-      type_branches f t type_instruction_seq i1 i2 A
+      type_branches f t (type_instruction_seq tm) i1 i2 A
     | LOOP_ f i, t :: A =>
-      type_loop f t type_instruction_seq i A
+      type_loop f t (type_instruction_seq tm) i A
     | EXEC, a :: lambda a' b :: B =>
       let A := a :: lambda a' b :: B in
       let A' := a :: lambda a b :: B in
       let! i := instruction_cast_domain A' A _ syntax.EXEC in
       Return (Inferred_type _ _ i)
     | PUSH a v, A =>
-      let! d := type_data v a in
+      let! d := type_data tm v a in
       Return (Inferred_type _ _ (syntax.PUSH a d))
     | LAMBDA a b i, A =>
       let! existT _ tff i :=
-        type_check_instruction_seq type_instruction_seq i (a :: nil) (b :: nil) in
+        type_check_instruction_seq (type_instruction_seq tm) i (a :: nil) (b :: nil) in
       Return (Inferred_type _ _ (syntax.LAMBDA a b i))
     | ITER i, list a :: A =>
-      let! i := type_check_instruction_seq_no_tail_fail type_instruction_seq i (a :: A) A in
+      let! i := type_check_instruction_seq_no_tail_fail (type_instruction_seq tm) i (a :: A) A in
       Return (Inferred_type _ _ (syntax.ITER (i := syntax.iter_list _) i))
     | ITER i, set a :: A =>
-      let! i := type_check_instruction_seq_no_tail_fail type_instruction_seq i (a ::: A) A in
+      let! i := type_check_instruction_seq_no_tail_fail (type_instruction_seq tm) i (a ::: A) A in
       Return (Inferred_type _ _ (syntax.ITER (i := syntax.iter_set _)i))
     | ITER i, map kty vty :: A =>
-      let! i := type_check_instruction_seq_no_tail_fail type_instruction_seq i (pair kty vty :: A) A in
+      let! i := type_check_instruction_seq_no_tail_fail (type_instruction_seq tm) i (pair kty vty :: A) A in
       Return (Inferred_type _ _ (syntax.ITER (i := syntax.iter_map _ _) i))
     | MAP i, list a :: A =>
-      let! r := type_instruction_seq_no_tail_fail type_instruction_seq i (a :: A) in
+      let! r := type_instruction_seq_no_tail_fail (type_instruction_seq tm) i (a :: A) in
       match r with
       | existT _ (b :: A') i =>
         let! i := instruction_seq_cast_range (a :: A) (b :: A') (b :: A) i in
@@ -733,7 +744,7 @@ Qed.
       | _ => Failed _ (Typing _ tt)
       end
     | MAP i, map kty vty :: A =>
-      let! r := type_instruction_seq_no_tail_fail type_instruction_seq i (pair kty vty ::: A) in
+      let! r := type_instruction_seq_no_tail_fail (type_instruction_seq tm) i (pair kty vty ::: A) in
       match r with
       | existT _ (b :: A') i =>
         let! i := instruction_seq_cast_range (pair kty vty :: A) (b :: A') (b :: A) i in
@@ -747,7 +758,7 @@ Qed.
       let A' :=
           option key_hash ::: mutez ::: g ::: B in
       let! existT _ tff i :=
-        type_check_instruction_seq (self_type := (Some (p, an))) type_instruction_seq i (pair p g :: nil) (pair (list operation) g :: nil) in
+        type_check_instruction_seq (self_type := (Some (p, an))) (type_instruction_seq tm) i (pair p g :: nil) (pair (list operation) g :: nil) in
       let! i := instruction_cast_domain A' A _ (syntax.CREATE_CONTRACT g p an i) in
       Return (Inferred_type _ _ i)
     | SELF an, A =>
@@ -760,7 +771,7 @@ Qed.
       end
     | DIP n i, S12 =>
       let! (exist _ S1 H1, S2) := take_n S12 n in
-      let! existT _ B i := type_instruction_seq_no_tail_fail type_instruction_seq i S2 in
+      let! existT _ B i := type_instruction_seq_no_tail_fail (type_instruction_seq tm) i S2 in
       let! i := instruction_cast_domain (S1 +++ S2) S12 _ (syntax.DIP n H1 i) in
       Return (Inferred_type S12 (S1 +++ B) i)
     | instruction_opcode o, A =>
@@ -769,14 +780,14 @@ Qed.
     | _, _ => Failed _ (Typing _ (i, A))
     end
   with
-  type_instruction_seq {self_type} i A {struct i} : M (typer_result_seq (self_type := self_type) A) :=
+  type_instruction_seq {self_type} tm i A {struct i} : M (typer_result_seq (self_type := self_type) A) :=
     match i, A with
     | NOOP, A => Return (Inferred_type_seq _ _ syntax.NOOP)
     | SEQ i1 i2, A =>
-      let! r1 := type_instruction i1 A in
+      let! r1 := type_instruction tm i1 A in
       match r1, i2 with
       | Inferred_type _ B i1, i2 =>
-        let! r2 := type_instruction_seq i2 B in
+        let! r2 := type_instruction_seq tm i2 B in
         match r2 with
         | Inferred_type_seq _ C i2 =>
           Return (Inferred_type_seq _ _ (syntax.SEQ i1 i2))
diff --git a/src/michocoq/untyper.v b/src/michocoq/untyper.v
index a00e385e..9a2ad603 100644
--- a/src/michocoq/untyper.v
+++ b/src/michocoq/untyper.v
@@ -4,10 +4,13 @@ Require Import typer.
 Require Import untyped_syntax error.
 Require Eqdep_dec.
 Import error.Notations.
+Require Import Lia.
 
 (* Not really needed but eases reading of proof states. *)
 Require Import String.
 
+Inductive untype_mode := untype_Readable | untype_Optimized.
+
   Definition untype_opcode {self_type A B} (o : @syntax.opcode self_type A B) : opcode :=
     match o with
     | syntax.APPLY => APPLY
@@ -91,14 +94,23 @@ Require Import String.
     | syntax.LOOP_or _ _ _ _ => LOOP_or
     end.
 
-  Fixpoint untype_data {a} (d : syntax.concrete_data a) : concrete_data :=
+  Fixpoint untype_data {a} (um : untype_mode) (d : syntax.concrete_data a) : concrete_data :=
     match d with
     | syntax.Int_constant z => Int_constant z
     | syntax.Nat_constant n => Int_constant (Z.of_N n)
     | syntax.String_constant s => String_constant s
     | syntax.Mutez_constant (Mk_mutez m) => Int_constant (tez.to_Z m)
     | syntax.Bytes_constant s => Bytes_constant s
-    | syntax.Timestamp_constant t => Int_constant t
+    | syntax.Timestamp_constant t =>
+      match um with
+      | untype_Readable =>
+        String_constant
+          (All.LString.to_string
+             (Moment.Print.rfc3339
+                (Moment.of_epoch t)))
+      | untype_Optimized =>
+        Int_constant t
+      end
     | syntax.Signature_constant s => String_constant s
     | syntax.Key_constant s => String_constant s
     | syntax.Key_hash_constant s => String_constant s
@@ -106,43 +118,43 @@ Require Import String.
     | syntax.Unit => Unit
     | syntax.True_ => True_
     | syntax.False_ => False_
-    | syntax.Pair x y => Pair (untype_data x) (untype_data y)
-    | syntax.Left x _ _ => Left (untype_data x)
-    | syntax.Right y _ _ => Right (untype_data y)
-    | syntax.Some_ x => Some_ (untype_data x)
+    | syntax.Pair x y => Pair (untype_data um x) (untype_data um y)
+    | syntax.Left x _ _ => Left (untype_data um x)
+    | syntax.Right y _ _ => Right (untype_data um y)
+    | syntax.Some_ x => Some_ (untype_data um x)
     | syntax.None_ => None_
-    | syntax.Concrete_list l => Concrete_seq (List.map (fun x => untype_data x) l)
-    | syntax.Concrete_set l => Concrete_seq (List.map (fun x => untype_data x) l)
+    | syntax.Concrete_list l => Concrete_seq (List.map (untype_data um) l)
+    | syntax.Concrete_set l => Concrete_seq (List.map (untype_data um) l)
     | syntax.Concrete_map l =>
       Concrete_seq (List.map
-                      (fun '(syntax.Elt _ _ x y) => Elt (untype_data x) (untype_data y))
+                      (fun '(syntax.Elt _ _ x y) => Elt (untype_data um x) (untype_data um y))
                       l)
-    | syntax.Instruction _ i => Instruction (untype_instruction_seq i)
+    | syntax.Instruction _ i => Instruction (untype_instruction_seq um i)
     | syntax.Chain_id_constant (Mk_chain_id c) => String_constant c
     end
   with
-  untype_instruction {self_type tff0 A B} (i : syntax.instruction self_type tff0 A B) : instruction :=
+  untype_instruction {self_type tff0 A B} (um : untype_mode) (i : syntax.instruction self_type tff0 A B) : instruction :=
     match i with
     | syntax.Instruction_seq i =>
-      Instruction_seq (untype_instruction_seq i)
+      Instruction_seq (untype_instruction_seq um i)
     | syntax.FAILWITH => FAILWITH
-    | syntax.IF_ f i1 i2 => IF_ (untype_if_family f) (untype_instruction_seq i1) (untype_instruction_seq i2)
-    | syntax.LOOP_ f i => LOOP_ (untype_loop_family f) (untype_instruction_seq i)
-    | syntax.DIP n _ i => DIP n (untype_instruction_seq i)
+    | syntax.IF_ f i1 i2 => IF_ (untype_if_family f) (untype_instruction_seq um i1) (untype_instruction_seq um i2)
+    | syntax.LOOP_ f i => LOOP_ (untype_loop_family f) (untype_instruction_seq um i)
+    | syntax.DIP n _ i => DIP n (untype_instruction_seq um i)
     | syntax.EXEC => EXEC
-    | syntax.PUSH a x => PUSH a (untype_data x)
-    | syntax.LAMBDA a b i => LAMBDA a b (untype_instruction_seq i)
-    | syntax.ITER i => ITER (untype_instruction_seq i)
-    | syntax.MAP i => MAP (untype_instruction_seq i)
-    | syntax.CREATE_CONTRACT g p an i => CREATE_CONTRACT g p an (untype_instruction_seq i)
+    | syntax.PUSH a x => PUSH a (untype_data um x)
+    | syntax.LAMBDA a b i => LAMBDA a b (untype_instruction_seq um i)
+    | syntax.ITER i => ITER (untype_instruction_seq um i)
+    | syntax.MAP i => MAP (untype_instruction_seq um i)
+    | syntax.CREATE_CONTRACT g p an i => CREATE_CONTRACT g p an (untype_instruction_seq um i)
     | syntax.SELF an _ => SELF an
     | syntax.Instruction_opcode o => instruction_opcode (untype_opcode o)
     end
-  with untype_instruction_seq {self_type tff0 A B} (i : syntax.instruction_seq self_type tff0 A B) : instruction_seq :=
+  with untype_instruction_seq {self_type tff0 A B} (um : untype_mode) (i : syntax.instruction_seq self_type tff0 A B) : instruction_seq :=
     match i with
     | syntax.NOOP => NOOP
-    | syntax.SEQ i1 i2 => SEQ (untype_instruction i1) (untype_instruction_seq i2)
-    | syntax.Tail_fail i => SEQ (untype_instruction i) NOOP
+    | syntax.SEQ i1 i2 => SEQ (untype_instruction um i1) (untype_instruction_seq um i2)
+    | syntax.Tail_fail i => SEQ (untype_instruction um i) NOOP
   end.
 
   Lemma stype_dec_same A : stype_dec A A = left eq_refl.
@@ -224,7 +236,7 @@ Require Import String.
   Qed.
 
   Definition untype_type_spec {self_type} tffi A B (i : syntax.instruction self_type tffi A B) :=
-    typer.type_instruction (untype_instruction i) A =
+    typer.type_instruction (typer.Optimized) (untype_instruction untype_Optimized i) A =
     Return ((if tffi return syntax.instruction self_type tffi A B -> typer.typer_result A
                then
                  fun i =>
@@ -233,7 +245,7 @@ Require Import String.
                  typer.Inferred_type _ B) i).
 
   Definition untype_type_spec_seq {self_type} tffi A B (i : syntax.instruction_seq self_type tffi A B) :=
-    typer.type_instruction_seq (untype_instruction_seq i) A =
+    typer.type_instruction_seq typer.Optimized (untype_instruction_seq untype_Optimized i) A =
     Return ((if tffi return syntax.instruction_seq self_type tffi A B -> typer.typer_result_seq A
                then
                  fun i =>
@@ -295,7 +307,7 @@ Require Import String.
 
   Lemma untype_type_check_instruction {self_type} tffi A B (i : syntax.instruction self_type tffi A B) :
     untype_type_spec _ _ _ i ->
-    typer.type_check_instruction typer.type_instruction (untype_instruction i) A B =
+    typer.type_check_instruction (typer.type_instruction typer.Optimized) (untype_instruction untype_Optimized i) A B =
     Return (existT _ tffi i).
   Proof.
     intro IH.
@@ -311,7 +323,7 @@ Require Import String.
 
   Lemma untype_type_check_instruction_seq {self_type} tffi A B (i : syntax.instruction_seq self_type tffi A B) :
     untype_type_spec_seq _ _ _ i ->
-    typer.type_check_instruction_seq typer.type_instruction_seq (untype_instruction_seq i) A B =
+    typer.type_check_instruction_seq (typer.type_instruction_seq typer.Optimized) (untype_instruction_seq untype_Optimized i) A B =
     Return (existT _ tffi i).
   Proof.
     intro IH.
@@ -327,7 +339,7 @@ Require Import String.
 
   Lemma untype_type_check_instruction_seq_no_tail_fail {self_type} A B (i : syntax.instruction_seq self_type false A B) :
     untype_type_spec_seq _ _ _ i ->
-    typer.type_check_instruction_seq_no_tail_fail typer.type_instruction_seq (untype_instruction_seq i) A B =
+    typer.type_check_instruction_seq_no_tail_fail (typer.type_instruction_seq typer.Optimized) (untype_instruction_seq untype_Optimized i) A B =
     Return i.
   Proof.
     intro IH.
@@ -339,7 +351,7 @@ Require Import String.
 
   Lemma untype_type_instruction_no_tail_fail {self_type} A B (i : syntax.instruction self_type false A B) :
     untype_type_spec _ _ _ i ->
-    typer.type_instruction_no_tail_fail typer.type_instruction (untype_instruction i) A = Return (existT _ _ i).
+    typer.type_instruction_no_tail_fail (typer.type_instruction typer.Optimized) (untype_instruction untype_Optimized i) A = Return (existT _ _ i).
   Proof.
     intro IH.
     unfold typer.type_instruction_no_tail_fail.
@@ -349,7 +361,7 @@ Require Import String.
 
   Lemma untype_type_instruction_seq_no_tail_fail {self_type} A B (i : syntax.instruction_seq self_type false A B) :
     untype_type_spec_seq _ _ _ i ->
-    typer.type_instruction_seq_no_tail_fail typer.type_instruction_seq (untype_instruction_seq i) A = Return (existT _ _ i).
+    typer.type_instruction_seq_no_tail_fail (typer.type_instruction_seq typer.Optimized) (untype_instruction_seq untype_Optimized i) A = Return (existT _ _ i).
   Proof.
     intro IH.
     unfold typer.type_instruction_seq_no_tail_fail.
@@ -430,7 +442,7 @@ Require Import String.
   Qed.
 
   Fixpoint untype_type_data a (d : syntax.concrete_data a) :
-    typer.type_data (untype_data d) a = Return d
+    typer.type_data typer.Optimized (untype_data untype_Optimized d) a = Return d
   with
   untype_type_instruction {self_type} tffi A B (i : syntax.instruction self_type tffi A B) :
     untype_type_spec _ _ _ i
@@ -438,7 +450,7 @@ Require Import String.
   untype_type_instruction_seq {self_type} tffi A B (i : syntax.instruction_seq self_type tffi A B) :
     untype_type_spec_seq _ _ _ i.
   Proof.
-    - destruct d; try reflexivity.
+    - destruct d; try reflexivity; try (simpl; repeat rewrite untype_type_data; reflexivity).
       + simpl.
         assert (0 <= Z.of_N n)%Z as H by apply N2Z.is_nonneg.
         rewrite <- Z.geb_le in H.
@@ -455,41 +467,15 @@ Require Import String.
         simpl.
         reflexivity.
       + simpl.
-        trans_refl (
-          let! x := typer.type_data (untype_data d1) a in
-          let! y := typer.type_data (untype_data d2) b in
-          Return (@syntax.Pair a b x y)
-        ).
-        rewrite (untype_type_data _ d1).
-        rewrite (untype_type_data _ d2).
-        reflexivity.
-      + trans_refl (
-          let! x := typer.type_data (untype_data d) a in
-          Return (@syntax.Left a b x an bn)
-        ).
-        rewrite (untype_type_data _ d).
-        reflexivity.
-      + trans_refl (
-          let! x := typer.type_data (untype_data d) b in
-          Return (@syntax.Right a b x an bn)
-        ).
-        rewrite (untype_type_data _ d).
-        reflexivity.
-      + trans_refl (
-          let! x := typer.type_data (untype_data d) a in
-          Return (@syntax.Some_ a x)
-        ).
-        rewrite (untype_type_data _ d).
-        reflexivity.
-      + pose (fix type_data_list (l : Datatypes.list concrete_data) :=
+        pose (fix type_data_list (l : Datatypes.list concrete_data) :=
                 match l with
                 | nil => Return nil
                 | cons x l =>
-                  let! x := typer.type_data x a in
+                  let! x := typer.type_data typer.Optimized x a in
                   let! l := type_data_list l in
                   Return (cons x l)
                 end) as type_data_list.
-        assert (forall l, type_data_list (List.map (fun x => untype_data x) l) = Return l).
+        assert (forall l, type_data_list (List.map (untype_data untype_Optimized) l) = Return l).
         * clear l.
           intro l; induction l.
           -- reflexivity.
@@ -497,21 +483,18 @@ Require Import String.
              rewrite untype_type_data.
              rewrite IHl.
              reflexivity.
-        * trans_refl (
-            let! l := type_data_list (List.map (fun x => untype_data x) l) in
-            Return (@syntax.Concrete_list a l)
-          ).
+        * simpl.
           rewrite H.
           reflexivity.
       + pose (fix type_data_set (l : Datatypes.list concrete_data) :=
                 match l with
                 | nil => Return nil
                 | cons x l =>
-                  let! x := typer.type_data x a in
+                  let! x := typer.type_data typer.Optimized x a in
                   let! l := type_data_set l in
                   Return (cons x l)
                 end) as type_data_set.
-        assert (forall l, type_data_set (List.map (fun x => untype_data x) l) = Return l).
+        assert (forall l, type_data_set (List.map (untype_data untype_Optimized) l) = Return l).
         * clear l.
           intro l; induction l.
           -- reflexivity.
@@ -519,23 +502,20 @@ Require Import String.
              rewrite untype_type_data.
              rewrite IHl.
              reflexivity.
-        * trans_refl (
-            let! l := type_data_set (List.map (fun x => untype_data x) l) in
-            Return (@syntax.Concrete_set a l)
-          ).
+        * simpl.
           rewrite H.
           reflexivity.
       + pose (fix type_data_list L :=
                    match L with
                    | nil => Return nil
                    | cons (Elt x y) l =>
-                    let! x := type_data x a in
-                    let! y := type_data y b in
+                    let! x := type_data typer.Optimized x a in
+                    let! y := type_data typer.Optimized y b in
                     let! l := type_data_list l in
                     Return (cons (syntax.Elt _ _ x y) l)
-                   | _ => Failed _ (Typing _ (untype_data (syntax.Concrete_map l), (map a b)))
+                   | _ => Failed _ (Typing _ (untype_data untype_Optimized (syntax.Concrete_map l), (map a b)))
                    end) as type_data_map.
-        assert (forall l, type_data_map (List.map (fun '(syntax.Elt _ _ x y) => Elt (untype_data x) (untype_data y)) l) = Return l).
+        assert (forall l, type_data_map (List.map (fun '(syntax.Elt _ _ x y) => Elt (untype_data untype_Optimized x) (untype_data untype_Optimized y)) l) = Return l).
         * intro L; induction L.
           -- reflexivity.
           -- simpl.
@@ -544,10 +524,7 @@ Require Import String.
              rewrite untype_type_data.
              rewrite IHL.
              reflexivity.
-        * trans_refl (
-            let! l := type_data_map (List.map (fun '(syntax.Elt _ _ x y) => Elt (untype_data x) (untype_data y)) l) in
-            Return (@syntax.Concrete_map a b l)
-          ).
+        * simpl.
           rewrite H.
           reflexivity.
       + simpl.
@@ -582,18 +559,12 @@ Require Import String.
           rewrite untype_type_check_instruction_seq_no_tail_fail.
           -- reflexivity.
           -- apply untype_type_instruction_seq.
-      + trans_refl (
-          let! d := typer.type_data (untype_data x) a in
-          Return (@typer.Inferred_type self_type A _ (syntax.PUSH a d))
-        ).
+      + unfold untype_type_spec.
+        simpl.
         rewrite untype_type_data.
         reflexivity.
-      + trans_refl (
-          let! existT _ tff i :=
-            typer.type_check_instruction_seq
-              typer.type_instruction_seq (untype_instruction_seq i) (a :: nil) (b :: nil) in
-          Return (@typer.Inferred_type self_type _ (lambda a b ::: A) (syntax.LAMBDA a b i))
-        ).
+      + unfold untype_type_spec.
+        simpl.
         rewrite untype_type_check_instruction_seq; auto.
       + destruct i as [c v]; destruct v.
         * unfold untype_type_spec; simpl.
-- 
GitLab


From 93912f6d687ecad2258fd22f576776ed2d2e59a7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Sat, 21 Dec 2019 23:12:06 +0100
Subject: [PATCH 27/56] [michocoq] Prove second half of typer correctness

This completes the correctness proof of the typer in Optimized
mode. Before this, only the typed -> untyped -> typed round-trip was
certified.
---
 src/michocoq/untyper.v | 411 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 411 insertions(+)

diff --git a/src/michocoq/untyper.v b/src/michocoq/untyper.v
index 9a2ad603..3c161a1a 100644
--- a/src/michocoq/untyper.v
+++ b/src/michocoq/untyper.v
@@ -632,3 +632,414 @@ Inductive untype_mode := untype_Readable | untype_Optimized.
         simpl.
         destruct tff; reflexivity.
   Qed.
+
+
+  Definition sigT_eq_1 {A} (P : A -> Set) (xa yb : sigT P) : xa = yb -> projT1 xa = projT1 yb.
+  Proof.
+    apply f_equal.
+  Defined.
+
+  Definition sigT_eq_2 {A} (P : A -> Set) (xa yb : sigT P) (H : xa = yb) :
+    eq_rec (projT1 xa) P (projT2 xa) (projT1 yb) (sigT_eq_1 P xa yb H) = projT2 yb.
+  Proof.
+    subst xa.
+    reflexivity.
+  Defined.
+
+  Definition existT_eq_1 {A} (P : A -> Set) x y a b : existT P x a = existT P y b -> x = y.
+  Proof.
+    apply (f_equal (@projT1 A P)).
+  Defined.
+
+  Definition existT_eq_2 {A} (P : A -> Set) x y a b (H : existT P x a = existT P y b ) :
+    eq_rec x P a y (existT_eq_1 P x y a b H) = b.
+  Proof.
+    apply (sigT_eq_2 P (existT P x a) (existT P y b)).
+  Defined.
+
+  Definition existT_eq_3 {A} (P : A -> Set) x y a b :
+    existT P x a = existT P y b ->
+    sig (fun H : x = y => eq_rec x P a y H = b).
+  Proof.
+    intro H.
+    exists (existT_eq_1 P x y a b H).
+    apply existT_eq_2.
+  Defined.
+
+  Lemma unreturn {A} (a b : A) : error.Return a = error.Return b -> a = b.
+  Proof.
+    intro H; injection H; intro; assumption.
+  Qed.
+
+  Lemma type_untype_cast_seq um self_type A B C D tff i i' :
+    instruction_seq_cast (self_type := self_type) (tff := tff) A B C D i = Return i' ->
+    untype_instruction_seq um i = untype_instruction_seq um i'.
+  Proof.
+    unfold instruction_seq_cast.
+    destruct (stype_dec A B); [| discriminate].
+    destruct (stype_dec C D); [| discriminate].
+    destruct e.
+    destruct e0.
+    simpl.
+    intro H; apply unreturn in H.
+    congruence.
+  Qed.
+
+  Lemma type_untype_cast um self_type A B C D tff i i' :
+    instruction_cast (self_type := self_type) (tff := tff) A B C D i = Return i' ->
+    untype_instruction um i = untype_instruction um i'.
+  Proof.
+    unfold instruction_cast.
+    destruct (stype_dec A B); [| discriminate].
+    destruct (stype_dec C D); [| discriminate].
+    destruct e.
+    destruct e0.
+    simpl.
+    intro H; apply unreturn in H.
+    congruence.
+  Qed.
+
+  Lemma type_untype_cast_opcode self_type A B C D i i' :
+    opcode_cast (self_type := self_type) A B C D i = Return i' ->
+    untype_opcode i = untype_opcode i'.
+  Proof.
+    unfold opcode_cast.
+    destruct (stype_dec A B); [| discriminate].
+    destruct (stype_dec C D); [| discriminate].
+    destruct e.
+    destruct e0.
+    simpl.
+    intro H; apply unreturn in H.
+    congruence.
+  Qed.
+
+  Lemma type_untype_if_family f t A B ff :
+    type_if_family f t = Return (existT _ A (existT _ B ff)) ->
+    untype_if_family ff = f.
+  Proof.
+    destruct f; destruct ff; try discriminate; simpl; reflexivity.
+  Qed.
+
+  Lemma type_untype_loop_family f t A B ff :
+    type_loop_family f t = Return (existT _ A (existT _ B ff)) ->
+    untype_loop_family ff = f.
+  Proof.
+    destruct f; destruct ff; try discriminate; simpl; reflexivity.
+  Qed.
+
+  Ltac mytac type_untype type_untype_seq type_untype_data :=
+    match goal with
+    | |- _ -> _ =>
+      intro
+    | H : (bind _ _ = Return _) |- _ =>
+      rewrite error.bind_eq_return in H
+    | H : (exists _, _) |- _ =>
+      destruct H
+    | H : (_ /\ _) |- _ =>
+      destruct H
+    | H : (Return _ = Return _) |- _ =>
+      apply unreturn in H
+    | H : (Failed _ _ = Return _) |- _ =>
+      discriminate
+    | H : (match ?x with | Any_type_seq _ _ => _ | Inferred_type_seq _ _ _ => _ end = Return _) |- _ =>
+      is_var x; destruct x
+    | H : (match ?x with | Any_type _ _ => _ | Inferred_type _ _ _ => _ end = Return _) |- _ =>
+      is_var x; destruct x
+    | H : (match ?x with | existT _ _ _ => _ end = Return _) |- _ =>
+      is_var x; destruct x
+    | H : (match ?x with | exist _ _ _ => _ end = Return _) |- _ =>
+      is_var x; destruct x
+    | H : (match ?x with | (_, _) => _ end = Return _) |- _ =>
+      is_var x; destruct x
+    | H : (match ?x with | nil => _ | cons _ _ => _ end = Return _) |- _ =>
+      is_var x; destruct x
+    | H : (match ?x with | nil => _ | cons _ _ => _ end _ = Return _) |- _ =>
+      is_var x; destruct x
+    | H : (match ?x with | None => _ | Some _ => _ end = Return _) |- _ =>
+      is_var x; destruct x
+    | H : (match ?x with | NOOP => _ | SEQ _ _ => _ end = Return _) |- _ =>
+      is_var x; destruct x
+    | H : _ = ?x |- _ =>
+      is_var x; subst x
+    | H : ?x = _ |- _ =>
+      is_var x; subst x
+    | H : type_instruction_seq _ _ _ = Return _ |- _ =>
+      apply type_untype_seq in H
+    | H : type_instruction _ _ _ = Return _ |- _ =>
+      apply type_untype in H
+    | H : type_data _ _ _ = Return _ |- _ =>
+      apply type_untype_data in H
+    | H : type_if_family _ _ = Return (existT _ _ (existT _ _ _)) |- _ =>
+      apply type_untype_if_family in H
+    | H : type_loop_family _ _ = Return (existT _ _ (existT _ _ _)) |- _ =>
+      apply type_untype_loop_family in H
+    | H : instruction_seq_cast_range _ _ _ _ = Return _ |- _ =>
+      unfold instruction_seq_cast_range in H
+    | H : instruction_seq_cast _ _ _ _ _ = Return _ |- _ =>
+      apply (type_untype_cast_seq untype_Optimized) in H
+    | H : instruction_cast _ _ _ _ _ = Return _ |- _ =>
+      apply (type_untype_cast untype_Optimized) in H
+    | H : opcode_cast _ _ _ _ _ = Return _ |- _ =>
+      apply type_untype_cast_opcode in H
+    | H : instruction_cast_domain _ _ _ _ = Return _ |- _ =>
+      unfold instruction_cast_domain in H
+    | H : opcode_cast_domain _ _ _ _ _ = Return _ |- _ =>
+      unfold opcode_cast_domain in H
+    | H : type_check_instruction_seq _ _ _ _ = Return _ |- _ =>
+      unfold type_check_instruction_seq in H
+    | H : type_check_instruction_seq_no_tail_fail _ _ _ _ = Return _ |- _ =>
+      unfold type_check_instruction_seq_no_tail_fail in H
+    | H : type_instruction_seq_no_tail_fail _ _ _ = Return _ |- _ =>
+      unfold type_instruction_seq_no_tail_fail in H
+    | H : assert_not_tail_fail_seq _ _ = Return _ |- _ =>
+      unfold assert_not_tail_fail_seq in H
+    |  H : match ?x with
+           | Comparable_type _ => _
+           | key => _
+           | unit => _
+           | signature => _
+           | option _ => _
+           | list _ => _
+           | set _ => _
+           | contract _ => _
+           | operation => _
+           | pair _ _ => _
+           | or _ _ _ _ => _
+           | lambda _ _ => _
+           | map _ _ => _
+           | big_map _ _ => _
+           | chain_id => _
+           end = Return _ |- _ =>
+       destruct x; try discriminate
+    | H : match ?x with
+            | syntax_type.string => _
+            | nat => _
+            | int => _
+            | bytes => _
+            | bool => _
+            | mutez => _
+            | address => _
+            | key_hash => _
+            | timestamp => _
+          end = Return _ |- _ =>
+      destruct x; try discriminate
+    | H : (existT _ _ _ = existT _ _ _) |- _ =>
+      apply existT_eq_3 in H; destruct H
+    | H : (untype_instruction_seq _
+             (eq_rec _ _ _ _ eq_refl) = _) |- _ =>
+      simpl in H
+    | H : (untype_instruction _
+             (syntax.CREATE_CONTRACT _ _ _
+                 (eq_rec _ _ _ _ eq_refl)) = _) |- _ =>
+      simpl in H
+    | H : (untype_instruction _
+             (syntax.DIP _ _
+                 (eq_rec _ _ _ _ eq_refl)) = _) |- _ =>
+      simpl in H
+    | |- _ = _ =>
+      simpl in *; f_equal; congruence
+    end.
+
+  Lemma type_untype_opcode self_type A B o (o' : syntax.opcode A B) :
+    typer.type_opcode (self_type := self_type) o A =
+    error.Return (existT _ B o') ->
+    untype_opcode o' = o.
+  Proof.
+    destruct o; simpl.
+    - destruct A; [discriminate|].
+      destruct A; [discriminate|].
+      destruct t0; try discriminate.
+      destruct t0_1; try discriminate.
+      match goal with
+        | |-
+          ((match ?b0 as b return _ with | true => ?th | false => ?e end) eq_refl = ?rhs -> _) =>
+          intro Ho'; assert (exists b (Hb : is_packable t = b),
+                                (if b return is_packable t = b -> _
+                                 then th else e) Hb = rhs)
+        end.
+      + exists (is_packable t); exists eq_refl; exact Ho'.
+      + clear Ho'.
+        destruct H as ([|], (Hb, H)); try discriminate.
+        unfold typer.opcode_cast_domain in H.
+        repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - unfold type_check_dig.
+      repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - unfold type_check_dug.
+      repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+    - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
+  Qed.
+
+  Fixpoint type_untype self_type A i t {struct i} :
+    typer.type_instruction typer.Optimized (self_type := self_type) i A = error.Return t ->
+    match t with
+    | Inferred_type _ B i' => untype_instruction untype_Optimized i' = i
+    | Any_type _ i' => forall B, untype_instruction untype_Optimized (i' B) = i
+    end
+  with type_untype_seq self_type A i t {struct i} :
+    typer.type_instruction_seq typer.Optimized (self_type := self_type) i A = error.Return t ->
+    match t with
+    | Inferred_type_seq _ B i' => untype_instruction_seq untype_Optimized i' = i
+    | Any_type_seq _ i' => forall B, untype_instruction_seq untype_Optimized (i' B) = i
+    end
+  with type_untype_data a x (x' : syntax.concrete_data a) {struct x} :
+    typer.type_data typer.Optimized x a = error.Return x' ->
+    untype_data untype_Optimized x' = x.
+  Proof.
+    {
+      destruct i; simpl.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - unfold type_branches.
+        repeat mytac type_untype type_untype_seq type_untype_data.
+      - unfold type_loop.
+        repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+        apply type_untype_opcode in H.
+        simpl.
+        f_equal.
+        exact H.
+    }
+    {
+      destruct i; simpl.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+    }
+    {
+      destruct x; simpl.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+        + case_eq (z >=? 0)%Z; intro He; rewrite He in H; try discriminate.
+          repeat mytac type_untype type_untype_seq type_untype_data.
+          simpl.
+          rewrite Z.geb_le in He.
+          f_equal.
+          apply Z2N.id.
+          assumption.
+        + simpl.
+          f_equal.
+          apply tez.of_Z_to_Z_eqv.
+          assumption.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+        + simpl.
+          f_equal.
+          generalize dependent x.
+          generalize dependent l.
+          induction l.
+          * repeat mytac type_untype type_untype_seq type_untype_data.
+          * repeat mytac type_untype type_untype_seq type_untype_data.
+            simpl.
+            f_equal.
+            apply IHl.
+            assumption.
+        + simpl.
+          f_equal.
+          generalize dependent x.
+          generalize dependent l.
+          induction l.
+          * repeat mytac type_untype type_untype_seq type_untype_data.
+          * repeat mytac type_untype type_untype_seq type_untype_data.
+            simpl.
+            f_equal.
+            apply IHl.
+            assumption.
+        + simpl.
+          f_equal.
+          match goal with | H : ?F l = Return x |- _ => pose F as type_data_list end.
+          change (type_data_list l = Return x) in H.
+          assert (exists l', l' = l) as Hl' by (exists l; reflexivity).
+          rename l into linit.
+          destruct Hl' as (l, Hl).
+          rewrite <- Hl in H.
+          rewrite <- Hl.
+          clear Hl.
+          generalize dependent x.
+          induction l; simpl in *.
+          * repeat mytac type_untype type_untype_seq type_untype_data.
+          * repeat mytac type_untype type_untype_seq type_untype_data.
+            destruct a0; try discriminate.
+            repeat mytac type_untype type_untype_seq type_untype_data.
+            simpl.
+            f_equal.
+            apply IHl.
+            assumption.
+      - repeat mytac type_untype type_untype_seq type_untype_data.
+    }
+  Qed.
-- 
GitLab


From 241569172d52cf882f8fd8e7398fb914a5d75226 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Sun, 26 Apr 2020 22:07:01 +0200
Subject: [PATCH 28/56] [michocoq] Simplification of tez.v

This uses `Bool.Is_true (negb ...)` instead of `... = false` in the
definition of the `mutez` type which simplifies a bit reasoning about
the implementation of mutez.
---
 src/michocoq/error.v   | 62 +++++++++++++++++++++++++++---
 src/michocoq/syntax.v  |  2 +-
 src/michocoq/tez.v     | 85 ++++++++++++++----------------------------
 src/michocoq/untyper.v | 38 -------------------
 4 files changed, 86 insertions(+), 101 deletions(-)

diff --git a/src/michocoq/error.v b/src/michocoq/error.v
index 02effec0..ef99cdb4 100644
--- a/src/michocoq/error.v
+++ b/src/michocoq/error.v
@@ -20,7 +20,8 @@
 (* DEALINGS IN THE SOFTWARE. *)
 
 
-(* The error monad *)
+(* The error monad, and various basic stuff *)
+
 Require Bool String.
 Require Import location.
 Require Import syntax_type.
@@ -42,6 +43,11 @@ Inductive M (A : Type) : Type :=
 
 Arguments Return {_} _.
 
+Lemma unreturn {A} (a b : A) : error.Return a = error.Return b -> a = b.
+Proof.
+  congruence.
+Qed.
+
 Definition bind {A B : Type} (m : M A) (f : A -> M B) :=
   match m with
   | Failed _ e => Failed B e
@@ -93,12 +99,9 @@ Definition success {A} (m : M A) :=
 
 Definition Is_true := Bool.Is_true.
 
-Lemma Is_true_UIP b : forall x y : Is_true b, x = y.
+Lemma Is_true_UIP b (x y : Is_true b) : x = y.
 Proof.
-  destruct b.
-  - intros [] [].
-    reflexivity.
-  - contradiction.
+  destruct b; destruct x; destruct y; reflexivity.
 Defined.
 
 Coercion is_true := Is_true.
@@ -243,3 +246,50 @@ Proof.
   - intro H.
     apply H.
 Qed.
+
+Definition dif {A : Datatypes.bool -> Type} (b : Datatypes.bool) (t : b -> A b) (e : negb b -> A b) : A b.
+Proof.
+  destruct b; [apply t | apply e]; constructor.
+Defined.
+
+Lemma dif_case {A : Datatypes.bool -> Type} {b t e} {P : A b -> Prop} : (forall h, P (t h)) -> (forall h, P (e h)) -> P (dif b t e).
+Proof.
+  unfold dif.
+  destruct b.
+  - intros H _; apply H.
+  - intros _ H; apply H.
+Defined.
+
+(* Lemmas about sigT *)
+
+Definition sigT_eq_1 {A} (P : A -> Set) (xa yb : sigT P) : xa = yb -> projT1 xa = projT1 yb.
+Proof.
+  apply f_equal.
+Defined.
+
+Definition sigT_eq_2 {A} (P : A -> Set) (xa yb : sigT P) (H : xa = yb) :
+  eq_rec (projT1 xa) P (projT2 xa) (projT1 yb) (sigT_eq_1 P xa yb H) = projT2 yb.
+Proof.
+  subst xa.
+  reflexivity.
+Defined.
+
+Definition existT_eq_1 {A} (P : A -> Set) x y a b : existT P x a = existT P y b -> x = y.
+Proof.
+  apply (f_equal (@projT1 A P)).
+Defined.
+
+Definition existT_eq_2 {A} (P : A -> Set) x y a b (H : existT P x a = existT P y b ) :
+  eq_rec x P a y (existT_eq_1 P x y a b H) = b.
+Proof.
+  apply (sigT_eq_2 P (existT P x a) (existT P y b)).
+Defined.
+
+Definition existT_eq_3 {A} (P : A -> Set) x y a b :
+  existT P x a = existT P y b ->
+  sig (fun H : x = y => eq_rec x P a y H = b).
+Proof.
+  intro H.
+  exists (existT_eq_1 P x y a b H).
+  apply existT_eq_2.
+Defined.
diff --git a/src/michocoq/syntax.v b/src/michocoq/syntax.v
index 8abf2084..81ff9223 100644
--- a/src/michocoq/syntax.v
+++ b/src/michocoq/syntax.v
@@ -699,7 +699,7 @@ Notation "{ }" := NOOP : michelson_scope.
 
 Notation "{ A ; .. ; B }" := (seq_aux A .. (seq_aux B NOOP) ..) : michelson_scope.
 
-Notation "n ~Mutez" := (exist _ (int64bv.of_Z_safe n eq_refl) eq_refl) (at level 100).
+Notation "n ~Mutez" := (exist _ (int64bv.of_Z_safe n eq_refl) I) (at level 100).
 
 Notation "n ~mutez" := (Mutez_constant (Mk_mutez (n ~Mutez))) (at level 100).
 
diff --git a/src/michocoq/tez.v b/src/michocoq/tez.v
index f0f5f012..ee48b905 100644
--- a/src/michocoq/tez.v
+++ b/src/michocoq/tez.v
@@ -28,7 +28,7 @@ Require Eqdep_dec.
 Require error.
 Import error.Notations.
 
-Definition mutez : Set := {t : int64bv.int64 | int64bv.sign t = false }.
+Definition mutez : Set := {t : int64bv.int64 | Bool.Is_true (negb (int64bv.sign t)) }.
 
 Definition to_int64 (t : mutez) : int64bv.int64 :=
   let (t, _) := t in t.
@@ -42,55 +42,36 @@ Proof.
   simpl in H.
   destruct H.
   f_equal.
-  apply Eqdep_dec.eq_proofs_unicity.
-  intros.
-  destruct (Bool.bool_dec x y); tauto.
+  apply error.Is_true_UIP.
 Qed.
 
 Definition to_Z (t : mutez) : Z := int64bv.to_Z (to_int64 t).
 
-Definition of_int64_aux (t : int64bv.int64) (sign : bool) :
-  int64bv.sign t = sign -> error.M mutez :=
-  if sign return int64bv.sign t = sign -> error.M mutez
-  then fun _ => error.Failed _ error.Overflow
-  else fun H => error.Return (exist _ t H).
-
 Definition of_int64 (t : int64bv.int64) : error.M mutez :=
-  of_int64_aux t (int64bv.sign t) eq_refl.
-
-Lemma of_int64_return (t : int64bv.int64) (H : int64bv.sign t = false) :
-  of_int64 t = error.Return (exist _ t H).
-Proof.
-  unfold of_int64.
-  cut (forall b H', of_int64_aux t b H' = error.Return (exist _ t H)).
-  - intro Hl.
-    apply Hl.
-  - intros b H'.
-    unfold of_int64_aux.
-    destruct b.
-    + congruence.
-    + f_equal.
-      apply to_int64_inj.
-      reflexivity.
-Qed.
-
-Lemma of_int64_aux_sign (t : int64bv.int64) sign (e : int64bv.sign t = sign) (b : mutez) :
-  of_int64_aux t sign e = error.Return b ->
-  sign = false.
+  let! H :=
+     error.dif
+       (A := fun b => error.M (Bool.Is_true (negb b)))
+       (int64bv.sign t)
+       (fun _ => error.Failed _ error.Overflow)
+       (fun H => error.Return H)
+  in
+  @error.Return mutez (exist _ t H).
+
+Lemma of_int64_to_int64_eqv (t : int64bv.int64) (m : mutez) :
+  to_int64 m = t <-> of_int64 t = error.Return m.
 Proof.
-  unfold of_int64_aux.
-  destruct sign.
-  - discriminate.
-  - reflexivity.
-Qed.
-
-Lemma of_int64_sign (t : int64bv.int64) (b : mutez) :
-  of_int64 t = error.Return b ->
-  int64bv.sign t = false.
-Proof.
-  destruct b.
-  unfold of_int64.
-  apply of_int64_aux_sign.
+  unfold of_int64, to_int64.
+  destruct m as (t', H).
+  rewrite error.bind_eq_return.
+  split.
+  - intro; subst.
+    exists H.
+    split; [| reflexivity].
+    apply (@error.dif_case (fun b => error.M (Bool.Is_true (negb b)))).
+    + intro Hn; destruct (int64bv.sign t); contradiction.
+    + intro H'; f_equal; apply error.Is_true_UIP.
+  - intros (H', (Hd, HR)).
+    congruence.
 Qed.
 
 Definition of_Z (t : Z) : error.M mutez :=
@@ -103,23 +84,15 @@ Proof.
   split.
   - intro; subst z.
     rewrite int64bv.of_Z_to_Z.
-    destruct t.
     simpl.
-    apply of_int64_return.
+    apply of_int64_to_int64_eqv.
+    reflexivity.
   - intro H.
     apply (error.bind_eq_return of_int64) in H.
     destruct H as (b, (Hz, Hb)).
+    apply of_int64_to_int64_eqv in Hb.
     rewrite <- int64bv.of_Z_to_Z_eqv in Hz.
-    subst z.
-    f_equal.
-    destruct t as (b', e').
-    simpl.
-    assert (int64bv.sign b = false) as e.
-    + apply of_int64_sign in Hb.
-      assumption.
-    + rewrite (of_int64_return _ e) in Hb.
-      injection Hb.
-      auto.
+    congruence.
 Qed.
 
 Lemma of_Z_to_Z (t : mutez) : of_Z (to_Z t) = error.Return t.
diff --git a/src/michocoq/untyper.v b/src/michocoq/untyper.v
index 3c161a1a..7b85ba75 100644
--- a/src/michocoq/untyper.v
+++ b/src/michocoq/untyper.v
@@ -633,44 +633,6 @@ Inductive untype_mode := untype_Readable | untype_Optimized.
         destruct tff; reflexivity.
   Qed.
 
-
-  Definition sigT_eq_1 {A} (P : A -> Set) (xa yb : sigT P) : xa = yb -> projT1 xa = projT1 yb.
-  Proof.
-    apply f_equal.
-  Defined.
-
-  Definition sigT_eq_2 {A} (P : A -> Set) (xa yb : sigT P) (H : xa = yb) :
-    eq_rec (projT1 xa) P (projT2 xa) (projT1 yb) (sigT_eq_1 P xa yb H) = projT2 yb.
-  Proof.
-    subst xa.
-    reflexivity.
-  Defined.
-
-  Definition existT_eq_1 {A} (P : A -> Set) x y a b : existT P x a = existT P y b -> x = y.
-  Proof.
-    apply (f_equal (@projT1 A P)).
-  Defined.
-
-  Definition existT_eq_2 {A} (P : A -> Set) x y a b (H : existT P x a = existT P y b ) :
-    eq_rec x P a y (existT_eq_1 P x y a b H) = b.
-  Proof.
-    apply (sigT_eq_2 P (existT P x a) (existT P y b)).
-  Defined.
-
-  Definition existT_eq_3 {A} (P : A -> Set) x y a b :
-    existT P x a = existT P y b ->
-    sig (fun H : x = y => eq_rec x P a y H = b).
-  Proof.
-    intro H.
-    exists (existT_eq_1 P x y a b H).
-    apply existT_eq_2.
-  Defined.
-
-  Lemma unreturn {A} (a b : A) : error.Return a = error.Return b -> a = b.
-  Proof.
-    intro H; injection H; intro; assumption.
-  Qed.
-
   Lemma type_untype_cast_seq um self_type A B C D tff i i' :
     instruction_seq_cast (self_type := self_type) (tff := tff) A B C D i = Return i' ->
     untype_instruction_seq um i = untype_instruction_seq um i'.
-- 
GitLab


From 11de7d7d551791754e9835b3319ea6b3506d5f36 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Sun, 10 May 2020 16:48:32 +0200
Subject: [PATCH 29/56] Untyped macros in `instruction`

---
 src/michocoq/untyped_syntax.v | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/michocoq/untyped_syntax.v b/src/michocoq/untyped_syntax.v
index 914799eb..e2e2e588 100644
--- a/src/michocoq/untyped_syntax.v
+++ b/src/michocoq/untyped_syntax.v
@@ -123,7 +123,7 @@ Fixpoint instruction_app i1 i2 :=
   end.
 
 (* Some macros *)
-Definition UNPAIR : instruction_seq :=
-  SEQ DUP (SEQ CAR (SEQ (DIP 1 (SEQ CDR NOOP)) NOOP)).
-Definition UNPAPAIR : instruction_seq :=
-  instruction_app UNPAIR (SEQ (DIP 1 UNPAIR) NOOP).
+Definition UNPAIR : instruction :=
+  Instruction_seq (SEQ DUP (SEQ CAR (SEQ (DIP 1 (SEQ CDR NOOP)) NOOP))).
+Definition UNPAPAIR : instruction :=
+  Instruction_seq (SEQ UNPAIR (SEQ (DIP 1 (SEQ UNPAIR NOOP)) NOOP)).
-- 
GitLab


From 2e8d5a3ff1c4789b7c1207b30e5e4b953999addd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Mon, 16 Dec 2019 09:18:47 +0100
Subject: [PATCH 30/56] [optimizer] Define and certify a Michelson optimizer

The optimizer was initially designed for the backend of the Albert
compiler, it has been slightly generalized and certified. The main
theorem is the last one in file typed_optimizer.v:

If the untyped instruction sequence i can be typechecked from
stack type A to stack type B and then run successfully on stack
sA, then (optimizer.optimize i) can also be typechecked from
stack type A to stack type B and run successfully on stack sA
yielding the same result.
---
 src/michocoq/error.v           |   39 +
 src/michocoq/optimizer.v       |  108 ++
 src/michocoq/syntax.v          |   20 +
 src/michocoq/typed_optimizer.v | 1686 ++++++++++++++++++++++++++++++++
 4 files changed, 1853 insertions(+)
 create mode 100644 src/michocoq/optimizer.v
 create mode 100644 src/michocoq/typed_optimizer.v

diff --git a/src/michocoq/error.v b/src/michocoq/error.v
index ef99cdb4..eb065d42 100644
--- a/src/michocoq/error.v
+++ b/src/michocoq/error.v
@@ -97,6 +97,11 @@ Definition success {A} (m : M A) :=
   | Return _ => true
   end.
 
+Lemma bool_dec (b1 b2 : Datatypes.bool) : { b1 = b2 } + { b1 <> b2 }.
+Proof.
+  repeat decide equality.
+Qed.
+
 Definition Is_true := Bool.Is_true.
 
 Lemma Is_true_UIP b (x y : Is_true b) : x = y.
@@ -293,3 +298,37 @@ Proof.
   exists (existT_eq_1 P x y a b H).
   apply existT_eq_2.
 Defined.
+
+(* Same about sig *)
+
+Definition sig_eq_1 {A} (P : A -> Prop) (xa yb : sig P) : xa = yb -> proj1_sig xa = proj1_sig yb.
+Proof.
+  apply f_equal.
+Defined.
+
+Definition sig_eq_2 {A} (P : A -> Prop) (xa yb : sig P) (H : xa = yb) :
+  eq_rec (proj1_sig xa) P (proj2_sig xa) (proj1_sig yb) (sig_eq_1 P xa yb H) = proj2_sig yb.
+Proof.
+  subst xa.
+  reflexivity.
+Defined.
+
+Definition exist_eq_1 {A} (P : A -> Prop) x y a b : exist P x a = exist P y b -> x = y.
+Proof.
+  apply (f_equal (@proj1_sig A P)).
+Defined.
+
+Definition exist_eq_2 {A} (P : A -> Prop) x y a b (H : exist P x a = exist P y b ) :
+  eq_rec x P a y (exist_eq_1 P x y a b H) = b.
+Proof.
+  apply (sig_eq_2 P (exist P x a) (exist P y b)).
+Defined.
+
+Definition exist_eq_3 {A} (P : A -> Prop) x y a b :
+  exist P x a = exist P y b ->
+  sig (fun H : x = y => eq_rec x P a y H = b).
+Proof.
+  intro H.
+  exists (exist_eq_1 P x y a b H).
+  apply exist_eq_2.
+Defined.
diff --git a/src/michocoq/optimizer.v b/src/michocoq/optimizer.v
new file mode 100644
index 00000000..da294131
--- /dev/null
+++ b/src/michocoq/optimizer.v
@@ -0,0 +1,108 @@
+(* Open Source License *)
+(* Copyright (c) 2019 Nomadic Labs. <contact@nomadic-labs.com> *)
+
+(* Permission is hereby granted, free of charge, to any person obtaining a *)
+(* copy of this software and associated documentation files (the "Software"), *)
+(* to deal in the Software without restriction, including without limitation *)
+(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
+(* and/or sell copies of the Software, and to permit persons to whom the *)
+(* Software is furnished to do so, subject to the following conditions: *)
+
+(* The above copyright notice and this permission notice shall be included *)
+(* in all copies or substantial portions of the Software. *)
+
+(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR *)
+(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
+(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
+(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *)
+(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
+(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
+(* DEALINGS IN THE SOFTWARE. *)
+
+(** Michelson optimizer working on the untyped syntax *)
+
+Require Import Michocoq.untyped_syntax.
+Require Import ZArith.
+
+(* Optimizations *)
+
+Fixpoint visit_instruction
+         (F : instruction_seq -> instruction_seq)
+         (i : instruction) {struct i} : instruction :=
+  match i with
+  | DIP n i => DIP n (visit_instruction_seq F i)
+  | IF_ f i1 i2 =>
+    IF_ f (visit_instruction_seq F i1) (visit_instruction_seq F i2)
+  | LOOP_ f i =>
+    LOOP_ f (visit_instruction_seq F i)
+  | ITER i => ITER (visit_instruction_seq F i)
+  | MAP i => MAP (visit_instruction_seq F i)
+  | LAMBDA a b i => LAMBDA a b i
+  | CREATE_CONTRACT a b an i => CREATE_CONTRACT a b an i
+  | PUSH ty x => PUSH ty x
+  | FAILWITH => FAILWITH
+  | SELF an => SELF an
+  | EXEC => EXEC
+  | instruction_opcode op => op
+  | Instruction_seq i =>
+    Instruction_seq (visit_instruction_seq F i)
+  end
+with
+visit_instruction_seq f i {struct i} :=
+  match i with
+  | NOOP => f NOOP
+  | SEQ i1 i2 =>
+    let i1' := visit_instruction f i1 in
+    let i2' := visit_instruction_seq f i2 in
+    f (SEQ i1' i2')
+  end.
+
+Definition dig0dug0 :=
+  visit_instruction_seq
+    (fun i =>
+       match i with
+       | SEQ (DIG 0) i => i
+       | SEQ (DUG 0) i => i
+       | SEQ (DROP 0) i => i
+       | SEQ (DIP 0 i1) i2 => instruction_app i1 i2
+       | SEQ (DIG 1) i => SEQ SWAP i
+       | SEQ (DUG 1) i => SEQ SWAP i
+       | SEQ (Instruction_seq i1) i2 => instruction_app i1 i2
+       | i => i
+       end).
+
+Definition digndugn :=
+  visit_instruction_seq
+    (fun i =>
+       match i with
+       | SEQ (DIG n1) (SEQ (DUG n2) i') =>
+         if (n1 =? n2) then i' else i
+       | i => i
+       end).
+
+Definition swapswap :=
+  visit_instruction_seq
+    (fun i =>
+       match i with
+       | SEQ SWAP (SEQ SWAP i) => i
+       | i => i
+       end).
+
+Definition push_drop :=
+  visit_instruction_seq
+    (fun i =>
+       match i with
+       | SEQ (PUSH _ _) (SEQ (DROP 1) i) => i
+       | SEQ (PUSH _ _) (SEQ (DROP (S n)) i) => SEQ (DROP n) i
+       | i => i
+       end).
+
+(** Clean some stuff in the code *)
+Definition cleanup (ins : instruction_seq) : instruction_seq :=
+  push_drop
+    (swapswap
+       (digndugn
+          (dig0dug0 ins))).
+
+(** Optimize the code (currently only cleanup of useless instructions *)
+Definition optimize := cleanup.
diff --git a/src/michocoq/syntax.v b/src/michocoq/syntax.v
index 81ff9223..e415b229 100644
--- a/src/michocoq/syntax.v
+++ b/src/michocoq/syntax.v
@@ -599,6 +599,26 @@ with tail_fail_induction_seq self_type A B
        | _ => I
        end .
 
+Corollary tail_fail_induction_and_seq
+         (P : forall self_type A B, instruction self_type true A B -> Type)
+         (Q : forall self_type A B, instruction_seq self_type true A B -> Type)
+         (HFAILWITH : forall st a A B, P st (a ::: A) B FAILWITH)
+         (HIF : forall st A B C1 C2 t (f : if_family C1 C2 t) i1 i2,
+             Q st (C1 ++ A)%list B i1 ->
+             Q st (C2 ++ A)%list B i2 ->
+             P st (t ::: A) B (IF_ f i1 i2))
+         (HSEQ : forall st A B C i1 i2,
+             Q st B C i2 -> Q st A C (SEQ i1 i2))
+         (HTF : forall st A B i, P st A B i -> Q st A B (Tail_fail i))
+         (HIS : forall st A B i, Q st A B i -> P st A B (Instruction_seq i))
+  : (forall self_type A B i, P self_type A B i) *
+    (forall self_type A B i, Q self_type A B i).
+Proof.
+  split.
+  - intros; eapply tail_fail_induction; eassumption.
+  - intros; eapply tail_fail_induction_seq; eassumption.
+Defined.
+
 Definition tail_fail_change_range {self_type} A B B' (i : instruction self_type true A B) :
   instruction self_type true A B'.
 Proof.
diff --git a/src/michocoq/typed_optimizer.v b/src/michocoq/typed_optimizer.v
new file mode 100644
index 00000000..e16b173f
--- /dev/null
+++ b/src/michocoq/typed_optimizer.v
@@ -0,0 +1,1686 @@
+(* Open Source License *)
+(* Copyright (c) 2019 Nomadic Labs. <contact@nomadic-labs.com> *)
+
+(* Permission is hereby granted, free of charge, to any person obtaining a *)
+(* copy of this software and associated documentation files (the "Software"), *)
+(* to deal in the Software without restriction, including without limitation *)
+(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
+(* and/or sell copies of the Software, and to permit persons to whom the *)
+(* Software is furnished to do so, subject to the following conditions: *)
+
+(* The above copyright notice and this permission notice shall be included *)
+(* in all copies or substantial portions of the Software. *)
+
+(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR *)
+(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
+(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
+(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *)
+(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
+(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
+(* DEALINGS IN THE SOFTWARE. *)
+
+(* Same as the untyped optimizer but at the level of Michocoq.syntax *)
+
+From Michocoq Require untyped_syntax typer untyper.
+From Michocoq Require Import syntax.
+Import error.Notations.
+Import Notations.
+Require optimizer.
+Require Import ZArith.
+Require JMeq.
+Require Import String.
+
+Definition hide_tf {st A B} (i : instruction st true A B) :
+           sigT (fun tff => instruction st tff A B) :=
+  existT _ true i.
+
+Definition hide_ntf {st A B} (i : instruction st false A B) :
+           sigT (fun tff => instruction st tff A B) :=
+  existT _ false i.
+
+
+
+(* Manipulations of options *)
+
+Definition option_bind {A B}
+           (o : Datatypes.option A) (f : A -> Datatypes.option B) :
+  Datatypes.option B :=
+  match o with
+  | None => None
+  | Some a => f a
+  end.
+
+Notation "'let?' x ':=' X 'in' Y" :=
+  (option_bind X (fun x => Y))
+    (at level 200, x pattern, X at level 100, Y at level 200).
+
+Definition opt_get {A} (o : Datatypes.option A) (default : A) : A :=
+  match o with Some x => x | None => default end.
+
+Lemma unsome {A} (x y : A) : Some x = Some y -> x = y.
+Proof.
+  congruence.
+Qed.
+
+Lemma bind_some {A B} (y : Datatypes.option A) (w : B) z : (let? x := y in z x) = Some w <-> (exists x, y = Some x /\ z x = Some w).
+Proof.
+  destruct y; simpl; split.
+  - intro H; exists a; split; congruence.
+  - intros (x, (Hx, Hz)); congruence.
+  - discriminate.
+  - intros (x, (Hx, Hz)); discriminate.
+Qed.
+
+Fixpoint visit_instruction
+         (F : forall st tff A B,
+             instruction_seq st tff A B -> instruction_seq st tff A B)
+         {st tff A B}
+         (i : instruction st tff A B) {struct i} : instruction st tff A B :=
+  match i with
+  | Instruction_seq i => Instruction_seq (visit_instruction_seq F i)
+  | DIP n H i => DIP n H (visit_instruction_seq F i)
+  | IF_ f i1 i2 =>
+    IF_ f (visit_instruction_seq F i1) (visit_instruction_seq F i2)
+  | LOOP_ f i =>
+    LOOP_ f (visit_instruction_seq F i)
+  | ITER i => ITER (visit_instruction_seq F i)
+  | MAP i => MAP (visit_instruction_seq F i)
+
+  (* Note that LAMBDA a b i => LAMBDA a b (visit_instruction_seq F i)
+     would be incorrect because we can use PACK to distinguish
+     semantically equivalent lambdas in Michelson *)
+  | LAMBDA a b i => LAMBDA a b i
+  | CREATE_CONTRACT a b an i => CREATE_CONTRACT a b an i
+  | PUSH ty x => PUSH ty x
+  | FAILWITH => FAILWITH
+  | SELF an H => SELF an H
+  | EXEC => EXEC
+  | Instruction_opcode op => Instruction_opcode op
+  end
+with
+visit_instruction_seq f {st tff A B} (i : instruction_seq st tff A B) {struct i}
+: instruction_seq st tff A B :=
+  match i with
+  | NOOP => f _ _ _ _ NOOP
+  | Tail_fail i =>
+    let i' := visit_instruction f i in
+    f _ _ _ _ (Tail_fail i')
+  | SEQ i1 i2 =>
+    let i1' := visit_instruction f i1 in
+    let i2' := visit_instruction_seq f i2 in
+    f _ _ _ _ (SEQ i1' i2')
+  end.
+
+Definition untype_fun_seq
+           (F1 : forall st tff A B, instruction_seq st tff A B ->
+                                    instruction_seq st tff A B)
+           (F2 : untyped_syntax.instruction_seq -> untyped_syntax.instruction_seq) :=
+  forall st tff A B i,
+    untyper.untype_instruction_seq untyper.untype_Optimized (F1 st tff A B i) = F2 (untyper.untype_instruction_seq untyper.untype_Optimized i).
+
+Fixpoint untype_visit_instruction F1 F2
+         (H : untype_fun_seq F1 F2)
+         (HNOOP : F2 untyped_syntax.NOOP = untyped_syntax.NOOP)
+         st tff A B
+         (i : instruction st tff A B) :
+  untyper.untype_instruction untyper.untype_Optimized (visit_instruction F1 i) =
+  optimizer.visit_instruction F2 (untyper.untype_instruction untyper.untype_Optimized i)
+with
+untype_visit_instruction_seq F1 F2
+                             (H : untype_fun_seq F1 F2)
+                             (HNOOP : F2 untyped_syntax.NOOP = untyped_syntax.NOOP)
+                             st tff A B
+                             (i : instruction_seq st tff A B) :
+  untyper.untype_instruction_seq untyper.untype_Optimized (visit_instruction_seq F1 i) =
+  optimizer.visit_instruction_seq F2 (untyper.untype_instruction_seq  untyper.untype_Optimized i).
+Proof.
+  - destruct i; simpl; try reflexivity; try (repeat f_equal; apply untype_visit_instruction_seq; assumption).
+  - destruct i.
+    + apply H.
+    + simpl.
+      rewrite H.
+      simpl.
+      repeat f_equal.
+      * apply (untype_visit_instruction F1 F2); assumption.
+      * symmetry; assumption.
+    + simpl.
+      rewrite H.
+      simpl.
+      repeat f_equal.
+      * apply (untype_visit_instruction F1 F2); assumption.
+      * apply (untype_visit_instruction_seq F1 F2); assumption.
+Qed.
+
+Lemma stype_refl (A : Datatypes.list type) (H : A = A) : H = eq_refl.
+Proof.
+  apply Eqdep_dec.UIP_dec.
+  apply stype_dec.
+Qed.
+
+Lemma st_dec (st1 st2 : self_info) : sumbool (st1 = st2) (st1 <> st2).
+Proof.
+  repeat decide equality.
+Qed.
+
+Lemma st_refl (st : self_info) (H : st = st) : H = eq_refl.
+Proof.
+  apply Eqdep_dec.UIP_dec.
+  apply st_dec.
+Qed.
+
+Definition cast_instruction_seq_opt {st tff A B st' tff' A' B'}
+           (i : instruction_seq st tff A B)
+  : Datatypes.option (instruction_seq st' tff' A' B').
+Proof.
+  case (st_dec st st'); [| intros; exact None].
+  case (error.bool_dec tff tff'); [| intros; exact None].
+  case (stype_dec A A'); [| intros; exact None].
+  case (stype_dec B B'); [| intros; exact None].
+  intros; subst; exact (Some i).
+Defined.
+
+Lemma cast_instruction_seq_same {st tff A B} (i : instruction_seq st tff A B) :
+  cast_instruction_seq_opt i = Some i.
+Proof.
+  unfold cast_instruction_seq_opt.
+  destruct (st_dec st st) as [Hst | n]; [|destruct (n eq_refl)].
+  destruct (error.bool_dec tff tff) as [Htff | n]; [|destruct (n eq_refl)].
+  destruct (stype_dec A A) as [HA | n]; [|destruct (n eq_refl)].
+  destruct (stype_dec B B) as [HB | n]; [|destruct (n eq_refl)].
+  assert (HA = eq_refl) by apply stype_refl; subst.
+  assert (HB = eq_refl) by apply stype_refl; subst.
+  assert (Htff = eq_refl) by (apply Eqdep_dec.UIP_dec; apply error.bool_dec); subst.
+  assert (Hst = eq_refl) by apply st_refl; subst.
+  reflexivity.
+Qed.
+
+Definition dig0dug0_opt {st tff A C} (i : instruction_seq st tff A C) :
+  Datatypes.option (instruction_seq st tff A C)
+  :=
+  match i with
+  | Tail_fail i =>
+    let 'existT _ _ i := hide_tf i in
+    match i with
+    | Instruction_seq i => cast_instruction_seq_opt i
+    | _ => None
+    end
+  | @SEQ st' A' B _ _ i1 i2 =>
+    let 'existT _ _ i1 := hide_ntf i1 in
+    let? i1' :=
+       match i1 return Datatypes.option (instruction_seq st' false A' B) with
+       | DIP 0 _ i => cast_instruction_seq_opt i
+       | Instruction_seq i => cast_instruction_seq_opt i
+       | Instruction_opcode op =>
+         match op with
+         | @DIG _ 0 nil S2 a _ =>
+           cast_instruction_seq_opt (@NOOP st' (a ::: S2))
+         | @DUG _ 0 nil S2 a _ =>
+           cast_instruction_seq_opt (@NOOP st' (a ::: S2))
+         | @DIG _ 1 (cons a nil) S2 b _ =>
+           cast_instruction_seq_opt (SEQ (@SWAP st' a b S2) NOOP)
+         | @DUG _ 1 (cons a nil) S2 b _ =>
+           cast_instruction_seq_opt (SEQ (@SWAP st' b a S2) NOOP)
+         | @DROP _ 0 nil B' _ =>
+           cast_instruction_seq_opt (@NOOP st' B')
+         | _ => None
+         end
+       | _ => None
+       end in
+    cast_instruction_seq_opt (instruction_app i1' i2)
+  | _ => None
+  end.
+
+
+Inductive dig0dug0_opt_rel {st} :
+  forall {tff A B} (i i' : instruction_seq st tff A B), Prop :=
+| D0D0_tf A B (i : instruction_seq st true A B) :
+    dig0dug0_opt_rel (Tail_fail (Instruction_seq i)) i
+| D0D0_seq_is {tff A B C}
+              (i1 : instruction_seq st false A B)
+              (i2 : instruction_seq st tff B C) :
+    dig0dug0_opt_rel (SEQ (Instruction_seq i1) i2) (instruction_app i1 i2)
+| D0D0_DIP0 {tff A B C}
+            (i1 : instruction_seq st false A B)
+            (i2 : instruction_seq st tff B C) :
+    dig0dug0_opt_rel (SEQ (DIP (A := nil) 0 eq_refl i1) i2) (instruction_app i1 i2)
+| D0D0_DROP0 {tff A B}
+             (i : instruction_seq st tff A B) :
+    dig0dug0_opt_rel (SEQ (DROP (A := nil) 0 eq_refl) i) i
+| D0D0_DIG0 {tff t A B}
+            (i : instruction_seq st tff (t ::: A) B) :
+    dig0dug0_opt_rel (SEQ (DIG 0 (S1 := nil) eq_refl) i) i
+| D0D0_DUG0 {tff t A B}
+            (i : instruction_seq st tff (t ::: A) B) :
+    dig0dug0_opt_rel (SEQ (DUG 0 (S1 := nil) eq_refl) i) i
+| D0D0_DIG1 {tff a b A B}
+            (i : instruction_seq st tff (b ::: a ::: A) B) :
+    dig0dug0_opt_rel (SEQ (DIG 1 (S1 := _ ::: nil) eq_refl) i) (SEQ SWAP i)
+| D0D0_DUG1 {tff a b A B}
+            (i : instruction_seq st tff (b ::: a ::: A) B) :
+    dig0dug0_opt_rel (SEQ (DUG 1 (S1 := _ ::: nil) eq_refl) i) (SEQ SWAP i).
+
+Lemma uncons {A} (a1 a2 : A) l1 l2 :
+  cons a1 l1 = cons a2 l2 -> a1 = a2 /\ l1 = l2.
+Proof.
+  intro H; injection H; auto.
+Qed.
+
+Ltac destructable_list l :=
+  is_var l +
+  match l with
+  | nil => idtac
+  | cons _ _ => idtac
+  end.
+
+Ltac mytac :=
+  match goal with
+  | H : ?A |- _ =>
+    match A with
+    | existT _ _ _ = existT _ _ _ =>
+      apply error.existT_eq_3 in H
+    | exist _ _ _ = exist _ _ _ =>
+      apply error.exist_eq_3 in H
+    | hide_tf _ = existT _ _ _ =>
+      apply error.existT_eq_3 in H
+    | hide_ntf _ = existT _ _ _ =>
+      apply error.existT_eq_3 in H
+    | sig _ =>
+      destruct H
+    | sigT _ =>
+      destruct H
+    | exists _, _ =>
+      destruct H
+    | _ /\ _ =>
+      destruct H
+    | Datatypes.unit =>
+      destruct H
+    | eq_rec _ _ _ _ eq_refl = _ =>
+      simpl in H
+    | ?x = ?y =>
+      is_var x; subst x
+    | ?x = ?y =>
+      is_var y; subst y
+    | ?x = ?y =>
+      assert (H = eq_refl)
+        by (match type of x with
+            | Datatypes.bool => apply Eqdep_dec.UIP_refl_bool
+            | Datatypes.list type => apply Eqdep_dec.UIP_dec;
+                                     apply stype_dec
+            | type => apply Eqdep_dec.UIP_dec;
+                      apply type_dec
+            | Datatypes.nat => apply Eqdep_dec.UIP_dec;
+                               decide equality
+            end);
+      subst H
+    | cons ?a1 ?l1 = cons ?a2 ?l2 =>
+      (destructable_list l1 + destructable_list l2);
+      assert (a1 = a2 /\ l1 = l2) by (apply uncons; exact H)
+    | Some _ = Some _ =>
+      apply unsome in H
+    | Some _ = None => discriminate
+    | cast_instruction_seq_opt _ = _ =>
+      rewrite cast_instruction_seq_same in H
+    | option_bind (Some _) _ = _ =>
+      simpl in H
+    | option_bind None _ = _ =>
+      simpl in H
+    | option_bind _ _ = Some _ =>
+      apply bind_some in H
+    | option_bind (cast_instruction_seq_opt _) _ = _ =>
+      rewrite cast_instruction_seq_same in H
+    end
+  end.
+
+Lemma dig0dug0_opt_dig0dug0 {st tff A C} (i i' : instruction_seq st tff A C) :
+  dig0dug0_opt i = Some i' <-> dig0dug0_opt_rel i i'.
+Proof.
+  split.
+  - destruct i; try discriminate; unfold dig0dug0_opt.
+    + case_eq (hide_tf i).
+      intros tff i0 He Hi0.
+      destruct i0; try discriminate.
+      repeat mytac.
+      constructor.
+    + case_eq (hide_ntf i).
+      intros tff1 i1 He Hi1.
+      destruct i1; try discriminate.
+      * repeat mytac.
+        constructor.
+      * destruct n; try discriminate.
+        destruct A; try discriminate.
+        repeat mytac.
+        constructor.
+      * destruct o; try discriminate; destruct n as [|[|n]]; try discriminate.
+        -- destruct S1; try discriminate.
+           repeat mytac.
+           constructor.
+        -- destruct S1 as [|b [|]]; try discriminate.
+           repeat mytac.
+           constructor.
+        -- destruct S1; try discriminate.
+           repeat mytac.
+           constructor.
+        -- destruct S1 as [|b [|]]; try discriminate.
+           repeat mytac.
+           constructor.
+        -- destruct A; try discriminate.
+           repeat mytac.
+           constructor.
+  - intro Hi; destruct Hi; unfold dig0dug0_opt, hide_tf, hide_ntf;
+      repeat (rewrite cast_instruction_seq_same; simpl); reflexivity.
+Qed.
+
+Definition dig0dug0_aux {st tff A B} (i : instruction_seq st tff A B) : instruction_seq st tff A B :=
+  opt_get (dig0dug0_opt i) i.
+
+Definition dig0dug0 {st tff A B} (i : instruction_seq st tff A B) : instruction_seq st tff A B :=
+  visit_instruction_seq (@dig0dug0_aux) i.
+
+Lemma untyped_instruction_app_NOOP :
+  forall i, untyped_syntax.instruction_app i untyped_syntax.NOOP = i.
+Proof.
+  induction i.
+  - reflexivity.
+  - simpl; f_equal; assumption.
+Qed.
+
+Lemma untype_instruction_seq_app_aux {st tff1 tff2 A B C}
+         (i1 : instruction_seq st tff1 A B)
+         (i2 : instruction_seq st tff2 B C) H :
+  untyper.untype_instruction_seq untyper.untype_Optimized (instruction_app_aux i1 H  i2) =
+  untyped_syntax.instruction_app
+    (untyper.untype_instruction_seq untyper.untype_Optimized i1)
+    (untyper.untype_instruction_seq untyper.untype_Optimized i2).
+Proof.
+  induction i1; simpl.
+  - reflexivity.
+  - discriminate.
+  - f_equal.
+    apply IHi1.
+Qed.
+
+Lemma untype_instruction_seq_app {st tff A B C}
+         (i1 : instruction_seq st false A B)
+         (i2 : instruction_seq st tff B C) :
+  untyper.untype_instruction_seq untyper.untype_Optimized (i1;;; i2) =
+  untyped_syntax.instruction_app
+    (untyper.untype_instruction_seq untyper.untype_Optimized i1)
+    (untyper.untype_instruction_seq untyper.untype_Optimized i2).
+Proof.
+  apply untype_instruction_seq_app_aux.
+Qed.
+
+Lemma untype_dig0dug0 : untype_fun_seq (@dig0dug0) (optimizer.dig0dug0).
+Proof.
+  unfold untype_fun_seq, dig0dug0, optimizer.dig0dug0.
+  apply untype_visit_instruction_seq; [| reflexivity].
+  intros st tff A B i; simpl.
+  unfold dig0dug0_aux.
+  case_eq (dig0dug0_opt i).
+  - intros i' Hi.
+    apply dig0dug0_opt_dig0dug0 in Hi.
+    destruct Hi; simpl; try reflexivity;
+      try (symmetry; apply untyped_instruction_app_NOOP);
+      try apply untype_instruction_seq_app.
+  - intro HN.
+    simpl.
+    destruct i; try reflexivity.
+    + unfold dig0dug0_opt in HN.
+      case_eq (hide_tf i).
+      intros tff i' He.
+      rewrite He in HN.
+      destruct i'; try discriminate; repeat mytac; try reflexivity.
+      destruct tffa; try discriminate.
+      repeat mytac; simpl in *; repeat mytac; reflexivity.
+    + unfold dig0dug0_opt in HN.
+      case_eq (hide_ntf i).
+      intros tff1 i' He.
+      rewrite He in HN.
+      apply error.existT_eq_3 in He.
+      destruct He as (Htff', Hi).
+      destruct i'; try discriminate;
+        try (assert (Htff' = eq_refl) by apply Eqdep_dec.UIP_refl_bool;
+             subst Htff'; simpl in Hi; subst; reflexivity).
+      * repeat mytac.
+      * repeat mytac.
+        destruct tffa; simpl in *; repeat mytac; reflexivity.
+      * destruct n; destruct A as [|a A]; try discriminate; repeat mytac;
+          reflexivity.
+      * repeat mytac.
+        destruct o; try reflexivity.
+        -- destruct n as [|[|n]]; destruct S1 as [|a [|b S1]];
+             try discriminate; repeat mytac; reflexivity.
+        -- destruct n as [|[|n]]; destruct S1 as [|a [|b S1]];
+             try discriminate; repeat mytac; reflexivity.
+        -- destruct n as [|n]; destruct A as [|a A];
+             try discriminate; repeat mytac; reflexivity.
+Qed.
+
+(* Destructors for types instruction_seq, instruction, and opcode *)
+
+Definition unseq {st tff A C} (i : instruction_seq st tff A C):
+  Datatypes.option (sigT (fun B1 =>
+                            (sigT (fun B2 =>
+                                     instruction st false A B1 *
+                                     instruction_seq st tff B2 C))))%type :=
+  match i with
+  | NOOP => None
+  | Tail_fail _ => None
+  | SEQ i1 i2 =>
+    Some (existT _ _ (existT _ _ (i1, i2)))
+  end.
+
+Definition unseq_fst {st tff A C} (i : instruction_seq st tff A C):
+  Datatypes.option (sigT (fun A =>
+                            (sigT (fun B =>
+                                     instruction st false A B))))%type :=
+  match i with
+  | SEQ i1 i2 =>
+    Some (existT _ _ (existT _ _ i1))
+  | _ => None
+  end.
+
+Definition unseq_snd {st tff A C} (i : instruction_seq st tff A C):
+  Datatypes.option (sigT (fun B =>
+                            (sigT (fun C =>
+                                     instruction_seq st tff B C))))%type :=
+  match i with
+  | SEQ i1 i2 =>
+    Some (existT _ _ (existT _ _ i2))
+  | _ => None
+  end.
+
+Lemma unseq_seq {st tff A B C} (i : instruction_seq st tff A C) i1 i2 :
+  unseq i = Some (existT _ B (existT _ B (i1, i2))) <-> i = SEQ i1 i2.
+Proof.
+  split.
+  - destruct i; simpl; intro; try discriminate.
+    apply unsome in H.
+    apply error.existT_eq_3 in H.
+    destruct H as (He, H).
+    subst B0.
+    simpl in H.
+    apply error.existT_eq_3 in H.
+    destruct H as (He, H).
+    assert (He = eq_refl) by (apply Eqdep_dec.UIP_dec; apply stype_dec).
+    subst He.
+    simpl in H.
+    congruence.
+  - intro; subst i.
+    simpl.
+    reflexivity.
+Qed.
+
+Definition unopcode {st tff A B} (i : instruction st tff A B) :
+  Datatypes.option (@opcode st A B) :=
+  match i with
+  | Instruction_opcode op => Some op
+  | _ => None
+  end.
+
+Lemma unopcode_opcode {st tff A B} (i : instruction st tff A B) o (H : false = tff) :
+  unopcode i = Some o <->
+  i = eq_rec false (fun tff => instruction st tff A B) o tff H.
+Proof.
+  split.
+  - destruct i; simpl; intro; try discriminate.
+    apply unsome in H0.
+    subst o0.
+    assert (H = eq_refl) by apply Eqdep_dec.UIP_refl_bool.
+    subst H.
+    reflexivity.
+  - subst tff.
+    simpl.
+    intro; subst i.
+    reflexivity.
+Qed.
+
+Definition unswap_opcode {st A B} (op : @opcode st A B) : Datatypes.option Datatypes.unit :=
+  match op with
+  | SWAP => Some tt
+  | _ => None
+  end.
+
+Definition unswap {st tff A B} (i : instruction st tff A B) : Datatypes.option Datatypes.unit :=
+  let? op := unopcode i in unswap_opcode op.
+
+(* SWAP-SWAP *)
+
+Definition swapswap_opt {st tff A D} (i : instruction_seq st tff A D) :
+  Datatypes.option (instruction_seq st tff A D) :=
+  let? existT _ _ (existT _ _ i1) := unseq_fst i in
+  let? existT _ _ (existT _ _ i23) := unseq_snd i in
+  let '(existT _ _ i1) := hide_ntf i1 in
+  let? existT _ _ (existT _ _ i2) := unseq_fst i23 in
+  let '(existT _ _ i2) := hide_ntf i2 in
+  let? existT _ _ (existT _ _ i3) := unseq_snd i23 in
+  let? tt := unswap i1 in
+  let? tt := unswap i2 in
+  cast_instruction_seq_opt i3.
+
+Inductive swapswap_rel {st tff} :
+  forall {A B} (i i' : instruction_seq st tff A B), Prop :=
+| Swapswap_intro {a b A B} (i : instruction_seq st tff (a ::: b ::: A) B) :
+    swapswap_rel (SEQ SWAP (SEQ SWAP i)) i.
+
+Lemma swapswap_opt_swapswap {st tff A D} (i i' : instruction_seq st tff A D) :
+  swapswap_opt i = Some i' <-> swapswap_rel i i'.
+Proof.
+  split.
+  - unfold swapswap_opt.
+    intro H.
+    apply bind_some in H; destruct H as ((A1, (B1, i1)), (He1, H)).
+    apply bind_some in H; destruct H as ((A23, (B23, i23)), (He23, H)).
+    case_eq (hide_ntf i1); intros tff1 i1' Hi1'; rewrite Hi1' in H.
+    apply bind_some in H; destruct H as ((A2, (B2, i2)), (He2, H)).
+    case_eq (hide_ntf i2); intros tff2 i2' Hi2'; rewrite Hi2' in H.
+    apply bind_some in H; destruct H as ((A3, (B3, i3)), (He3, H)).
+
+    destruct i1'; try discriminate.
+    destruct o; try discriminate.
+    simpl in H.
+
+    destruct i2'; try discriminate.
+    destruct o; try discriminate.
+    simpl in H.
+
+    destruct i; try discriminate.
+    destruct i23; try discriminate.
+    simpl in *.
+    repeat mytac.
+    constructor.
+  - intro H.
+    destruct H.
+    simpl.
+    unfold swapswap_opt; simpl.
+    apply cast_instruction_seq_same.
+Qed.
+
+Definition swapswap_aux {st tff A D} (i : instruction_seq st tff A D) :
+  instruction_seq st tff A D :=
+  opt_get (swapswap_opt i) i.
+
+Definition swapswap {st tff A B} (i : instruction_seq st tff A B) : instruction_seq st tff A B :=
+  visit_instruction_seq (@swapswap_aux) i.
+
+Lemma untype_inversion_seq {st tff A C um} {i : instruction_seq st tff A C} {ui1 ui2} :
+  untyper.untype_instruction_seq um i = untyped_syntax.SEQ ui1 ui2 ->
+  (exists (H : tff = true) i',
+      eq_rec _ (fun tff => instruction_seq st tff A C) i _ H = Tail_fail i')
+  \/
+  (exists B (i1 : instruction st false A B) i2, i = SEQ i1 i2).
+Proof.
+  destruct i.
+  - discriminate.
+  - intro H; left.
+    exists eq_refl.
+    exists i.
+    reflexivity.
+  - intro H; right.
+    repeat eexists.
+Qed.
+
+Lemma untype_inversion_swap {st tff A B um} (i : instruction st tff A B) :
+  untyper.untype_instruction um i =
+  untyped_syntax.instruction_opcode untyped_syntax.SWAP ->
+  exists a b SA
+         (H : tff = false)
+         (HA : A = a ::: b ::: SA)
+         (HB : B = b ::: a ::: SA),
+    eq_rec
+      _
+      (fun A => instruction st false A (b ::: a ::: SA))
+      (eq_rec
+         _
+         (fun B => instruction st false A B)
+         (eq_rec _ (fun tff => instruction st tff A B) i _ H) _ HB) _ HA
+    = Instruction_opcode SWAP.
+Proof.
+  destruct i; try discriminate.
+  destruct o; try discriminate.
+  simpl.
+  intros _.
+  do 3 eexists.
+  do 3 (exists eq_refl).
+  reflexivity.
+Qed.
+
+Lemma untype_inversion_dig {st tff A B um} (i : instruction st tff A B) n :
+  untyper.untype_instruction um i =
+  untyped_syntax.instruction_opcode (untyped_syntax.DIG n) ->
+  exists S1 S2 t
+         (H : tff = false)
+         (HA : A = S1 +++ t ::: S2)
+         (HB : B = t ::: S1 +++ S2)
+         (Hn : n = List.length S1),
+    eq_rec
+      _
+      (fun A => instruction st false A (t ::: S1 +++ S2))
+      (eq_rec
+         _
+         (fun B => instruction st false A B)
+         (eq_rec _ (fun tff => instruction st tff A B) i _ H) _ HB) _ HA
+    = Instruction_opcode (@DIG _ (List.length S1) S1 S2 t eq_refl).
+Proof.
+  destruct i; try discriminate.
+  destruct o; try discriminate.
+  simpl.
+  intro H.
+  injection H.
+  intro; subst; clear H.
+  do 3 eexists.
+  do 4 (exists eq_refl).
+  reflexivity.
+Qed.
+
+Lemma untype_inversion_dug {st tff A B um} (i : instruction st tff A B) n :
+  untyper.untype_instruction um i =
+  untyped_syntax.instruction_opcode (untyped_syntax.DUG n) ->
+  exists S1 S2 t
+         (H : tff = false)
+         (HA : A = t ::: S1 +++ S2)
+         (HB : B = S1 +++ t ::: S2)
+         (Hn : n = List.length S1),
+    eq_rec
+      _
+      (fun A => instruction st false A (S1 +++ t ::: S2))
+      (eq_rec
+         _
+         (fun B => instruction st false A B)
+         (eq_rec _ (fun tff => instruction st tff A B) i _ H) _ HB) _ HA
+    = Instruction_opcode (@DUG _ (List.length S1) S1 S2 t eq_refl).
+Proof.
+  destruct i; try discriminate.
+  destruct o; try discriminate.
+  simpl.
+  intro H.
+  injection H.
+  intro; subst; clear H.
+  do 3 eexists.
+  do 4 (exists eq_refl).
+  reflexivity.
+Qed.
+
+Lemma untype_swapswap : untype_fun_seq (@swapswap) (optimizer.swapswap).
+Proof.
+  unfold untype_fun_seq, swapswap, optimizer.swapswap.
+  apply untype_visit_instruction_seq; [| reflexivity].
+  intros st tff A D i; simpl.
+  unfold swapswap_aux.
+  unfold opt_get.
+  case_eq (swapswap_opt i).
+  - intros i' H.
+    rewrite swapswap_opt_swapswap in H.
+    destruct H.
+    reflexivity.
+  - intro H.
+    unfold swapswap_opt in H.
+    case_eq (untyper.untype_instruction_seq untyper.untype_Optimized i);
+      try reflexivity.
+    intros ui1 ui23 Hi.
+    destruct ui1; try reflexivity.
+    destruct o; try reflexivity.
+    destruct ui23; try reflexivity.
+    destruct i0; try reflexivity.
+    destruct o; try reflexivity.
+    exfalso.
+    generalize (untype_inversion_seq Hi).
+    intro Hiinv.
+    destruct Hiinv as [(Htff, (i', Hi')) | (B, (i1, (i23, Hi123)))].
+    * repeat mytac.
+      discriminate.
+    * subst i.
+      simpl in Hi.
+      injection Hi.
+      intros Hi23 Hi1.
+      generalize (untype_inversion_seq Hi23).
+      intros Hiinv.
+      destruct Hiinv as [(Htff, (i', Hi')) | (C, (i2, (i3, Hi23')))].
+      -- repeat mytac.
+         injection Hi23.
+         intros Hui23 Hi'.
+         apply untype_inversion_swap in Hi'.
+         repeat mytac.
+         discriminate.
+      -- repeat mytac.
+         injection Hi23.
+         intros Hi3 Hi2.
+         apply untype_inversion_swap in Hi1.
+         apply untype_inversion_swap in Hi2.
+         repeat mytac.
+         simpl in H.
+         repeat mytac.
+Qed.
+
+(* DIG n - DUG n *)
+
+
+Definition undig_opcode {st A B} (op : @opcode st A B) : Datatypes.option Datatypes.nat :=
+  match op with
+  | DIG n _ => Some n
+  | _ => None
+  end.
+
+Definition undug_opcode {st A B} (op : @opcode st A B) : Datatypes.option Datatypes.nat :=
+  match op with
+  | DUG n _ => Some n
+  | _ => None
+  end.
+
+Definition undig {st tff A B} (i : instruction st tff A B) : Datatypes.option Datatypes.nat :=
+  let? o := unopcode i in undig_opcode o.
+
+Definition undug {st tff A B} (i : instruction st tff A B) : Datatypes.option Datatypes.nat :=
+  let? o := unopcode i in undug_opcode o.
+
+Lemma untype_inversion_undig {st tff A B um} (i : instruction st tff A B) n :
+  untyper.untype_instruction um i =
+  untyped_syntax.instruction_opcode (untyped_syntax.DIG n) ->
+  undig i = Some n.
+Proof.
+  intro H.
+  apply untype_inversion_dig in H.
+  repeat mytac.
+  reflexivity.
+Qed.
+
+Lemma untype_inversion_undug {st tff A B um} (i : instruction st tff A B) n :
+  untyper.untype_instruction um i =
+  untyped_syntax.instruction_opcode (untyped_syntax.DUG n) ->
+  undug i = Some n.
+Proof.
+  intro H.
+  apply untype_inversion_dug in H.
+  repeat mytac.
+  reflexivity.
+Qed.
+
+Definition digndugn_opt {st tff A D} (i : instruction_seq st tff A D) :
+  Datatypes.option (instruction_seq st tff A D) :=
+  let? existT _ _ (existT _ _ i1) := unseq_fst i in
+  let? existT _ _ (existT _ _ i23) := unseq_snd i in
+  let '(existT _ _ i1) := hide_ntf i1 in
+  let? existT _ _ (existT _ _ i2) := unseq_fst i23 in
+  let '(existT _ _ i2) := hide_ntf i2 in
+  let? existT _ _ (existT _ _ i3) := unseq_snd i23 in
+  let? n1 := undig i1 in
+  let? n2 := undug i2 in
+  if (n1 =? n2) then cast_instruction_seq_opt i3 else None.
+
+Inductive digndugn_rel {st tff} :
+  forall {A B} (i i' : instruction_seq st tff A B), Prop :=
+| DignDugn_intro {S1 S2 t B} (i : instruction_seq st tff (S1 +++ t ::: S2) B) :
+    digndugn_rel
+      (SEQ (@DIG st (List.length S1) S1 S2 t eq_refl)
+            (SEQ (@DUG st (List.length S1) S1 S2 t eq_refl) i)) i.
+
+Lemma digndugn_opt_digndugn {st tff A D} (i i' : instruction_seq st tff A D) :
+  digndugn_opt i = Some i' <->
+  digndugn_rel i i'.
+Proof.
+  split.
+  - unfold digndugn_opt.
+    intro H.
+    apply bind_some in H; destruct H as ((A1, (B1, i1)), (He1, H)).
+    apply bind_some in H; destruct H as ((A23, (B23, i23)), (He23, H)).
+    case_eq (hide_ntf i1); intros tff1 i1' Hi1'; rewrite Hi1' in H.
+    apply bind_some in H; destruct H as ((A2, (B2, i2)), (He2, H)).
+    case_eq (hide_ntf i2); intros tff2 i2' Hi2'; rewrite Hi2' in H.
+    apply bind_some in H; destruct H as ((A3, (B3, i3)), (He3, H)).
+
+    destruct i1'; try discriminate.
+    destruct o; try discriminate.
+    simpl in H.
+
+    destruct i2'; try discriminate.
+    destruct o; try discriminate.
+    simpl in H.
+
+    case_eq (n =? n0); intro Hn; rewrite Hn in H; [|discriminate].
+
+    destruct i; try discriminate.
+    destruct i23; try discriminate.
+    simpl in *.
+
+    repeat mytac.
+    match goal with | H : _ ::: _ +++ _ = _ ::: _ +++ _ |- _ => injection H end.
+    intros Happ Ht.
+    apply beq_nat_true in Hn.
+    symmetry in Hn.
+    apply untyper.app_length_inv in Happ; [|assumption].
+    repeat mytac.
+    constructor.
+  - intro H.
+    destruct H.
+    simpl.
+    unfold digndugn_opt; simpl.
+    rewrite Nat.eqb_refl.
+    apply cast_instruction_seq_same.
+Qed.
+
+Definition digndugn_aux {st tff A D} (i : instruction_seq st tff A D) :
+  instruction_seq st tff A D :=
+  opt_get (digndugn_opt i) i.
+
+Definition digndugn {st tff A B} (i : instruction_seq st tff A B) : instruction_seq st tff A B :=
+  visit_instruction_seq (@digndugn_aux) i.
+
+Lemma untype_digndugn : untype_fun_seq (@digndugn) (optimizer.digndugn).
+Proof.
+  unfold untype_fun_seq, digndugn, optimizer.digndugn.
+  apply untype_visit_instruction_seq; [| reflexivity].
+  intros st tff A D i; simpl.
+  unfold digndugn_aux.
+  unfold opt_get.
+  case_eq (digndugn_opt i).
+  - intros i' H.
+    rewrite digndugn_opt_digndugn in H.
+    destruct H.
+    simpl.
+    rewrite Nat.eqb_refl.
+    reflexivity.
+  - intro H.
+    unfold digndugn_opt in H.
+    case_eq (untyper.untype_instruction_seq untyper.untype_Optimized i);
+      try reflexivity.
+    intros ui1 ui23 Hi.
+    destruct ui1; try reflexivity.
+    destruct o; try reflexivity.
+    destruct ui23; try reflexivity.
+    destruct i0; try reflexivity.
+    destruct o; try reflexivity.
+    case_eq (n =? n0); intro Hn; try reflexivity.
+    exfalso.
+    generalize (untype_inversion_seq Hi).
+    intro Hiinv.
+    destruct Hiinv as [(Htff, (i', Hi')) | (B, (i1, (i23, Hi123)))].
+    * repeat mytac.
+      discriminate.
+    * subst i.
+      simpl in Hi.
+      injection Hi.
+      intros Hi23 Hi1.
+      generalize (untype_inversion_seq Hi23).
+      intros Hiinv.
+      destruct Hiinv as [(Htff, (i', Hi')) | (C, (i2, (i3, Hi23')))].
+      -- repeat mytac.
+         injection Hi23.
+         intros Hui23 Hi'.
+         apply untype_inversion_dug in Hi'.
+         repeat mytac.
+         discriminate.
+      -- repeat mytac.
+         injection Hi23.
+         intros Hi3 Hi2.
+         assert (undig i1 = Some n) as Hni1
+             by (eapply untype_inversion_undig; eassumption).
+         assert (undug i2 = Some n0) as Hni2
+             by (eapply untype_inversion_undug; eassumption).
+         simpl in H.
+         rewrite Hni1 in H.
+         rewrite Hni2 in H.
+         simpl in H.
+         rewrite Hn in H.
+         apply untype_inversion_dig in Hi1.
+         apply untype_inversion_dug in Hi2.
+         repeat mytac.
+         match goal with | H : _ ::: ?S1 +++ _ = _ ::: ?S2 +++ _ |- _ =>
+                           rename H into Hl end.
+         injection Hl; intros Happ Ht.
+         apply beq_nat_true in Hn.
+         symmetry in Hn.
+         apply untyper.app_length_inv in Happ; [|assumption].
+         repeat mytac.
+Qed.
+
+(* PUSH - DROP *)
+
+Definition unpush {st tff A B} (i : instruction st tff A B) : Datatypes.option Datatypes.unit :=
+  match i with
+  | PUSH _ _ => Some tt
+  | _ => None
+  end.
+
+Lemma untype_inversion_push {st tff A B um} (i : instruction st tff A B) a x :
+  untyper.untype_instruction um i =
+  untyped_syntax.PUSH a x ->
+  exists y (H : tff = false) (HB : B = a ::: A),
+    untyper.untype_data um y = x /\
+    eq_rec
+      _
+      (fun B => instruction st false A B)
+      (eq_rec _ (fun tff => instruction st tff A B) i _ H) _ HB
+    = PUSH a y.
+Proof.
+  destruct i; try discriminate.
+  simpl.
+  intro H.
+  injection H.
+  intros; subst; clear H.
+  eexists.
+  do 2 (exists eq_refl).
+  split; reflexivity.
+Qed.
+
+Definition undrop_opcode {st A B} (i : @opcode st A B) : Datatypes.option Datatypes.nat :=
+  match i with
+  | DROP n _ => Some n
+  | _ => None
+  end.
+
+Definition undrop {st tff A B} (i : instruction st tff A B) : Datatypes.option Datatypes.nat :=
+  let? o := unopcode i in undrop_opcode o.
+
+
+Lemma untype_inversion_drop {st tff A B um} (i : instruction st tff A B) n :
+  untyper.untype_instruction um i =
+  untyped_syntax.instruction_opcode (untyped_syntax.DROP n) ->
+  exists S1
+         (H : tff = false)
+         (HA : A = S1 +++ B)
+         (Hn : n = List.length S1),
+    eq_rec
+      _
+      (fun A => instruction st false A B)
+      (eq_rec _ (fun tff => instruction st tff A B) i _ H) _ HA
+    = Instruction_opcode (@DROP _ (List.length S1) S1 B eq_refl).
+Proof.
+  destruct i; try discriminate.
+  destruct o; try discriminate.
+  simpl.
+  intro H.
+  injection H.
+  intro; subst; clear H.
+  eexists.
+  do 3 (exists eq_refl).
+  reflexivity.
+Qed.
+
+Definition take_one_opt (A : stack_type) :
+  Datatypes.option (sigT (fun a : type =>
+                          sig (fun B : stack_type => A = a ::: B))) :=
+  match A with
+  | nil => None
+  | cons a A => Some (existT _ a (exist _ A eq_refl))
+  end.
+
+Fixpoint take_n_opt (A : stack_type) n :
+  Datatypes.option (sig (fun S1 : stack_type => List.length S1 = n)) :=
+  match n with
+  | 0 => Some (exist _ nil eq_refl)
+  | S n =>
+    let? existT _ a (exist _ B H) := take_one_opt A in
+    let? exist _ S1 H := take_n_opt B n in
+    Some (exist _ (a ::: S1) (f_equal S H))
+  end.
+
+Lemma take_n_opt_length S1 S2 : take_n_opt (S1 +++ S2) (Datatypes.length S1) =
+                                Some (exist _ S1 eq_refl).
+Proof.
+  induction S1; simpl.
+  - reflexivity.
+  - rewrite IHS1; reflexivity.
+Qed.
+
+Definition pushdrop_opt {st tff A D} (i : instruction_seq st tff A D) :
+  Datatypes.option (instruction_seq st tff A D) :=
+  let? existT _ _ (existT _ _ i1) := unseq_fst i in
+  let? existT _ _ (existT _ _ i23) := unseq_snd i in
+  let '(existT _ _ i1) := hide_ntf i1 in
+  let? existT _ _ (existT _ _ i2) := unseq_fst i23 in
+  let '(existT _ _ i2) := hide_ntf i2 in
+  let? existT _ B (existT _ _ i3) := unseq_snd i23 in
+  let? tt := unpush i1 in
+  let? n := undrop i2 in
+  match n with
+  | 0 => None
+  | 1 => cast_instruction_seq_opt i3
+  | S n =>
+    let? exist _ S1 H1 := take_n_opt A n in
+    cast_instruction_seq_opt (SEQ (@DROP st n S1 B H1) i3)
+  end.
+
+Inductive pushdrop_rel {st tff} :
+  forall {A B} (i i' : instruction_seq st tff A B), Prop :=
+| PushDrop_1 {A B t x} (i : instruction_seq st tff A B) :
+    pushdrop_rel
+      (SEQ (PUSH t x) (SEQ (@DROP _ 1 (cons t nil) A eq_refl) i)) i
+| PushDrop_S {t2 S1 S2 B t1 x} (i : instruction_seq st tff S2 B) :
+    pushdrop_rel
+      (SEQ (PUSH t1 x) (SEQ (@DROP _ (S (S (List.length S1))) (cons t1 (cons t2 S1)) S2 eq_refl) i))
+      (SEQ (@DROP _ (S (List.length S1)) (cons t2 S1) S2 eq_refl) i).
+
+Lemma pushdrop_opt_pushdrop {st tff A D} (i i' : instruction_seq st tff A D) :
+  pushdrop_opt i = Some i' <-> pushdrop_rel i i'.
+Proof.
+  split.
+  - unfold pushdrop_opt.
+    intro H.
+    apply bind_some in H; destruct H as ((A1, (B1, i1)), (He1, H)).
+    apply bind_some in H; destruct H as ((A23, (B23, i23)), (He23, H)).
+    case_eq (hide_ntf i1); intros tff1 i1' Hi1'; rewrite Hi1' in H.
+    apply bind_some in H; destruct H as ((A2, (B2, i2)), (He2, H)).
+    case_eq (hide_ntf i2); intros tff2 i2' Hi2'; rewrite Hi2' in H.
+    apply bind_some in H; destruct H as ((A3, (B3, i3)), (He3, H)).
+
+    destruct i1'; try discriminate.
+    simpl in H.
+
+    destruct i2'; try discriminate.
+    destruct o; try discriminate.
+    simpl in H.
+
+    destruct n as [|[|n]]; destruct A1 as [|t1[|t2 A1]]; try discriminate.
+    + destruct i; try discriminate.
+      destruct i23; try discriminate.
+      simpl in *.
+      repeat mytac.
+      constructor.
+    + destruct i; try discriminate.
+      destruct i23; try discriminate.
+      simpl in *.
+      injection e; intro.
+      repeat mytac.
+      rewrite take_n_opt_length in H1.
+      simpl in *.
+      repeat mytac.
+      simpl.
+      constructor.
+  - intro H.
+    destruct H.
+    + simpl.
+      unfold pushdrop_opt; simpl.
+      apply cast_instruction_seq_same.
+    + simpl.
+      unfold pushdrop_opt; simpl.
+      rewrite take_n_opt_length.
+      simpl.
+      apply cast_instruction_seq_same.
+Qed.
+
+Definition pushdrop_aux {st tff A B} (i : instruction_seq st tff A B)
+  : instruction_seq st tff A B :=
+  opt_get (pushdrop_opt i) i.
+
+Definition pushdrop {st tff A B} (i : instruction_seq st tff A B) :=
+  visit_instruction_seq (@pushdrop_aux) i.
+
+Lemma untype_pushdrop : untype_fun_seq (@pushdrop) (optimizer.push_drop).
+Proof.
+  unfold untype_fun_seq, pushdrop, optimizer.push_drop.
+  apply untype_visit_instruction_seq; [| reflexivity].
+  intros st tff A D i; simpl.
+  unfold pushdrop_aux.
+  unfold opt_get.
+  case_eq (pushdrop_opt i).
+  - intros i' H.
+    rewrite pushdrop_opt_pushdrop in H.
+    destruct H; reflexivity.
+  - intro H.
+    unfold pushdrop_opt in H.
+    case_eq (untyper.untype_instruction_seq untyper.untype_Optimized i);
+      try reflexivity.
+    intros ui1 ui23 Hi.
+    destruct ui1; try reflexivity.
+    destruct ui23; try reflexivity.
+    destruct i0; try reflexivity.
+    destruct o; try reflexivity.
+    destruct n as [|n]; try reflexivity.
+    exfalso.
+    generalize (untype_inversion_seq Hi).
+    intro Hiinv.
+    destruct Hiinv as [(Htff, (i', Hi')) | (B, (i1, (i23, Hi123)))].
+    * repeat mytac.
+      discriminate.
+    * subst i.
+      simpl in Hi.
+      injection Hi.
+      intros Hi23 Hi1.
+      generalize (untype_inversion_seq Hi23).
+      intros Hiinv.
+      destruct Hiinv as [(Htff, (i', Hi')) | (C, (i2, (i3, Hi23')))].
+      -- repeat mytac.
+         injection Hi23.
+         intros Hui23 Hi'.
+         apply untype_inversion_drop in Hi'.
+         repeat mytac.
+         discriminate.
+      -- repeat mytac.
+         injection Hi23.
+         intros Hi3 Hi2.
+         apply untype_inversion_push in Hi1.
+         apply untype_inversion_drop in Hi2.
+         repeat mytac.
+         match goal with H : S _ = Datatypes.length ?l |- _ =>
+                         rename l into B; rename H into HB end.
+         destruct B as [| a [| b B]]; [discriminate| |].
+         ++ simpl in *.
+            injection HB; intro.
+            repeat mytac.
+            simpl in H.
+            repeat mytac.
+         ++ simpl in *.
+            injection HB; intro.
+            repeat mytac.
+            simpl in H.
+            rewrite take_n_opt_length in H.
+            simpl in H.
+            repeat mytac.
+Qed.
+
+Definition cleanup {st tff A B} (i : instruction_seq st tff A B)
+  : instruction_seq st tff A B :=
+  pushdrop
+    (swapswap
+       (digndugn
+          (dig0dug0 i))).
+
+Lemma untype_cleanup : untype_fun_seq (@cleanup) (optimizer.cleanup).
+Proof.
+  intros st tff A B i.
+  unfold cleanup, optimizer.cleanup.
+  rewrite (@untype_pushdrop st tff A B); f_equal.
+  rewrite (@untype_swapswap st tff A B); f_equal.
+  rewrite (@untype_digndugn st tff A B); f_equal.
+  rewrite (@untype_dig0dug0 st tff A B); f_equal.
+Qed.
+
+
+Module Semantics_Preservation (C : semantics.ContractContext).
+  Module S := semantics.Semantics C.
+  Import S.
+
+  Definition same_semantics
+             (F : forall st tff A B, instruction_seq st tff A B ->
+                                     instruction_seq st tff A B)
+    :=
+      forall st tff env A B fuel i stA,
+        Bool.Is_true (error.success (eval_seq env i fuel stA)) ->
+        eval_seq env (F st tff A B i) fuel stA = eval_seq env i fuel stA.
+
+  Lemma eval_seq_SEQ st tff env A B C
+        (i1 : instruction st false A B)
+        (i2 : instruction_seq st tff B C) fuel SA :
+    eval_seq env (SEQ i1 i2) fuel SA =
+    let! SB := eval env i1 fuel SA in
+    eval_seq env i2 fuel SB.
+  Proof.
+    unfold eval_seq.
+    destruct fuel; reflexivity.
+  Qed.
+
+  Lemma eval_fail_and_seq :
+    (forall st A B (i : instruction st true A B)
+            fuel env stA, ~ Bool.Is_true (error.success (eval env i fuel stA))) *
+    (forall st A B (i : instruction_seq st true A B)
+            fuel env stA, ~ Bool.Is_true (error.success (eval_seq env i fuel stA))).
+  Proof.
+    apply tail_fail_induction_and_seq; intros; (destruct fuel as [|fuel]; [simpl; auto|]); simpl.
+    - destruct stA as (x, stA); simpl.
+      auto.
+    - destruct stA as (x, stA); simpl.
+      destruct (if_family_destruct f x); simpl; [apply H | apply H0].
+    - rewrite eval_seq_SEQ.
+      intro Hs; apply error.success_bind in Hs.
+      destruct Hs as (stB, (Hi1, Hs)).
+      apply H in Hs.
+      assumption.
+    - apply H.
+    - apply H.
+  Qed.
+
+  Lemma eval_fail st A B (i : instruction st true A B) fuel env stA :
+    ~ Bool.Is_true (error.success (eval env i fuel stA)).
+  Proof.
+    apply eval_fail_and_seq.
+  Qed.
+
+  Lemma eval_fail_seq st A B (i : instruction_seq st true A B) fuel env stA :
+    ~ Bool.Is_true (error.success (eval_seq env i fuel stA)).
+  Proof.
+    apply eval_fail_and_seq.
+  Qed.
+
+  Lemma same_semantics_visit_seq_aux F (HF : same_semantics F)
+        (HNOOP : forall st A, F st _ A A NOOP = NOOP) :
+    (forall st tff env A B fuel (i : instruction st tff A B) stA,
+        Bool.Is_true (error.success (eval env i fuel stA)) ->
+        eval env (visit_instruction F i) fuel stA = eval env i fuel stA) ->
+    same_semantics (@visit_instruction_seq F).
+  Proof.
+    intros Heval st tff env A B fuel i stA Hsucc.
+    induction i.
+    - simpl.
+      rewrite HNOOP.
+      reflexivity.
+    - simpl.
+      apply eval_fail in Hsucc.
+      contradiction.
+    - simpl.
+      rewrite eval_seq_SEQ in Hsucc.
+      apply error.success_bind in Hsucc.
+      destruct Hsucc as (stB, (Hi, Hsucc)).
+      transitivity
+        (eval_seq env (SEQ
+                         (visit_instruction F i)
+                         (visit_instruction_seq F i0)) fuel stA).
+      + apply HF.
+        rewrite eval_seq_SEQ.
+        specialize (IHi env stB Hsucc).
+        rewrite Heval; rewrite Hi; [|constructor].
+        simpl.
+        rewrite IHi.
+        assumption.
+      + do 2 rewrite eval_seq_SEQ.
+        rewrite Heval.
+        * rewrite Hi.
+          simpl.
+          apply IHi.
+          exact Hsucc.
+        * rewrite Hi.
+          simpl.
+          constructor.
+  Defined.
+
+  Fixpoint same_semantics_visit F (HF : same_semantics F) (HNOOP : forall st A, F st false A A NOOP = NOOP)
+           st tff env A B fuel (i : instruction st tff A B) stA {struct fuel} :
+    Bool.Is_true (error.success (eval env i fuel stA)) ->
+    eval env (visit_instruction F i) fuel stA =
+    eval env i fuel stA.
+  Proof.
+    specialize (same_semantics_visit_seq_aux F HF HNOOP (same_semantics_visit F HF HNOOP)).
+    unfold same_semantics.
+    intros Hseq.
+    destruct fuel as [|fuel]; [reflexivity|]; destruct i; try reflexivity.
+    + apply Hseq; try assumption.
+    + destruct stA as (x, SA);
+        simpl; destruct (if_family_destruct i x);
+          intro Hsucc; apply Hseq; exact Hsucc.
+    + destruct stA as (ab, SA); simpl; destruct (loop_family_destruct i ab) as [a|b];
+        intro Hsucc.
+      * apply error.success_bind in Hsucc.
+        destruct Hsucc as ((x, SA'), (Hret,Hsucc)).
+        unfold eval_seq in Hseq.
+        rewrite Hseq.
+        -- rewrite Hret; simpl.
+           unfold stack_type in Hret; rewrite Hret; simpl.
+           generalize (same_semantics_visit F HF HNOOP _ _ env _ _ fuel (LOOP_ i i0));
+             intro Hv.
+           simpl in Hv.
+           apply Hv.
+           assumption.
+        -- unfold stack_type in Hret.
+           rewrite Hret.
+           constructor.
+      * reflexivity.
+    + destruct stA as (x, SA); simpl.
+      destruct (iter_destruct (iter_elt_type collection i) collection (iter_variant_field collection i)) as [(a, y)|]; intro Hsucc.
+      * apply error.success_bind in Hsucc.
+        destruct Hsucc as (z, (Hret,Hsucc)).
+        unfold stack_type.
+        unfold eval_seq in Hseq.
+        rewrite Hseq.
+        -- generalize (same_semantics_visit F HF HNOOP _ _ env _ _ fuel (ITER i0));
+             intro Hv.
+           simpl in Hv.
+           unfold stack_type in Hret.
+           rewrite Hret.
+           simpl.
+           apply Hv.
+           assumption.
+        -- unfold stack_type in Hret.
+           rewrite Hret.
+           constructor.
+      * reflexivity.
+    + destruct stA as (x, SA); simpl.
+      destruct (map_destruct (map_in_type collection b i) b collection (map_out_collection_type collection b i) (map_variant_field collection b i) x) as [(a, y)|]; intro Hsucc.
+      * apply error.success_bind in Hsucc.
+        destruct Hsucc as ((b0, SB), (Hret,Hsucc)).
+        unfold eval_seq in Hseq.
+        rewrite Hseq.
+        -- generalize (same_semantics_visit F HF HNOOP self_type _ env _ _ fuel (MAP i0));
+             intro Hv.
+           simpl in Hv.
+           rewrite Hret.
+           unfold stack_type in Hret.
+           simpl.
+           simpl in Hret.
+           match goal with |- (let! (b1, SB0) := ?lhs in _ ) = _ =>
+                           replace lhs with (error.Return (b0, SB))
+           end.
+           simpl.
+           rewrite Hv.
+           ++ reflexivity.
+           ++ apply error.success_bind_arg in Hsucc.
+              assumption.
+        -- unfold stack_type in Hret.
+           match goal with |- (Bool.Is_true (error.success ?lhs)) =>
+                           replace lhs with (error.Return (b0, SB))
+           end.
+           constructor.
+      * reflexivity.
+    + simpl.
+      intro Hsucc.
+      destruct (stack_split stA) as (S1, S2).
+      unfold eval_seq in Hseq.
+      rewrite Hseq.
+      * reflexivity.
+      * unfold stack_type in Hsucc.
+        apply error.success_bind_arg in Hsucc.
+        assumption.
+  Qed.
+
+  Lemma same_semantics_visit_seq F (HF : same_semantics F) (HNOOP : forall st A, F st false A A NOOP = NOOP) :
+    same_semantics (@visit_instruction_seq F).
+  Proof.
+    apply same_semantics_visit_seq_aux; try assumption.
+    apply same_semantics_visit; assumption.
+  Qed.
+
+  Lemma same_semantics_opt F :
+    (forall st tff env A B (i i' : instruction_seq st tff A B) SA fuel,
+        F st tff A B i = Some i' ->
+        Bool.Is_true (error.success (eval_seq env i fuel SA)) ->
+        eval_seq env i' fuel SA = eval_seq env i fuel SA) ->
+    same_semantics (fun st tff A B (i : instruction_seq st tff A B) => opt_get (F st tff A B i) i).
+  Proof.
+    intros HF st tff env A B fuel i SA Hsucc.
+    case_eq (F st tff A B i).
+    - intros i' Hi'.
+      apply HF; assumption.
+    - intro; reflexivity.
+  Qed.
+
+  Lemma eval_Instruction_seq_aux st tff env A B (i : instruction_seq st tff A B) fuel stA :
+    Bool.Is_true (error.success (eval env (Instruction_seq i) fuel stA)) ->
+    eval env (Instruction_seq i) fuel stA =
+    eval_seq env i fuel stA.
+  Proof.
+    destruct fuel.
+    - contradiction.
+    - intro Hsucc.
+      change (eval_seq env i fuel stA = eval_seq env i (S fuel) stA).
+      apply eval_seq_deterministic_le.
+      + omega.
+      + assumption.
+  Qed.
+
+  Lemma eval_seq_instruction_app_aux st tff1 H1 tff2 env A B C
+        (i1 : instruction_seq st tff1 A B)
+        (i2 : instruction_seq st tff2 B C) fuel SA :
+    eval_seq env (instruction_app_aux i1 H1 i2) fuel SA =
+    let! SB := eval_seq env i1 fuel SA in
+    eval_seq env i2 fuel SB.
+  Proof.
+    induction i1; simpl.
+    - reflexivity.
+    - discriminate.
+    - unfold eval_seq.
+      simpl.
+      destruct (eval env i fuel SA); simpl.
+      + reflexivity.
+      + apply IHi1.
+  Qed.
+
+  Lemma eval_seq_instruction_app st tff env A B C
+        (i1 : instruction_seq st false A B)
+        (i2 : instruction_seq st tff B C) fuel SA :
+    eval_seq env (i1;;;i2) fuel SA =
+    let! SB := eval_seq env i1 fuel SA in
+    eval_seq env i2 fuel SB.
+  Proof.
+    apply eval_seq_instruction_app_aux.
+  Qed.
+
+  Lemma eval_Instruction_seq self_type tff env fuel A B C
+        (i1 : instruction_seq self_type false A B)
+        (i2 : instruction_seq self_type tff B C)
+        stA:
+    Bool.Is_true (error.success (eval_seq env (SEQ (Instruction_seq i1) i2) fuel stA)) ->
+    eval_seq env (i1;;; i2) fuel stA =
+    eval_seq env (SEQ (Instruction_seq i1) i2) fuel stA.
+  Proof.
+    intro Hsucc.
+    rewrite eval_seq_instruction_app.
+    rewrite eval_seq_SEQ.
+    rewrite eval_Instruction_seq_aux.
+    - reflexivity.
+    - rewrite eval_seq_SEQ in Hsucc.
+      apply error.success_bind_arg in Hsucc.
+      assumption.
+  Qed.
+
+  Lemma same_semantics_dig0dug0 :
+    same_semantics (@dig0dug0).
+  Proof.
+    apply same_semantics_visit_seq.
+    - apply same_semantics_opt.
+      intros st tff env A B i i' stA fuel HS Hsucc.
+      apply dig0dug0_opt_dig0dug0 in HS.
+      destruct HS.
+      + apply eval_fail_seq in Hsucc.
+        contradiction.
+      + apply eval_Instruction_seq.
+        assumption.
+      + rewrite eval_seq_instruction_app.
+        rewrite eval_seq_SEQ.
+        f_equal.
+        unfold eval_seq in Hsucc.
+        apply error.success_bind in Hsucc.
+        destruct Hsucc as (stB, (HDIP, _)).
+        destruct fuel; [simpl in HDIP; discriminate|].
+        simpl.
+        simpl in HDIP.
+        apply error.bind_eq_return in HDIP.
+        destruct HDIP as (stB', (Hi1, HstB')).
+        apply error.unreturn in HstB'.
+        subst stB'.
+        rewrite Hi1.
+        simpl.
+        rewrite <- Hi1.
+        symmetry.
+        apply eval_seq_deterministic_le; [omega|].
+        unfold eval_seq.
+        unfold stack_type in Hi1.
+        rewrite Hi1.
+        constructor.
+      + rewrite eval_seq_SEQ.
+        destruct fuel; [simpl in Hsucc; contradiction|].
+        reflexivity.
+      + rewrite eval_seq_SEQ.
+        destruct fuel; [simpl in Hsucc; contradiction|].
+        destruct stA; reflexivity.
+      + rewrite eval_seq_SEQ.
+        destruct fuel; [simpl in Hsucc; contradiction|].
+        destruct stA; reflexivity.
+      + rewrite eval_seq_SEQ.
+        destruct fuel; [simpl in Hsucc; contradiction|].
+        destruct stA as (x, (y, stA)); reflexivity.
+      + rewrite eval_seq_SEQ.
+        destruct fuel; [simpl in Hsucc; contradiction|].
+        destruct stA as (x, (y, stA)); reflexivity.
+    - reflexivity.
+  Qed.
+
+
+  Lemma same_semantics_swapswap :
+    same_semantics (@swapswap).
+  Proof.
+    apply same_semantics_visit_seq.
+    - apply same_semantics_opt.
+      intros st tff env A D i i' stA fuel HS Hsucc.
+      apply swapswap_opt_swapswap in HS.
+      destruct HS.
+      destruct fuel as [|fuel]; [contradiction|].
+      destruct stA as (x, (y, stA)).
+      rewrite eval_seq_SEQ.
+      simpl.
+      rewrite eval_seq_SEQ.
+      simpl.
+      reflexivity.
+    - reflexivity.
+  Qed.
+
+  Lemma stack_app_split (S1 S2 : Datatypes.list type) (s1 : stack S1) (s2 : stack S2) sA :
+    stack_split sA = (s1, s2) <-> sA = stack_app s1 s2.
+  Proof.
+    generalize s2; clear s2.
+    induction S1; intro s2.
+    - simpl.
+      simpl in s1.
+      destruct s1.
+      split; congruence.
+    - simpl.
+      simpl in s1.
+      destruct s1 as (x, s1).
+      simpl in sA.
+      destruct sA as (y, sA).
+      case_eq (stack_split sA).
+      intros s1' s2' HsA.
+      split.
+      + rewrite IHS1 in HsA.
+        congruence.
+      + intro H; injection H; intros.
+        subst y.
+        rewrite <- IHS1 in H0.
+        congruence.
+  Qed.
+
+  Lemma same_semantics_digndugn :
+    same_semantics (@digndugn).
+  Proof.
+    apply same_semantics_visit_seq.
+    - apply same_semantics_opt.
+      intros st tff env A D i i' stA fuel HS Hsucc.
+      apply digndugn_opt_digndugn in HS.
+      destruct HS.
+      + destruct fuel as [|fuel]; [contradiction|].
+        rewrite eval_seq_SEQ.
+        simpl.
+        rewrite eval_seq_SEQ.
+        simpl.
+        unfold stack_dig, stack_dug.
+        case_eq (stack_split stA).
+        intros s1 s2 HS12.
+        destruct s2 as (x, s2).
+        assert (stack_split (stack_app s1 s2) = (s1, s2)) as H.
+        * rewrite stack_app_split.
+          reflexivity.
+        * rewrite H.
+          rewrite stack_app_split in HS12.
+          congruence.
+    - reflexivity.
+  Qed.
+
+  Lemma same_semantics_push_drop :
+    same_semantics (@pushdrop).
+  Proof.
+    apply same_semantics_visit_seq.
+    - apply same_semantics_opt.
+      intros st tff env A D i i' stA fuel HS Hsucc.
+      apply pushdrop_opt_pushdrop in HS.
+      destruct HS.
+      + destruct fuel as [|fuel]; [contradiction|].
+        rewrite eval_seq_SEQ.
+        simpl.
+        rewrite eval_seq_SEQ.
+        simpl.
+        reflexivity.
+      + destruct fuel as [|fuel]; [contradiction|].
+        rewrite eval_seq_SEQ.
+        simpl.
+        rewrite eval_seq_SEQ.
+        simpl.
+        rewrite eval_seq_SEQ.
+        simpl.
+        destruct stA as (y, stA).
+        case_eq (stack_split stA).
+        reflexivity.
+    - reflexivity.
+  Qed.
+
+  Lemma same_semantics_compose F G :
+    same_semantics F ->
+    same_semantics G ->
+    same_semantics (fun st tff A B i => F st tff A B (G st tff A B i)).
+  Proof.
+    intros HF HG.
+    unfold same_semantics.
+    intros.
+    rewrite HF.
+    - rewrite HG.
+      + reflexivity.
+      + assumption.
+    - rewrite HG; assumption.
+  Qed.
+
+  Lemma same_semantics_cleanup :
+    same_semantics (@cleanup).
+  Proof.
+    unfold cleanup.
+    apply same_semantics_compose; [exact same_semantics_push_drop|].
+    apply same_semantics_compose; [exact same_semantics_swapswap|].
+    apply same_semantics_compose; [exact same_semantics_digndugn|].
+    exact same_semantics_dig0dug0.
+  Qed.
+
+  Definition typecheck_and_eval_seq
+             (i : untyped_syntax.instruction_seq)
+             A B (sA : stack A)
+             self_type env fuel : error.M (stack B) :=
+    let! existT _ tff i' :=
+       typer.type_check_instruction_seq
+         (self_type := self_type)
+         (typer.type_instruction_seq typer.Optimized)
+         i A B in
+    eval_seq env i' fuel sA.
+
+  (* If the untyped instruction sequence i can be typechecked from
+     stack type A to stack type B and then run successfully on stack
+     sA, then (optimizer.optimize i) can also be typechecked from
+     stack type A to stack type B and run successfully on stack sA
+     yielding the same result. *)
+
+  Theorem optimize_correct :
+    forall i A B sA self_type env fuel,
+      let e := typecheck_and_eval_seq i A B sA self_type env fuel in
+      Bool.Is_true (error.success e) ->
+      typecheck_and_eval_seq (optimizer.optimize i) A B sA self_type env fuel = e.
+  Proof.
+    intros ui A B sA self_type env fuel.
+    unfold typecheck_and_eval_seq.
+    intro Hsucc.
+    apply error.success_bind in Hsucc.
+    destruct Hsucc as ((tff, i), (Hret, Hsucc)).
+    rewrite Hret.
+    simpl.
+    unfold typer.type_check_instruction_seq in Hret.
+    apply error.bind_eq_return in Hret.
+    destruct Hret as (t, (Ht, Hret)).
+    apply untyper.type_untype_seq in Ht.
+    destruct t.
+    - subst ui.
+      unfold typer.instruction_seq_cast_range, typer.instruction_seq_cast in Hret.
+      rewrite untyper.stype_dec_same in Hret.
+      destruct (stype_dec B0 B); [|discriminate].
+      simpl in Hret.
+      apply error.unreturn in Hret.
+      repeat mytac.
+      rewrite <- (untype_cleanup).
+      unfold typer.type_check_instruction_seq.
+      simpl in *.
+      rewrite untyper.untype_type_instruction_seq.
+      simpl.
+      unfold typer.instruction_seq_cast_range.
+      rewrite untyper.instruction_seq_cast_same.
+      simpl.
+      apply same_semantics_cleanup.
+      assumption.
+    - apply error.unreturn in Hret.
+      repeat mytac.
+      simpl in Hsucc.
+      apply eval_fail_seq in Hsucc.
+      contradiction.
+  Qed.
+
+End Semantics_Preservation.
-- 
GitLab


From f797bb50e5647284cb4a17c945008c63d871ca3f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Wed, 8 Apr 2020 12:02:49 +0200
Subject: [PATCH 31/56] [michocoq] remove an unused file

---
 src/michocoq/dummy_contract_context.v | 4 ----
 src/michocoq/main.v                   | 1 -
 2 files changed, 5 deletions(-)
 delete mode 100644 src/michocoq/dummy_contract_context.v

diff --git a/src/michocoq/dummy_contract_context.v b/src/michocoq/dummy_contract_context.v
deleted file mode 100644
index d0ebe7e4..00000000
--- a/src/michocoq/dummy_contract_context.v
+++ /dev/null
@@ -1,4 +0,0 @@
-Require syntax.
-Require syntax_type.
-Definition get_contract_type (_ : syntax.contract_constant) :
-  Datatypes.option syntax_type.type := None.
diff --git a/src/michocoq/main.v b/src/michocoq/main.v
index 56f6e73a..ddbdbed0 100644
--- a/src/michocoq/main.v
+++ b/src/michocoq/main.v
@@ -3,7 +3,6 @@ Require micheline_lexer micheline_parser.
 Require micheline2michelson typer.
 Require Import syntax.
 Require Import syntax_type.
-Require dummy_contract_context.
 Require error_pp.
 Import error.Notations.
 
-- 
GitLab


From 0512b4986d08ccfda24fceefb91994b69ae88395 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Wed, 8 Apr 2020 12:10:55 +0200
Subject: [PATCH 32/56] [michocoq] Formalize the relation between key_hash,
 addresses and contracts

---
 src/contracts_coq/boomerang.v        |  4 +-
 src/contracts_coq/deposit.v          |  4 +-
 src/contracts_coq/generic_multisig.v |  4 +-
 src/contracts_coq/manager.v          |  2 +-
 src/contracts_coq/multisig.v         |  4 +-
 src/michocoq/comparable.v            | 25 ++++++----
 src/michocoq/semantics.v             | 62 +++++++++++++++++--------
 src/michocoq/syntax.v                |  7 ++-
 src/michocoq/typer.v                 | 37 ++++++++++++++-
 src/michocoq/untyper.v               | 69 ++++++++++++++++++++++++++--
 10 files changed, 174 insertions(+), 44 deletions(-)

diff --git a/src/contracts_coq/boomerang.v b/src/contracts_coq/boomerang.v
index 0d3b45ae..c86c35f8 100644
--- a/src/contracts_coq/boomerang.v
+++ b/src/contracts_coq/boomerang.v
@@ -82,7 +82,7 @@ Lemma boomerang_correct :
   <->
   (amount env = (0 ~Mutez) /\ ops = nil) \/
   (amount env <> (0 ~Mutez) /\
-    exists ctr, contract_ env None unit (source env) = Some ctr /\
+    exists ctr, contract_ None unit (source env) = Some ctr /\
            ops = ((transfer_tokens env unit tt (amount env) ctr) :: nil)%list).
 Proof.
   intros env ops fuel Hfuel.
@@ -112,7 +112,7 @@ Proof.
   - intro Hneq.
     rewrite eqb_neq in Hneq.
     do 7 (more_fuel ; simpl).
-    destruct (contract_ env None unit (source env)).
+    destruct (contract_ None unit (source env)).
     + (* Some *)
       split.
       * intro H ; right; split.
diff --git a/src/contracts_coq/deposit.v b/src/contracts_coq/deposit.v
index 34edd4b3..029722a5 100644
--- a/src/contracts_coq/deposit.v
+++ b/src/contracts_coq/deposit.v
@@ -64,7 +64,7 @@ Lemma deposit_correct :
    | inl tt => ops = nil
    | inr am => (storage_in = sender env /\
                 exists c : data (contract unit),
-                  contract_ env None unit storage_in = Some c /\
+                  contract_ None unit storage_in = Some c /\
                   ops = cons (transfer_tokens env unit tt am c) nil)
    end).
 Proof.
@@ -81,7 +81,7 @@ Proof.
     rewrite match_if_exchange.
     rewrite if_false_is_and.
     rewrite (eqb_eq address).
-    remember (contract_ env None unit storage_in) as d.
+    remember (contract_ None unit storage_in) as d.
     match goal with
       |- context [match ?x with | Some y => _ | None => _ end] =>
       remember x as d2
diff --git a/src/contracts_coq/generic_multisig.v b/src/contracts_coq/generic_multisig.v
index fc6b1766..cf181825 100644
--- a/src/contracts_coq/generic_multisig.v
+++ b/src/contracts_coq/generic_multisig.v
@@ -167,7 +167,7 @@ Definition multisig_spec
       (fun k sig =>
          check_signature
            env k sig
-           (pack env pack_ty (chain_id_ env, address_ env unit (self env None I),
+           (pack env pack_ty (chain_id_ env, address_ unit (self env None I),
                               (counter, action)))) /\
     (count_signatures sigs >= threshold)%N /\
     new_stored_counter = (1 + stored_counter)%N /\
@@ -227,7 +227,7 @@ Definition multisig_head_spec
        (keys,
         (sigs,
          (pack env pack_ty
-               (chain_id_ env, address_ env unit (self (self_ty := Some (parameter_ty, None)) env None I), (counter, action)),
+               (chain_id_ env, address_ unit (self (self_ty := Some (parameter_ty, None)) env None I), (counter, action)),
           (action, (storage, tt)))))).
 
 Ltac fold_eval_precond :=
diff --git a/src/contracts_coq/manager.v b/src/contracts_coq/manager.v
index 9fbf9183..c6d78884 100644
--- a/src/contracts_coq/manager.v
+++ b/src/contracts_coq/manager.v
@@ -80,7 +80,7 @@ Definition manager_spec
   | inl (existT _ _ lam) =>
     (* %do is only available to the stored manager and rejects non-null amounts*)
     amount env = (0 ~Mutez) /\
-    sender env = address_ env unit (implicit_account env storage) /\
+    sender env = address_ unit (implicit_account storage) /\
     new_storage = storage /\
     eval_seq (no_self env) lam fuel (tt, tt) = Return (returned_operations, tt)
   end.
diff --git a/src/contracts_coq/multisig.v b/src/contracts_coq/multisig.v
index 31b650fc..c79481b4 100644
--- a/src/contracts_coq/multisig.v
+++ b/src/contracts_coq/multisig.v
@@ -159,7 +159,7 @@ Definition multisig_spec
       (fun k sig =>
          check_signature
            env k sig
-           (pack env pack_ty ((chain_id_ env, address_ env parameter_ty (self env None I)),
+           (pack env pack_ty ((chain_id_ env, address_ parameter_ty (self env None I)),
                              (counter, action)))) /\
     (count_signatures first_sigs >= threshold)%N /\
     new_stored_counter = (1 + stored_counter)%N /\
@@ -220,7 +220,7 @@ Definition multisig_head_spec
         (keys,
          (sigs,
           (pack env pack_ty
-                ((chain_id_ env, address_ env parameter_ty (self env None I)), (counter, action)),
+                ((chain_id_ env, address_ parameter_ty (self env None I)), (counter, action)),
            (action, (storage, tt)))))).
 
 Lemma fold_eval_precond fuel :
diff --git a/src/michocoq/comparable.v b/src/michocoq/comparable.v
index 23c2ebe5..bae478a4 100644
--- a/src/michocoq/comparable.v
+++ b/src/michocoq/comparable.v
@@ -271,9 +271,13 @@ Proof.
   apply (string_compare_Lt_trans _ s2); assumption.
 Qed.
 
+(* Not documented, see contract_repr.ml in the Tezos protocol  *)
 Definition address_compare (a1 a2 : address_constant) : comparison :=
   match a1, a2 with
-  | Mk_address s1, Mk_address s2 => string_compare s1 s2
+  | Implicit (Mk_key_hash s1), Implicit (Mk_key_hash s2) => string_compare s1 s2
+  | Originated (Mk_smart_contract_address s1), Originated (Mk_smart_contract_address s2) => string_compare s1 s2
+  | Implicit _, Originated _ => Lt
+  | Originated _, Implicit _ => Gt
   end.
 
 Definition key_hash_compare (h1 h2 : key_hash_constant) : comparison :=
@@ -341,9 +345,8 @@ Proof.
   - apply string_compare_Eq_correct.
   - destruct c1; destruct c2; split; simpl; congruence.
   - apply tez.compare_eq_iff.
-  - destruct c1 as [s1]; destruct c2 as [s2]. simpl.
-    rewrite string_compare_Eq_correct.
-    split; congruence.
+  - destruct c1 as [[s1]|[s1]]; destruct c2 as [[s2]|[s2]]; simpl;
+      try rewrite string_compare_Eq_correct; split; congruence.
   - destruct c1 as [s1]; destruct c2 as [s2]. simpl.
     rewrite string_compare_Eq_correct.
     split; congruence.
@@ -399,8 +402,11 @@ Proof.
   - apply string_compare_Lt_trans.
   - unfold lt_comp; destruct x; destruct y; destruct z; simpl; congruence.
   - apply Z.lt_trans.
-  - destruct x as [x]; destruct y as [y]; destruct z as [z].
-    apply string_compare_Lt_trans.
+  - unfold lt_comp;
+      destruct x as [[x]|[x]];
+      destruct y as [[y]|[y]];
+      destruct z as [[z]|[z]]; simpl;
+        try reflexivity; try discriminate; apply string_compare_Lt_trans.
   - destruct x as [x]; destruct y as [y]; destruct z as [z].
     apply string_compare_Lt_trans.
   - apply Z.lt_trans.
@@ -462,8 +468,11 @@ Proof.
   - unfold gt_comp.
     destruct x; destruct y; destruct z; simpl; congruence.
   - apply Zcompare_Gt_trans.
-  - destruct x as [x]; destruct y as [y]; destruct z as [z].
-    apply string_compare_Gt_trans.
+  - unfold gt_comp;
+      destruct x as [[x]|[x]];
+      destruct y as [[y]|[y]];
+      destruct z as [[z]|[z]]; simpl;
+        try reflexivity; try discriminate; apply string_compare_Gt_trans.
   - destruct x as [x]; destruct y as [y]; destruct z as [z].
     apply string_compare_Gt_trans.
   - apply Zcompare_Gt_trans.
diff --git a/src/michocoq/semantics.v b/src/michocoq/semantics.v
index e2056c97..ccc1c818 100644
--- a/src/michocoq/semantics.v
+++ b/src/michocoq/semantics.v
@@ -31,12 +31,24 @@ Require Import comparable error.
 Import error.Notations.
 
 Module Type ContractContext.
-  Parameter get_contract_type : contract_constant -> Datatypes.option type.
+  Parameter get_contract_type :
+    smart_contract_address_constant -> Datatypes.option type.
 End ContractContext.
 
 Module Semantics(C : ContractContext).
   Export C.
 
+  Definition get_address_type (sao : comparable_data address * annot_o)
+    : Datatypes.option type :=
+    let '(addr, ao) := sao in
+    opt_bind
+      (match addr with
+        | Implicit _ => Some unit
+        | Originated addr => get_contract_type addr
+       end)
+      (fun ty =>
+         get_entrypoint_opt ao ty None).
+
   Fixpoint data (a : type) {struct a} : Set :=
     match a with
     | Comparable_type b => comparable_data b
@@ -54,7 +66,7 @@ Module Semantics(C : ContractContext).
     | lambda a b =>
       sigT (fun tff : Datatypes.bool =>
              instruction_seq None tff (a ::: nil) (b ::: nil))
-    | contract a => sig (fun s : contract_constant => get_contract_type s = Some a )
+    | contract a => sig (fun sao : (address_constant * annot_o) => get_address_type sao = Some a )
     | chain_id => chain_id_constant
     end.
 
@@ -74,9 +86,6 @@ Module Semantics(C : ContractContext).
         set_delegate : Datatypes.option (comparable_data key_hash) ->
                        data operation;
         balance : tez.mutez;
-        address_ : forall p, data (contract p) -> data address;
-        contract_ : Datatypes.option annotation -> forall p, data address ->
-                              data (option (contract p));
         source : data address;
         sender : data address;
         self :
@@ -87,8 +96,6 @@ Module Semantics(C : ContractContext).
                 data (contract (get_opt (get_entrypoint_opt annot_opt ty self_annot) H))
             end;
         amount : tez.mutez;
-        implicit_account :
-          comparable_data key_hash -> data (contract unit);
         now : comparable_data timestamp;
         hash_key : data key -> comparable_data key_hash;
         pack : forall a, data a -> data bytes;
@@ -110,13 +117,10 @@ Module Semantics(C : ContractContext).
                  (transfer_tokens e)
                  (set_delegate e)
                  (balance e)
-                 (address_ e)
-                 (contract_ e)
                  (source e)
                  (sender e)
                  tt
                  (amount e)
-                 (implicit_account e)
                  (now e)
                  (hash_key e)
                  (pack e)
@@ -543,9 +547,29 @@ Module Semantics(C : ContractContext).
 
   Definition data_to_string {a} (x : data a) : String.string := "".
 
-  (* The gas argument is used to ensure termination, it is not the
-  amount of gas that is actually required to run the contract because
-  in the SEQ case, both instructions are run with gas n *)
+  Definition contract_ (an : annot_o) (p : type) (x : data address) : data (option (contract p)).
+  Proof.
+    case_eq (get_address_type (x, an)).
+    - intros p' H.
+      simpl.
+      case (type_dec p p').
+      + intro; subst p'.
+        apply Some.
+        eexists.
+        eassumption.
+      + intro; apply None.
+    - intro; apply None.
+  Defined.
+
+  Definition implicit_account (x : data key_hash) : data (contract unit).
+  Proof.
+    simpl.
+    exists (Implicit x, None).
+    reflexivity.
+  Defined.
+
+  Definition address_ a (x : data (contract a)) : data address :=
+    match x with exist _ (addr, _) _ => addr end.
 
   Definition eval_opcode param_ty (env : @proto_env param_ty) {A B : stack_type}
              (o : @opcode param_ty A B) (SA : stack A) : M (stack B) :=
@@ -631,12 +655,12 @@ Module Semantics(C : ContractContext).
         Return (transfer_tokens env _ a b c, SA)
       | SET_DELEGATE, (x, SA) => Return (set_delegate env x, SA)
       | BALANCE, SA => Return (balance env, SA)
-      | ADDRESS, (x, SA) => Return (address_ env _ x, SA)
-      | CONTRACT ao p, (x, SA) => Return (contract_ env ao p x, SA)
+      | ADDRESS, (x, SA) => Return (address_ _ x, SA)
+      | CONTRACT ao p, (x, SA) => Return (contract_ ao p x, SA)
       | SOURCE, SA => Return (source env, SA)
       | SENDER, SA => Return (sender env, SA)
       | AMOUNT, SA => Return (amount env, SA)
-      | IMPLICIT_ACCOUNT, (x, SA) => Return (implicit_account env x, SA)
+      | IMPLICIT_ACCOUNT, (x, SA) => Return (implicit_account x, SA)
       | NOW, SA => Return (now env, SA)
       | PACK, (x, SA) => Return (pack env _ x, SA)
       | UNPACK ty, (x, SA) => Return (unpack env ty x, SA)
@@ -966,12 +990,12 @@ Module Semantics(C : ContractContext).
     | SET_DELEGATE, env, psi, (x, SA) =>
       psi (set_delegate env x, SA)
     | BALANCE, env, psi, SA => psi (balance env, SA)
-    | ADDRESS, env, psi, (x, SA) => psi (address_ env _ x, SA)
-    | CONTRACT ao p, env, psi, (x, SA) => psi (contract_ env ao p x, SA)
+    | ADDRESS, env, psi, (x, SA) => psi (address_ _ x, SA)
+    | CONTRACT ao p, env, psi, (x, SA) => psi (contract_ ao p x, SA)
     | SOURCE, env, psi, SA => psi (source env, SA)
     | SENDER, env, psi, SA => psi (sender env, SA)
     | AMOUNT, env, psi, SA => psi (amount env, SA)
-    | IMPLICIT_ACCOUNT, env, psi, (x, SA) => psi (implicit_account env x, SA)
+    | IMPLICIT_ACCOUNT, env, psi, (x, SA) => psi (implicit_account x, SA)
     | NOW, env, psi, SA => psi (now env, SA)
     | PACK, env, psi, (x, SA) => psi (pack env _ x, SA)
     | UNPACK ty, env, psi, (x, SA) => psi (unpack env ty x, SA)
diff --git a/src/michocoq/syntax.v b/src/michocoq/syntax.v
index e415b229..13fcec1b 100644
--- a/src/michocoq/syntax.v
+++ b/src/michocoq/syntax.v
@@ -280,8 +280,11 @@ Inductive signature_constant : Set := Mk_sig : str -> signature_constant.
 Inductive key_constant : Set := Mk_key : str -> key_constant.
 Inductive key_hash_constant : Set := Mk_key_hash : str -> key_hash_constant.
 Inductive tez_constant : Set := Mk_tez : str -> tez_constant.
-Inductive contract_constant : Set := Mk_contract : str -> contract_constant.
-Inductive address_constant : Set := Mk_address : str -> address_constant.
+Inductive smart_contract_address_constant : Set :=
+| Mk_smart_contract_address : str -> smart_contract_address_constant.
+Inductive address_constant : Set :=
+| Implicit : key_hash_constant -> address_constant
+| Originated : smart_contract_address_constant -> address_constant.
 Inductive operation_constant : Set := Mk_operation : str -> operation_constant.
 Inductive mutez_constant : Set := Mk_mutez : tez.mutez -> mutez_constant.
 Inductive chain_id_constant : Set := Mk_chain_id : str -> chain_id_constant.
diff --git a/src/michocoq/typer.v b/src/michocoq/typer.v
index df1a5509..f4ef553d 100644
--- a/src/michocoq/typer.v
+++ b/src/michocoq/typer.v
@@ -1,4 +1,4 @@
-Require Import ZArith List Nat String.
+Require Import ZArith List Nat Ascii String.
 Require Import ListString.All.
 Require Import Moment.All.
 Require syntax semantics.
@@ -566,7 +566,40 @@ Qed.
         | signature => Return (syntax.Signature_constant s)
         | key => Return (syntax.Key_constant s)
         | Comparable_type key_hash => Return (syntax.Key_hash_constant s)
-        | Comparable_type address => Return (syntax.Address_constant (syntax.Mk_address s))
+        | Comparable_type address =>
+          let fail :=
+              Failed
+                _
+                (Typing
+                   _
+                   ("Address litterals should start by 'tz' or by 'KT1'"%string,
+                    s))
+          in
+          match s with
+          | String c1 (String c2 s) =>
+            if ascii_dec c1 "t" then
+              if ascii_dec c2 "z" then
+                Return (syntax.Address_constant
+                          (syntax.Implicit (syntax.Mk_key_hash s)))
+              else fail
+            else
+              match s with
+              | String c3 s =>
+                if ascii_dec c1 "K" then
+                  if ascii_dec c2 "T" then
+                    if ascii_dec c3 "1" then
+                      Return (syntax.Address_constant
+                                (syntax.Originated
+                                   (syntax.Mk_smart_contract_address s)))
+                    else
+                      fail
+                  else
+                    fail
+                else fail
+              | _ => fail
+              end
+          | _ => fail
+          end
         | Comparable_type timestamp =>
           match tm with
           | Optimized => Failed _ (Typing _ ("Not optimized"%string, (d, ty)))
diff --git a/src/michocoq/untyper.v b/src/michocoq/untyper.v
index 7b85ba75..803407b7 100644
--- a/src/michocoq/untyper.v
+++ b/src/michocoq/untyper.v
@@ -8,6 +8,7 @@ Require Import Lia.
 
 (* Not really needed but eases reading of proof states. *)
 Require Import String.
+Require Import Ascii.
 
 Inductive untype_mode := untype_Readable | untype_Optimized.
 
@@ -114,7 +115,13 @@ Inductive untype_mode := untype_Readable | untype_Optimized.
     | syntax.Signature_constant s => String_constant s
     | syntax.Key_constant s => String_constant s
     | syntax.Key_hash_constant s => String_constant s
-    | syntax.Address_constant (Mk_address c) => String_constant c
+    | syntax.Address_constant c =>
+      match c with
+      | syntax.Implicit (syntax.Mk_key_hash s) =>
+        String_constant (String "t" (String "z" s))
+      | syntax.Originated (syntax.Mk_smart_contract_address s) =>
+        String_constant (String "K" (String "T" (String "1" s)))
+      end
     | syntax.Unit => Unit
     | syntax.True_ => True_
     | syntax.False_ => False_
@@ -463,9 +470,7 @@ Inductive untype_mode := untype_Readable | untype_Optimized.
         rewrite tez.of_Z_to_Z.
         reflexivity.
       + simpl.
-        destruct a.
-        simpl.
-        reflexivity.
+        destruct a as [c|c]; destruct c; simpl; reflexivity.
       + simpl.
         pose (fix type_data_list (l : Datatypes.list concrete_data) :=
                 match l with
@@ -891,6 +896,48 @@ Inductive untype_mode := untype_Readable | untype_Optimized.
     - repeat mytac (eq_refl Z) (eq_refl Z) (eq_refl Z).
   Qed.
 
+  Definition un_address ty (addr : syntax.concrete_data ty) :
+    Datatypes.option (comparable.comparable_data address) :=
+    match addr return Datatypes.option (comparable.comparable_data address) with
+    | Address_constant x => Some x
+    | _ => None
+    end.
+
+  Lemma un_address_some ty (addr : syntax.concrete_data ty) (H : ty = address) :
+    exists x, un_address ty addr = Some x.
+  Proof.
+    destruct addr; try discriminate.
+    simpl; eexists; reflexivity.
+  Qed.
+
+  Lemma un_address_some_rev ty (addr : syntax.concrete_data ty) x :
+    un_address ty addr = Some x ->
+    exists He, eq_rect ty syntax.concrete_data addr address He = Address_constant x.
+  Proof.
+    destruct addr; try discriminate.
+    simpl.
+    intro Hs; injection Hs; intro; subst x.
+    exists eq_refl.
+    reflexivity.
+  Qed.
+
+  Lemma concrete_address_inversion (addr : syntax.concrete_data (Comparable_type address)) :
+    exists x : comparable.comparable_data address,
+      addr = Address_constant x.
+  Proof.
+    case_eq (un_address address addr).
+    - intros c Hc.
+      apply un_address_some_rev in Hc.
+      destruct Hc as (Haddr, H).
+      assert (Haddr = eq_refl) by (apply Eqdep_dec.UIP_dec; apply type_dec).
+      subst Haddr.
+      simpl in H.
+      eexists; eassumption.
+    - intro H.
+      destruct (un_address_some address addr eq_refl) as (c, Hc).
+      congruence.
+  Qed.
+
   Fixpoint type_untype self_type A i t {struct i} :
     typer.type_instruction typer.Optimized (self_type := self_type) i A = error.Return t ->
     match t with
@@ -949,6 +996,20 @@ Inductive untype_mode := untype_Readable | untype_Optimized.
           apply tez.of_Z_to_Z_eqv.
           assumption.
       - repeat mytac type_untype type_untype_seq type_untype_data.
+        destruct (concrete_address_inversion x') as (x, Hx).
+        subst x'.
+        simpl.
+        destruct s as [|c1 [|c2 s]]; try discriminate.
+        destruct (ascii_dec c1 "t").
+        + destruct (ascii_dec c2 "z"); try discriminate.
+          injection H; intros; subst x.
+          congruence.
+        + destruct s as [|c3 s]; try discriminate.
+          destruct (ascii_dec c1 "K"); try discriminate.
+          destruct (ascii_dec c2 "T"); try discriminate.
+          destruct (ascii_dec c3 "1"); try discriminate.
+          injection H; intros; subst x.
+          congruence.
       - repeat mytac type_untype type_untype_seq type_untype_data.
       - repeat mytac type_untype type_untype_seq type_untype_data.
       - repeat mytac type_untype type_untype_seq type_untype_data.
-- 
GitLab


From d6a0cf0da55af75c82213b9586ad16c07c96d652 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Tue, 14 Apr 2020 22:13:21 +0200
Subject: [PATCH 33/56] [Michocoq] Add the missing case ADD :: int : nat : 'S 
 ->  nat : 'S

---
 src/michocoq/semantics.v | 14 ++++++++------
 src/michocoq/syntax.v    | 15 +++++++++++++--
 src/michocoq/typer.v     |  6 ++++--
 3 files changed, 25 insertions(+), 10 deletions(-)

diff --git a/src/michocoq/semantics.v b/src/michocoq/semantics.v
index ccc1c818..d5bb52e7 100644
--- a/src/michocoq/semantics.v
+++ b/src/michocoq/semantics.v
@@ -327,10 +327,12 @@ Module Semantics(C : ContractContext).
     | Bitwise_variant_nat => N.lor
     end.
 
-  Definition and a (v : bitwise_variant a) : data a -> data a -> data a :=
+  Definition and a b c (v : and_variant a b c) : data a -> data b -> data c :=
     match v with
-    | Bitwise_variant_bool => andb
-    | Bitwise_variant_nat => N.land
+    | And_variant_bool => andb
+    | And_variant_nat => N.land
+    | And_variant_int =>
+      fun x y => Z.to_N (Z.land x (Z.of_N y))
     end.
 
   Definition xor a (v : bitwise_variant a) : data a -> data a -> data a :=
@@ -589,8 +591,8 @@ Module Semantics(C : ContractContext).
       | GE, (x, SA) => Return ((x >=? 0)%Z, SA)
       | @OR _ _ s, (x, (y, SA)) =>
         Return (or_fun _ (bitwise_variant_field _ s) x y, SA)
-      | @AND _ _ s, (x, (y, SA)) =>
-        Return (and _ (bitwise_variant_field _ s) x y, SA)
+      | @AND _ _ _ s, (x, (y, SA)) =>
+        Return (and _ _ _ (and_variant_field _ _ s) x y, SA)
       | @XOR _ _ s, (x, (y, SA)) =>
         Return (xor _ (bitwise_variant_field _ s) x y, SA)
       | @NOT _ _ s, (x, SA) => Return (not _ _ (not_variant_field _ s) x, SA)
@@ -943,7 +945,7 @@ Module Semantics(C : ContractContext).
     | LE, env, psi, (x, SA) => psi ((x <=? 0)%Z, SA)
     | GE, env, psi, (x, SA) => psi ((x >=? 0)%Z, SA)
     | @OR _ _ s _, env, psi, (x, (y, SA)) => psi (or_fun _ (bitwise_variant_field _ s) x y, SA)
-    | @AND _ _ s _, env, psi, (x, (y, SA)) => psi (and _ (bitwise_variant_field _ s) x y, SA)
+    | @AND _ _ _ s _, env, psi, (x, (y, SA)) => psi (and _ _ _ (and_variant_field _ _ s) x y, SA)
     | @XOR _ _ s _, env, psi, (x, (y, SA)) => psi (xor _ (bitwise_variant_field _ s) x y, SA)
     | @NOT _ _ s _, env, psi, (x, SA) => psi (not _ _ (not_variant_field _ s) x, SA)
     | @NEG _ _ s _, env, psi, (x, SA) => psi (neg _ (neg_variant_field _ s) x, SA)
diff --git a/src/michocoq/syntax.v b/src/michocoq/syntax.v
index 13fcec1b..940bb97e 100644
--- a/src/michocoq/syntax.v
+++ b/src/michocoq/syntax.v
@@ -33,7 +33,8 @@ Require Export syntax_type.
 
 Section Overloading.
 
-(* Boolean binary opertations (OR, XOR, AND) are overloaded as bitwise operations for nat. *)
+(* Boolean binary opertations (OR and XOR) are overloaded as bitwise
+operations for nat. AND also has a case for int and nat. *)
 Inductive bitwise_variant : type -> Set :=
 | Bitwise_variant_bool : bitwise_variant bool
 | Bitwise_variant_nat : bitwise_variant nat.
@@ -42,6 +43,16 @@ Structure bitwise_struct (a : type) :=
 Canonical Structure bitwise_bool : bitwise_struct bool := {| bitwise_variant_field := Bitwise_variant_bool |}.
 Canonical Structure bitwise_nat : bitwise_struct nat := {| bitwise_variant_field := Bitwise_variant_nat |}.
 
+Inductive and_variant : type -> type -> type -> Set :=
+| And_variant_bool : and_variant bool bool bool
+| And_variant_nat : and_variant nat nat nat
+| And_variant_int : and_variant int nat nat.
+Structure and_struct (a b : type) :=
+  Mk_and { and_ret_type : type; and_variant_field : and_variant a b and_ret_type }.
+Canonical Structure and_bool : and_struct bool bool := {| and_variant_field := And_variant_bool |}.
+Canonical Structure and_nat : and_struct nat nat := {| and_variant_field := And_variant_nat |}.
+Canonical Structure and_int : and_struct int nat := {| and_variant_field := And_variant_int |}.
+
 Set Warnings "-redundant-canonical-projection".
 
 (* Logical negation is also overloaded for int *)
@@ -368,7 +379,7 @@ Inductive opcode {self_type : self_info} : forall (A B : Datatypes.list type), S
 | LE {S} : opcode (int ::: S) (bool ::: S)
 | GE {S} : opcode (int ::: S) (bool ::: S)
 | OR {b} {s : bitwise_struct b} {S} : opcode (b ::: b ::: S) (b ::: S)
-| AND {b} {s : bitwise_struct b} {S} : opcode (b ::: b ::: S) (b ::: S)
+| AND {a b} {s : and_struct a b} {S} : opcode (a ::: b ::: S) (and_ret_type _ _ s ::: S)
 | XOR {b} {s : bitwise_struct b} {S} : opcode (b ::: b ::: S) (b ::: S)
 | NOT {b} {s : not_struct b} {S} : opcode (b ::: S) (not_ret_type _ s ::: S)
 | NEG {n} {s : neg_struct n} {S} : opcode (n ::: S) (int ::: S)
diff --git a/src/michocoq/typer.v b/src/michocoq/typer.v
index f4ef553d..ddbf688c 100644
--- a/src/michocoq/typer.v
+++ b/src/michocoq/typer.v
@@ -313,9 +313,11 @@ Qed.
     | OR, Comparable_type nat :: Comparable_type nat :: A =>
       Return (existT _ _ (@syntax.OR _ _ syntax.bitwise_nat _))
     | AND, Comparable_type bool :: Comparable_type bool :: A =>
-      Return (existT _ _ (@syntax.AND _ _ syntax.bitwise_bool _))
+      Return (existT _ _ (@syntax.AND _ _ _ syntax.and_bool _))
     | AND, Comparable_type nat :: Comparable_type nat :: A =>
-      Return (existT _ _ (@syntax.AND _ _ syntax.bitwise_nat _))
+      Return (existT _ _ (@syntax.AND _ _ _ syntax.and_nat _))
+    | AND, Comparable_type int :: Comparable_type nat :: A =>
+      Return (existT _ _ (@syntax.AND _ _ _ syntax.and_int _))
     | XOR, Comparable_type bool :: Comparable_type bool :: A =>
       Return (existT _ _ (@syntax.XOR _ _ syntax.bitwise_bool _))
     | XOR, Comparable_type nat :: Comparable_type nat :: A =>
-- 
GitLab


From c8200ce0b3dccb83de83b5e30667c3e50f0250d7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Tue, 14 Apr 2020 22:29:53 +0200
Subject: [PATCH 34/56] Add missing case for the `chain_id` type in the
 Micheline2michelson parser

---
 src/michocoq/micheline2michelson.v | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/michocoq/micheline2michelson.v b/src/michocoq/micheline2michelson.v
index ee56db51..f7b82b4a 100644
--- a/src/michocoq/micheline2michelson.v
+++ b/src/michocoq/micheline2michelson.v
@@ -44,6 +44,7 @@ Fixpoint micheline2michelson_type (bem : loc_micheline) : M type :=
        | Mk_loc_micheline (_, PRIM (_, "unit") nil) => Return unit
        | Mk_loc_micheline (_, PRIM (_, "signature") nil) => Return signature
        | Mk_loc_micheline (_, PRIM (_, "operation") nil) => Return operation
+       | Mk_loc_micheline (_, PRIM (_, "chain_id") nil) => Return chain_id
        | Mk_loc_micheline (_, PRIM (_, "option") (a :: nil)) =>
         let! a := micheline2michelson_type a in
         Return (option a)
-- 
GitLab


From 6cdd5d637102224fb08e52652d572250e60b6942 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Wed, 15 Apr 2020 16:01:33 +0200
Subject: [PATCH 35/56] Big map litterals

---
 src/michocoq/semantics.v | 17 ++++++++++++++
 src/michocoq/syntax.v    |  3 +++
 src/michocoq/typer.v     | 14 ++++++++++++
 src/michocoq/untyper.v   | 49 ++++++++++++++++++++++++++++++++++++++++
 4 files changed, 83 insertions(+)

diff --git a/src/michocoq/semantics.v b/src/michocoq/semantics.v
index d5bb52e7..eb390c61 100644
--- a/src/michocoq/semantics.v
+++ b/src/michocoq/semantics.v
@@ -262,6 +262,23 @@ Module Semantics(C : ContractContext).
              (Some (concrete_data_to_data _ y))
              (concrete_data_map_to_data l)
          end) l
+    | @Concrete_big_map a b l =>
+      (fix concrete_data_map_to_data
+           (l : Datatypes.list (elt_pair (concrete_data a) (concrete_data b))) :=
+         match l with
+         | nil => map.empty _ _ _
+         | cons (Elt _ _ x y) l =>
+           map.update
+             (comparable_data a)
+             (data b)
+             (comparable.compare a)
+             (comparable.compare_eq_iff a)
+             (comparable.lt_trans a)
+             (comparable.gt_trans a)
+             (data_to_comparable_data _ (concrete_data_to_data _ x))
+             (Some (concrete_data_to_data _ y))
+             (concrete_data_map_to_data l)
+         end) l
     | Instruction tff i => existT _ _ i
     | Chain_id_constant x => x
     end.
diff --git a/src/michocoq/syntax.v b/src/michocoq/syntax.v
index 940bb97e..801126d4 100644
--- a/src/michocoq/syntax.v
+++ b/src/michocoq/syntax.v
@@ -529,6 +529,9 @@ with concrete_data : type -> Set :=
 | Concrete_map {a : comparable_type} {b} :
     Datatypes.list (elt_pair (concrete_data a) (concrete_data b)) ->
     concrete_data (map a b)
+| Concrete_big_map {a : comparable_type} {b} :
+    Datatypes.list (elt_pair (concrete_data a) (concrete_data b)) ->
+    concrete_data (big_map a b)
 | Instruction {a b} tff : instruction_seq None tff (a ::: nil) (b ::: nil) ->
                           concrete_data (lambda a b)
 | Chain_id_constant : chain_id_constant -> concrete_data chain_id.
diff --git a/src/michocoq/typer.v b/src/michocoq/typer.v
index ddbf688c..c97a16c7 100644
--- a/src/michocoq/typer.v
+++ b/src/michocoq/typer.v
@@ -722,6 +722,20 @@ Qed.
               end
             ) l in
           Return (syntax.Concrete_map l)
+        | big_map a b =>
+          let! l :=
+            (fix type_data_list l :=
+              match l with
+              | nil => Return nil
+              | cons (Elt x y) l =>
+                let! x := type_data tm x a in
+                let! y := type_data tm y b in
+                let! l := type_data_list l in
+                Return (cons (syntax.Elt _ _ x y) l)
+              | _ => Failed _ (Typing _ (d, ty))
+              end
+            ) l in
+          Return (syntax.Concrete_big_map l)
         | _ => Failed _ (Typing _ (d, ty))
         end
     | Instruction i =>
diff --git a/src/michocoq/untyper.v b/src/michocoq/untyper.v
index 803407b7..311aa05b 100644
--- a/src/michocoq/untyper.v
+++ b/src/michocoq/untyper.v
@@ -136,6 +136,10 @@ Inductive untype_mode := untype_Readable | untype_Optimized.
       Concrete_seq (List.map
                       (fun '(syntax.Elt _ _ x y) => Elt (untype_data um x) (untype_data um y))
                       l)
+    | syntax.Concrete_big_map l =>
+      Concrete_seq (List.map
+                      (fun '(syntax.Elt _ _ x y) => Elt (untype_data um x) (untype_data um y))
+                      l)
     | syntax.Instruction _ i => Instruction (untype_instruction_seq um i)
     | syntax.Chain_id_constant (Mk_chain_id c) => String_constant c
     end
@@ -532,6 +536,31 @@ Inductive untype_mode := untype_Readable | untype_Optimized.
         * simpl.
           rewrite H.
           reflexivity.
+      + pose (fix type_data_list L :=
+                   match L with
+                   | nil => Return nil
+                   | cons (Elt x y) l =>
+                    let! x := type_data Optimized x a in
+                    let! y := type_data Optimized y b in
+                    let! l := type_data_list l in
+                    Return (cons (syntax.Elt _ _ x y) l)
+                   | _ => Failed _ (Typing _ (untype_data untype_Optimized (syntax.Concrete_big_map l), (big_map a b)))
+                   end) as type_data_map.
+        assert (forall l, type_data_map (List.map (fun '(syntax.Elt _ _ x y) => Elt (untype_data untype_Optimized x) (untype_data untype_Optimized y)) l) = Return l).
+        * intro L; induction L.
+          -- reflexivity.
+          -- simpl.
+             destruct a0.
+             rewrite untype_type_data.
+             rewrite untype_type_data.
+             rewrite IHL.
+             reflexivity.
+        * trans_refl (
+            let! l := type_data_map (List.map (fun '(syntax.Elt _ _ x y) => Elt (untype_data untype_Optimized x) (untype_data untype_Optimized y)) l) in
+            Return (@syntax.Concrete_big_map a b l)
+          ).
+          rewrite H.
+          reflexivity.
       + simpl.
         rewrite untype_type_check_instruction_seq; auto.
       + simpl.
@@ -1063,6 +1092,26 @@ Inductive untype_mode := untype_Readable | untype_Optimized.
             f_equal.
             apply IHl.
             assumption.
+        + simpl.
+          f_equal.
+          match goal with | H : ?F l = Return x |- _ => pose F as type_data_list end.
+          change (type_data_list l = Return x) in H.
+          assert (exists l', l' = l) as Hl' by (exists l; reflexivity).
+          rename l into linit.
+          destruct Hl' as (l, Hl).
+          rewrite <- Hl in H.
+          rewrite <- Hl.
+          clear Hl.
+          generalize dependent x.
+          induction l; simpl in *.
+          * repeat mytac type_untype type_untype_seq type_untype_data.
+          * repeat mytac type_untype type_untype_seq type_untype_data.
+            destruct a0; try discriminate.
+            repeat mytac type_untype type_untype_seq type_untype_data.
+            simpl.
+            f_equal.
+            apply IHl.
+            assumption.
       - repeat mytac type_untype type_untype_seq type_untype_data.
     }
   Qed.
-- 
GitLab


From f9e5a882f34b64ede1a4cb7c2f9e3e729e3be825 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Wed, 15 Apr 2020 15:43:50 +0200
Subject: [PATCH 36/56] Fix the semantics of EDIV

---
 src/michocoq/semantics.v | 121 ++++++++++++++++++++++++++++++++++++++-
 1 file changed, 119 insertions(+), 2 deletions(-)

diff --git a/src/michocoq/semantics.v b/src/michocoq/semantics.v
index eb390c61..7cd5393f 100644
--- a/src/michocoq/semantics.v
+++ b/src/michocoq/semantics.v
@@ -22,7 +22,7 @@
 
 (* Operational semantics of the Michelson language *)
 
-Require Import ZArith.
+Require Import ZArith Lia.
 Require Import String.
 Require Import syntax macros.
 Require NPeano.
@@ -405,10 +405,127 @@ Module Semantics(C : ContractContext).
     end.
 
   Definition ediv_Z x y :=
-    if (y =? 0)%Z then None else Some (x / y, Z.to_N (x mod y))%Z.
+    (if y =? 0 then None else
+      let d := x / y in
+      let r := x mod y in
+      if y >? 0 then Some (d, Z.to_N r)
+      else if r =? 0 then Some (d, 0%N)
+           else Some (d + 1, Z.to_N (r - y)))%Z.
+
+  Lemma ediv_Z_correct_pos x y (Hy : (y > 0)%Z) d r :
+    (Some (x / y, Z.to_N (x mod y)) = Some (d, r) <-> (y * d + Z.of_N r = x /\ 0 <= Z.of_N r < Z.abs y))%Z.
+  Proof.
+    rewrite Z.abs_eq; [|lia].
+    split.
+    - intro H; injection H; clear H.
+      intros; subst.
+      assert (0 <= x mod y < y)%Z as Hbound by (apply Z.mod_pos_bound; lia).
+      rewrite Z2N.id; [|apply Hbound].
+      split; [|assumption].
+      symmetry.
+      apply Z_div_mod_eq.
+      assumption.
+    - intros (He, Hbound).
+      f_equal.
+      assert (d = x / y)%Z.
+      + subst x.
+        rewrite Z.mul_comm.
+        rewrite Z_div_plus_full_l; [|lia].
+        assert (Z.of_N r / y = 0)%Z as Hr by (apply Z.div_small_iff; lia).
+        lia.
+      + subst d.
+        f_equal.
+        rewrite Zmod_eq; [|lia].
+        assert (x - x / y * y = Z.of_N r)%Z as Hr by lia.
+        rewrite Hr.
+        apply N2Z.id.
+  Qed.
+
+  Lemma ediv_Z_correct x y d r :
+    ediv_Z x y = Some (d, r) <-> (y * d + Z.of_N r = x /\ 0 <= Z.of_N r < Z.abs y)%Z.
+  Proof.
+    unfold ediv_Z.
+    case_eq (y =? 0)%Z.
+    - intro Hy.
+      apply Z.eqb_eq in Hy.
+      subst y.
+      simpl.
+      split.
+      + discriminate.
+      + intros (_, Habs).
+        exfalso.
+        lia.
+    - intro Hy.
+      apply Z.eqb_neq in Hy.
+      case_eq (y >? 0)%Z.
+      + intro Hy2.
+        apply Z.gtb_lt in Hy2.
+        apply ediv_Z_correct_pos; lia.
+      + intro Hy2.
+        rewrite Z.gtb_ltb in Hy2.
+        rewrite Z.ltb_ge in Hy2.
+        assert (- y > 0)%Z as Hym by lia.
+        specialize (ediv_Z_correct_pos x (- y) Hym (- d) r); intro Hm.
+        rewrite Z.abs_opp in Hm.
+        case_eq (x mod y =? 0)%Z.
+        * intro Hr.
+          apply Z.eqb_eq in Hr.
+          assert (x mod - y = 0)%Z as Hmodm by (apply Z_mod_zero_opp_r; assumption).
+          rewrite Hmodm in Hm.
+          rewrite Z2N.inj_0 in Hm.
+          rewrite Z.mul_opp_opp in Hm.
+          rewrite <- Hm.
+          apply Z_div_zero_opp_r in Hr.
+          rewrite Hr.
+          split.
+          -- intuition congruence.
+          -- intro H; injection H; clear H.
+             intros.
+             f_equal.
+             f_equal; lia.
+        * intro Hr.
+          apply Z.eqb_neq in Hr.
+          assert (x mod - y = x mod y - y)%Z as Hmodm by (apply Z_mod_nz_opp_r; congruence).
+          rewrite Hmodm in Hm.
+          rewrite Z.mul_opp_opp in Hm.
+          rewrite <- Hm.
+          apply Z_div_nz_opp_r in Hr.
+          rewrite Hr.
+          split.
+          -- intro H; injection H; clear H.
+             intros.
+             f_equal.
+             f_equal; lia.
+          -- intro H; injection H; clear H.
+             intros.
+             f_equal.
+             f_equal; lia.
+  Qed.
+
   Definition ediv_N x y :=
     if (y =? 0)%N then None else Some (x / y, x mod y)%N.
 
+  Lemma ediv_N_correct x y (Hy : (y <> 0)%N) d r :
+    (Some (x / y, x mod y) = Some (d, r) <-> (y * d + r = x /\ r < y))%N.
+  Proof.
+    split.
+    - intro H; injection H; clear H.
+      intros; subst.
+      assert (x mod y < y)%N as Hbound by (apply N.mod_upper_bound; lia).
+      split; [|assumption].
+      symmetry.
+      apply N.div_mod.
+      assumption.
+    - intros (He, Hbound).
+      f_equal.
+      symmetry in He.
+      f_equal.
+      + symmetry.
+        apply N.div_unique with (r := r); assumption.
+      + symmetry.
+        apply N.mod_unique with (q := d); assumption.
+  Qed.
+
   Definition ediv a b c d (v : ediv_variant a b c d) : data a -> data b -> data (option (pair c d)) :=
     match v with
     | Ediv_variant_nat_nat => fun x y => ediv_N x y
-- 
GitLab


From c375c1fdfc2edabda034691e2ff6fdedfd676076 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Thu, 16 Apr 2020 11:43:32 +0200
Subject: [PATCH 37/56] Export of Zarith div and modulo; seems to have no
 effect for now

---
 src/michocoq/extraction/extraction.v | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/michocoq/extraction/extraction.v b/src/michocoq/extraction/extraction.v
index a9b8699e..ac352434 100644
--- a/src/michocoq/extraction/extraction.v
+++ b/src/michocoq/extraction/extraction.v
@@ -86,6 +86,8 @@ Extract Constant Z.abs => "Zarith.abs".
 Extract Constant Z.min => "Zarith.min".
 Extract Constant Z.max => "Zarith.max".
 Extract Constant Z.compare => "fun x y -> Zarith.(if x < y then Lt else if x > y then Gt else Eq)".
+Extract Constant Z.div => "Zarith.div".
+Extract Constant Z.modulo => "Zarith.rem".
 
 Extract Constant Z.of_N => "fun p -> p".
 Extract Constant Z.abs_N => "Zarith.abs".
-- 
GitLab


From c4eb2d6e8d6680b24b48bd8aa50f604dc77254be Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Fri, 17 Apr 2020 23:22:21 +0200
Subject: [PATCH 38/56] Override extraction of ediv

---
 src/michocoq/extraction/extraction.v |  15 +-
 src/michocoq/semantics.v             | 245 ++++++++++++++-------------
 2 files changed, 135 insertions(+), 125 deletions(-)

diff --git a/src/michocoq/extraction/extraction.v b/src/michocoq/extraction/extraction.v
index ac352434..7aeade10 100644
--- a/src/michocoq/extraction/extraction.v
+++ b/src/michocoq/extraction/extraction.v
@@ -28,7 +28,7 @@ Extract Constant Ascii.ascii_of_pos => "(fun x -> Char.chr (Zarith.to_int x))".
 (* Require Import Michocoq.semantics. *)
 (* Recursive Extraction Library semantics. *)
 Require Import Michocoq.comparable Michocoq.int64bv Michocoq.typer Michocoq.micheline_lexer Michocoq.micheline_parser
-Michocoq.micheline2michelson Michocoq.main.
+Michocoq.micheline2michelson Michocoq.semantics Michocoq.main.
 (* Recursive Extraction Library micheline_lexer. *)
 (* Recursive Extraction Library micheline_parser. *)
 
@@ -85,9 +85,18 @@ Extract Constant Z.opp => "Zarith.neg".
 Extract Constant Z.abs => "Zarith.abs".
 Extract Constant Z.min => "Zarith.min".
 Extract Constant Z.max => "Zarith.max".
+Extract Constant Z.land => "Zarith.logand".
+Extract Constant ediv_Z => "fun x y -> try
+    let (q, r) = Zarith.ediv_rem x y in
+    Some (q, r)
+  with _ -> None".
+
+
+Extract Constant Z.div =>
+ "fun a b -> Zarith.(if b = zero then zero else Zarith.div a b)".
+Extract Constant Z.modulo =>
+ "fun a b -> Zarith.(if b = zero then zero else Zarith.rem a b)".
 Extract Constant Z.compare => "fun x y -> Zarith.(if x < y then Lt else if x > y then Gt else Eq)".
-Extract Constant Z.div => "Zarith.div".
-Extract Constant Z.modulo => "Zarith.rem".
 
 Extract Constant Z.of_N => "fun p -> p".
 Extract Constant Z.abs_N => "Zarith.abs".
diff --git a/src/michocoq/semantics.v b/src/michocoq/semantics.v
index 7cd5393f..3004163b 100644
--- a/src/michocoq/semantics.v
+++ b/src/michocoq/semantics.v
@@ -35,6 +35,129 @@ Module Type ContractContext.
     smart_contract_address_constant -> Datatypes.option type.
 End ContractContext.
 
+
+Definition ediv_Z x y :=
+  (if y =? 0 then None else
+     let d := x / y in
+     let r := x mod y in
+     if y >? 0 then Some (d, Z.to_N r)
+     else if r =? 0 then Some (d, 0%N)
+          else Some (d + 1, Z.to_N (r - y)))%Z.
+
+Lemma ediv_Z_correct_pos x y (Hy : (y > 0)%Z) d r :
+  (Some (x / y, Z.to_N (x mod y)) = Some (d, r) <-> (y * d + Z.of_N r = x /\ 0 <= Z.of_N r < Z.abs y))%Z.
+Proof.
+  rewrite Z.abs_eq; [|lia].
+  split.
+  - intro H; injection H; clear H.
+    intros; subst.
+    assert (0 <= x mod y < y)%Z as Hbound by (apply Z.mod_pos_bound; lia).
+    rewrite Z2N.id; [|apply Hbound].
+    split; [|assumption].
+    symmetry.
+    apply Z_div_mod_eq.
+    assumption.
+  - intros (He, Hbound).
+    f_equal.
+    assert (d = x / y)%Z.
+    + subst x.
+      rewrite Z.mul_comm.
+      rewrite Z_div_plus_full_l; [|lia].
+      assert (Z.of_N r / y = 0)%Z as Hr by (apply Z.div_small_iff; lia).
+      lia.
+    + subst d.
+      f_equal.
+      rewrite Zmod_eq; [|lia].
+      assert (x - x / y * y = Z.of_N r)%Z as Hr by lia.
+      rewrite Hr.
+      apply N2Z.id.
+Qed.
+
+Lemma ediv_Z_correct x y d r :
+  ediv_Z x y = Some (d, r) <-> (y * d + Z.of_N r = x /\ 0 <= Z.of_N r < Z.abs y)%Z.
+Proof.
+  unfold ediv_Z.
+  case_eq (y =? 0)%Z.
+  - intro Hy.
+    apply Z.eqb_eq in Hy.
+    subst y.
+    simpl.
+    split.
+    + discriminate.
+    + intros (_, Habs).
+      exfalso.
+      lia.
+  - intro Hy.
+    apply Z.eqb_neq in Hy.
+    case_eq (y >? 0)%Z.
+    + intro Hy2.
+      apply Z.gtb_lt in Hy2.
+      apply ediv_Z_correct_pos; lia.
+    + intro Hy2.
+      rewrite Z.gtb_ltb in Hy2.
+      rewrite Z.ltb_ge in Hy2.
+      assert (- y > 0)%Z as Hym by lia.
+      specialize (ediv_Z_correct_pos x (- y) Hym (- d) r); intro Hm.
+      rewrite Z.abs_opp in Hm.
+      case_eq (x mod y =? 0)%Z.
+      * intro Hr.
+        apply Z.eqb_eq in Hr.
+        assert (x mod - y = 0)%Z as Hmodm by (apply Z_mod_zero_opp_r; assumption).
+        rewrite Hmodm in Hm.
+        rewrite Z2N.inj_0 in Hm.
+        rewrite Z.mul_opp_opp in Hm.
+        rewrite <- Hm.
+        apply Z_div_zero_opp_r in Hr.
+        rewrite Hr.
+        split.
+        -- intuition congruence.
+        -- intro H; injection H; clear H.
+           intros.
+           f_equal.
+           f_equal; lia.
+      * intro Hr.
+        apply Z.eqb_neq in Hr.
+        assert (x mod - y = x mod y - y)%Z as Hmodm by (apply Z_mod_nz_opp_r; congruence).
+        rewrite Hmodm in Hm.
+        rewrite Z.mul_opp_opp in Hm.
+        rewrite <- Hm.
+        apply Z_div_nz_opp_r in Hr.
+        rewrite Hr.
+        split.
+        -- intro H; injection H; clear H.
+           intros.
+           f_equal.
+           f_equal; lia.
+        -- intro H; injection H; clear H.
+           intros.
+           f_equal.
+           f_equal; lia.
+Qed.
+
+Definition ediv_N x y :=
+  if (y =? 0)%N then None else Some (x / y, x mod y)%N.
+
+Lemma ediv_N_correct x y (Hy : (y <> 0)%N) d r :
+  (Some (x / y, x mod y) = Some (d, r) <-> (y * d + r = x /\ r < y))%N.
+Proof.
+  split.
+  - intro H; injection H; clear H.
+    intros; subst.
+    assert (x mod y < y)%N as Hbound by (apply N.mod_upper_bound; lia).
+    split; [|assumption].
+    symmetry.
+    apply N.div_mod.
+    assumption.
+  - intros (He, Hbound).
+    f_equal.
+    symmetry in He.
+    f_equal.
+    + symmetry.
+      apply N.div_unique with (r := r); assumption.
+    + symmetry.
+      apply N.mod_unique with (q := d); assumption.
+Qed.
+
 Module Semantics(C : ContractContext).
   Export C.
 
@@ -404,128 +527,6 @@ Module Semantics(C : ContractContext).
     | Mul_variant_nat_tez => fun x y => tez.of_Z (Z.of_N x * tez.to_Z y)
     end.
 
-  Definition ediv_Z x y :=
-    (if y =? 0 then None else
-      let d := x / y in
-      let r := x mod y in
-      if y >? 0 then Some (d, Z.to_N r)
-      else if r =? 0 then Some (d, 0%N)
-           else Some (d + 1, Z.to_N (r - y)))%Z.
-
-  Lemma ediv_Z_correct_pos x y (Hy : (y > 0)%Z) d r :
-    (Some (x / y, Z.to_N (x mod y)) = Some (d, r) <-> (y * d + Z.of_N r = x /\ 0 <= Z.of_N r < Z.abs y))%Z.
-  Proof.
-    rewrite Z.abs_eq; [|lia].
-    split.
-    - intro H; injection H; clear H.
-      intros; subst.
-      assert (0 <= x mod y < y)%Z as Hbound by (apply Z.mod_pos_bound; lia).
-      rewrite Z2N.id; [|apply Hbound].
-      split; [|assumption].
-      symmetry.
-      apply Z_div_mod_eq.
-      assumption.
-    - intros (He, Hbound).
-      f_equal.
-      assert (d = x / y)%Z.
-      + subst x.
-        rewrite Z.mul_comm.
-        rewrite Z_div_plus_full_l; [|lia].
-        assert (Z.of_N r / y = 0)%Z as Hr by (apply Z.div_small_iff; lia).
-        lia.
-      + subst d.
-        f_equal.
-        rewrite Zmod_eq; [|lia].
-        assert (x - x / y * y = Z.of_N r)%Z as Hr by lia.
-        rewrite Hr.
-        apply N2Z.id.
-  Qed.
-
-  Lemma ediv_Z_correct x y d r :
-    ediv_Z x y = Some (d, r) <-> (y * d + Z.of_N r = x /\ 0 <= Z.of_N r < Z.abs y)%Z.
-  Proof.
-    unfold ediv_Z.
-    case_eq (y =? 0)%Z.
-    - intro Hy.
-      apply Z.eqb_eq in Hy.
-      subst y.
-      simpl.
-      split.
-      + discriminate.
-      + intros (_, Habs).
-        exfalso.
-        lia.
-    - intro Hy.
-      apply Z.eqb_neq in Hy.
-      case_eq (y >? 0)%Z.
-      + intro Hy2.
-        apply Z.gtb_lt in Hy2.
-        apply ediv_Z_correct_pos; lia.
-      + intro Hy2.
-        rewrite Z.gtb_ltb in Hy2.
-        rewrite Z.ltb_ge in Hy2.
-        assert (- y > 0)%Z as Hym by lia.
-        specialize (ediv_Z_correct_pos x (- y) Hym (- d) r); intro Hm.
-        rewrite Z.abs_opp in Hm.
-        case_eq (x mod y =? 0)%Z.
-        * intro Hr.
-          apply Z.eqb_eq in Hr.
-          assert (x mod - y = 0)%Z as Hmodm by (apply Z_mod_zero_opp_r; assumption).
-          rewrite Hmodm in Hm.
-          rewrite Z2N.inj_0 in Hm.
-          rewrite Z.mul_opp_opp in Hm.
-          rewrite <- Hm.
-          apply Z_div_zero_opp_r in Hr.
-          rewrite Hr.
-          split.
-          -- intuition congruence.
-          -- intro H; injection H; clear H.
-             intros.
-             f_equal.
-             f_equal; lia.
-        * intro Hr.
-          apply Z.eqb_neq in Hr.
-          assert (x mod - y = x mod y - y)%Z as Hmodm by (apply Z_mod_nz_opp_r; congruence).
-          rewrite Hmodm in Hm.
-          rewrite Z.mul_opp_opp in Hm.
-          rewrite <- Hm.
-          apply Z_div_nz_opp_r in Hr.
-          rewrite Hr.
-          split.
-          -- intro H; injection H; clear H.
-             intros.
-             f_equal.
-             f_equal; lia.
-          -- intro H; injection H; clear H.
-             intros.
-             f_equal.
-             f_equal; lia.
-  Qed.
-
-  Definition ediv_N x y :=
-    if (y =? 0)%N then None else Some (x / y, x mod y)%N.
-
-  Lemma ediv_N_correct x y (Hy : (y <> 0)%N) d r :
-    (Some (x / y, x mod y) = Some (d, r) <-> (y * d + r = x /\ r < y))%N.
-  Proof.
-    split.
-    - intro H; injection H; clear H.
-      intros; subst.
-      assert (x mod y < y)%N as Hbound by (apply N.mod_upper_bound; lia).
-      split; [|assumption].
-      symmetry.
-      apply N.div_mod.
-      assumption.
-    - intros (He, Hbound).
-      f_equal.
-      symmetry in He.
-      f_equal.
-      + symmetry.
-        apply N.div_unique with (r := r); assumption.
-      + symmetry.
-        apply N.mod_unique with (q := d); assumption.
-  Qed.
-
   Definition ediv a b c d (v : ediv_variant a b c d) : data a -> data b -> data (option (pair c d)) :=
     match v with
     | Ediv_variant_nat_nat => fun x y => ediv_N x y
-- 
GitLab


From cbd29fdc312a20e2e37a28252eb7e8461e7549f6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Thu, 16 Apr 2020 11:43:55 +0200
Subject: [PATCH 39/56] Bytes

---
 src/michocoq/bytes_repr.v                     | 250 ++++++++++++++++++
 .../extraction/michocoq.ml.hand-written       |   6 +-
 src/michocoq/micheline_lexer.v                |  17 +-
 src/michocoq/micheline_pp.v                   |   6 +-
 4 files changed, 269 insertions(+), 10 deletions(-)
 create mode 100644 src/michocoq/bytes_repr.v

diff --git a/src/michocoq/bytes_repr.v b/src/michocoq/bytes_repr.v
new file mode 100644
index 00000000..553181ef
--- /dev/null
+++ b/src/michocoq/bytes_repr.v
@@ -0,0 +1,250 @@
+(* Open Source License *)
+(* Copyright (c) 2020 Nomadic Labs. <contact@nomadic-labs.com> *)
+
+(* Permission is hereby granted, free of charge, to any person obtaining a *)
+(* copy of this software and associated documentation files (the "Software"), *)
+(* to deal in the Software without restriction, including without limitation *)
+(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
+(* and/or sell copies of the Software, and to permit persons to whom the *)
+(* Software is furnished to do so, subject to the following conditions: *)
+
+(* The above copyright notice and this permission notice shall be included *)
+(* in all copies or substantial portions of the Software. *)
+
+(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR *)
+(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
+(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
+(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *)
+(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
+(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
+(* DEALINGS IN THE SOFTWARE. *)
+
+
+(* Manipulation of sequences of bytes *)
+Require Import String Ascii ZArith Lia.
+Require error.
+Import error.Notations.
+Require Import ListString.All.
+
+Definition byte := ascii.
+Definition bytes := string.
+
+Open Scope N_scope.
+Open Scope char_scope.
+
+Definition is_hexa_char (c : ascii) : bool :=
+  match c with
+  | "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9"
+  | "a" | "A" | "b" | "B" | "c" | "C" | "d" | "D" | "e" | "E" | "f" | "F" => true
+  | _ => false
+  end.
+
+Definition read_hexa (c : ascii) : Bool.Is_true (is_hexa_char c) -> N :=
+  match c with
+  | "0" => fun _ => 0
+  | "1" => fun _ => 1
+  | "2" => fun _ => 2
+  | "3" => fun _ => 3
+  | "4" => fun _ => 4
+  | "5" => fun _ => 5
+  | "6" => fun _ => 6
+  | "7" => fun _ => 7
+  | "8" => fun _ => 8
+  | "9" => fun _ => 9
+  | "a" | "A" => fun _ => 10
+  | "b" | "B" => fun _ => 11
+  | "c" | "C" => fun _ => 12
+  | "d" | "D" => fun _ => 13
+  | "e" | "E" => fun _ => 14
+  | "f" | "F" => fun _ => 15
+  | c => fun H => match H with end
+  end.
+
+Definition pp_hexa (n : N) (H : n < 16) : ascii :=
+  if (n <? 10) then ascii_of_N (n + 48) else ascii_of_N (n + 87).
+
+Lemma arith_aux m n : m < n + 1 <-> m < n \/ m = n.
+Proof.
+  lia.
+Qed.
+
+Lemma arith_aux2 n : n < 1 <-> n = 0.
+Proof.
+  lia.
+Qed.
+
+Lemma is_hexa_pp_hexa n H : Bool.Is_true (is_hexa_char (pp_hexa n H)).
+Proof.
+  assert (n < 16) as H' by assumption.
+  rewrite (arith_aux n 15) in H'.
+  rewrite (arith_aux n 14) in H'.
+  rewrite (arith_aux n 13) in H'.
+  rewrite (arith_aux n 12) in H'.
+  rewrite (arith_aux n 11) in H'.
+  rewrite (arith_aux n 10) in H'.
+  rewrite (arith_aux n 9) in H'.
+  rewrite (arith_aux n 8) in H'.
+  rewrite (arith_aux n 7) in H'.
+  rewrite (arith_aux n 6) in H'.
+  rewrite (arith_aux n 5) in H'.
+  rewrite (arith_aux n 4) in H'.
+  rewrite (arith_aux n 3) in H'.
+  rewrite (arith_aux n 2) in H'.
+  rewrite (arith_aux n 1) in H'.
+  repeat (destruct H' as [H'|He]; [|subst n; constructor]).
+  apply arith_aux2 in H'.
+  subst n; constructor.
+Qed.
+
+Lemma read_pp_hexa n H : read_hexa (pp_hexa n H) (is_hexa_pp_hexa n H) = n.
+Proof.
+  assert (n < 16) as H' by assumption.
+  rewrite (arith_aux n 15) in H'.
+  rewrite (arith_aux n 14) in H'.
+  rewrite (arith_aux n 13) in H'.
+  rewrite (arith_aux n 12) in H'.
+  rewrite (arith_aux n 11) in H'.
+  rewrite (arith_aux n 10) in H'.
+  rewrite (arith_aux n 9) in H'.
+  rewrite (arith_aux n 8) in H'.
+  rewrite (arith_aux n 7) in H'.
+  rewrite (arith_aux n 6) in H'.
+  rewrite (arith_aux n 5) in H'.
+  rewrite (arith_aux n 4) in H'.
+  rewrite (arith_aux n 3) in H'.
+  rewrite (arith_aux n 2) in H'.
+  rewrite (arith_aux n 1) in H'.
+  repeat (destruct H' as [H'|He]; [|subst n; reflexivity]).
+  apply arith_aux2 in H'.
+  subst n; reflexivity.
+Qed.
+
+Lemma read_hexa_lt_16 c H : read_hexa c H < 16.
+Proof.
+  destruct c as [[|] [|] [|] [|] [|] [|] [|] [|]];
+    simpl in H; try contradiction; simpl; lia.
+Qed.
+
+Lemma pp_read_hexa c H : pp_hexa (read_hexa c H) (read_hexa_lt_16 c H) = ListString.Char.down_case c.
+Proof.
+  destruct c as [[|] [|] [|] [|] [|] [|] [|] [|]];
+    simpl in H; try contradiction; reflexivity.
+Qed.
+
+Definition read_2_hexa c1 H1 c2 H2 : N :=
+  let n1 := read_hexa c1 H1 in
+  let n2 := read_hexa c2 H2 in
+  16 * n1 + n2.
+
+Lemma read_2_hexa_lt_256 c1 H1 c2 H2 : read_2_hexa c1 H1 c2 H2 < 256.
+Proof.
+  unfold read_2_hexa.
+  specialize (read_hexa_lt_16 c1 H1).
+  specialize (read_hexa_lt_16 c2 H2).
+  lia.
+Qed.
+
+Definition high_half (n : N) (H : n < 256) : N := n / 16.
+Definition low_half (n : N) (H : n < 256) : N := n mod 16.
+
+Lemma high_lt_16 n H : high_half n H < 16.
+Proof.
+  apply (N.div_lt_upper_bound n 16 16).
+  - lia.
+  - exact H.
+Qed.
+
+Lemma low_lt_16 n H : low_half n H < 16.
+Proof.
+  apply N.mod_upper_bound.
+  lia.
+Qed.
+
+Definition pp_2_hexa (n : N) (H : n < 256) :=
+  let h := high_half n H in
+  let l := low_half n H in
+  let Hh : h < 16 := high_lt_16 n H in
+  let Hl : l < 16 := low_lt_16 n H in
+  let c1 := pp_hexa h Hh in
+  let c2 := pp_hexa l Hl in
+  String c1 (String c2 ""%string).
+
+Definition read_byte c1 H1 c2 H2 : byte :=
+  ascii_of_N (read_2_hexa c1 H1 c2 H2).
+
+(* This is proved in stdlib but only from Coq 8.10. *)
+Lemma N_ascii_bounded (a : ascii) : N_of_ascii a < 256.
+Proof.
+  destruct a as [[|] [|] [|] [|] [|] [|] [|] [|]]; simpl; lia.
+Qed.
+
+Definition pp_byte (b : byte) : string :=
+  pp_2_hexa (N_of_ascii b) (N_ascii_bounded b).
+
+Close Scope N_scope.
+
+Fixpoint forallb {A} (P : A -> bool) (l : list A) : bool :=
+  match l with
+  | nil => true
+  | cons a l => (P a && forallb P l)%bool
+  end.
+
+(* Redefinition of stdlib lemmas because we need them to compute *)
+Definition andb_prop a b : (a && b)%bool = true -> a = true /\ b = true.
+Proof.
+  destruct a; destruct b; try discriminate; split; reflexivity.
+Defined.
+
+Definition andb_prop_elim a b : Bool.Is_true (a && b) -> Bool.Is_true a /\ Bool.Is_true b.
+Proof.
+  destruct a; destruct b; try contradiction; split; constructor.
+Defined.
+
+Fixpoint of_list_char (s : list ascii) (H : Bool.Is_true (forallb is_hexa_char s)) (Hl : (N.of_nat (List.length s) mod 2 = 0)%N) : bytes.
+Proof.
+  destruct s as [|c1 [|c2 s]].
+  - exact ""%string.
+  - simpl in Hl.
+    compute in Hl.
+    exfalso.
+    lia.
+  - change (Datatypes.length (c1 :: c2 :: s)%list) with (2 + Datatypes.length s) in Hl.
+    rewrite Nnat.Nat2N.inj_add in Hl.
+    rewrite <- N.add_mod_idemp_l in Hl; [|lia].
+    simpl in Hl.
+    simpl in H.
+    apply andb_prop_elim in H.
+    destruct H as (H1, H).
+    apply andb_prop_elim in H.
+    destruct H as (H2, H).
+    apply (String (read_byte c1 H1 c2 H2)).
+    apply (of_list_char s H Hl).
+Defined.
+
+Definition of_string (s : string) : option bytes.
+Proof.
+  pose (l := LString.of_string s).
+  case_eq (forallb is_hexa_char l && (N.of_nat (List.length l) mod 2 =? 0)%N)%bool.
+  - intro Htrue.
+    apply andb_prop in Htrue.
+    destruct Htrue as (H, Hl).
+    apply error.IT_eq_rev in H.
+    apply Neqb_ok in Hl.
+    apply Some.
+    apply (of_list_char l H Hl).
+  - intro; apply None.
+Defined.
+
+Fixpoint to_string (bs : bytes) : string :=
+  match bs with
+  | ""%string => ""%string
+  | String b bs =>
+    pp_byte b ++ to_string bs
+  end.
+
+Eval compute in
+    (match of_string "0123456789abcdefABCDEF" with
+     | Some bs => Some (to_string bs)
+     | None => None
+     end).
+
diff --git a/src/michocoq/extraction/michocoq.ml.hand-written b/src/michocoq/extraction/michocoq.ml.hand-written
index 63ac130e..16b14189 100644
--- a/src/michocoq/extraction/michocoq.ml.hand-written
+++ b/src/michocoq/extraction/michocoq.ml.hand-written
@@ -1,11 +1,11 @@
 (* Conversion functions between Coq and OCaml strings, taken from CompCert. *)
 
 let camlstring_of_coqstring (s : char list) =
-  let r = Bytes.create (Stdlib.List.length s) in
+  let r = Stdlib.Bytes.create (Stdlib.List.length s) in
   let rec fill pos = function
     | [] -> r
-    | c :: s -> Bytes.set r pos c; fill (pos + 1) s
-  in Bytes.to_string (fill 0 s)
+    | c :: s -> Stdlib.Bytes.set r pos c; fill (pos + 1) s
+  in Stdlib.Bytes.to_string (fill 0 s)
 
 let coqstring_of_camlstring s =
   let rec cstring accu pos =
diff --git a/src/michocoq/micheline_lexer.v b/src/michocoq/micheline_lexer.v
index b6ba2aa7..0e2d3fab 100644
--- a/src/michocoq/micheline_lexer.v
+++ b/src/michocoq/micheline_lexer.v
@@ -1,5 +1,5 @@
 Require Import List String Ascii ZArith.
-Require error micheline_parser.
+Require error micheline_parser bytes_repr.
 Require Import micheline_tokens location.
 Import error.Notations.
 
@@ -72,6 +72,12 @@ Definition Z_of_char (c : ascii) (acc : Z) : Z :=
 
 Definition string_snoc s c := (s ++ String c "")%string.
 
+Definition bytes_of_string loc (s : string) :=
+  match bytes_repr.of_string s with
+  | Some bs => error.Return bs
+  | None => error.Failed _ (error.Lexing loc)
+ end.
+
 Fixpoint lex_micheline (input : string) (loc : location) : error.M (list (location.location * location.location * token)) :=
   match input with
   | String first_char input =>
@@ -130,9 +136,12 @@ Fixpoint lex_micheline (input : string) (loc : location) : error.M (list (locati
                let loc := location_incr loc in
                lex_micheline_bytes s (string_snoc acc c) start loc
              else
-              let! l := lex_micheline input loc in
-              error.Return (cons (start, loc, BYTES acc) l)
-           | EmptyString => error.Return (cons (start, loc, BYTES acc) nil)
+               let! l := lex_micheline input loc in
+               let! bs := bytes_of_string start acc in
+              error.Return (cons (start, loc, BYTES bs) l)
+           | EmptyString =>
+               let! bs := bytes_of_string start acc in
+               error.Return (cons (start, loc, BYTES bs) nil)
            end) s EmptyString loc (location_incr (location_incr loc))
       | String c s =>
         if char_is_num c then error.Failed _ (error.Lexing loc)
diff --git a/src/michocoq/micheline_pp.v b/src/michocoq/micheline_pp.v
index cc644572..9971f02f 100644
--- a/src/michocoq/micheline_pp.v
+++ b/src/michocoq/micheline_pp.v
@@ -23,7 +23,7 @@ Fixpoint micheline_length (mich : loc_micheline) (in_seq : bool) :=
   match m with
   | NUMBER z => String.length (string_of_Z z)
   | STR s => 2 + String.length s
-  | BYTES s => 2 + String.length s
+  | BYTES s => 2 + 2 * String.length s
   | SEQ nil => 2
   | SEQ es => fold_left (fun acc m => 2 + micheline_length m true + acc) es 0
   | PRIM (_, _, s) nil => String.length s
@@ -37,7 +37,7 @@ Fixpoint micheline_pp_single_line (mich : loc_micheline) (in_seq : bool) :=
   match m with
   | NUMBER z => string_of_Z z
   | STR s => """" ++ s ++ """"
-  | BYTES s => "0x" ++ s
+  | BYTES bs => "0x" ++ (bytes_repr.to_string bs)
   | SEQ es => "{" ++ String.concat "; " (map (fun m => micheline_pp_single_line m true) es) ++ "}"
   | PRIM (_, _, s) nil => s
   | PRIM (_, _, s) es =>
@@ -53,7 +53,7 @@ Fixpoint micheline_pp (mich : loc_micheline) (indent : nat) (in_seq : bool)
   match mich with
   | Mk_loc_micheline (_, _, NUMBER z) => (string_of_Z z)
   | Mk_loc_micheline (_, _, STR s) => """"++s++""""
-  | Mk_loc_micheline (_, _, BYTES s) => "0x"++s
+  | Mk_loc_micheline (_, _, BYTES bs) => "0x"++bytes_repr.to_string bs
   | Mk_loc_micheline (_, _, SEQ es) =>
     let indent_space := (make_string " " indent) in
     let separator := (";"  ++ lf ++ indent_space ++ "  ") in
-- 
GitLab


From d45009546172e67b6aff86c6bbdedf20271036c2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Wed, 22 Apr 2020 16:00:01 +0200
Subject: [PATCH 40/56] Fix typing of chain_id constants (bytes instead of
 strings)

---
 src/michocoq/typer.v   | 2 +-
 src/michocoq/untyper.v | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/michocoq/typer.v b/src/michocoq/typer.v
index c97a16c7..a8a59222 100644
--- a/src/michocoq/typer.v
+++ b/src/michocoq/typer.v
@@ -615,13 +615,13 @@ Qed.
               Failed _ (Typing _ ("Cannot parse timestamp according to rfc3339"%string, s))
             end
           end
-        | chain_id => Return (syntax.Chain_id_constant (syntax.Mk_chain_id s))
         | _ => Failed _ (Typing _ (d, ty))
         end
     | Bytes_constant s =>
       fun ty =>
         match ty with
         | Comparable_type bytes => Return (syntax.Bytes_constant s)
+        | chain_id => Return (syntax.Chain_id_constant (syntax.Mk_chain_id s))
         | _ => Failed _ (Typing _ (d, ty))
         end
     | Unit =>
diff --git a/src/michocoq/untyper.v b/src/michocoq/untyper.v
index 311aa05b..a26f2f4f 100644
--- a/src/michocoq/untyper.v
+++ b/src/michocoq/untyper.v
@@ -141,7 +141,7 @@ Inductive untype_mode := untype_Readable | untype_Optimized.
                       (fun '(syntax.Elt _ _ x y) => Elt (untype_data um x) (untype_data um y))
                       l)
     | syntax.Instruction _ i => Instruction (untype_instruction_seq um i)
-    | syntax.Chain_id_constant (Mk_chain_id c) => String_constant c
+    | syntax.Chain_id_constant (Mk_chain_id c) => Bytes_constant c
     end
   with
   untype_instruction {self_type tff0 A B} (um : untype_mode) (i : syntax.instruction self_type tff0 A B) : instruction :=
-- 
GitLab


From b191aa26c455319de88248286ae136842eddd64c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Tue, 14 Apr 2020 16:38:09 +0200
Subject: [PATCH 41/56] [michocoq]] Add a file about decidable types

A type is said to be decidable if equality on this type is a decidable
relation. The type A is decidable if we have

forall x y : A, {x = y} + {x <> y}.

Decidability is an important notion for unit tests of the eval
function because we need to compare stacks.
---
 src/michocoq/comparable.v      |  6 +++
 src/michocoq/decidable_types.v | 74 ++++++++++++++++++++++++++++++++++
 src/michocoq/map.v             | 21 +++++++++-
 src/michocoq/semantics.v       | 50 ++++++++++++++++++++++-
 src/michocoq/set.v             | 30 +++++++-------
 5 files changed, 163 insertions(+), 18 deletions(-)
 create mode 100644 src/michocoq/decidable_types.v

diff --git a/src/michocoq/comparable.v b/src/michocoq/comparable.v
index bae478a4..d47f8942 100644
--- a/src/michocoq/comparable.v
+++ b/src/michocoq/comparable.v
@@ -495,3 +495,9 @@ Proof.
   apply map.compare_diff.
   apply compare_eq_iff.
 Qed.
+
+Lemma comparable_data_dec {a : comparable_type} (x y : comparable_data a) :
+  {x = y} + {x <> y}.
+Proof.
+  apply (decidable_types.comparable_decidable (compare_eq_iff a)).
+Qed.
diff --git a/src/michocoq/decidable_types.v b/src/michocoq/decidable_types.v
new file mode 100644
index 00000000..2773e55e
--- /dev/null
+++ b/src/michocoq/decidable_types.v
@@ -0,0 +1,74 @@
+Require Eqdep_dec.
+
+Definition decidable (A : Set) := forall x y : A, {x = y} + {x <> y}.
+
+Lemma decidable_UIP {A : Set} : decidable A -> forall x y : A, forall H1 H2 : x = y, H1 = H2.
+Proof.
+  apply Eqdep_dec.UIP_dec.
+Qed.
+
+Lemma decidable_UIP_refl {A : Set} : decidable A -> forall x : A, forall H : x = x, H = eq_refl.
+Proof.
+  intros HA x H.
+  apply decidable_UIP.
+  assumption.
+Qed.
+
+Lemma list_dec {A : Set} : decidable A -> decidable (Datatypes.list A).
+Proof.
+  unfold decidable.
+  decide equality.
+Defined.
+
+Lemma option_dec {A : Set} : decidable A -> decidable (Datatypes.option A).
+Proof.
+  unfold decidable.
+  decide equality.
+Defined.
+
+Lemma pair_dec {A B : Set} : decidable A -> decidable B -> decidable (A * B).
+Proof.
+  unfold decidable.
+  decide equality.
+Defined.
+
+Lemma or_dec {A B : Set} : decidable A -> decidable B -> decidable (A + B).
+Proof.
+  unfold decidable.
+  decide equality.
+Defined.
+
+Lemma sigT_dec {A : Set} {B : A -> Set} :
+  decidable A ->
+  (forall x : A, decidable (B x)) ->
+  decidable (sigT B).
+Proof.
+  intros HA HB xy1 xy2.
+  case (HA (projT1 xy1) (projT1 xy2)).
+  - intro Hx.
+    case (HB _ (projT2 xy2) (eq_rec (projT1 xy1) B (projT2 xy1) (projT1 xy2) Hx)).
+    + intro Hy.
+      left.
+      destruct xy1 as (x1, y1).
+      destruct xy2 as (x2, y2).
+      simpl in *.
+      destruct Hx.
+      simpl in Hy.
+      congruence.
+    + intro Hy.
+      right; intro Hxy.
+      destruct Hxy.
+      assert (Hx = eq_refl) by (apply decidable_UIP_refl; assumption).
+      subst Hx.
+      simpl in Hy.
+      congruence.
+  - intuition congruence.
+Defined.
+
+Lemma comparable_decidable {A : Set} {compare : A -> A -> comparison} :
+  (forall x y : A, compare x y = Eq <-> x = y) ->
+  decidable A.
+Proof.
+  intros Hcomparable x y. specialize (Hcomparable x y).
+  case_eq (compare x y); intuition congruence.
+Defined.
diff --git a/src/michocoq/map.v b/src/michocoq/map.v
index ad80bfe7..c6cacc80 100644
--- a/src/michocoq/map.v
+++ b/src/michocoq/map.v
@@ -22,7 +22,7 @@
 
 (* Finite maps implemented as finite sets of pairs. *)
 
-Require set.
+Require set decidable_types.
 Require Import error.
 Import error.Notations.
 
@@ -508,6 +508,25 @@ Section map.
       apply set.sorted_irrel.
   Qed.
 
+  Lemma A_dec (a1 a2 : A) : {a1 = a2} + {a1 <> a2}.
+  Proof.
+    exact (decidable_types.comparable_decidable compare_eq_iff a1 a2).
+  Qed.
+
+  Hypothesis B_dec : forall b1 b2 : B, {b1 = b2} + {b1 <> b2}.
+
+  Lemma map_dec (m1 m2 : map) : {m1 = m2} + {m1 <> m2}.
+  Proof.
+    destruct m1 as (l1, H1).
+    destruct m2 as (l2, H2).
+    case (decidable_types.list_dec (decidable_types.pair_dec A_dec B_dec) l1 l2).
+    - intro H; destruct H.
+      left.
+      f_equal.
+      apply set.sorted_irrel.
+    - intuition congruence.
+  Qed.
+
   (* Interesting lemmas to use when working with maps *)
 
   Lemma map_getmem : forall k m v, 
diff --git a/src/michocoq/semantics.v b/src/michocoq/semantics.v
index 3004163b..1b00d732 100644
--- a/src/michocoq/semantics.v
+++ b/src/michocoq/semantics.v
@@ -25,7 +25,7 @@
 Require Import ZArith Lia.
 Require Import String.
 Require Import syntax macros.
-Require NPeano.
+Require NPeano Eqdep_dec.
 
 Require Import comparable error.
 Import error.Notations.
@@ -158,6 +158,11 @@ Proof.
       apply N.mod_unique with (q := d); assumption.
 Qed.
 
+Lemma instruction_dec self_info tff A B : decidable_types.decidable (instruction self_info tff A B).
+Proof.
+  admit.
+Admitted.
+
 Module Semantics(C : ContractContext).
   Export C.
 
@@ -193,6 +198,49 @@ Module Semantics(C : ContractContext).
     | chain_id => chain_id_constant
     end.
 
+  Lemma address_dec : forall x y : address_constant, {x = y} + {x <> y}.
+  Proof.
+    repeat decide equality.
+  Defined.
+
+  Lemma data_dec {a : type} : forall x y : data a, {x = y} + {x <> y}.
+  Proof.
+    induction a; simpl.
+    - intros x y.
+      apply (@comparable.comparable_data_dec (Comparable_type_simple s)).
+    - repeat decide equality.
+    - repeat decide equality.
+    - repeat decide equality.
+    - apply decidable_types.option_dec.
+      assumption.
+    - apply decidable_types.list_dec. assumption.
+    - apply set.set_dec.
+      apply comparable.compare_eq_iff.
+    - intros (xsao, Hx) (ysao, Hy).
+      case (decidable_types.pair_dec address_dec (decidable_types.option_dec string_dec) xsao ysao); [|right; congruence].
+      intro H; destruct H.
+      left.
+      f_equal.
+      apply Eqdep_dec.UIP_dec.
+      apply decidable_types.option_dec.
+      unfold decidable_types.decidable.
+      apply type_dec.
+    - repeat decide equality.
+    - apply decidable_types.pair_dec; assumption.
+    - apply decidable_types.or_dec; assumption.
+    - apply decidable_types.sigT_dec.
+      + unfold decidable_types.decidable.
+        decide equality.
+      + intro; apply instruction_dec.
+    - apply map.map_dec.
+      + apply comparable.compare_eq_iff.
+      + assumption.
+    - apply map.map_dec.
+      + apply comparable.compare_eq_iff.
+      + assumption.
+    - repeat decide equality.
+  Defined.
+
   Record proto_env {self_ty : self_info} : Type :=
     mk_proto_env
       {
diff --git a/src/michocoq/set.v b/src/michocoq/set.v
index 01a25ad2..96490fee 100644
--- a/src/michocoq/set.v
+++ b/src/michocoq/set.v
@@ -23,7 +23,7 @@
 (* Finite sets implemented by sorted lists *)
 
 Require Sorted Eqdep_dec.
-Require Import error.
+Require Import error decidable_types.
 Import error.Notations.
 
 Section definition.
@@ -74,21 +74,7 @@ Section definition.
 
   Lemma decide_eq (a b : A) : {a = b} + {a <> b}.
   Proof.
-    case_eq (compare a b).
-    - intro H.
-      left.
-      apply compare_eq_iff.
-      assumption.
-    - intro H.
-      right.
-      intro ne.
-      rewrite <- compare_eq_iff in ne.
-      congruence.
-    - intro H.
-      right.
-      intro ne.
-      rewrite <- compare_eq_iff in ne.
-      congruence.
+    eapply decidable_types.comparable_decidable; eassumption.
   Qed.
 
 
@@ -491,4 +477,16 @@ Section definition.
       apply sorted_irrel.
   Qed.
 
+  Lemma set_dec (s1 s2 : set) : {s1 = s2} + {s1 <> s2}.
+  Proof.
+    destruct s1 as (l1, HS1).
+    destruct s2 as (l2, HS2).
+    case (decidable_types.list_dec decide_eq l1 l2).
+    - intro Hl; destruct Hl.
+      left.
+      f_equal.
+      apply sorted_irrel.
+    - intro Hr; right; congruence.
+  Qed.
+
 End definition.
-- 
GitLab


From 33aaa9af889b55f44ca267843d40c4da4ceee061 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Tue, 14 Apr 2020 16:43:52 +0200
Subject: [PATCH 42/56] [michocoq] TZT format support

This adds a `michocoq-tzt.native` binary that can be used to run unit
tests. The format is very partially supported and comparison of stacks
containing lambdas is buggy.
---
 src/michocoq/error.v                          |  3 +-
 src/michocoq/error_pp.v                       |  1 +
 src/michocoq/extraction/Makefile.local        |  3 +-
 src/michocoq/extraction/extraction.v          |  5 +-
 .../extraction/michocoq-tzt.ml.hand-written   | 18 ++++
 src/michocoq/main.v                           | 73 +++++++++++++++
 src/michocoq/micheline2michelson.v            | 91 +++++++++++++++++++
 src/michocoq/semantics.v                      | 18 ++++
 src/michocoq/syntax.v                         | 17 ++++
 src/michocoq/typer.v                          | 12 +++
 10 files changed, 238 insertions(+), 3 deletions(-)
 create mode 100644 src/michocoq/extraction/michocoq-tzt.ml.hand-written

diff --git a/src/michocoq/error.v b/src/michocoq/error.v
index eb065d42..ac0e22c0 100644
--- a/src/michocoq/error.v
+++ b/src/michocoq/error.v
@@ -35,7 +35,8 @@ Inductive exception : Type :=
 | Parsing_Out_of_Fuel
 | Expansion (_ _ : location)
 | Expansion_prim (_ _ : location) (_ : String.string)
-| Typing (A : Set) (a : A).
+| Typing (A : Set) (a : A)
+| Unit_test.
 
 Inductive M (A : Type) : Type :=
 | Failed : exception -> M A
diff --git a/src/michocoq/error_pp.v b/src/michocoq/error_pp.v
index defdec43..67da0e12 100644
--- a/src/michocoq/error_pp.v
+++ b/src/michocoq/error_pp.v
@@ -17,6 +17,7 @@ Definition exception_pp (e : exception) : string :=
   | Expansion b e => "Expansion error between " ++ location_pp b ++ " and " ++ location_pp e
   | Expansion_prim b e s => "Unknown primitive " ++ s ++ " between " ++ location_pp b ++ " and " ++ location_pp e
   | Typing _ _ => "Typing error"
+  | Unit_test => "Unit test failed"
   end.
 
 Definition m_pp {A} (m : M A) : string :=
diff --git a/src/michocoq/extraction/Makefile.local b/src/michocoq/extraction/Makefile.local
index aae70dba..1e5db0d2 100644
--- a/src/michocoq/extraction/Makefile.local
+++ b/src/michocoq/extraction/Makefile.local
@@ -30,8 +30,9 @@ zarith.mli:
 %.ml: %.ml.hand-written
 	cp $< $@
 
-post-all:: michocoq.ml extraction.vo zarith.ml zarith.mli
+post-all:: michocoq.ml michocoq-tzt.ml extraction.vo zarith.ml zarith.mli
 	ocamlbuild -package zarith michocoq.native
+	ocamlbuild -package zarith michocoq-tzt.native
 
 clean-extracted:
 	rm -f *.ml *.mli *.cmi *.cmo *.native
diff --git a/src/michocoq/extraction/extraction.v b/src/michocoq/extraction/extraction.v
index 7aeade10..8365a817 100644
--- a/src/michocoq/extraction/extraction.v
+++ b/src/michocoq/extraction/extraction.v
@@ -32,7 +32,7 @@ Michocoq.micheline2michelson Michocoq.semantics Michocoq.main.
 (* Recursive Extraction Library micheline_lexer. *)
 (* Recursive Extraction Library micheline_parser. *)
 
-Extract Inlined Constant ascii_compare => "(fun c1 c2 -> if (c1 < c2) then cl else if (c1 > c2) then Gt else Eq)".
+Extract Inlined Constant ascii_compare => "(fun c1 c2 -> if (c1 < c2) then Lt else if (c1 > c2) then Gt else Eq)".
 
 Require Import ZArith NArith.
 
@@ -108,6 +108,9 @@ Extract Inlined Constant sign => "(fun x -> Int64.compare x 0L < 0)".
 Extract Inlined Constant to_Z => "Zarith.of_int64".
 Extract Inlined Constant of_Z_unsafe => "Zarith.to_int64".
 
+(* TODO lemma *)
+Extract Inlined Constant semantics.instruction_dec => "(fun _ _ _ _ -> true)".
+
 (* Avoid a name collision for the module [Char] from the [coq-list-string]
    library. *)
 Extraction Blacklist Char.
diff --git a/src/michocoq/extraction/michocoq-tzt.ml.hand-written b/src/michocoq/extraction/michocoq-tzt.ml.hand-written
new file mode 100644
index 00000000..5660053b
--- /dev/null
+++ b/src/michocoq/extraction/michocoq-tzt.ml.hand-written
@@ -0,0 +1,18 @@
+(* Conversion functions between Coq and OCaml strings, taken from CompCert. *)
+
+let camlstring_of_coqstring (s : char list) =
+  let r = Bytes.create (Stdlib.List.length s) in
+  let rec fill pos = function
+    | [] -> r
+    | c :: s -> Bytes.set r pos c; fill (pos + 1) s
+  in Bytes.to_string (fill 0 s)
+
+let coqstring_of_camlstring s =
+  let rec cstring accu pos =
+    if pos < 0 then accu else cstring (Stdlib.String.get s pos :: accu) (pos - 1)
+  in cstring [] (Stdlib.String.length s - 1)
+
+(* main entrypoint *)
+let () =
+  if Array.length Sys.argv > 1 then
+    print_endline (camlstring_of_coqstring (Main0.print_info_tzt (coqstring_of_camlstring Sys.argv.(1)) Main0.fixed_fuel));
diff --git a/src/michocoq/main.v b/src/michocoq/main.v
index ddbdbed0..a1bc733d 100644
--- a/src/michocoq/main.v
+++ b/src/michocoq/main.v
@@ -5,6 +5,14 @@ Require Import syntax.
 Require Import syntax_type.
 Require error_pp.
 Import error.Notations.
+Require semantics.
+
+Module TrivialContractContext : semantics.ContractContext.
+  Definition get_contract_type
+    (cst : smart_contract_address_constant) : Datatypes.option type := None.
+End TrivialContractContext.
+
+Module Sem := semantics.Semantics TrivialContractContext.
 
 Section Main.
   Variable input : String.string.
@@ -70,4 +78,69 @@ Definition print_info :=
    "Expansion: " ++ is_michelson ++ lf ++
    "Type checking: " ++ type_check ++ lf)%string.
 
+(* TZT *)
+
+Definition tzt_file_M :=
+  let! x := parsed_M in
+  micheline2michelson.micheline2tzt_file x.
+
+Definition tzt_file_typed_M :=
+  let! file := tzt_file_M in
+  let! input := typer.type_stack file.(micheline2michelson.input) in
+  let! output := typer.type_stack file.(micheline2michelson.output) in
+  let! tcode := typer.type_check_instruction_no_tail_fail typer.type_instruction file.(micheline2michelson.tcode) _ _ in
+  error.Return
+    {|
+      tzt_file_input := input;
+      tzt_file_output := output;
+      tzt_file_code := tcode;
+    |}.
+
+Import Sem.
+
+Definition tzt_file_check_M :=
+  let! file := tzt_file_typed_M in
+  let output := file.(tzt_file_output) in
+  let input := file.(tzt_file_input) in
+  let proto_env : Sem.proto_env :=
+      mk_proto_env
+        None
+            (fun g p annot ttf delegate balance code storage =>
+              (Mk_operation "origination"%string,
+               Originated (Mk_smart_contract_address  "new_contract"%string)))
+            (fun p arg amount destination => Mk_operation "transfer"%string)
+          (fun delegate => Mk_operation "set_delegate"%string)
+          (0 ~Mutez)            (* Balance *)
+          (Implicit (Mk_key_hash "Source"%string))
+          (Implicit (Mk_key_hash "Sender"%string))
+          tt                    (* Self *)
+          (0 ~Mutez)            (* Amount *)
+          0%Z                     (* Now *)
+          (fun key => Mk_key_hash "key_hash"%string)
+          (fun a x => "pack"%string)
+          (fun a bytes => None)
+          (fun x => x)
+          (fun x => x)
+          (fun x => x)
+          (fun key sig data => false)
+          (Mk_chain_id "chain_id"%string) in
+  let! actual_output :=
+     Sem.eval proto_env file.(tzt_file_code) fuel (Sem.stack_from_concrete input)
+  in
+  let expected_output := Sem.stack_from_concrete output in
+  match stack_dec _ actual_output expected_output with
+  | left _ => error.Return tt
+  | right _ => error.Failed _ error.Unit_test
+  end.
+
+Definition is_tzt := error_pp.m_pp tzt_file_M.
+
+Definition unit_test_check := error_pp.m_pp tzt_file_check_M.
+
+Definition print_info_tzt :=
+  ("Lexing: " ++ is_lexed ++ lf ++
+   "Parsing: " ++ is_parsed ++ lf ++
+   "Expansion: " ++ is_tzt ++ lf ++
+   "Unit test: " ++ unit_test_check ++ lf)%string.
+
 End Main.
diff --git a/src/michocoq/micheline2michelson.v b/src/michocoq/micheline2michelson.v
index f7b82b4a..c29f85ce 100644
--- a/src/michocoq/micheline2michelson.v
+++ b/src/michocoq/micheline2michelson.v
@@ -707,6 +707,9 @@ Fixpoint micheline2michelson_instruction (m : loc_micheline) : M instruction_seq
   | Mk_loc_micheline ((b, e), _) => Failed _ (Expansion b e)
   end.
 
+
+(* Full Michelson files *)
+
 Record untyped_michelson_file :=
   Mk_untyped_michelson_file
     { parameter : type;
@@ -774,3 +777,91 @@ Definition micheline2michelson_file (m : Datatypes.list loc_micheline) : M untyp
     | _, _, _ => Failed _ Parsing
     end.
 
+(* TZT unit test files *)
+
+Definition concrete_stack := Datatypes.list (type * concrete_data).
+
+Fixpoint micheline2michelson_stack (bem : loc_micheline) : M concrete_stack :=
+  match bem with
+  | Mk_loc_micheline (_, SEQ l) =>
+    (fix micheline2michelson_stack_list (l : Datatypes.list loc_micheline) : M concrete_stack :=
+       match l with
+       | nil => Return nil
+       | (Mk_loc_micheline (_, PRIM (_, "Stack_elt") (mty :: m :: nil))) :: l =>
+         let! d := micheline2michelson_data m in
+         let! ty := micheline2michelson_type mty in
+         let! l := micheline2michelson_stack_list l in
+         Return ((ty, d) :: l)
+       | (Mk_loc_micheline ((b, e), _)) :: _ => Failed _ (Expansion b e)
+       end
+    ) l
+  | Mk_loc_micheline ((b, e), _) => Failed _ (Expansion b e)
+  end.
+
+Record untyped_tzt_file :=
+  Mk_untyped_tzt_file
+    { input : concrete_stack;
+      tcode : instruction;
+      output : concrete_stack }.
+
+Record untyped_tzt_file_opt :=
+  Mk_untyped_tzt_file_opt
+    { input_opt : Datatypes.option concrete_stack;
+      tcode_opt : Datatypes.option instruction;
+      output_opt : Datatypes.option concrete_stack }.
+
+Definition read_tzt_input (s : concrete_stack) (f : untyped_tzt_file_opt) :=
+  match f.(input_opt) with
+  | None => Return {| input_opt := Some s;
+                      tcode_opt := f.(tcode_opt);
+                      output_opt := f.(output_opt) |}
+  | Some _ => Failed _ Parsing
+  end.
+
+Definition read_tzt_code (c : instruction) (f : untyped_tzt_file_opt) :=
+  match f.(tcode_opt) with
+  | None => Return {| input_opt := f.(input_opt);
+                      tcode_opt := Some c;
+                      output_opt := f.(output_opt) |}
+  | Some _ => Failed _ Parsing
+  end.
+
+Definition read_tzt_output (s : concrete_stack) (f : untyped_tzt_file_opt) :=
+  match f.(output_opt) with
+  | None => Return {| input_opt := f.(input_opt);
+                      tcode_opt := f.(tcode_opt);
+                      output_opt := Some s |}
+  | Some _ => Failed _ Parsing
+  end.
+
+Definition micheline2tzt_file (m : Datatypes.list loc_micheline) : M untyped_tzt_file :=
+  let l :=
+      match m with
+      | Mk_loc_micheline (_, SEQ l) :: nil => l
+      | l => l
+      end
+  in
+  let! a :=
+    error.list_fold_left
+      (fun (a : untyped_tzt_file_opt) (lm : loc_micheline) =>
+        let 'Mk_loc_micheline (_, _, m) := lm in
+        match m with
+        | PRIM (_, _, "input") (cons input nil) =>
+          let! input := micheline2michelson_stack input in
+          read_tzt_input input a
+        | PRIM (_, _, "code") (cons code nil) =>
+          let! c := micheline2michelson_instruction code in
+          read_tzt_code c a
+        | PRIM (_, _, "output") (cons output nil) =>
+          let! output := micheline2michelson_stack output in
+          read_tzt_output output a
+        | _ => Failed _ Parsing
+        end)
+      l
+    {| input_opt := None; tcode_opt := None; output_opt := None |} in
+    match a.(input_opt), a.(tcode_opt), a.(output_opt) with
+    | Some input, Some code, Some output =>
+      Return {| input := input; tcode := code; output := output |}
+    | _, _, _ => Failed _ Parsing
+    end.
+
diff --git a/src/michocoq/semantics.v b/src/michocoq/semantics.v
index 1b00d732..9c8d126e 100644
--- a/src/michocoq/semantics.v
+++ b/src/michocoq/semantics.v
@@ -308,6 +308,18 @@ Module Semantics(C : ContractContext).
     | cons a A => data a * stack A
     end.
 
+  Lemma stack_dec : forall A (s1 s2 : stack A), { s1 = s2 } + { s1 <> s2 }.
+  Proof.
+    induction A.
+    - intros [] []; left; reflexivity.
+    - intros (x, sx) (y, sy).
+      case (data_dec x y).
+      + intro Hxy.
+        subst x.
+        case (IHA sx sy); intro; intuition congruence.
+      + intro; intuition congruence.
+  Defined.
+
   (** Stack manipulation *)
   Inductive stack_ind : stack_type -> Set -> Prop :=
   | stack_nil : stack_ind nil Datatypes.unit
@@ -454,6 +466,12 @@ Module Semantics(C : ContractContext).
     | Chain_id_constant x => x
     end.
 
+  Fixpoint stack_from_concrete {A} (s : typed_concrete_stack A) : stack A :=
+    match A, s with
+    | nil, tt => tt
+    | cons a A, (x, s) => (concrete_data_to_data a x, stack_from_concrete s)
+    end.
+
 
   Definition simple_comparable_data_to_concrete_data (a : simple_comparable_type) (x : comparable_data a) : concrete_data a :=
     match a, x with
diff --git a/src/michocoq/syntax.v b/src/michocoq/syntax.v
index 801126d4..7b5d0969 100644
--- a/src/michocoq/syntax.v
+++ b/src/michocoq/syntax.v
@@ -891,3 +891,20 @@ Proof.
     specialize (stacktype_dug_aux_proof_irrelevant (l1+++l2) n (length_app_cons_dug n l1 l2 H0)) as Hpi.
     rewrite <- Hpi. rewrite IHl1. reflexivity.
 Qed.
+
+Fixpoint typed_concrete_stack l :=
+  match l with
+  | nil => Datatypes.unit
+  | cons ty l => (syntax.concrete_data ty * typed_concrete_stack l)%type
+  end.
+
+Record tzt_file : Set :=
+  Mk_tzt_file
+    {
+      tzt_file_input_type : Datatypes.list type;
+      tzt_file_output_type : Datatypes.list type;
+      tzt_file_input : typed_concrete_stack tzt_file_input_type;
+      tzt_file_output : typed_concrete_stack tzt_file_output_type;
+      tzt_file_code :
+        instruction None Datatypes.false tzt_file_input_type tzt_file_output_type;
+    }.
diff --git a/src/michocoq/typer.v b/src/michocoq/typer.v
index a8a59222..72ef8cd4 100644
--- a/src/michocoq/typer.v
+++ b/src/michocoq/typer.v
@@ -851,3 +851,15 @@ Qed.
       end
     end.
 
+  Definition extract_stack_type : Datatypes.list (type * concrete_data) -> Datatypes.list type :=
+    List.map (fun c => fst c).
+
+  Fixpoint type_stack (s : Datatypes.list (type * concrete_data)) :
+    M (syntax.typed_concrete_stack (extract_stack_type s)) :=
+    match s with
+    | nil => Return tt
+    | cons (ty, x) s =>
+      let! x := type_data x ty in
+      let! s := type_stack s in
+      Return (x, s)
+    end.
-- 
GitLab


From 1cd48a2f94a38fbd496a2b2b4c9fc715af4fa866 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Tue, 14 Apr 2020 22:26:58 +0200
Subject: [PATCH 43/56] More imformational error message at expansion

---
 src/michocoq/micheline2michelson.v | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

diff --git a/src/michocoq/micheline2michelson.v b/src/michocoq/micheline2michelson.v
index c29f85ce..277d3462 100644
--- a/src/michocoq/micheline2michelson.v
+++ b/src/michocoq/micheline2michelson.v
@@ -19,6 +19,7 @@ Definition micheline2michelson_sctype (bem : loc_micheline) : M simple_comparabl
   | PRIM (_, "key_hash") nil => Return key_hash
   | PRIM (_, "timestamp") nil => Return timestamp
   | PRIM (_, "address") nil => Return address
+  | PRIM (_, prim) _ => Failed _ (Expansion_prim b e prim)
   | _ => Failed _ (Expansion b e)
   end.
 
@@ -77,6 +78,7 @@ Fixpoint micheline2michelson_type (bem : loc_micheline) : M type :=
         let! a := micheline2michelson_ctype a in
         let! b := micheline2michelson_type b in
         Return (big_map a b)
+       | Mk_loc_micheline ((b, e), PRIM (_, prim) _) => Failed _ (Expansion_prim b e prim)
        | Mk_loc_micheline ((b, e), _) => Failed _ (Expansion b e)
        end).
 
@@ -118,7 +120,7 @@ Fixpoint micheline2michelson_data (bem : loc_micheline) : M concrete_data :=
     let! a := micheline2michelson_data a in
     Return (Some_ a)
   | Mk_loc_micheline (_, PRIM (_, "None") nil) => Return None_
-  | Mk_loc_micheline ((b, e), PRIM s _) => Failed _ (Expansion b e)
+  | Mk_loc_micheline ((b, e), PRIM (_, s) _) => Failed _ (Expansion_prim b e s)
   end.
 
 Definition op_of_string (s : String.string) b e :=
@@ -129,7 +131,7 @@ Definition op_of_string (s : String.string) b e :=
   | "GE" => Return GE
   | "LT" => Return LT
   | "GT" => Return GT
-  | _ => Failed _ (Expansion b e)
+  | _ => Failed _ (Expansion_prim b e s)
   end.
 
 Definition FAIL := UNIT ;; FAILWITH ;; NOOP.
@@ -140,7 +142,7 @@ Definition IF_op_of_string (s : String.string) b e bt bf :=
   | String "I" (String "F" s) =>
     let! op := op_of_string s b e in
     Return (op ;; IF_ IF_bool bt bf ;; NOOP)
-  | _ => Failed _ (Expansion b e)
+  | _ => Failed _ (Expansion_prim b e s)
   end.
 
 Definition ASSERT_op_of_string (s : String.string) b e :=
@@ -148,7 +150,8 @@ Definition ASSERT_op_of_string (s : String.string) b e :=
   | String "A" (String "S" (String "S" (String "E" (String "R" (String "T" (String "_" s)))))) =>
     let! op := op_of_string s b e in
     Return (op ;; ASSERT ;; NOOP)
-  | _ => Failed _ (Expansion b e)
+  | _ => Failed _ (Expansion_prim b e s)
+>>>>>>> 5f7af49... More imformational error message at expansion
   end.
 
 Definition ASSERT_NONE := IF_NONE NOOP FAIL.
@@ -678,7 +681,7 @@ Fixpoint micheline2michelson_instruction (m : loc_micheline) : M instruction_seq
   | Mk_loc_micheline ((b, e), PRIM (_, "DUP") (Mk_loc_micheline (_, NUMBER n) :: nil)) =>
     match BinInt.Z.to_nat n with
     | S n => Return (DUP_Sn n)
-    | O => Failed _ (Expansion b e)
+    | O => Failed _ (Expansion_prim b e "DUP")
     end
   | Mk_loc_micheline ((b, e), PRIM (_, String "D" (String "U" (String "U" s))) nil) =>
     let is_duup := fix is_duup s :=
@@ -792,9 +795,11 @@ Fixpoint micheline2michelson_stack (bem : loc_micheline) : M concrete_stack :=
          let! ty := micheline2michelson_type mty in
          let! l := micheline2michelson_stack_list l in
          Return ((ty, d) :: l)
+       | (Mk_loc_micheline ((b, e), PRIM (_, prim) _)) :: _ => Failed _ (Expansion_prim b e prim)
        | (Mk_loc_micheline ((b, e), _)) :: _ => Failed _ (Expansion b e)
        end
     ) l
+  | Mk_loc_micheline ((b, e), PRIM (_, prim) _) => Failed _ (Expansion_prim b e prim)
   | Mk_loc_micheline ((b, e), _) => Failed _ (Expansion b e)
   end.
 
-- 
GitLab


From 30f80c048c21d0d6a7941e001a88fac4e06f4438 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Wed, 15 Apr 2020 21:44:30 +0200
Subject: [PATCH 44/56] Fixup more informational message

---
 src/michocoq/micheline2michelson.v | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/michocoq/micheline2michelson.v b/src/michocoq/micheline2michelson.v
index 277d3462..6a31a687 100644
--- a/src/michocoq/micheline2michelson.v
+++ b/src/michocoq/micheline2michelson.v
@@ -849,7 +849,7 @@ Definition micheline2tzt_file (m : Datatypes.list loc_micheline) : M untyped_tzt
   let! a :=
     error.list_fold_left
       (fun (a : untyped_tzt_file_opt) (lm : loc_micheline) =>
-        let 'Mk_loc_micheline (_, _, m) := lm in
+        let 'Mk_loc_micheline (b, e, m) := lm in
         match m with
         | PRIM (_, _, "input") (cons input nil) =>
           let! input := micheline2michelson_stack input in
@@ -860,6 +860,8 @@ Definition micheline2tzt_file (m : Datatypes.list loc_micheline) : M untyped_tzt
         | PRIM (_, _, "output") (cons output nil) =>
           let! output := micheline2michelson_stack output in
           read_tzt_output output a
+        | PRIM (_, _, prim) _ =>
+          Failed _ (Expansion_prim b e prim)
         | _ => Failed _ Parsing
         end)
       l
-- 
GitLab


From a8a2d2392ba21f7176743d5b0898db62ca8d965a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Wed, 15 Apr 2020 22:01:30 +0200
Subject: [PATCH 45/56] Improve name of the conversion function from concrete
 data to Micheline

---
 src/michocoq/michelson2micheline.v | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/src/michocoq/michelson2micheline.v b/src/michocoq/michelson2micheline.v
index 08b38135..13ec287b 100644
--- a/src/michocoq/michelson2micheline.v
+++ b/src/michocoq/michelson2micheline.v
@@ -70,7 +70,7 @@ Fixpoint michelson2micheline_type (t : type) : loc_micheline :=
   | chain_id => dummy_prim "chain_id" []
   end.
 
-Fixpoint michelson2micheline_data (d : concrete_data) : loc_micheline :=
+Fixpoint michelson2micheline_concrete_data (d : concrete_data) : loc_micheline :=
   match d with
   | Int_constant z => dummy_mich (NUMBER z)
   | String_constant s => dummy_mich (STR s)
@@ -79,14 +79,14 @@ Fixpoint michelson2micheline_data (d : concrete_data) : loc_micheline :=
   | True_ => dummy_prim "True" []
   | False_ => dummy_prim "False" []
   | Pair a b =>
-    dummy_prim "Pair" [michelson2micheline_data a; michelson2micheline_data b]
-  | Left a => dummy_prim "Left" [michelson2micheline_data a]
-  | Right a => dummy_prim "Right" [michelson2micheline_data a]
-  | Some_ a => dummy_prim "Some" [michelson2micheline_data a]
+    dummy_prim "Pair" [michelson2micheline_concrete_data a; michelson2micheline_concrete_data b]
+  | Left a => dummy_prim "Left" [michelson2micheline_concrete_data a]
+  | Right a => dummy_prim "Right" [michelson2micheline_concrete_data a]
+  | Some_ a => dummy_prim "Some" [michelson2micheline_concrete_data a]
   | None_ => dummy_prim "None" []
   | Elt a b =>
-    dummy_prim "Elt" [michelson2micheline_data a; michelson2micheline_data b]
-  | Concrete_seq s => dummy_mich (SEQ (List.map michelson2micheline_data s))
+    dummy_prim "Elt" [michelson2micheline_concrete_data a; michelson2micheline_concrete_data b]
+  | Concrete_seq s => dummy_mich (SEQ (List.map michelson2micheline_concrete_data s))
   | Instruction _ => dummy_prim "NOOP" [] (* Should never occur *)
   end.
 
@@ -196,7 +196,7 @@ Fixpoint michelson2micheline_instruction (i : instruction) : loc_micheline :=
     | Instruction d' =>
       dummy_prim "PUSH" [t'; dummy_mich (SEQ (michelson2micheline_ins_seq d'))]
     | _ =>
-      dummy_prim "PUSH" [t'; michelson2micheline_data d]
+      dummy_prim "PUSH" [t'; michelson2micheline_concrete_data d]
     end
   | LAMBDA t1 t2 i =>
     dummy_prim "LAMBDA" [ michelson2micheline_type t1;
-- 
GitLab


From f8a0c3100c90ce3720cf500bdda59c54385f296a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Thu, 16 Apr 2020 11:42:33 +0200
Subject: [PATCH 46/56] Partial pretty-printing of stacks in unit test error
 messages

---
 src/michocoq/error.v    |  2 +-
 src/michocoq/error_pp.v |  2 +-
 src/michocoq/main.v     | 34 +++++++++++++++++++++++++++++++++-
 3 files changed, 35 insertions(+), 3 deletions(-)

diff --git a/src/michocoq/error.v b/src/michocoq/error.v
index ac0e22c0..7a97e08c 100644
--- a/src/michocoq/error.v
+++ b/src/michocoq/error.v
@@ -36,7 +36,7 @@ Inductive exception : Type :=
 | Expansion (_ _ : location)
 | Expansion_prim (_ _ : location) (_ : String.string)
 | Typing (A : Set) (a : A)
-| Unit_test.
+| Unit_test (expected actual : String.string).
 
 Inductive M (A : Type) : Type :=
 | Failed : exception -> M A
diff --git a/src/michocoq/error_pp.v b/src/michocoq/error_pp.v
index 67da0e12..1592a2f8 100644
--- a/src/michocoq/error_pp.v
+++ b/src/michocoq/error_pp.v
@@ -17,7 +17,7 @@ Definition exception_pp (e : exception) : string :=
   | Expansion b e => "Expansion error between " ++ location_pp b ++ " and " ++ location_pp e
   | Expansion_prim b e s => "Unknown primitive " ++ s ++ " between " ++ location_pp b ++ " and " ++ location_pp e
   | Typing _ _ => "Typing error"
-  | Unit_test => "Unit test failed"
+  | Unit_test expected actual => "Unit test failed, expected: " ++ expected ++ "; actual: " ++ actual
   end.
 
 Definition m_pp {A} (m : M A) : string :=
diff --git a/src/michocoq/main.v b/src/michocoq/main.v
index a1bc733d..038cc200 100644
--- a/src/michocoq/main.v
+++ b/src/michocoq/main.v
@@ -98,6 +98,35 @@ Definition tzt_file_typed_M :=
 
 Import Sem.
 
+Fixpoint pp_data {a : type} (x : data a) : Datatypes.option String.string :=
+  match a, x with
+  | Comparable_type int, z => Some (micheline_pp.string_of_Z z)
+  | Comparable_type nat, n => Some (micheline_pp.string_of_Z (Z.of_N n))
+  | Comparable_type string, s => Some ("""" ++ s ++ """")%string
+  | Comparable_type bytes, s => Some ("0x" ++ s)%string
+  | pair a b, (x, y) =>
+    let? s1 := pp_data x in
+    let? s2 := pp_data y in
+    Some ("Pair (" ++ s1 ++ ") (" ++ s2 ++ ")")%string
+  | option a, Some x =>
+    let? s1 := pp_data x in
+    Some ("Some (" ++ s1 ++ ")")%string
+  | option a, None =>
+    Some "None"%string
+  | _, _ => None
+  end.
+
+Fixpoint pp_stack {A : Datatypes.list type} (s : stack A) : Datatypes.option String.string :=
+  match A, s with
+  | nil, tt => Some ""%string
+  | cons a A, (x, s) =>
+    let? s1 := pp_data x in
+    let? s2 := pp_stack s in
+    Some ("Stack_elt (" ++
+                        micheline_pp.micheline_pp_single_line (michelson2micheline.michelson2micheline_type a) true ++
+                        ") (" ++ s1 ++ "); " ++ s2)%string
+  end.
+
 Definition tzt_file_check_M :=
   let! file := tzt_file_typed_M in
   let output := file.(tzt_file_output) in
@@ -130,7 +159,10 @@ Definition tzt_file_check_M :=
   let expected_output := Sem.stack_from_concrete output in
   match stack_dec _ actual_output expected_output with
   | left _ => error.Return tt
-  | right _ => error.Failed _ error.Unit_test
+  | right _ =>
+    let expected_string := match (pp_stack expected_output) with Some s => s | None => "???"%string end in
+    let actual_string := match (pp_stack actual_output) with Some s => s | None => "???"%string end in
+    error.Failed _ (error.Unit_test expected_string actual_string)
   end.
 
 Definition is_tzt := error_pp.m_pp tzt_file_M.
-- 
GitLab


From 75d0a3574cc6c3381153348bda975461f18e40b5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Thu, 16 Apr 2020 11:43:12 +0200
Subject: [PATCH 47/56] Monadic notation for the option monad

---
 src/michocoq/error.v  | 22 ++++++++++++++++++++++
 src/michocoq/syntax.v | 41 ++++++++++++++++-------------------------
 2 files changed, 38 insertions(+), 25 deletions(-)

diff --git a/src/michocoq/error.v b/src/michocoq/error.v
index 7a97e08c..6151b5a1 100644
--- a/src/michocoq/error.v
+++ b/src/michocoq/error.v
@@ -55,6 +55,18 @@ Definition bind {A B : Type} (m : M A) (f : A -> M B) :=
   | Return SB => f SB
   end.
 
+Definition opt_bind {A B : Set} (m : Datatypes.option A) (f : A -> Datatypes.option B) : Datatypes.option B :=
+  match m with
+  | Some a => f a
+  | None => None
+  end.
+
+Definition opt_merge {A : Set} (m1 m2 : Datatypes.option A) : Datatypes.option A :=
+  match m1 with
+  | Some a1 => Some a1
+  | None => m2
+  end.
+
 Module Notations.
   (** Notation for the bind with a typed answer. *)
   Notation "'let!' x : A ':=' X 'in' Y" :=
@@ -65,6 +77,16 @@ Module Notations.
   Notation "'let!' x ':=' X 'in' Y" :=
     (bind X (fun x => Y))
     (at level 200, x pattern, X at level 100, Y at level 200).
+
+  (** Same for the option monad. *)
+  Notation "'let?' x : A ':=' X 'in' Y" :=
+    (opt_bind X (fun (x : A) => Y))
+    (at level 200, x pattern, X at level 100, A at level 200, Y at level 200).
+
+  (** Notation for the bind. *)
+  Notation "'let?' x ':=' X 'in' Y" :=
+    (opt_bind X (fun x => Y))
+    (at level 200, x pattern, X at level 100, Y at level 200).
 End Notations.
 
 Import Notations.
diff --git a/src/michocoq/syntax.v b/src/michocoq/syntax.v
index 7b5d0969..9ca498f2 100644
--- a/src/michocoq/syntax.v
+++ b/src/michocoq/syntax.v
@@ -305,40 +305,31 @@ Inductive elt_pair (a b : Set) : Set :=
 
 Definition stack_type := Datatypes.list type.
 
-Definition opt_bind {A B : Set} (m : Datatypes.option A) (f : A -> Datatypes.option B) : Datatypes.option B :=
-  match m with
-  | Some a => f a
-  | None => None
-  end.
-
-Definition opt_merge {A : Set} (m1 m2 : Datatypes.option A) : Datatypes.option A :=
-  match m1 with
-  | Some a1 => Some a1
-  | None => m2
-  end.
-
 Definition get_entrypoint_root (e : annotation) (a : type) (an : annot_o) :
   Datatypes.option type :=
-  opt_bind an (fun e' =>
-                 match String.string_dec e e' with
-                 | left _ => Some a
-                 | right _ => None
-                 end).
+  error.opt_bind an (fun e' =>
+                       match String.string_dec e e' with
+                       | left _ => Some a
+                       | right _ => None
+                       end).
 
 Fixpoint get_entrypoint (e : annotation) (a : type) (an : annot_o) : Datatypes.option type :=
-  opt_merge (get_entrypoint_root e a an)
-            (match a with
-             | or a annot_a b annot_b =>
-               opt_merge (get_entrypoint e a annot_a) (get_entrypoint e b annot_b)
-             | _ => None
-             end).
+  error.opt_merge (get_entrypoint_root e a an)
+                  (match a with
+                   | or a annot_a b annot_b =>
+                     error.opt_merge
+                       (get_entrypoint e a annot_a)
+                       (get_entrypoint e b annot_b)
+                   | _ => None
+                   end).
 
 Definition get_entrypoint_opt (e : annot_o) (a : type) (an : annot_o) :
   Datatypes.option type :=
   match e with
   | None =>
-    opt_merge (get_entrypoint default_entrypoint.default a an)
-              (Some a)
+    error.opt_merge
+      (get_entrypoint default_entrypoint.default a an)
+      (Some a)
   | Some e => get_entrypoint e a an
   end.
 
-- 
GitLab


From bb87657d44c47c74d7737e84ccc00ee77b8e3ea7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Thu, 16 Apr 2020 21:25:07 +0200
Subject: [PATCH 48/56] Prefix all error messages by KO to ease counting

---
 src/michocoq/error_pp.v | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/michocoq/error_pp.v b/src/michocoq/error_pp.v
index 1592a2f8..bb17d8bf 100644
--- a/src/michocoq/error_pp.v
+++ b/src/michocoq/error_pp.v
@@ -23,5 +23,5 @@ Definition exception_pp (e : exception) : string :=
 Definition m_pp {A} (m : M A) : string :=
   match m with
   | Return _ => "OK"
-  | Failed _ e => exception_pp e
+  | Failed _ e => "KO: " ++ exception_pp e
   end.
-- 
GitLab


From 1deb5cd528f83254567654739cc9e5f530389ef1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Sat, 18 Apr 2020 13:27:44 +0200
Subject: [PATCH 49/56] Fix traces for fixed typing bugs

---
 src/contracts/testsuite/opcodes/and_binary.tz.expected     | 2 +-
 src/contracts/testsuite/opcodes/chain_id_store.tz.expected | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/contracts/testsuite/opcodes/and_binary.tz.expected b/src/contracts/testsuite/opcodes/and_binary.tz.expected
index de2bb5f3..aa765d66 100644
--- a/src/contracts/testsuite/opcodes/and_binary.tz.expected
+++ b/src/contracts/testsuite/opcodes/and_binary.tz.expected
@@ -1,5 +1,5 @@
 Lexing: OK
 Parsing: OK
 Expansion: OK
-Type checking: Typing error
+Type checking: OK
 
diff --git a/src/contracts/testsuite/opcodes/chain_id_store.tz.expected b/src/contracts/testsuite/opcodes/chain_id_store.tz.expected
index 070189dc..aa765d66 100644
--- a/src/contracts/testsuite/opcodes/chain_id_store.tz.expected
+++ b/src/contracts/testsuite/opcodes/chain_id_store.tz.expected
@@ -1,5 +1,5 @@
 Lexing: OK
 Parsing: OK
-Expansion: Expansion error between line 2 column 13 and line 2 column 20
-Type checking: Expansion error between line 2 column 13 and line 2 column 20
+Expansion: OK
+Type checking: OK
 
-- 
GitLab


From b1a8aca9690b1837ef1cba10b9268a055b8b98df Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Sat, 18 Apr 2020 13:28:24 +0200
Subject: [PATCH 50/56] Add "KO" in expected error messages

---
 .../testsuite/deprecated/create_account.tz.expected         | 4 ++--
 .../testsuite/deprecated/create_contract.tz.expected        | 2 +-
 src/contracts/testsuite/deprecated/originator.tz.expected   | 4 ++--
 .../testsuite/entrypoints/delegatable_target.tz.expected    | 6 +++---
 src/contracts/testsuite/ill_typed/big_map_arity.tz.expected | 4 ++--
 src/contracts/testsuite/opcodes/big_map_to_self.tz.expected | 2 +-
 6 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/src/contracts/testsuite/deprecated/create_account.tz.expected b/src/contracts/testsuite/deprecated/create_account.tz.expected
index a237d4ff..723cdab1 100644
--- a/src/contracts/testsuite/deprecated/create_account.tz.expected
+++ b/src/contracts/testsuite/deprecated/create_account.tz.expected
@@ -1,5 +1,5 @@
 Lexing: OK
 Parsing: OK
-Expansion: Unknown primitive CREATE_ACCOUNT between line 23 column 11 and line 23 column 24
-Type checking: Unknown primitive CREATE_ACCOUNT between line 23 column 11 and line 23 column 24
+Expansion: KO: Unknown primitive CREATE_ACCOUNT between line 23 column 11 and line 23 column 24
+Type checking: KO: Unknown primitive CREATE_ACCOUNT between line 23 column 11 and line 23 column 24
 
diff --git a/src/contracts/testsuite/deprecated/create_contract.tz.expected b/src/contracts/testsuite/deprecated/create_contract.tz.expected
index de2bb5f3..dbb0aef1 100644
--- a/src/contracts/testsuite/deprecated/create_contract.tz.expected
+++ b/src/contracts/testsuite/deprecated/create_contract.tz.expected
@@ -1,5 +1,5 @@
 Lexing: OK
 Parsing: OK
 Expansion: OK
-Type checking: Typing error
+Type checking: KO: Typing error
 
diff --git a/src/contracts/testsuite/deprecated/originator.tz.expected b/src/contracts/testsuite/deprecated/originator.tz.expected
index 5da234fc..ab3773a2 100644
--- a/src/contracts/testsuite/deprecated/originator.tz.expected
+++ b/src/contracts/testsuite/deprecated/originator.tz.expected
@@ -1,5 +1,5 @@
 Lexing: OK
 Parsing: OK
-Expansion: Unknown primitive CREATE_ACCOUNT between line 11 column 8 and line 11 column 21
-Type checking: Unknown primitive CREATE_ACCOUNT between line 11 column 8 and line 11 column 21
+Expansion: KO: Unknown primitive CREATE_ACCOUNT between line 11 column 8 and line 11 column 21
+Type checking: KO: Unknown primitive CREATE_ACCOUNT between line 11 column 8 and line 11 column 21
 
diff --git a/src/contracts/testsuite/entrypoints/delegatable_target.tz.expected b/src/contracts/testsuite/entrypoints/delegatable_target.tz.expected
index c8ec5552..6d7f6f0c 100644
--- a/src/contracts/testsuite/entrypoints/delegatable_target.tz.expected
+++ b/src/contracts/testsuite/entrypoints/delegatable_target.tz.expected
@@ -1,5 +1,5 @@
 Lexing: OK
-Parsing: Parsing error
-Expansion: Parsing error
-Type checking: Parsing error
+Parsing: KO: Parsing error
+Expansion: KO: Parsing error
+Type checking: KO: Parsing error
 
diff --git a/src/contracts/testsuite/ill_typed/big_map_arity.tz.expected b/src/contracts/testsuite/ill_typed/big_map_arity.tz.expected
index 06af7b57..307ace29 100644
--- a/src/contracts/testsuite/ill_typed/big_map_arity.tz.expected
+++ b/src/contracts/testsuite/ill_typed/big_map_arity.tz.expected
@@ -1,5 +1,5 @@
 Lexing: OK
 Parsing: OK
-Expansion: Unknown primitive EMPTY_BIG_MAP between line 5 column 10 and line 5 column 25
-Type checking: Unknown primitive EMPTY_BIG_MAP between line 5 column 10 and line 5 column 25
+Expansion: KO: Unknown primitive EMPTY_BIG_MAP between line 5 column 10 and line 5 column 25
+Type checking: KO: Unknown primitive EMPTY_BIG_MAP between line 5 column 10 and line 5 column 25
 
diff --git a/src/contracts/testsuite/opcodes/big_map_to_self.tz.expected b/src/contracts/testsuite/opcodes/big_map_to_self.tz.expected
index de2bb5f3..dbb0aef1 100644
--- a/src/contracts/testsuite/opcodes/big_map_to_self.tz.expected
+++ b/src/contracts/testsuite/opcodes/big_map_to_self.tz.expected
@@ -1,5 +1,5 @@
 Lexing: OK
 Parsing: OK
 Expansion: OK
-Type checking: Typing error
+Type checking: KO: Typing error
 
-- 
GitLab


From cf50b15d817c2f5efdfff4f91046dbb75d58dfed Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Sat, 18 Apr 2020 13:29:31 +0200
Subject: [PATCH 51/56] Improve error message for failed unit tests

---
 src/michocoq/error.v    |  2 +-
 src/michocoq/error_pp.v |  9 ++++++++-
 src/michocoq/main.v     | 45 ++++++++++++++++++++---------------------
 3 files changed, 31 insertions(+), 25 deletions(-)

diff --git a/src/michocoq/error.v b/src/michocoq/error.v
index 6151b5a1..04b9e0a8 100644
--- a/src/michocoq/error.v
+++ b/src/michocoq/error.v
@@ -36,7 +36,7 @@ Inductive exception : Type :=
 | Expansion (_ _ : location)
 | Expansion_prim (_ _ : location) (_ : String.string)
 | Typing (A : Set) (a : A)
-| Unit_test (expected actual : String.string).
+| Unit_test (input expected actual : String.string).
 
 Inductive M (A : Type) : Type :=
 | Failed : exception -> M A
diff --git a/src/michocoq/error_pp.v b/src/michocoq/error_pp.v
index bb17d8bf..b780a371 100644
--- a/src/michocoq/error_pp.v
+++ b/src/michocoq/error_pp.v
@@ -17,7 +17,14 @@ Definition exception_pp (e : exception) : string :=
   | Expansion b e => "Expansion error between " ++ location_pp b ++ " and " ++ location_pp e
   | Expansion_prim b e s => "Unknown primitive " ++ s ++ " between " ++ location_pp b ++ " and " ++ location_pp e
   | Typing _ _ => "Typing error"
-  | Unit_test expected actual => "Unit test failed, expected: " ++ expected ++ "; actual: " ++ actual
+  | Unit_test input expected actual =>
+    let input := if String.length input <? 50 then input else "<...>" in
+    let expected := if String.length expected <? 50 then expected else "<...>" in
+    let actual := if String.length actual <? 50 then actual else "<...>" in
+    "Unit test failed" ++ lf ++
+                       "  input: {" ++ input ++ "}" ++ lf ++
+                       "  expected output: {" ++ expected ++ "}" ++ lf ++
+                       "  actual output: {" ++ actual ++ "}"
   end.
 
 Definition m_pp {A} (m : M A) : string :=
diff --git a/src/michocoq/main.v b/src/michocoq/main.v
index 038cc200..9b722882 100644
--- a/src/michocoq/main.v
+++ b/src/michocoq/main.v
@@ -98,33 +98,30 @@ Definition tzt_file_typed_M :=
 
 Import Sem.
 
-Fixpoint pp_data {a : type} (x : data a) : Datatypes.option String.string :=
+Fixpoint pp_data {a : type} (x : data a) : String.string :=
   match a, x with
-  | Comparable_type int, z => Some (micheline_pp.string_of_Z z)
-  | Comparable_type nat, n => Some (micheline_pp.string_of_Z (Z.of_N n))
-  | Comparable_type string, s => Some ("""" ++ s ++ """")%string
-  | Comparable_type bytes, s => Some ("0x" ++ s)%string
+  | Comparable_type int, z => micheline_pp.string_of_Z z
+  | Comparable_type nat, n => micheline_pp.string_of_Z (Z.of_N n)
+  | Comparable_type string, s => ("""" ++ s ++ """")%string
+  | Comparable_type bytes, s => ("0x" ++ s)%string
   | pair a b, (x, y) =>
-    let? s1 := pp_data x in
-    let? s2 := pp_data y in
-    Some ("Pair (" ++ s1 ++ ") (" ++ s2 ++ ")")%string
+    ("Pair (" ++ pp_data x ++ ") (" ++ pp_data y ++ ")")%string
   | option a, Some x =>
-    let? s1 := pp_data x in
-    Some ("Some (" ++ s1 ++ ")")%string
+    ("Some (" ++ pp_data x ++ ")")%string
   | option a, None =>
-    Some "None"%string
-  | _, _ => None
+    "None"%string
+  | _, _ => "???"
   end.
 
-Fixpoint pp_stack {A : Datatypes.list type} (s : stack A) : Datatypes.option String.string :=
+Fixpoint pp_stack {A : Datatypes.list type} (s : stack A) : String.string :=
   match A, s with
-  | nil, tt => Some ""%string
+  | nil, tt => ""%string
   | cons a A, (x, s) =>
-    let? s1 := pp_data x in
-    let? s2 := pp_stack s in
-    Some ("Stack_elt (" ++
-                        micheline_pp.micheline_pp_single_line (michelson2micheline.michelson2micheline_type a) true ++
-                        ") (" ++ s1 ++ "); " ++ s2)%string
+    let s1 := pp_data x in
+    let s2 := pp_stack s in
+    ("Stack_elt (" ++
+                   micheline_pp.micheline_pp_single_line (michelson2micheline.michelson2micheline_type a) true ++
+                   ") (" ++ s1 ++ "); " ++ s2)%string
   end.
 
 Definition tzt_file_check_M :=
@@ -153,16 +150,18 @@ Definition tzt_file_check_M :=
           (fun x => x)
           (fun key sig data => false)
           (Mk_chain_id "chain_id"%string) in
+  let input := Sem.stack_from_concrete input in
   let! actual_output :=
-     Sem.eval proto_env file.(tzt_file_code) fuel (Sem.stack_from_concrete input)
+     Sem.eval proto_env file.(tzt_file_code) fuel input
   in
   let expected_output := Sem.stack_from_concrete output in
   match stack_dec _ actual_output expected_output with
   | left _ => error.Return tt
   | right _ =>
-    let expected_string := match (pp_stack expected_output) with Some s => s | None => "???"%string end in
-    let actual_string := match (pp_stack actual_output) with Some s => s | None => "???"%string end in
-    error.Failed _ (error.Unit_test expected_string actual_string)
+    let expected_string := pp_stack expected_output in
+    let actual_string := pp_stack actual_output in
+    let input_string := pp_stack input in
+    error.Failed _ (error.Unit_test input_string expected_string actual_string)
   end.
 
 Definition is_tzt := error_pp.m_pp tzt_file_M.
-- 
GitLab


From 3552535f9e17096d66b0472a4c7f96d2172af623 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Sun, 19 Apr 2020 14:47:27 +0200
Subject: [PATCH 52/56] [Michocoq|TZT] Fix parsing of lambdas in stacks

---
 src/michocoq/micheline2michelson.v | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/src/michocoq/micheline2michelson.v b/src/michocoq/micheline2michelson.v
index 6a31a687..d97eecfe 100644
--- a/src/michocoq/micheline2michelson.v
+++ b/src/michocoq/micheline2michelson.v
@@ -791,8 +791,14 @@ Fixpoint micheline2michelson_stack (bem : loc_micheline) : M concrete_stack :=
        match l with
        | nil => Return nil
        | (Mk_loc_micheline (_, PRIM (_, "Stack_elt") (mty :: m :: nil))) :: l =>
-         let! d := micheline2michelson_data m in
          let! ty := micheline2michelson_type mty in
+         let! d :=
+            match ty with
+            | lambda _ _ =>
+              let! i := micheline2michelson_instruction m in
+              Return (Instruction i)
+            | _ => micheline2michelson_data m
+            end in
          let! l := micheline2michelson_stack_list l in
          Return ((ty, d) :: l)
        | (Mk_loc_micheline ((b, e), PRIM (_, prim) _)) :: _ => Failed _ (Expansion_prim b e prim)
-- 
GitLab


From d05ad76f65021632b49ae8b5b844ddc61a422934 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Wed, 22 Apr 2020 14:07:41 +0200
Subject: [PATCH 53/56] Complete the decidability proof for instructions, data,
 and stacks

---
 src/michocoq/comparable.v            |  3 +-
 src/michocoq/decidable_types.v       | 17 ++++++-
 src/michocoq/extraction/extraction.v |  3 --
 src/michocoq/main.v                  |  6 ++-
 src/michocoq/map.v                   |  5 +--
 src/michocoq/micheline2michelson.v   |  7 ++-
 src/michocoq/semantics.v             | 62 +++++++++++++++++++------
 src/michocoq/set.v                   |  5 +--
 src/michocoq/syntax.v                |  2 +-
 src/michocoq/typed_optimizer.v       | 24 +++-------
 src/michocoq/typer.v                 |  4 +-
 src/michocoq/untyped_syntax.v        | 67 ++++++++++++++++++++++++++++
 src/michocoq/untyper.v               |  6 +--
 13 files changed, 156 insertions(+), 55 deletions(-)

diff --git a/src/michocoq/comparable.v b/src/michocoq/comparable.v
index d47f8942..af3e9429 100644
--- a/src/michocoq/comparable.v
+++ b/src/michocoq/comparable.v
@@ -496,8 +496,7 @@ Proof.
   apply compare_eq_iff.
 Qed.
 
-Lemma comparable_data_dec {a : comparable_type} (x y : comparable_data a) :
-  {x = y} + {x <> y}.
+Lemma comparable_data_dec {a : comparable_type} : decidable_types.decidable (comparable_data a).
 Proof.
   apply (decidable_types.comparable_decidable (compare_eq_iff a)).
 Qed.
diff --git a/src/michocoq/decidable_types.v b/src/michocoq/decidable_types.v
index 2773e55e..19265ff6 100644
--- a/src/michocoq/decidable_types.v
+++ b/src/michocoq/decidable_types.v
@@ -1,4 +1,5 @@
-Require Eqdep_dec.
+Require Eqdep_dec String.
+Require Import ZArith.
 
 Definition decidable (A : Set) := forall x y : A, {x = y} + {x <> y}.
 
@@ -14,6 +15,20 @@ Proof.
   assumption.
 Qed.
 
+Lemma nat_dec : decidable nat.
+  unfold decidable.
+  decide equality.
+Defined.
+
+Lemma Z_dec : decidable Z.
+  unfold decidable.
+  repeat decide equality.
+Defined.
+
+Lemma string_dec : decidable String.string.
+  exact String.string_dec.
+Defined.
+
 Lemma list_dec {A : Set} : decidable A -> decidable (Datatypes.list A).
 Proof.
   unfold decidable.
diff --git a/src/michocoq/extraction/extraction.v b/src/michocoq/extraction/extraction.v
index 8365a817..ab784246 100644
--- a/src/michocoq/extraction/extraction.v
+++ b/src/michocoq/extraction/extraction.v
@@ -108,9 +108,6 @@ Extract Inlined Constant sign => "(fun x -> Int64.compare x 0L < 0)".
 Extract Inlined Constant to_Z => "Zarith.of_int64".
 Extract Inlined Constant of_Z_unsafe => "Zarith.to_int64".
 
-(* TODO lemma *)
-Extract Inlined Constant semantics.instruction_dec => "(fun _ _ _ _ -> true)".
-
 (* Avoid a name collision for the module [Char] from the [coq-list-string]
    library. *)
 Extraction Blacklist Char.
diff --git a/src/michocoq/main.v b/src/michocoq/main.v
index 9b722882..e47734b7 100644
--- a/src/michocoq/main.v
+++ b/src/michocoq/main.v
@@ -88,7 +88,9 @@ Definition tzt_file_typed_M :=
   let! file := tzt_file_M in
   let! input := typer.type_stack file.(micheline2michelson.input) in
   let! output := typer.type_stack file.(micheline2michelson.output) in
-  let! tcode := typer.type_check_instruction_no_tail_fail typer.type_instruction file.(micheline2michelson.tcode) _ _ in
+  let! tcode := typer.type_check_instruction_seq_no_tail_fail
+                  (typer.type_instruction_seq typer.Any)
+                  file.(micheline2michelson.tcode) _ _ in
   error.Return
     {|
       tzt_file_input := input;
@@ -152,7 +154,7 @@ Definition tzt_file_check_M :=
           (Mk_chain_id "chain_id"%string) in
   let input := Sem.stack_from_concrete input in
   let! actual_output :=
-     Sem.eval proto_env file.(tzt_file_code) fuel input
+     Sem.eval_seq proto_env file.(tzt_file_code) fuel input
   in
   let expected_output := Sem.stack_from_concrete output in
   match stack_dec _ actual_output expected_output with
diff --git a/src/michocoq/map.v b/src/michocoq/map.v
index c6cacc80..061b5d8c 100644
--- a/src/michocoq/map.v
+++ b/src/michocoq/map.v
@@ -515,10 +515,9 @@ Section map.
 
   Hypothesis B_dec : forall b1 b2 : B, {b1 = b2} + {b1 <> b2}.
 
-  Lemma map_dec (m1 m2 : map) : {m1 = m2} + {m1 <> m2}.
+  Lemma map_dec : decidable_types.decidable map.
   Proof.
-    destruct m1 as (l1, H1).
-    destruct m2 as (l2, H2).
+    intros (l1, H1) (l2, H2).
     case (decidable_types.list_dec (decidable_types.pair_dec A_dec B_dec) l1 l2).
     - intro H; destruct H.
       left.
diff --git a/src/michocoq/micheline2michelson.v b/src/michocoq/micheline2michelson.v
index d97eecfe..efb20e4e 100644
--- a/src/michocoq/micheline2michelson.v
+++ b/src/michocoq/micheline2michelson.v
@@ -151,7 +151,6 @@ Definition ASSERT_op_of_string (s : String.string) b e :=
     let! op := op_of_string s b e in
     Return (op ;; ASSERT ;; NOOP)
   | _ => Failed _ (Expansion_prim b e s)
->>>>>>> 5f7af49... More imformational error message at expansion
   end.
 
 Definition ASSERT_NONE := IF_NONE NOOP FAIL.
@@ -812,13 +811,13 @@ Fixpoint micheline2michelson_stack (bem : loc_micheline) : M concrete_stack :=
 Record untyped_tzt_file :=
   Mk_untyped_tzt_file
     { input : concrete_stack;
-      tcode : instruction;
+      tcode : instruction_seq;
       output : concrete_stack }.
 
 Record untyped_tzt_file_opt :=
   Mk_untyped_tzt_file_opt
     { input_opt : Datatypes.option concrete_stack;
-      tcode_opt : Datatypes.option instruction;
+      tcode_opt : Datatypes.option instruction_seq;
       output_opt : Datatypes.option concrete_stack }.
 
 Definition read_tzt_input (s : concrete_stack) (f : untyped_tzt_file_opt) :=
@@ -829,7 +828,7 @@ Definition read_tzt_input (s : concrete_stack) (f : untyped_tzt_file_opt) :=
   | Some _ => Failed _ Parsing
   end.
 
-Definition read_tzt_code (c : instruction) (f : untyped_tzt_file_opt) :=
+Definition read_tzt_code (c : instruction_seq) (f : untyped_tzt_file_opt) :=
   match f.(tcode_opt) with
   | None => Return {| input_opt := f.(input_opt);
                       tcode_opt := Some c;
diff --git a/src/michocoq/semantics.v b/src/michocoq/semantics.v
index 9c8d126e..aecac05e 100644
--- a/src/michocoq/semantics.v
+++ b/src/michocoq/semantics.v
@@ -25,6 +25,7 @@
 Require Import ZArith Lia.
 Require Import String.
 Require Import syntax macros.
+Require untyped_syntax untyper.
 Require NPeano Eqdep_dec.
 
 Require Import comparable error.
@@ -35,7 +36,6 @@ Module Type ContractContext.
     smart_contract_address_constant -> Datatypes.option type.
 End ContractContext.
 
-
 Definition ediv_Z x y :=
   (if y =? 0 then None else
      let d := x / y in
@@ -158,10 +158,45 @@ Proof.
       apply N.mod_unique with (q := d); assumption.
 Qed.
 
-Lemma instruction_dec self_info tff A B : decidable_types.decidable (instruction self_info tff A B).
+Lemma instruction_seq_dec self_info tff A B : decidable_types.decidable (instruction_seq self_info tff A B).
 Proof.
-  admit.
-Admitted.
+  intros i1 i2.
+  case (untyped_syntax.instruction_seq_dec
+          (untyper.untype_instruction_seq untyper.untype_Optimized i1)
+          (untyper.untype_instruction_seq untyper.untype_Optimized i2)).
+  - left.
+    destruct tff.
+    + assert
+        (typer.type_instruction_seq
+           (self_type := self_info)
+           typer.Optimized
+           (untyper.untype_instruction_seq untyper.untype_Optimized i1) A =
+         typer.type_instruction_seq
+           typer.Optimized
+           (untyper.untype_instruction_seq untyper.untype_Optimized i2) A)
+        as H by congruence.
+      rewrite untyper.untype_type_instruction_seq in H.
+      rewrite untyper.untype_type_instruction_seq in H.
+      injection H.
+      intro H2.
+      apply (f_equal (fun f => f B)) in H2.
+      rewrite untyper.tail_fail_change_range_same_seq in H2.
+      rewrite untyper.tail_fail_change_range_same_seq in H2.
+      exact H2.
+    + assert
+        (typer.type_check_instruction_seq_no_tail_fail
+           (self_type := self_info)
+           (typer.type_instruction_seq typer.Optimized)
+           (untyper.untype_instruction_seq untyper.untype_Optimized i1) A B =
+         typer.type_check_instruction_seq_no_tail_fail
+           (typer.type_instruction_seq typer.Optimized)
+           (untyper.untype_instruction_seq untyper.untype_Optimized i2) A B) as H by congruence.
+    rewrite untyper.untype_type_check_instruction_seq_no_tail_fail in H; [| apply untyper.untype_type_instruction_seq].
+    rewrite untyper.untype_type_check_instruction_seq_no_tail_fail in H; [| apply untyper.untype_type_instruction_seq].
+    congruence.
+  - right.
+    congruence.
+Defined.
 
 Module Semantics(C : ContractContext).
   Export C.
@@ -198,19 +233,20 @@ Module Semantics(C : ContractContext).
     | chain_id => chain_id_constant
     end.
 
-  Lemma address_dec : forall x y : address_constant, {x = y} + {x <> y}.
+  Lemma address_dec : decidable_types.decidable address_constant.
   Proof.
+    intros x y.
     repeat decide equality.
   Defined.
 
-  Lemma data_dec {a : type} : forall x y : data a, {x = y} + {x <> y}.
+  Lemma data_dec {a : type} : decidable_types.decidable (data a).
   Proof.
     induction a; simpl.
     - intros x y.
       apply (@comparable.comparable_data_dec (Comparable_type_simple s)).
-    - repeat decide equality.
-    - repeat decide equality.
-    - repeat decide equality.
+    - intros x y. repeat decide equality.
+    - intros x y. repeat decide equality.
+    - intros x y. repeat decide equality.
     - apply decidable_types.option_dec.
       assumption.
     - apply decidable_types.list_dec. assumption.
@@ -225,20 +261,20 @@ Module Semantics(C : ContractContext).
       apply decidable_types.option_dec.
       unfold decidable_types.decidable.
       apply type_dec.
-    - repeat decide equality.
+    - intros x y. repeat decide equality.
     - apply decidable_types.pair_dec; assumption.
     - apply decidable_types.or_dec; assumption.
     - apply decidable_types.sigT_dec.
       + unfold decidable_types.decidable.
         decide equality.
-      + intro; apply instruction_dec.
+      + intro; apply instruction_seq_dec.
     - apply map.map_dec.
       + apply comparable.compare_eq_iff.
       + assumption.
     - apply map.map_dec.
       + apply comparable.compare_eq_iff.
       + assumption.
-    - repeat decide equality.
+    - intros x y. repeat decide equality.
   Defined.
 
   Record proto_env {self_ty : self_info} : Type :=
@@ -308,7 +344,7 @@ Module Semantics(C : ContractContext).
     | cons a A => data a * stack A
     end.
 
-  Lemma stack_dec : forall A (s1 s2 : stack A), { s1 = s2 } + { s1 <> s2 }.
+  Lemma stack_dec : forall A, decidable_types.decidable (stack A).
   Proof.
     induction A.
     - intros [] []; left; reflexivity.
diff --git a/src/michocoq/set.v b/src/michocoq/set.v
index 96490fee..71436fcf 100644
--- a/src/michocoq/set.v
+++ b/src/michocoq/set.v
@@ -477,10 +477,9 @@ Section definition.
       apply sorted_irrel.
   Qed.
 
-  Lemma set_dec (s1 s2 : set) : {s1 = s2} + {s1 <> s2}.
+  Lemma set_dec : decidable_types.decidable set.
   Proof.
-    destruct s1 as (l1, HS1).
-    destruct s2 as (l2, HS2).
+    intros (l1, HS1) (l2, HS2).
     case (decidable_types.list_dec decide_eq l1 l2).
     - intro Hl; destruct Hl.
       left.
diff --git a/src/michocoq/syntax.v b/src/michocoq/syntax.v
index 9ca498f2..7c308268 100644
--- a/src/michocoq/syntax.v
+++ b/src/michocoq/syntax.v
@@ -897,5 +897,5 @@ Record tzt_file : Set :=
       tzt_file_input : typed_concrete_stack tzt_file_input_type;
       tzt_file_output : typed_concrete_stack tzt_file_output_type;
       tzt_file_code :
-        instruction None Datatypes.false tzt_file_input_type tzt_file_output_type;
+        instruction_seq None Datatypes.false tzt_file_input_type tzt_file_output_type;
     }.
diff --git a/src/michocoq/typed_optimizer.v b/src/michocoq/typed_optimizer.v
index e16b173f..620e1664 100644
--- a/src/michocoq/typed_optimizer.v
+++ b/src/michocoq/typed_optimizer.v
@@ -21,7 +21,7 @@
 
 (* Same as the untyped optimizer but at the level of Michocoq.syntax *)
 
-From Michocoq Require untyped_syntax typer untyper.
+From Michocoq Require untyped_syntax typer untyper semantics.
 From Michocoq Require Import syntax.
 Import error.Notations.
 Import Notations.
@@ -42,18 +42,6 @@ Definition hide_ntf {st A B} (i : instruction st false A B) :
 
 (* Manipulations of options *)
 
-Definition option_bind {A B}
-           (o : Datatypes.option A) (f : A -> Datatypes.option B) :
-  Datatypes.option B :=
-  match o with
-  | None => None
-  | Some a => f a
-  end.
-
-Notation "'let?' x ':=' X 'in' Y" :=
-  (option_bind X (fun x => Y))
-    (at level 200, x pattern, X at level 100, Y at level 200).
-
 Definition opt_get {A} (o : Datatypes.option A) (default : A) : A :=
   match o with Some x => x | None => default end.
 
@@ -62,7 +50,7 @@ Proof.
   congruence.
 Qed.
 
-Lemma bind_some {A B} (y : Datatypes.option A) (w : B) z : (let? x := y in z x) = Some w <-> (exists x, y = Some x /\ z x = Some w).
+Lemma bind_some {A B : Set} (y : Datatypes.option A) (w : B) z : (let? x := y in z x) = Some w <-> (exists x, y = Some x /\ z x = Some w).
 Proof.
   destruct y; simpl; split.
   - intro H; exists a; split; congruence.
@@ -320,13 +308,13 @@ Ltac mytac :=
     | Some _ = None => discriminate
     | cast_instruction_seq_opt _ = _ =>
       rewrite cast_instruction_seq_same in H
-    | option_bind (Some _) _ = _ =>
+    | error.opt_bind (Some _) _ = _ =>
       simpl in H
-    | option_bind None _ = _ =>
+    | error.opt_bind None _ = _ =>
       simpl in H
-    | option_bind _ _ = Some _ =>
+    | error.opt_bind _ _ = Some _ =>
       apply bind_some in H
-    | option_bind (cast_instruction_seq_opt _) _ = _ =>
+    | error.opt_bind (cast_instruction_seq_opt _) _ = _ =>
       rewrite cast_instruction_seq_same in H
     end
   end.
diff --git a/src/michocoq/typer.v b/src/michocoq/typer.v
index 72ef8cd4..3cf30519 100644
--- a/src/michocoq/typer.v
+++ b/src/michocoq/typer.v
@@ -1,7 +1,7 @@
 Require Import ZArith List Nat Ascii String.
 Require Import ListString.All.
 Require Import Moment.All.
-Require syntax semantics.
+Require syntax.
 Require Import syntax_type.
 Require Import untyped_syntax error.
 Import error.Notations.
@@ -859,7 +859,7 @@ Qed.
     match s with
     | nil => Return tt
     | cons (ty, x) s =>
-      let! x := type_data x ty in
+      let! x := type_data Any x ty in
       let! s := type_stack s in
       Return (x, s)
     end.
diff --git a/src/michocoq/untyped_syntax.v b/src/michocoq/untyped_syntax.v
index e2e2e588..105ce7b5 100644
--- a/src/michocoq/untyped_syntax.v
+++ b/src/michocoq/untyped_syntax.v
@@ -1,6 +1,7 @@
 Require syntax.
 Require Import ZArith String.
 Require Import syntax_type.
+Require decidable_types.
 
 Inductive opcode : Set :=
 | APPLY : opcode
@@ -127,3 +128,69 @@ Definition UNPAIR : instruction :=
   Instruction_seq (SEQ DUP (SEQ CAR (SEQ (DIP 1 (SEQ CDR NOOP)) NOOP))).
 Definition UNPAPAIR : instruction :=
   Instruction_seq (SEQ UNPAIR (SEQ (DIP 1 (SEQ UNPAIR NOOP)) NOOP)).
+
+Lemma opcode_dec (o1 o2 : opcode) : {o1 = o2} + {o1 <> o2}.
+Proof.
+  destruct o1; destruct o2; try (right; discriminate); try (left; reflexivity);
+    try (case (type_dec t t0); intuition congruence);
+    try (case (comparable_type_dec c c0); intuition congruence).
+  - (* EMPTY_MAP *)
+    case (comparable_type_dec c c0); case (type_dec t t0); intuition congruence.
+  - (* EMPTY_BIG_MAP *)
+    case (comparable_type_dec c c0); case (type_dec t t0); intuition congruence.
+  - (* CONTRACT *)
+    case (type_dec t t0); case (decidable_types.option_dec string_dec a a0);
+      intuition congruence.
+  - (* DIG *)
+    case (decidable_types.nat_dec n n0); intuition congruence.
+  - (* DUG *)
+    case (decidable_types.nat_dec n n0); intuition congruence.
+  - (* DROP *)
+    case (decidable_types.nat_dec n n0); intuition congruence.
+Defined.
+
+Fixpoint instruction_dec (i1 i2 : instruction) : { i1 = i2 } + { i1 <> i2 }
+with instruction_seq_dec (i1 i2 : instruction_seq) : { i1 = i2 } + { i1 <> i2 }
+with concrete_data_dec (d1 d2 : concrete_data) : {d1 = d2} + {d1 <> d2}.
+Proof.
+  - (* instruction_dec *)
+    destruct i1; destruct i2; try (right; discriminate); try (left; reflexivity);
+    try (case (instruction_seq_dec i i0); intuition congruence);
+    try (case (instruction_seq_dec i1_1 i2_1); case (instruction_seq_dec i1_2 i2_2); intuition congruence).
+    + (* IF_ *)
+      destruct i; destruct i2; try (right; discriminate);
+        case (instruction_seq_dec i0 i3); case (instruction_seq_dec i1 i4); intuition congruence.
+    + (* LOOP_ *)
+      destruct l; destruct l0; try (right; discriminate);
+        case (instruction_seq_dec i i0); intuition congruence.
+    + (* PUSH *)
+      case (type_dec t t0); case (concrete_data_dec c c0); intuition congruence.
+    + (* LAMBDA *)
+      case (type_dec t t1); case (type_dec t0 t2); case (instruction_seq_dec i i0); intuition congruence.
+    + (* CREATE_CONTRACT *)
+      case (type_dec t t1); case (type_dec t0 t2); case (decidable_types.option_dec string_dec a a0);
+        case (instruction_seq_dec i i0); intuition congruence.
+    + (* DIP *)
+      case (decidable_types.nat_dec n n0); case (instruction_seq_dec i i0); intuition congruence.
+    + (* SELF *)
+      case (decidable_types.option_dec string_dec a a0); intuition congruence.
+    + (* opcodes *)
+      case (opcode_dec o o0); intuition congruence.
+  - destruct i1; destruct i2; try (right; discriminate).
+    + intuition.
+    + case (instruction_dec i i0); case (instruction_seq_dec i1 i2); intuition congruence.
+  - (* concrete_data_dec *)
+    destruct d1; destruct d2; try (right; discriminate);
+      try (left; reflexivity);
+      try (case (concrete_data_dec d1 d2); intuition congruence);
+      try (case (concrete_data_dec d1_1 d2_1); case (concrete_data_dec d1_2 d2_2);
+           intuition congruence).
+    + (* Int *)
+      case (decidable_types.Z_dec z z0); intuition congruence.
+    + (* String *)
+      case (string_dec s s0); intuition congruence.
+    + (* Bytes *)
+      case (string_dec s s0); intuition congruence.
+    + case (decidable_types.list_dec concrete_data_dec l l0); intuition congruence.
+    + case (instruction_seq_dec i i0); intuition congruence.
+Defined.
diff --git a/src/michocoq/untyper.v b/src/michocoq/untyper.v
index a26f2f4f..a003958a 100644
--- a/src/michocoq/untyper.v
+++ b/src/michocoq/untyper.v
@@ -926,8 +926,8 @@ Inductive untype_mode := untype_Readable | untype_Optimized.
   Qed.
 
   Definition un_address ty (addr : syntax.concrete_data ty) :
-    Datatypes.option (comparable.comparable_data address) :=
-    match addr return Datatypes.option (comparable.comparable_data address) with
+    Datatypes.option address_constant :=
+    match addr return Datatypes.option address_constant with
     | Address_constant x => Some x
     | _ => None
     end.
@@ -951,7 +951,7 @@ Inductive untype_mode := untype_Readable | untype_Optimized.
   Qed.
 
   Lemma concrete_address_inversion (addr : syntax.concrete_data (Comparable_type address)) :
-    exists x : comparable.comparable_data address,
+    exists x : address_constant,
       addr = Address_constant x.
   Proof.
     case_eq (un_address address addr).
-- 
GitLab


From 77f913594dd687e115ad3ae94ba15cf35e9a4b9d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Wed, 22 Apr 2020 15:59:16 +0200
Subject: [PATCH 54/56] General-purpose error named Debug

---
 src/michocoq/error.v    | 3 ++-
 src/michocoq/error_pp.v | 1 +
 2 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/michocoq/error.v b/src/michocoq/error.v
index 04b9e0a8..14597f8d 100644
--- a/src/michocoq/error.v
+++ b/src/michocoq/error.v
@@ -36,7 +36,8 @@ Inductive exception : Type :=
 | Expansion (_ _ : location)
 | Expansion_prim (_ _ : location) (_ : String.string)
 | Typing (A : Set) (a : A)
-| Unit_test (input expected actual : String.string).
+| Unit_test (input expected actual : String.string)
+| Debug (_ : String.string).
 
 Inductive M (A : Type) : Type :=
 | Failed : exception -> M A
diff --git a/src/michocoq/error_pp.v b/src/michocoq/error_pp.v
index b780a371..c678dc49 100644
--- a/src/michocoq/error_pp.v
+++ b/src/michocoq/error_pp.v
@@ -25,6 +25,7 @@ Definition exception_pp (e : exception) : string :=
                        "  input: {" ++ input ++ "}" ++ lf ++
                        "  expected output: {" ++ expected ++ "}" ++ lf ++
                        "  actual output: {" ++ actual ++ "}"
+  | Debug s => "Debug: " ++ s
   end.
 
 Definition m_pp {A} (m : M A) : string :=
-- 
GitLab


From a3dc02e34476b01c59e434fbcbf6343b6d01b55b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Wed, 22 Apr 2020 16:00:45 +0200
Subject: [PATCH 55/56] Support for some of the optional fields of TZT

The following fields are now supported:
- amount
- balance
- chain_id
- now
- sender
- source
---
 src/michocoq/main.v                | 100 ++++++++++++++-
 src/michocoq/micheline2michelson.v | 188 +++++++++++++++++++++++++++--
 src/michocoq/syntax.v              |   7 +-
 3 files changed, 276 insertions(+), 19 deletions(-)

diff --git a/src/michocoq/main.v b/src/michocoq/main.v
index e47734b7..12f5caa2 100644
--- a/src/michocoq/main.v
+++ b/src/michocoq/main.v
@@ -84,6 +84,15 @@ Definition tzt_file_M :=
   let! x := parsed_M in
   micheline2michelson.micheline2tzt_file x.
 
+Definition lift_opt {A B : Set} (f : A -> error.M B) (a : Datatypes.option A) : error.M (Datatypes.option B)
+:=
+  match a with
+  | None => error.Return None
+  | Some a =>
+    let! b := f a in
+    error.Return (Some b)
+  end.
+
 Definition tzt_file_typed_M :=
   let! file := tzt_file_M in
   let! input := typer.type_stack file.(micheline2michelson.input) in
@@ -91,11 +100,47 @@ Definition tzt_file_typed_M :=
   let! tcode := typer.type_check_instruction_seq_no_tail_fail
                   (typer.type_instruction_seq typer.Any)
                   file.(micheline2michelson.tcode) _ _ in
+  let! amount :=
+     lift_opt
+       (fun amount => typer.type_data typer.Optimized amount mutez)
+       file.(micheline2michelson.amount)
+  in
+  let! balance :=
+     lift_opt
+       (fun balance => typer.type_data typer.Optimized balance mutez)
+       file.(micheline2michelson.balance)
+  in
+  let! chain_id_ :=
+     lift_opt
+       (fun chain_id_ => typer.type_data typer.Optimized chain_id_ chain_id)
+       file.(micheline2michelson.chain_id)
+  in
+  let! now :=
+     lift_opt
+       (fun now => typer.type_data typer.Optimized now timestamp)
+       file.(micheline2michelson.now)
+  in
+  let! sender :=
+     lift_opt
+       (fun sender => typer.type_data typer.Optimized sender address)
+       file.(micheline2michelson.sender)
+  in
+  let! source :=
+     lift_opt
+       (fun source => typer.type_data typer.Optimized source address)
+       file.(micheline2michelson.source)
+  in
   error.Return
     {|
       tzt_file_input := input;
       tzt_file_output := output;
       tzt_file_code := tcode;
+      tzt_file_amount := amount;
+      tzt_file_balance := balance;
+      tzt_file_chain_id := chain_id_;
+      tzt_file_now := now;
+      tzt_file_sender := sender;
+      tzt_file_source := source;
     |}.
 
 Import Sem.
@@ -130,6 +175,49 @@ Definition tzt_file_check_M :=
   let! file := tzt_file_typed_M in
   let output := file.(tzt_file_output) in
   let input := file.(tzt_file_input) in
+  let amount :=
+      match file.(tzt_file_amount) with
+      | None => 0 ~Mutez
+      | Some amount =>
+        concrete_data_to_data mutez amount
+      end
+  in
+  let balance :=
+      match file.(tzt_file_balance) with
+      | None => 0 ~Mutez
+      | Some balance =>
+        concrete_data_to_data mutez balance
+      end
+  in
+  let chain_id_ :=
+      match file.(tzt_file_chain_id) with
+      | None => (Mk_chain_id "chain_id"%string)
+      | Some chain_id_ =>
+        concrete_data_to_data chain_id chain_id_
+      end
+  in
+  let now :=
+      match file.(tzt_file_now) with
+      | None => 0%Z
+      | Some now =>
+        concrete_data_to_data timestamp now
+      end
+  in
+  let sender :=
+      match file.(tzt_file_sender) with
+      | None => (Implicit (Mk_key_hash "Sender"%string))
+      | Some sender =>
+        concrete_data_to_data address sender
+      end
+  in
+  let source :=
+      match file.(tzt_file_source) with
+      | None => (Implicit (Mk_key_hash "Source"%string))
+      | Some source =>
+        concrete_data_to_data address source
+      end
+  in
+
   let proto_env : Sem.proto_env :=
       mk_proto_env
         None
@@ -138,12 +226,12 @@ Definition tzt_file_check_M :=
                Originated (Mk_smart_contract_address  "new_contract"%string)))
             (fun p arg amount destination => Mk_operation "transfer"%string)
           (fun delegate => Mk_operation "set_delegate"%string)
-          (0 ~Mutez)            (* Balance *)
-          (Implicit (Mk_key_hash "Source"%string))
-          (Implicit (Mk_key_hash "Sender"%string))
+          balance
+          source
+          sender
           tt                    (* Self *)
-          (0 ~Mutez)            (* Amount *)
-          0%Z                     (* Now *)
+          amount
+          now
           (fun key => Mk_key_hash "key_hash"%string)
           (fun a x => "pack"%string)
           (fun a bytes => None)
@@ -151,7 +239,7 @@ Definition tzt_file_check_M :=
           (fun x => x)
           (fun x => x)
           (fun key sig data => false)
-          (Mk_chain_id "chain_id"%string) in
+          chain_id_ in
   let input := Sem.stack_from_concrete input in
   let! actual_output :=
      Sem.eval_seq proto_env file.(tzt_file_code) fuel input
diff --git a/src/michocoq/micheline2michelson.v b/src/michocoq/micheline2michelson.v
index efb20e4e..86f0609c 100644
--- a/src/michocoq/micheline2michelson.v
+++ b/src/michocoq/micheline2michelson.v
@@ -812,36 +812,162 @@ Record untyped_tzt_file :=
   Mk_untyped_tzt_file
     { input : concrete_stack;
       tcode : instruction_seq;
-      output : concrete_stack }.
+      output : concrete_stack;
+      amount : Datatypes.option concrete_data;
+      balance : Datatypes.option concrete_data;
+      chain_id : Datatypes.option concrete_data;
+      now : Datatypes.option concrete_data;
+      sender : Datatypes.option concrete_data;
+      source : Datatypes.option concrete_data;
+    }.
 
 Record untyped_tzt_file_opt :=
   Mk_untyped_tzt_file_opt
     { input_opt : Datatypes.option concrete_stack;
       tcode_opt : Datatypes.option instruction_seq;
-      output_opt : Datatypes.option concrete_stack }.
+      output_opt : Datatypes.option concrete_stack;
+      amount_opt : Datatypes.option concrete_data;
+      balance_opt : Datatypes.option concrete_data;
+      chain_id_opt : Datatypes.option concrete_data;
+      now_opt : Datatypes.option concrete_data;
+      sender_opt : Datatypes.option concrete_data;
+      source_opt : Datatypes.option concrete_data;
+    }.
 
 Definition read_tzt_input (s : concrete_stack) (f : untyped_tzt_file_opt) :=
   match f.(input_opt) with
   | None => Return {| input_opt := Some s;
                       tcode_opt := f.(tcode_opt);
-                      output_opt := f.(output_opt) |}
-  | Some _ => Failed _ Parsing
+                      output_opt := f.(output_opt);
+                      amount_opt := f.(amount_opt);
+                      balance_opt := f.(balance_opt);
+                      chain_id_opt := f.(chain_id_opt);
+                      now_opt := f.(now_opt);
+                      sender_opt := f.(sender_opt);
+                      source_opt := f.(source_opt);
+                   |}
+  | Some _ => Failed _ (Debug "duplicated input field")
   end.
 
 Definition read_tzt_code (c : instruction_seq) (f : untyped_tzt_file_opt) :=
   match f.(tcode_opt) with
   | None => Return {| input_opt := f.(input_opt);
                       tcode_opt := Some c;
-                      output_opt := f.(output_opt) |}
-  | Some _ => Failed _ Parsing
+                      output_opt := f.(output_opt);
+                      amount_opt := f.(amount_opt);
+                      balance_opt := f.(balance_opt);
+                      chain_id_opt := f.(chain_id_opt);
+                      now_opt := f.(now_opt);
+                      sender_opt := f.(sender_opt);
+                      source_opt := f.(source_opt);
+                   |}
+  | Some _ => Failed _ (Debug "duplicated code field")
   end.
 
 Definition read_tzt_output (s : concrete_stack) (f : untyped_tzt_file_opt) :=
   match f.(output_opt) with
   | None => Return {| input_opt := f.(input_opt);
                       tcode_opt := f.(tcode_opt);
-                      output_opt := Some s |}
-  | Some _ => Failed _ Parsing
+                      output_opt := Some s;
+                      amount_opt := f.(amount_opt);
+                      balance_opt := f.(balance_opt);
+                      chain_id_opt := f.(chain_id_opt);
+                      now_opt := f.(now_opt);
+                      sender_opt := f.(sender_opt);
+                      source_opt := f.(source_opt);
+                   |}
+  | Some _ => Failed _ (Debug "duplicated output field")
+  end.
+
+Definition read_tzt_amount (s : concrete_data) (f : untyped_tzt_file_opt) :=
+  match f.(amount_opt) with
+  | None => Return {| input_opt := f.(input_opt);
+                      tcode_opt := f.(tcode_opt);
+                      output_opt := f.(output_opt);
+                      amount_opt := Some s;
+                      balance_opt := f.(balance_opt);
+                      chain_id_opt := f.(chain_id_opt);
+                      now_opt := f.(now_opt);
+                      sender_opt := f.(sender_opt);
+                      source_opt := f.(source_opt);
+                   |}
+  | Some s' => Failed _ (Debug "duplicated amount field")
+  end.
+
+Definition read_tzt_balance (s : concrete_data) (f : untyped_tzt_file_opt) :=
+  match f.(balance_opt) with
+  | None => Return {| input_opt := f.(input_opt);
+                      tcode_opt := f.(tcode_opt);
+                      output_opt := f.(output_opt);
+                      amount_opt := f.(amount_opt);
+                      balance_opt := Some s;
+                      chain_id_opt := f.(chain_id_opt);
+                      now_opt := f.(now_opt);
+                      sender_opt := f.(sender_opt);
+                      source_opt := f.(source_opt);
+                   |}
+  | Some _ => Failed _ (Debug "duplicated balance field")
+  end.
+
+Definition read_tzt_chain_id (s : concrete_data) (f : untyped_tzt_file_opt) :=
+  match f.(chain_id_opt) with
+  | None => Return {| input_opt := f.(input_opt);
+                      tcode_opt := f.(tcode_opt);
+                      output_opt := f.(output_opt);
+                      amount_opt := f.(amount_opt);
+                      balance_opt := f.(balance_opt);
+                      chain_id_opt := Some s;
+                      now_opt := f.(now_opt);
+                      sender_opt := f.(sender_opt);
+                      source_opt := f.(source_opt);
+                   |}
+  | Some _ => Failed _ (Debug "duplicated chain_id field")
+  end.
+
+Definition read_tzt_now (s : concrete_data) (f : untyped_tzt_file_opt) :=
+  match f.(now_opt) with
+  | None => Return {| input_opt := f.(input_opt);
+                      tcode_opt := f.(tcode_opt);
+                      output_opt := f.(output_opt);
+                      amount_opt := f.(amount_opt);
+                      balance_opt := f.(balance_opt);
+                      chain_id_opt := f.(chain_id_opt);
+                      now_opt := Some s;
+                      sender_opt := f.(sender_opt);
+                      source_opt := f.(source_opt);
+                   |}
+  | Some _ => Failed _ (Debug "duplicated now field")
+  end.
+
+Definition read_tzt_sender (s : concrete_data) (f : untyped_tzt_file_opt) :=
+  match f.(sender_opt) with
+  | None => Return {| input_opt := f.(input_opt);
+                      tcode_opt := f.(tcode_opt);
+                      output_opt := f.(output_opt);
+                      amount_opt := f.(amount_opt);
+                      balance_opt := f.(balance_opt);
+                      chain_id_opt := f.(chain_id_opt);
+                      now_opt := f.(now_opt);
+                      sender_opt := Some s;
+                      source_opt := f.(source_opt);
+                   |}
+  | Some _ => Failed _ (Debug "duplicated sender field")
+  end.
+
+
+Definition read_tzt_source (s : concrete_data) (f : untyped_tzt_file_opt) :=
+  match f.(source_opt) with
+  | None => Return {| input_opt := f.(input_opt);
+                      tcode_opt := f.(tcode_opt);
+                      output_opt := f.(output_opt);
+                      amount_opt := f.(amount_opt);
+                      balance_opt := f.(balance_opt);
+                      chain_id_opt := f.(chain_id_opt);
+                      now_opt := f.(now_opt);
+                      sender_opt := f.(sender_opt);
+                      source_opt := Some s;
+                   |}
+  | Some _ => Failed _ (Debug "duplicated source field")
   end.
 
 Definition micheline2tzt_file (m : Datatypes.list loc_micheline) : M untyped_tzt_file :=
@@ -865,15 +991,53 @@ Definition micheline2tzt_file (m : Datatypes.list loc_micheline) : M untyped_tzt
         | PRIM (_, _, "output") (cons output nil) =>
           let! output := micheline2michelson_stack output in
           read_tzt_output output a
+        | PRIM (_, _, "amount") (cons amount nil) =>
+          let! amount := micheline2michelson_data amount in
+          read_tzt_amount amount a
+        | PRIM (_, _, "balance") (cons balance nil) =>
+          let! balance := micheline2michelson_data balance in
+          read_tzt_balance balance a
+        | PRIM (_, _, "chain_id") (cons chain_id nil) =>
+          let! chain_id := micheline2michelson_data chain_id in
+          read_tzt_chain_id chain_id a
+        | PRIM (_, _, "now") (cons now nil) =>
+          let! now := micheline2michelson_data now in
+          read_tzt_now now a
+        | PRIM (_, _, "sender") (cons sender nil) =>
+          let! sender := micheline2michelson_data sender in
+          read_tzt_sender sender a
+        | PRIM (_, _, "source") (cons source nil) =>
+          let! source := micheline2michelson_data source in
+          read_tzt_source source a
         | PRIM (_, _, prim) _ =>
           Failed _ (Expansion_prim b e prim)
-        | _ => Failed _ Parsing
+        | _ => Failed _ (Expansion b e)
         end)
       l
-    {| input_opt := None; tcode_opt := None; output_opt := None |} in
+      {|
+        input_opt := None;
+        tcode_opt := None;
+        output_opt := None;
+        amount_opt := None;
+        balance_opt := None;
+        chain_id_opt := None;
+        now_opt := None;
+        sender_opt := None;
+        source_opt := None;
+      |} in
     match a.(input_opt), a.(tcode_opt), a.(output_opt) with
     | Some input, Some code, Some output =>
-      Return {| input := input; tcode := code; output := output |}
-    | _, _, _ => Failed _ Parsing
+      Return
+        {| input := input;
+           tcode := code;
+           output := output;
+           amount := a.(amount_opt);
+           balance := a.(balance_opt);
+           chain_id := a.(chain_id_opt);
+           now := a.(now_opt);
+           sender := a.(sender_opt);
+           source := a.(source_opt);
+        |}
+    | _, _, _ => Failed _ (Debug "missing a mandatory field")
     end.
 
diff --git a/src/michocoq/syntax.v b/src/michocoq/syntax.v
index 7c308268..82394ff6 100644
--- a/src/michocoq/syntax.v
+++ b/src/michocoq/syntax.v
@@ -888,7 +888,6 @@ Fixpoint typed_concrete_stack l :=
   | nil => Datatypes.unit
   | cons ty l => (syntax.concrete_data ty * typed_concrete_stack l)%type
   end.
-
 Record tzt_file : Set :=
   Mk_tzt_file
     {
@@ -898,4 +897,10 @@ Record tzt_file : Set :=
       tzt_file_output : typed_concrete_stack tzt_file_output_type;
       tzt_file_code :
         instruction_seq None Datatypes.false tzt_file_input_type tzt_file_output_type;
+      tzt_file_amount : Datatypes.option (concrete_data mutez);
+      tzt_file_balance : Datatypes.option (concrete_data mutez);
+      tzt_file_chain_id : Datatypes.option (concrete_data chain_id);
+      tzt_file_now : Datatypes.option (concrete_data timestamp);
+      tzt_file_sender : Datatypes.option (concrete_data address);
+      tzt_file_source : Datatypes.option (concrete_data address);
     }.
-- 
GitLab


From 6410e49866729f49d131cc88c18375fd90e8be77 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?=
 <raphael.cauderlier@nomadic-labs.com>
Date: Wed, 6 May 2020 13:24:39 +0200
Subject: [PATCH 56/56] WIP: self and param

---
 src/michocoq/main.v                |  75 +++++---
 src/michocoq/micheline2michelson.v |  66 +++++++
 src/michocoq/semantics.v           | 268 +++++++++++++++--------------
 src/michocoq/syntax.v              |   3 +
 4 files changed, 257 insertions(+), 155 deletions(-)

diff --git a/src/michocoq/main.v b/src/michocoq/main.v
index 12f5caa2..36458b11 100644
--- a/src/michocoq/main.v
+++ b/src/michocoq/main.v
@@ -130,6 +130,12 @@ Definition tzt_file_typed_M :=
        (fun source => typer.type_data typer.Optimized source address)
        file.(micheline2michelson.source)
   in
+  let param := file.(micheline2michelson.param) in
+  let! self :=
+     lift_opt
+       (fun self => typer.type_data self address)
+       file.(micheline2michelson.self)
+  in
   error.Return
     {|
       tzt_file_input := input;
@@ -141,6 +147,8 @@ Definition tzt_file_typed_M :=
       tzt_file_now := now;
       tzt_file_sender := sender;
       tzt_file_source := source;
+      tzt_file_param := param;
+      tzt_file_self := self;
     |}.
 
 Import Sem.
@@ -217,29 +225,49 @@ Definition tzt_file_check_M :=
         concrete_data_to_data address source
       end
   in
-
+  let param :=
+      match file.(tzt_file_param) with
+      | None => unit
+      | Some ty => ty
+      end
+  in
+  let self :=
+      match file.(tzt_file_self) with
+      | None => (Originated (syntax.Mk_smart_contract_address "Self"%string))
+      | Some addr => concrete_data_to_data address addr
+      end
+  in
+  let dummy_hash_key (key : data key) := Mk_key_hash "key_hash"%string in
+  let dummy_hash (x : data bytes) := x in
+  let dummy_pack (a : type) (x : data a) : data bytes := "pack"%string in
+  let dummy_unpack (a : type) (x : data bytes) : data (option a) := None in
+  let dummy_check_signature key sig data := false in
+  let dummy_create_contract g p annot ttf delegate balance code storage :=
+      (Mk_operation "origination"%string,
+       Originated (Mk_smart_contract_address  "new_contract"%string)) in
+  let dummy_transfer_tokens p arg amount destination :=
+      Mk_operation "transfer"%string in
+  let dummy_set_delegate delegate := Mk_operation "set_delegate"%string in
   let proto_env : Sem.proto_env :=
       mk_proto_env
-        None
-            (fun g p annot ttf delegate balance code storage =>
-              (Mk_operation "origination"%string,
-               Originated (Mk_smart_contract_address  "new_contract"%string)))
-            (fun p arg amount destination => Mk_operation "transfer"%string)
-          (fun delegate => Mk_operation "set_delegate"%string)
-          balance
-          source
-          sender
-          tt                    (* Self *)
-          amount
-          now
-          (fun key => Mk_key_hash "key_hash"%string)
-          (fun a x => "pack"%string)
-          (fun a bytes => None)
-          (fun x => x)
-          (fun x => x)
-          (fun x => x)
-          (fun key sig data => false)
-          chain_id_ in
+        (Some (param, None))
+        dummy_create_contract
+        dummy_transfer_tokens
+        dummy_set_delegate
+        balance
+        source
+        sender
+        self
+        amount
+        now
+        dummy_hash_key
+        dummy_pack
+        dummy_unpack
+        dummy_hash
+        dummy_hash
+        dummy_hash
+        dummy_check_signature
+        chain_id_ in
   let input := Sem.stack_from_concrete input in
   let! actual_output :=
      Sem.eval_seq proto_env file.(tzt_file_code) fuel input
@@ -259,9 +287,6 @@ Definition is_tzt := error_pp.m_pp tzt_file_M.
 Definition unit_test_check := error_pp.m_pp tzt_file_check_M.
 
 Definition print_info_tzt :=
-  ("Lexing: " ++ is_lexed ++ lf ++
-   "Parsing: " ++ is_parsed ++ lf ++
-   "Expansion: " ++ is_tzt ++ lf ++
-   "Unit test: " ++ unit_test_check ++ lf)%string.
+  ("Unit test: " ++ unit_test_check ++ lf)%string.
 
 End Main.
diff --git a/src/michocoq/micheline2michelson.v b/src/michocoq/micheline2michelson.v
index 86f0609c..4ca6c896 100644
--- a/src/michocoq/micheline2michelson.v
+++ b/src/michocoq/micheline2michelson.v
@@ -819,6 +819,8 @@ Record untyped_tzt_file :=
       now : Datatypes.option concrete_data;
       sender : Datatypes.option concrete_data;
       source : Datatypes.option concrete_data;
+      param : Datatypes.option type;
+      self : Datatypes.option concrete_data;
     }.
 
 Record untyped_tzt_file_opt :=
@@ -832,6 +834,8 @@ Record untyped_tzt_file_opt :=
       now_opt : Datatypes.option concrete_data;
       sender_opt : Datatypes.option concrete_data;
       source_opt : Datatypes.option concrete_data;
+      param_opt : Datatypes.option type;
+      self_opt : Datatypes.option concrete_data;
     }.
 
 Definition read_tzt_input (s : concrete_stack) (f : untyped_tzt_file_opt) :=
@@ -845,6 +849,8 @@ Definition read_tzt_input (s : concrete_stack) (f : untyped_tzt_file_opt) :=
                       now_opt := f.(now_opt);
                       sender_opt := f.(sender_opt);
                       source_opt := f.(source_opt);
+                      param_opt := f.(param_opt);
+                      self_opt := f.(self_opt);
                    |}
   | Some _ => Failed _ (Debug "duplicated input field")
   end.
@@ -860,6 +866,8 @@ Definition read_tzt_code (c : instruction_seq) (f : untyped_tzt_file_opt) :=
                       now_opt := f.(now_opt);
                       sender_opt := f.(sender_opt);
                       source_opt := f.(source_opt);
+                      param_opt := f.(param_opt);
+                      self_opt := f.(self_opt);
                    |}
   | Some _ => Failed _ (Debug "duplicated code field")
   end.
@@ -875,6 +883,8 @@ Definition read_tzt_output (s : concrete_stack) (f : untyped_tzt_file_opt) :=
                       now_opt := f.(now_opt);
                       sender_opt := f.(sender_opt);
                       source_opt := f.(source_opt);
+                      param_opt := f.(param_opt);
+                      self_opt := f.(self_opt);
                    |}
   | Some _ => Failed _ (Debug "duplicated output field")
   end.
@@ -890,6 +900,8 @@ Definition read_tzt_amount (s : concrete_data) (f : untyped_tzt_file_opt) :=
                       now_opt := f.(now_opt);
                       sender_opt := f.(sender_opt);
                       source_opt := f.(source_opt);
+                      param_opt := f.(param_opt);
+                      self_opt := f.(self_opt);
                    |}
   | Some s' => Failed _ (Debug "duplicated amount field")
   end.
@@ -905,6 +917,8 @@ Definition read_tzt_balance (s : concrete_data) (f : untyped_tzt_file_opt) :=
                       now_opt := f.(now_opt);
                       sender_opt := f.(sender_opt);
                       source_opt := f.(source_opt);
+                      param_opt := f.(param_opt);
+                      self_opt := f.(self_opt);
                    |}
   | Some _ => Failed _ (Debug "duplicated balance field")
   end.
@@ -920,6 +934,8 @@ Definition read_tzt_chain_id (s : concrete_data) (f : untyped_tzt_file_opt) :=
                       now_opt := f.(now_opt);
                       sender_opt := f.(sender_opt);
                       source_opt := f.(source_opt);
+                      param_opt := f.(param_opt);
+                      self_opt := f.(self_opt);
                    |}
   | Some _ => Failed _ (Debug "duplicated chain_id field")
   end.
@@ -935,6 +951,8 @@ Definition read_tzt_now (s : concrete_data) (f : untyped_tzt_file_opt) :=
                       now_opt := Some s;
                       sender_opt := f.(sender_opt);
                       source_opt := f.(source_opt);
+                      param_opt := f.(param_opt);
+                      self_opt := f.(self_opt);
                    |}
   | Some _ => Failed _ (Debug "duplicated now field")
   end.
@@ -950,6 +968,8 @@ Definition read_tzt_sender (s : concrete_data) (f : untyped_tzt_file_opt) :=
                       now_opt := f.(now_opt);
                       sender_opt := Some s;
                       source_opt := f.(source_opt);
+                      param_opt := f.(param_opt);
+                      self_opt := f.(self_opt);
                    |}
   | Some _ => Failed _ (Debug "duplicated sender field")
   end.
@@ -966,10 +986,46 @@ Definition read_tzt_source (s : concrete_data) (f : untyped_tzt_file_opt) :=
                       now_opt := f.(now_opt);
                       sender_opt := f.(sender_opt);
                       source_opt := Some s;
+                      param_opt := f.(param_opt);
+                      self_opt := f.(self_opt);
                    |}
   | Some _ => Failed _ (Debug "duplicated source field")
   end.
 
+Definition read_tzt_param (s : type) (f : untyped_tzt_file_opt) :=
+  match f.(param_opt) with
+  | None => Return {| input_opt := f.(input_opt);
+                      tcode_opt := f.(tcode_opt);
+                      output_opt := f.(output_opt);
+                      amount_opt := f.(amount_opt);
+                      balance_opt := f.(balance_opt);
+                      chain_id_opt := f.(chain_id_opt);
+                      now_opt := f.(now_opt);
+                      sender_opt := f.(sender_opt);
+                      source_opt := f.(source_opt);
+                      param_opt := Some s;
+                      self_opt := f.(self_opt);
+                   |}
+  | Some _ => Failed _ (Debug "duplicated param field")
+  end.
+
+Definition read_tzt_self (s : concrete_data) (f : untyped_tzt_file_opt) :=
+  match f.(self_opt) with
+  | None => Return {| input_opt := f.(input_opt);
+                      tcode_opt := f.(tcode_opt);
+                      output_opt := f.(output_opt);
+                      amount_opt := f.(amount_opt);
+                      balance_opt := f.(balance_opt);
+                      chain_id_opt := f.(chain_id_opt);
+                      now_opt := f.(now_opt);
+                      sender_opt := f.(sender_opt);
+                      source_opt := f.(source_opt);
+                      param_opt := f.(param_opt);
+                      self_opt := Some s;
+                   |}
+  | Some _ => Failed _ (Debug "duplicated self field")
+  end.
+
 Definition micheline2tzt_file (m : Datatypes.list loc_micheline) : M untyped_tzt_file :=
   let l :=
       match m with
@@ -1009,6 +1065,12 @@ Definition micheline2tzt_file (m : Datatypes.list loc_micheline) : M untyped_tzt
         | PRIM (_, _, "source") (cons source nil) =>
           let! source := micheline2michelson_data source in
           read_tzt_source source a
+        | PRIM (_, _, "parameter") (cons param nil) =>
+          let! param := micheline2michelson_type param in
+          read_tzt_param param a
+        | PRIM (_, _, "self") (cons self nil) =>
+          let! self := micheline2michelson_data self in
+          read_tzt_self self a
         | PRIM (_, _, prim) _ =>
           Failed _ (Expansion_prim b e prim)
         | _ => Failed _ (Expansion b e)
@@ -1024,6 +1086,8 @@ Definition micheline2tzt_file (m : Datatypes.list loc_micheline) : M untyped_tzt
         now_opt := None;
         sender_opt := None;
         source_opt := None;
+        param_opt := None;
+        self_opt := None;
       |} in
     match a.(input_opt), a.(tcode_opt), a.(output_opt) with
     | Some input, Some code, Some output =>
@@ -1037,6 +1101,8 @@ Definition micheline2tzt_file (m : Datatypes.list loc_micheline) : M untyped_tzt
            now := a.(now_opt);
            sender := a.(sender_opt);
            source := a.(source_opt);
+           param := a.(param_opt);
+           self := a.(self_opt);
         |}
     | _, _, _ => Failed _ (Debug "missing a mandatory field")
     end.
diff --git a/src/michocoq/semantics.v b/src/michocoq/semantics.v
index aecac05e..4cef955b 100644
--- a/src/michocoq/semantics.v
+++ b/src/michocoq/semantics.v
@@ -201,8 +201,11 @@ Defined.
 Module Semantics(C : ContractContext).
   Export C.
 
-  Definition get_address_type (sao : comparable_data address * annot_o)
-    : Datatypes.option type :=
+  Definition get_address_type
+             (get_contract_type :
+                smart_contract_address_constant -> Datatypes.option type)
+             (sao : comparable_data address * annot_o)
+  : Datatypes.option type :=
     let '(addr, ao) := sao in
     opt_bind
       (match addr with
@@ -212,24 +215,24 @@ Module Semantics(C : ContractContext).
       (fun ty =>
          get_entrypoint_opt ao ty None).
 
-  Fixpoint data (a : type) {struct a} : Set :=
+  Fixpoint data g (a : type) {struct a} : Set :=
     match a with
     | Comparable_type b => comparable_data b
     | signature => signature_constant
     | operation => operation_constant
     | key => key_constant
     | unit => Datatypes.unit
-    | pair a b => data a * data b
-    | or a _ b _ => sum (data a) (data b)
-    | option a => Datatypes.option (data a)
-    | list a => Datatypes.list (data a)
+    | pair a b => data g a * data g b
+    | or a _ b _ => sum (data g a) (data g b)
+    | option a => Datatypes.option (data g a)
+    | list a => Datatypes.list (data g a)
     | set a => set.set (comparable_data a) (compare a)
-    | map a b => map.map (comparable_data a) (data b) (compare a)
-    | big_map a b => map.map (comparable_data a) (data b) (compare a)
+    | map a b => map.map (comparable_data a) (data g b) (compare a)
+    | big_map a b => map.map (comparable_data a) (data g b) (compare a)
     | lambda a b =>
       sigT (fun tff : Datatypes.bool =>
              instruction_seq None tff (a ::: nil) (b ::: nil))
-    | contract a => sig (fun sao : (address_constant * annot_o) => get_address_type sao = Some a )
+    | contract a => sig (fun sao : (address_constant * annot_o) => get_address_type g sao = Some a )
     | chain_id => chain_id_constant
     end.
 
@@ -239,7 +242,7 @@ Module Semantics(C : ContractContext).
     repeat decide equality.
   Defined.
 
-  Lemma data_dec {a : type} : decidable_types.decidable (data a).
+  Lemma data_dec {g} {a : type} : decidable_types.decidable (data g a).
   Proof.
     induction a; simpl.
     - intros x y.
@@ -277,49 +280,50 @@ Module Semantics(C : ContractContext).
     - intros x y. repeat decide equality.
   Defined.
 
-  Record proto_env {self_ty : self_info} : Type :=
+  Record proto_env {self_ty : self_info} {g} : Type :=
     mk_proto_env
       {
-        create_contract : forall g p annot tff,
+        create_contract : forall st p annot tff,
           Datatypes.option (comparable_data key_hash) ->
           tez.mutez ->
           syntax.instruction_seq (Some (p, annot)) tff
-                             (pair p g ::: nil)
+                             (pair p st ::: nil)
                              (pair (list operation) g ::: nil) ->
-          data g -> data (pair operation address);
+          data g st -> data g (pair operation address);
         transfer_tokens : forall p,
-            data p -> tez.mutez -> data (contract p) ->
-            data operation;
+            data g p -> tez.mutez -> data g (contract p) ->
+            data g operation;
         set_delegate : Datatypes.option (comparable_data key_hash) ->
-                       data operation;
+                       data g operation;
         balance : tez.mutez;
-        source : data address;
-        sender : data address;
+        source : data g address;
+        sender : data g address;
         self :
             match self_ty with
             | None => Datatypes.unit
             | Some (ty, self_annot) =>
               forall annot_opt H,
-                data (contract (get_opt (get_entrypoint_opt annot_opt ty self_annot) H))
+                data g (contract (get_opt (get_entrypoint_opt annot_opt ty self_annot) H))
             end;
         amount : tez.mutez;
         now : comparable_data timestamp;
-        hash_key : data key -> comparable_data key_hash;
-        pack : forall a, data a -> data bytes;
-        unpack : forall a, data bytes -> data (option a);
-        blake2b : data bytes -> data bytes;
-        sha256 : data bytes -> data bytes;
-        sha512 : data bytes -> data bytes;
+        hash_key : data g key -> comparable_data key_hash;
+        pack : forall a, data g a -> data g bytes;
+        unpack : forall a, data g bytes -> data g (option a);
+        blake2b : data g bytes -> data g bytes;
+        sha256 : data g bytes -> data g bytes;
+        sha512 : data g bytes -> data g bytes;
         check_signature :
-          data key -> data signature -> data bytes -> data bool;
-        chain_id_ : data chain_id
+          data g key -> data g signature -> data g bytes -> data g bool;
+        chain_id_ : data g chain_id
       }.
 
   Definition no_self
-             {self_type}
+             {g self_type}
              (e : proto_env (self_ty := self_type)) :
     proto_env (self_ty := None) :=
     mk_proto_env None
+                 g
                  (create_contract e)
                  (transfer_tokens e)
                  (set_delegate e)
@@ -338,13 +342,13 @@ Module Semantics(C : ContractContext).
                  (check_signature e)
                  (chain_id_ e).
 
-  Fixpoint stack (t : stack_type) : Set :=
+  Fixpoint stack g (t : stack_type) : Set :=
     match t with
     | nil => Datatypes.unit
-    | cons a A => data a * stack A
+    | cons a A => data g a * stack g A
     end.
 
-  Lemma stack_dec : forall A, decidable_types.decidable (stack A).
+  Lemma stack_dec : forall g A, decidable_types.decidable (stack g A).
   Proof.
     induction A.
     - intros [] []; left; reflexivity.
@@ -357,35 +361,35 @@ Module Semantics(C : ContractContext).
   Defined.
 
   (** Stack manipulation *)
-  Inductive stack_ind : stack_type -> Set -> Prop :=
-  | stack_nil : stack_ind nil Datatypes.unit
+  Inductive stack_ind g : stack_type -> Set -> Prop :=
+  | stack_nil : stack_ind g nil Datatypes.unit
   | stack_cons : forall a A S,
-      stack_ind A S -> stack_ind (cons a A) (data a * S).
+      stack_ind g A S -> stack_ind g (cons a A) (data g a * S).
 
-  Lemma stack_iff_stack_ind : forall (t : stack_type) (s : Set),
-      stack t = s <-> stack_ind t s.
+  Lemma stack_iff_stack_ind g (t : stack_type) : forall (s : Set),
+      stack g t = s <-> stack_ind g t s.
   Proof.
-    intros t.
     induction t as [|a t]; intros s; simpl.
     - split; intros; subst.
       + constructor.
       + inversion H; reflexivity.
     - split; intros; subst.
-      + constructor. rewrite <- (IHt (stack t)); reflexivity.
+      + constructor. rewrite <- (IHt (stack g t)); reflexivity.
       + inversion H; subst.
-        assert (stack t = S) by (rewrite (IHt S); assumption); subst; reflexivity.
+        assert (stack g t = S) by (rewrite (IHt S); assumption); subst; reflexivity.
   Qed.
 
   (* Dig stuff *)
 
-  Definition stack_app {l1} {l2} (S1 : stack l1) (S2 : stack l2) : stack (l1+++l2).
+  Definition stack_app {g l1 l2} (S1 : stack g l1) (S2 : stack g l2) :
+    stack g (l1+++l2).
   Proof.
     induction l1 as [|a l1]; simpl.
     - assumption.
     - inversion S1. split; auto.
   Defined.
 
-  Definition stack_split {l1 l2} (S : stack (l1 +++ l2)) : (stack l1 * stack l2).
+  Definition stack_split {g l1 l2} (S : stack g (l1 +++ l2)) : (stack g l1 * stack g l2).
   Proof.
     induction l1; simpl.
     - exact (tt, S).
@@ -396,7 +400,8 @@ Module Semantics(C : ContractContext).
       repeat (split; try assumption).
   Defined.
 
-  Definition stack_dig {l1 l2 t} (SA : stack (l1+++t:::l2)) : stack (t:::l1+++l2).
+  Definition stack_dig {g l1 l2 t} (SA : stack g (l1+++t:::l2)) :
+    stack g (t:::l1+++l2).
   Proof.
     simpl.
     apply stack_split in SA.
@@ -406,7 +411,8 @@ Module Semantics(C : ContractContext).
     apply stack_app; assumption.
   Defined.
 
-  Definition stack_dug {l1 l2 t} (SA : stack (t:::l1+++l2)) : stack (l1+++t:::l2).
+  Definition stack_dug {g l1 l2 t} (SA : stack g (t:::l1+++l2)) :
+    stack g (l1+++t:::l2).
   Proof.
     simpl in SA.
     destruct SA as (x, S12).
@@ -417,95 +423,97 @@ Module Semantics(C : ContractContext).
     - exact (x, S2).
   Defined.
 
-  Fixpoint comparable_data_to_data (a : comparable_type) (x : comparable_data a) : data a :=
+  Fixpoint comparable_data_to_data g (a : comparable_type) (x : comparable_data a) : data g a :=
     match a, x with
-    | Cpair a b, (x, y) => (x, comparable_data_to_data _ y)
+    | Cpair a b, (x, y) => (x, comparable_data_to_data g _ y)
     | Comparable_type_simple _, x => x
     end.
 
-  Fixpoint data_to_comparable_data (a : comparable_type) (x : data a) : comparable_data a :=
+  Fixpoint data_to_comparable_data {g} (a : comparable_type) (x : data g a) :
+    comparable_data a :=
     match a, x with
     | Cpair a b, (x, y) => (x, data_to_comparable_data _ y)
     | Comparable_type_simple _, x => x
     end.
 
-  Fixpoint concrete_data_to_data (a : type) (d : concrete_data a) : data a :=
-    match d with
-    | Int_constant x => x
-    | Nat_constant x => x
-    | String_constant x => x
-    | Bytes_constant x => x
-    | Timestamp_constant x => x
-    | Signature_constant x => Mk_sig x
-    | Key_constant x => Mk_key x
-    | Key_hash_constant x => Mk_key_hash x
-    | Mutez_constant (Mk_mutez x) => x
-    | Address_constant x => x
-    | Unit => tt
-    | True_ => true
-    | False_ => false
-    | Pair a b => (concrete_data_to_data _ a, concrete_data_to_data _ b)
-    | Left a _ _ => inl (concrete_data_to_data _ a)
-    | Right b _ _ => inr (concrete_data_to_data _ b)
-    | Some_ a => Some (concrete_data_to_data _ a)
-    | None_ => None
-    | Concrete_list l => List.map (concrete_data_to_data _) l
-    | @Concrete_set a l =>
-      (fix concrete_data_set_to_data (l : Datatypes.list (concrete_data a)) :=
-         match l with
-         | nil => set.empty _ _
-         | cons x l =>
-           set.insert
-             (comparable_data a)
-             (comparable.compare a)
-             (comparable.compare_eq_iff a)
-             (comparable.lt_trans a)
-             (comparable.gt_trans a)
-             (data_to_comparable_data _ (concrete_data_to_data a x))
-             (concrete_data_set_to_data l)
-         end) l
-    | @Concrete_map a b l =>
-      (fix concrete_data_map_to_data
-           (l : Datatypes.list (elt_pair (concrete_data a) (concrete_data b))) :=
-         match l with
-         | nil => map.empty _ _ _
-         | cons (Elt _ _ x y) l =>
-           map.update
-             (comparable_data a)
-             (data b)
-             (comparable.compare a)
-             (comparable.compare_eq_iff a)
-             (comparable.lt_trans a)
-             (comparable.gt_trans a)
-             (data_to_comparable_data _ (concrete_data_to_data _ x))
-             (Some (concrete_data_to_data _ y))
-             (concrete_data_map_to_data l)
-         end) l
-    | @Concrete_big_map a b l =>
-      (fix concrete_data_map_to_data
-           (l : Datatypes.list (elt_pair (concrete_data a) (concrete_data b))) :=
-         match l with
-         | nil => map.empty _ _ _
-         | cons (Elt _ _ x y) l =>
-           map.update
-             (comparable_data a)
-             (data b)
-             (comparable.compare a)
-             (comparable.compare_eq_iff a)
-             (comparable.lt_trans a)
-             (comparable.gt_trans a)
-             (data_to_comparable_data _ (concrete_data_to_data _ x))
-             (Some (concrete_data_to_data _ y))
-             (concrete_data_map_to_data l)
-         end) l
-    | Instruction tff i => existT _ _ i
-    | Chain_id_constant x => x
-    end.
-
-  Fixpoint stack_from_concrete {A} (s : typed_concrete_stack A) : stack A :=
+  Fixpoint concrete_data_to_data g (a : type) (d : concrete_data a) : data g a
+    :=
+      match d in (concrete_data t) return (data g t) with
+      | Int_constant z => z
+      | Nat_constant n => n
+      | String_constant s => s
+      | Bytes_constant s => s
+      | Timestamp_constant z => z
+      | Signature_constant s => Mk_sig s
+      | Key_constant s => Mk_key s
+      | Key_hash_constant s => Mk_key_hash s
+      | Mutez_constant (Mk_mutez m) => m
+      | Address_constant a => a
+      | Unit => tt
+      | True_ => true
+      | False_ => false
+      | Pair a b => (concrete_data_to_data g _ a, concrete_data_to_data g _ b)
+      | Left a _ _ => inl (concrete_data_to_data g _ a)
+      | Right b _ _ => inr (concrete_data_to_data g _ b)
+      | Some_ a => Some (concrete_data_to_data g _ a)
+      | None_ => None
+      | Concrete_list l => List.map (concrete_data_to_data g _) l
+      | @Concrete_set a l =>
+        (fix concrete_data_set_to_data (l : Datatypes.list (concrete_data a)) :=
+           match l with
+           | nil => set.empty _ _
+           | cons x l =>
+             set.insert
+               (comparable_data a)
+               (comparable.compare a)
+               (comparable.compare_eq_iff a)
+               (comparable.lt_trans a)
+               (comparable.gt_trans a)
+               (data_to_comparable_data _ (concrete_data_to_data g a x))
+               (concrete_data_set_to_data l)
+           end) l
+      | @Concrete_map a b l =>
+        (fix concrete_data_map_to_data
+             (l : Datatypes.list (elt_pair (concrete_data a) (concrete_data b))) :=
+           match l with
+           | nil => map.empty _ _ _
+           | cons (Elt _ _ x y) l =>
+             map.update
+               (comparable_data a)
+               (data g b)
+               (comparable.compare a)
+               (comparable.compare_eq_iff a)
+               (comparable.lt_trans a)
+               (comparable.gt_trans a)
+               (data_to_comparable_data _ (concrete_data_to_data g _ x))
+               (Some (concrete_data_to_data g _ y))
+               (concrete_data_map_to_data l)
+           end) l
+      | @Concrete_big_map a b l =>
+        (fix concrete_data_map_to_data
+             (l : Datatypes.list (elt_pair (concrete_data a) (concrete_data b))) :=
+           match l with
+           | nil => map.empty _ _ _
+           | cons (Elt _ _ x y) l =>
+             map.update
+               (comparable_data a)
+               (data g b)
+               (comparable.compare a)
+               (comparable.compare_eq_iff a)
+               (comparable.lt_trans a)
+               (comparable.gt_trans a)
+               (data_to_comparable_data _ (concrete_data_to_data g _ x))
+               (Some (concrete_data_to_data g _ y))
+               (concrete_data_map_to_data l)
+           end) l
+      | @Instruction a0 b tff i => existT _ _ i
+      | Chain_id_constant c => c
+      end.
+
+  Fixpoint stack_from_concrete {A} g (s : typed_concrete_stack A) : stack g A :=
     match A, s with
     | nil, tt => tt
-    | cons a A, (x, s) => (concrete_data_to_data a x, stack_from_concrete s)
+    | cons a A, (x, s) => (concrete_data_to_data g a x, stack_from_concrete g s)
     end.
 
 
@@ -529,7 +537,7 @@ Module Semantics(C : ContractContext).
     | Comparable_type_simple a, x => simple_comparable_data_to_concrete_data a x
     end.
 
-  Fixpoint data_to_concrete_data (a : type) (H : Is_true (is_packable a)) (x : data a) :
+  Fixpoint data_to_concrete_data {g} (a : type) (H : Is_true (is_packable a)) (x : data g a) :
     concrete_data a :=
     match a, H, x with
     | Comparable_type b, _, x => comparable_data_to_concrete_data b x
@@ -563,13 +571,13 @@ Module Semantics(C : ContractContext).
     | chain_id, _, x => Chain_id_constant x
     end.
 
-  Definition or_fun a (v : bitwise_variant a) : data a -> data a -> data a :=
+  Definition or_fun {g} a (v : bitwise_variant a) : data g a -> data g a -> data g a :=
     match v with
     | Bitwise_variant_bool => orb
     | Bitwise_variant_nat => N.lor
     end.
 
-  Definition and a b c (v : and_variant a b c) : data a -> data b -> data c :=
+  Definition and {g} a b c (v : and_variant a b c) : data g a -> data g b -> data g c :=
     match v with
     | And_variant_bool => andb
     | And_variant_nat => N.land
@@ -577,26 +585,26 @@ Module Semantics(C : ContractContext).
       fun x y => Z.to_N (Z.land x (Z.of_N y))
     end.
 
-  Definition xor a (v : bitwise_variant a) : data a -> data a -> data a :=
+  Definition xor {g} a (v : bitwise_variant a) : data g a -> data g a -> data g a :=
     match v with
     | Bitwise_variant_bool => xorb
     | Bitwise_variant_nat => N.lxor
     end.
 
-  Definition not a b (v : not_variant a b) : data a -> data b :=
+  Definition not {g} a b (v : not_variant a b) : data g a -> data g b :=
     match v with
     | Not_variant_bool => negb
     | Not_variant_int => fun x => (- 1 - x)%Z
     | Not_variant_nat => fun x => (- 1 - Z.of_N x)%Z
     end.
 
-  Definition neg a (v : neg_variant a) : data a -> data int :=
+  Definition neg {g} a (v : neg_variant a) : data g a -> data g int :=
     match v with
     | Neg_variant_nat => fun x => (- Z.of_N x)%Z
     | Neg_variant_int => fun x => (- x)%Z
     end.
 
-  Definition add a b c (v : add_variant a b c) : data a -> data b -> M (data c) :=
+  Definition add {g} a b c (v : add_variant a b c) : data g a -> data g b -> M (data g c) :=
     match v with
     | Add_variant_nat_nat => fun x y => Return (x + y)%N
     | Add_variant_nat_int => fun x y => Return (Z.of_N x + y)%Z
diff --git a/src/michocoq/syntax.v b/src/michocoq/syntax.v
index 82394ff6..59f75ff7 100644
--- a/src/michocoq/syntax.v
+++ b/src/michocoq/syntax.v
@@ -888,6 +888,7 @@ Fixpoint typed_concrete_stack l :=
   | nil => Datatypes.unit
   | cons ty l => (syntax.concrete_data ty * typed_concrete_stack l)%type
   end.
+
 Record tzt_file : Set :=
   Mk_tzt_file
     {
@@ -903,4 +904,6 @@ Record tzt_file : Set :=
       tzt_file_now : Datatypes.option (concrete_data timestamp);
       tzt_file_sender : Datatypes.option (concrete_data address);
       tzt_file_source : Datatypes.option (concrete_data address);
+      tzt_file_param : Datatypes.option type;
+      tzt_file_self : Datatypes.option (concrete_data address);
     }.
-- 
GitLab