Merge branch 'refactor/new-tezos-deps-ci' into 'dev'

new tezos deps + fix the ci

See merge request ligolang/ligo!67

.gitignore

@@ -3,3 +3,4 @@
 *~
 cache/*
 Version.ml
+/_opam/

.gitlab-ci.yml

@@ -9,34 +9,21 @@ stages:
   - test
 
 .website_build: &website_build
-  stage: build_and_deploy_website
+  stage: test # TODO DODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODO restore to  build_and_deploy_website
   image: node:8
   before_script:
     - scripts/install_native_dependencies.sh
-    # TODO: these things are moved to scripts in other branches.
+    - scripts/install_opam.sh # TODO: or scripts/install_build_environment.sh ?
-    - wget https://github.com/ocaml/opam/releases/download/2.0.1/opam-2.0.1-x86_64-linux -O opam-2.0.1-x86_64-linux
-    - cp opam-2.0.1-x86_64-linux /usr/local/bin/opam
-    - chmod +x /usr/local/bin/opam
     - export PATH="/usr/local/bin${PATH:+:}${PATH:-}"
-
-    # Initialise opam
-    - printf '' | opam init --bare
     - eval $(opam config env)
-
+    - scripts/setup_switch.sh
-    # Create switch
-    - printf '' | opam switch create toto ocaml-base-compiler.4.06.1
     - eval $(opam config env)
-
+    - scripts/debug_show_versions.sh || true
-    # Show versions and current switch
-    - echo "$PATH"
-    - opam --version
-    - printf '' | ocaml
-    - opam switch
 
     # install deps for internal documentation
     - opam install -y odoc
-    - vendors/opam-repository-tools/rewrite-local-opam-repository.sh
+    # - vendors/opam-repository-tools/rewrite-local-opam-repository.sh
-    - opam repository add localrepo "file://$PWD/vendors/ligo-opam-repository-local-generated/"
+    # - opam repository add localrepo "file://$PWD/vendors/ligo-opam-repository-local-generated/"
     - opam install -y --build-test --deps-only ./src/
     - dune build -p ligo
     # TODO: also try instead from time to time:
@@ -75,44 +62,36 @@ stages:
   before_script:
     # Install dependencies
     # rsync is needed by opam to sync a package installed from a local directory with the copy in ~/.opam
-    - apt-get update -qq
     - scripts/install_native_dependencies.sh
-    - scripts/install_opam.sh
+    - scripts/install_opam.sh # TODO: or scripts/install_build_environment.sh ?
     - export PATH="/usr/local/bin${PATH:+:}${PATH:-}"
-
+    - echo "$PATH"; which ocaml || true
-    # Initialise opam, create switch, load opam environment variables
-    - printf '' | opam init --bare
-    - printf '' | opam switch create ligo-switch ocaml-base-compiler.4.06.1
     - eval $(opam config env)
-
+    - echo "$PATH"; which ocaml || true
-    # Show versions and current switch
+    - scripts/setup_switch.sh
-    - echo "$PATH"
+    - echo "$PATH"; which ocaml || true
-    - opam --version
+    - eval $(opam config env)
-    - printf '' | ocaml
+    - echo "$PATH"; which ocaml || true
-    - opam switch
+    - scripts/debug_show_versions.sh || true
 
 local-dune-job:
   <<: *before_script
   stage: test
   script:
-    - scripts/setup_ligo_opam_repository.sh
+    - scripts/install_vendors_deps.sh
-    - opam install -y --build-test --deps-only ./src/
+    - scripts/build_ligo_local.sh
-    - dune build -p ligo
-    # TODO: also try instead from time to time:
-    #- (cd ./src/; dune build -p ligo)
     - dune build @ligo-test
-#   artifacts:
-#     paths:
-#       - src/ligo/bin/cli.ml
 
-local-repo-job:
+# TODO: uncomment this
-  <<: *before_script
+
-  stage: test
+# TODO
-  script:
+# local-repo-job:
-    - vendors/opam-repository-tools/rewrite-local-opam-repository.sh
+#   <<: *before_script
-    - opam repository add localrepo "file://$PWD/vendors/ligo-opam-repository-local-generated/"
+#   stage: test
-    #--build-test
+#   script:
-    - opam install -y ligo
+#     - scripts/install_vendors_deps.sh
+#     # TODO: also try from time to time with --build-test
+#     - opam install -y ligo
 
 remote-repo-job:
   <<: *before_script
@@ -130,19 +109,21 @@ remote-repo-job:
   only:
     - master
 
-# Run a docker build without publishing to the registry
+# TODO: uncomment this
-build-current-docker-image:
+
-  stage: build_docker
+# # Run a docker build without publishing to the registry
-  <<: *docker
+# build-current-docker-image:
-  <<: *docker_build
+#   stage: test # TODO DODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODO restore to  build_docker
-  except:
+#   <<: *docker
-    - master
+#   <<: *docker_build
-    - dev
+#   except:
+#     - master
+#     - dev
 
 # When a MR/PR is merged to dev
 # take the previous build and publish it to Docker Hub
 build-and-publish-latest-docker-image:
-  stage: build_and_deploy_docker
+  stage: test # TODO DODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODODO restore to  build_and_deploy_docker
   <<: *docker
   <<: *docker_build
   after_script:

Makefile

@@ -1,3 +1,37 @@
+.ONESHELL:
+
+all: test
+
+# Use install-deps instead of 'install' because usually 'make install' adds a
+# binary to the system path and we don't want to confuse users
+install-deps:
+#	Install ligo/tezos specific system-level dependencies
+	sudo scripts/install_native_dependencies.sh
+	scripts/install_build_environment.sh # TODO: or scripts/install_opam.sh ?
+
 build-deps:
-	scripts/install_native_dependencies.sh
+	echo aa
-	scripts/install_opam.sh
+	export PATH="/usr/local/bin$${PATH:+:}$${PATH:-}"
+#	Create opam dev switch locally for use with Ligo, add merlin/etc
+	if [ -n "`opam switch show | grep -P ".+/ligo"`" ];
+	then :; else scripts/setup_dev_switch.sh;
+	fi
+	echo bb
+	eval $$(opam config env)
+	echo cc
+#	Install OCaml build dependencies for Ligo
+	scripts/install_vendors_deps.sh
+	echo dd
+	scripts/install_ligo_with_dependencies.sh # TODO: rename & cleanup
+	echo ee
+
+build: build-deps
+	export PATH="/usr/local/bin$${PATH:+:}$${PATH:-}"
+	eval $$(opam config env)
+#	Build Ligo for local dev use
+	scripts/build_ligo_local.sh
+
+test: build
+	export PATH="/usr/local/bin$${PATH:+:}$${PATH:-}"
+	eval $$(opam config env)
+	scripts/test_ligo.sh

docker/Dockerfile

@@ -19,12 +19,17 @@ WORKDIR /ligo
 # Install required native dependencies
 RUN sh scripts/install_native_dependencies.sh
 
-# Setup a custom opam repository where ligo is published
+# Install OPAM
-RUN sh scripts/setup_ligo_opam_repository.sh
+# TODO: or scripts/install_build_environment.sh ?
+RUN sh scripts/install_opam.sh
+
+# Creat opam switch
+RUN sh scripts/setup_switch.sh
 
 RUN opam update
 
 # Install ligo
+RUN sh scripts/install_vendors_deps.sh
 RUN sh scripts/install_ligo_with_dependencies.sh
 
 # Use the ligo binary as a default command

makefile

@@ -1,25 +0,0 @@
-# Use install-deps instead of 'install' because usually 'make install' adds a
-# binary to the system path and we don't want to confuse users
-install-deps:
-#	Install ligo/tezos specific system-level dependencies
-	sudo scripts/install_native_dependencies.sh
-
-build-deps:
-#	Create opam dev switch locally for use with Ligo, add merlin/etc
-	if [ -n "`opam switch show | grep -P ".+/ligo"`" ];
-	then exit; else scripts/setup_dev_switch.sh;
-	fi
-#	Set up the local ligo opam repository so that it can be built
-	if [ -n "`opam repo list --safe | grep -P "ligo-opam-repository"`" ];
-	then exit; else scripts/setup_ligo_opam_repository.sh;
-	fi
-#	Install OCaml build dependencies for Ligo
-	scripts/install_ligo_with_dependencies.sh
-
-build: build-deps
-#	Build Ligo for local dev use
-	scripts/build_ligo_local.sh
-
-.ONESHELL:
-test: build
-	scripts/test_ligo.sh

scripts/build_ligo_local.sh

@@ -1,2 +1,8 @@
-eval $(opam env)
+#!/bin/sh
-dune build -p ligo
+set -e
+
+eval $(opam config env)
+dune build src # TODO: make it work with -p ligo
+
+# TODO: also try instead from time to time:
+#- (cd ./src/; dune build -p ligo)

scripts/debug_show_versions.sh

@@ -0,0 +1,8 @@
+#!/bin/sh
+set -e
+
+echo "$PATH"
+opam --version
+printf '' | ocaml
+opam switch
+

scripts/install_build_environment.sh

@@ -1,3 +1,6 @@
+#!/bin/sh
+set -e
+
 # This script installs opam for the user. It should NOT be included in any makefiles/etc.
 
 if [ -n "`which opam`" ]

scripts/install_opam.sh

@@ -1,10 +1,27 @@
 #!/bin/sh
 set -e
+set -x
 
 # TODO: this has many different modes of failure (file temp.opam-2.0.1-x86_64-linux.download-in-progress already exists, /usr/local/bin/opam already exists and is a directory or hard link, …)
 # Try to improve these aspects.
 
-wget https://github.com/ocaml/opam/releases/download/2.0.1/opam-2.0.1-x86_64-linux -O temp.opam-2.0.1-x86_64-linux.download-in-progress
+if command -v wget >/dev/null 2>&1; then
+  wget https://github.com/ocaml/opam/releases/download/2.0.1/opam-2.0.1-x86_64-linux -O temp.opam-2.0.1-x86_64-linux.download-in-progress
+else
+  curl -L https://github.com/ocaml/opam/releases/download/2.0.1/opam-2.0.1-x86_64-linux --output temp.opam-2.0.1-x86_64-linux.download-in-progress
+fi
+
+# debug
+ls
+apt -y install hexdump || true
+apt -y install xxd || true
+(cat temp.opam-2.0.1-x86_64-linux.download-in-progress | xxd | head -n 30) || true
+
 cp -i temp.opam-2.0.1-x86_64-linux.download-in-progress /usr/local/bin/opam
 chmod +x /usr/local/bin/opam
 rm temp.opam-2.0.1-x86_64-linux.download-in-progress
+
+which opam || true
+
+
+opam init -a --bare

scripts/install_vendors_deps.sh

@@ -0,0 +1,12 @@
+#!/bin/sh
+set -e
+
+# Install local dependencies
+opam install -y ./vendors/ligo-utils/simple-utils
+opam install -y ./vendors/ligo-utils/tezos-protocol-alpha
+opam install -y ./vendors/ligo-utils/tezos-protocol-alpha-parameters
+opam install -y ./vendors/ligo-utils/memory-proto-alpha
+opam install -y ./vendors/ligo-utils/tezos-utils/michelson-parser
+opam install -y ./vendors/ligo-utils/tezos-utils
+opam install -y ./vendors/ligo-utils/proto-alpha-utils
+opam install -y getopt ppx_deriving menhir

scripts/setup_dev_switch.sh

@@ -1,4 +1,7 @@
-opam switch create . ocaml-base-compiler.4.06.1
+#!/bin/sh
-eval $(opam env)
+set -e
+
+"$(dirname "$0")"/setup_switch.sh
+
 opam install -y ocp-indent tuareg merlin alcotest-lwt crowbar
 opam -y user-setup install

scripts/setup_switch.sh

@@ -0,0 +1,15 @@
+#!/bin/sh
+set -e
+set -x
+
+printf '' | opam switch create . 4.07.1 # toto ocaml-base-compiler.4.06.1
+eval $(opam config env)
+
+# Add Tezos opam repository
+opam repo add tezos-opam-repository https://gitlab.com/nomadic-labs/tezos-opam-repository.git
+
+# TODO: move this to install_vendor_deps.sh
+# Pin the versions of some dependencies
+opam pin -y zarith 1.7
+opam pin -y ipaddr 3.1.0
+opam pin -y macaddr 3.1.0

scripts/test_ligo.sh

@@ -1,2 +1,5 @@
-eval $(opam env)
+#!/bin/sh
+set -e
+
+eval $(opam config env)
 dune build @ligo-test

src/README_INSTALL

@@ -1,20 +0,0 @@
-switch=titi
-cd src/ligo
-sudo apt -y install libev-dev libhidapi-dev
-opam init
-eval $(opam env)
-opam switch create $switch ocaml-base-compiler.4.06.1
-eval $(opam env --switch=$switch --set-switch)
-opam repository add new-tezos https://gitlab.com/ligolang/new-tezos-opam-repository.git
-
-# si une build a déjà été tentée, il vaut mieux git add tout ce qui est utile et git clean -dfx pour supprimer tout le reste (dune 1.7 crée des fichiers non compatibles avec dune 1.6)
-opam install -y ocplib-endian alcotest
-
-(cd ligo-parser && opam install -y .)
-eval $(opam env)
-(cd ligo-helpers && opam install -y .)
-eval $(opam env)
-(opam install -y .)
-eval $(opam env)
-opam install merlin ocp-indent ledit
-opam user-setup install

src/ast_simplified/dune

@@ -6,7 +6,7 @@
     tezos-utils
   )
   (preprocess
-    (pps simple-utils.ppx_let_generalized)
+    (pps ppx_let)
   )
   (flags (:standard -open Simple_utils ))
 )

src/ast_simplified/types.ml

@@ -92,7 +92,7 @@ and literal =
   | Literal_bytes of bytes
   | Literal_address of string
   | Literal_timestamp of int
-  | Literal_operation of Memory_proto_alpha.Alpha_context.packed_internal_operation
+  | Literal_operation of Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation
 
 and 'a matching =
   | Match_bool of {

src/ast_typed/dune

@@ -7,7 +7,7 @@
     ast_simplified ; Is that a good idea?
   )
   (preprocess
-    (pps simple-utils.ppx_let_generalized)
+    (pps ppx_let)
   )
   (flags (:standard -open Simple_utils))
 )

src/ast_typed/types.ml

@@ -122,7 +122,7 @@ and literal =
   | Literal_string of string
   | Literal_bytes of bytes
   | Literal_address of string
-  | Literal_operation of Memory_proto_alpha.Alpha_context.packed_internal_operation
+  | Literal_operation of Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation
 
 and access =
   | Access_tuple of int

src/bin/dune

@@ -8,7 +8,7 @@
   )
   (package ligo)
   (preprocess
-    (pps simple-utils.ppx_let_generalized)
+    (pps ppx_let)
   )
   (flags (:standard -open Simple_utils))
 )

src/compiler/compiler_environment.ml

@@ -3,12 +3,9 @@ open Trace
 open Mini_c
 open Environment
 open Michelson
-open Memory_proto_alpha.Script_ir_translator
-
-module Stack = Meta_michelson.Stack
 
 let get : environment -> string -> michelson result = fun e s ->
-  let%bind (type_value , position) =
+  let%bind (_type_value , position) =
     let error =
       let title () = "Environment.get" in
       let content () = Format.asprintf "%s in %a"
@@ -26,22 +23,10 @@ let get : environment -> string -> michelson result = fun e s ->
   in
   let code = aux position in
 
-  let%bind () =
-    let error () = ok @@ simple_error "error producing Env.get" in
-    let%bind (Stack.Ex_stack_ty input_stack_ty) = Compiler_type.Ty.environment e in
-    let%bind (Ex_ty ty) = Compiler_type.Ty.type_ type_value in
-    let output_stack_ty = Stack.(ty @: input_stack_ty) in
-    let%bind _ =
-      Trace.trace_tzresult_lwt_r error @@
-      Memory_proto_alpha.parse_michelson code
-        input_stack_ty output_stack_ty in
-    ok ()
-  in
-
   ok code
 
 let set : environment -> string -> michelson result = fun e s ->
-  let%bind (type_value , position) =
+  let%bind (_type_value , position) =
     generic_try (simple_error "Environment.get") @@
     (fun () -> Environment.get_i s e) in
   let rec aux = fun n ->
@@ -54,37 +39,11 @@ let set : environment -> string -> michelson result = fun e s ->
   in
   let code = aux position in
 
-  let%bind () =
-    let error () = ok @@ simple_error "error producing Env.set" in
-    let%bind (Stack.Ex_stack_ty env_stack_ty) = Compiler_type.Ty.environment e in
-    let%bind (Ex_ty ty) = Compiler_type.Ty.type_ type_value in
-    let input_stack_ty = Stack.(ty @: env_stack_ty) in
-    let output_stack_ty = env_stack_ty in
-    let%bind _ =
-      Trace.trace_tzresult_lwt_r error @@
-      Memory_proto_alpha.parse_michelson code
-        input_stack_ty output_stack_ty in
-    ok ()
-  in
-
   ok code
 
-let add : environment -> (string * type_value) -> michelson result = fun e (_s , type_value) ->
+let add : environment -> (string * type_value) -> michelson result = fun _e (_s , _type_value) ->
   let code = seq [] in
 
-  let%bind () =
-    let error () = ok @@ simple_error "error producing Env.get" in
-    let%bind (Stack.Ex_stack_ty env_stack_ty) = Compiler_type.Ty.environment e in
-    let%bind (Ex_ty ty) = Compiler_type.Ty.type_ type_value in
-    let input_stack_ty = Stack.(ty @: env_stack_ty) in
-    let output_stack_ty = Stack.(ty @: env_stack_ty) in
-    let%bind _ =
-      Trace.trace_tzresult_lwt_r error @@
-      Memory_proto_alpha.parse_michelson code
-        input_stack_ty output_stack_ty in
-    ok ()
-  in
-
   ok code
 
 let select ?(rev = false) ?(keep = true) : environment -> string list -> michelson result = fun e lst ->
@@ -111,32 +70,6 @@ let select ?(rev = false) ?(keep = true) : environment -> string list -> michels
     in
     List.fold_right' aux (seq []) e_lst in
 
-  let%bind () =
-    let%bind (Stack.Ex_stack_ty input_stack_ty) = Compiler_type.Ty.environment e in
-    let e' =
-      Environment.of_list
-      @@ List.map fst
-      @@ List.filter snd
-      @@ e_lst
-    in
-    let%bind (Stack.Ex_stack_ty output_stack_ty) = Compiler_type.Ty.environment e' in
-    let error () =
-      let title () = "error producing Env.select" in
-      let content () = Format.asprintf "\nInput : %a\nOutput : %a\nList : {%a}\nCode : %a\nLog : %s\n"
-          PP.environment e
-          PP.environment e'
-          PP_helpers.(list_sep (pair PP.environment_element bool) (const " || ")) e_lst
-          Michelson.pp code
-          (L.get ())
-      in
-      ok @@ (error title content) in
-    let%bind _ =
-      Trace.trace_tzresult_lwt_r error @@
-      Memory_proto_alpha.parse_michelson code
-        input_stack_ty output_stack_ty in
-    ok ()
-  in
-
   ok code
 
 let select_env : environment -> environment -> michelson result = fun source filter ->
@@ -158,23 +91,6 @@ let pack : environment -> michelson result = fun e ->
     Assert.assert_true (List.length e <> 0) in
   let code = seq @@ List.map (Function.constant i_pair) @@ List.tl e in
 
-  let%bind () =
-    let%bind (Stack.Ex_stack_ty input_stack_ty) = Compiler_type.Ty.environment e in
-    let repr = Environment.closure_representation e in
-    let%bind (Ex_ty output_ty) = Compiler_type.Ty.type_ repr in
-    let output_stack_ty = Stack.(output_ty @: nil) in
-    let error () =
-      let title () = "error producing Env.pack" in
-      let content () = Format.asprintf ""
-      in
-      ok @@ (error title content) in
-    let%bind _ =
-      Trace.trace_tzresult_lwt_r error @@
-      Memory_proto_alpha.parse_michelson code
-        input_stack_ty output_stack_ty in
-    ok ()
-  in
-
   ok code
 
 let unpack : environment -> michelson result = fun e ->
@@ -192,26 +108,6 @@ let unpack : environment -> michelson result = fun e ->
       ] in
   let code = aux l in
 
-  let%bind () =
-    let%bind (Stack.Ex_stack_ty output_stack_ty) = Compiler_type.Ty.environment e in
-    let repr = Environment.closure_representation e in
-    let%bind (Ex_ty input_ty) = Compiler_type.Ty.type_ repr in
-    let input_stack_ty = Stack.(input_ty @: nil) in
-    let error () =
-      let title () = "error producing Env.unpack" in
-      let content () = Format.asprintf "\nEnvironment:%a\nType Representation:%a\nCode:%a\n"
-          PP.environment e
-          PP.type_ repr
-          Michelson.pp code
-      in
-      ok @@ (error title content) in
-    let%bind _ =
-      Trace.trace_tzresult_lwt_r error @@
-      Memory_proto_alpha.parse_michelson code
-        input_stack_ty output_stack_ty in
-    ok ()
-  in
-
   ok code
 
 
@@ -239,53 +135,11 @@ let pack_select : environment -> string list -> michelson result = fun e lst ->
     in
     List.fold_right' aux (true , seq []) e_lst in
 
-  let%bind () =
-    let%bind (Stack.Ex_stack_ty input_stack_ty) = Compiler_type.Ty.environment e in
-    let e' =
-      Environment.of_list
-      @@ List.map fst
-      @@ List.filter snd
-      @@ e_lst
-    in
-    let%bind (Ex_ty output_ty) = Compiler_type.Ty.environment_representation e' in
-    let output_stack_ty = Stack.(output_ty @: input_stack_ty) in
-    let error () =
-      let title () = "error producing Env.pack_select" in
-      let content () = Format.asprintf "\nInput : %a\nOutput : %a\nList : {%a}\nCode : %a\nLog : %s\n"
-          PP.environment e
-          PP.environment e'
-          PP_helpers.(list_sep (pair PP.environment_element bool) (const " || ")) e_lst
-          Michelson.pp code
-          (L.get ())
-      in
-      ok @@ (error title content) in
-    let%bind _ =
-      Trace.trace_tzresult_lwt_r error @@
-      Memory_proto_alpha.parse_michelson code
-        input_stack_ty output_stack_ty in
-    ok ()
-  in
-
   ok code
 
-let add_packed_anon : environment -> type_value -> michelson result = fun e type_value ->
+let add_packed_anon : environment -> type_value -> michelson result = fun _e _type_value ->
   let code = seq [i_pair] in
 
-  let%bind () =
-    let error () = ok @@ simple_error "error producing add packed" in
-    let%bind (Ex_ty input_ty) = Compiler_type.Ty.environment_representation e in
-    let e' = Environment.add ("_add_packed_anon" , type_value) e in
-    let%bind (Ex_ty output_ty) = Compiler_type.Ty.environment_representation e' in
-    let%bind (Ex_ty ty) = Compiler_type.Ty.type_ type_value in
-    let input_stack_ty = Stack.(ty @: input_ty @: nil) in
-    let output_stack_ty = Stack.(output_ty @: nil) in
-    let%bind _ =
-      Trace.trace_tzresult_lwt_r error @@
-      Memory_proto_alpha.parse_michelson code
-        input_stack_ty output_stack_ty in
-    ok ()
-  in
-
   ok code
 
 let pop : environment -> environment result = fun e ->

src/compiler/compiler_program.ml

@@ -2,10 +2,8 @@ open Trace
 open Mini_c
 
 open Michelson
-module Stack = Meta_michelson.Stack
-module Contract_types = Meta_michelson.Types
 
-open Memory_proto_alpha.Script_ir_translator
+open Memory_proto_alpha.Protocol.Script_ir_translator
 
 open Operators.Compiler
 
@@ -141,9 +139,9 @@ and translate_expression ?push_var_name (expr:expression) (env:environment) : (m
          else ok end_env
       )
     in
-    let%bind (Stack.Ex_stack_ty input_stack_ty) = Compiler_type.Ty.environment env in
+    let%bind (Ex_stack_ty input_stack_ty) = Compiler_type.Ty.environment env in
     let%bind output_type = Compiler_type.type_ ty in
-    let%bind (Stack.Ex_stack_ty output_stack_ty) = Compiler_type.Ty.environment env' in
+    let%bind (Ex_stack_ty output_stack_ty) = Compiler_type.Ty.environment env' in
     let error_message () =
       let%bind schema_michelsons = Compiler_type.environment env in
       ok @@ Format.asprintf
@@ -470,10 +468,11 @@ and translate_quote_body ({result ; binder ; input} as f:anon_function) : michel
     ] in
 
   let%bind _assert_type =
+    let open Memory_proto_alpha.Protocol.Script_typed_ir in
     let%bind (Ex_ty input_ty) = Compiler_type.Ty.type_ f.input in
     let%bind (Ex_ty output_ty) = Compiler_type.Ty.type_ f.output in
-    let input_stack_ty = Stack.(input_ty @: nil) in
+    let input_stack_ty = Item_t (input_ty, Empty_t, None) in
-    let output_stack_ty = Stack.(output_ty @: nil) in
+    let output_stack_ty = Item_t (output_ty, Empty_t, None) in
     let error_message () =
       Format.asprintf
         "\nCode : %a\nMichelson code : %a\ninput : %a\noutput : %a\nstart env : %a\nend env : %a\n"

src/compiler/compiler_type.ml

@@ -2,18 +2,52 @@ open Trace
 open Mini_c.Types
 
 open Proto_alpha_utils.Memory_proto_alpha
+open Protocol
 open Script_ir_translator
 
 module O = Tezos_utils.Michelson
-module Contract_types = Meta_michelson.Types
 
 module Ty = struct
 
   let not_comparable name () = error (thunk "not a comparable type") (fun () -> name) ()
   let not_compilable_type name () = error (thunk "not a compilable type") (fun () -> name) ()
 
+  open Script_typed_ir
+
+
+  let nat_k = Nat_key None
+  let tez_k = Mutez_key None
+  let int_k = Int_key None
+  let string_k = String_key None
+  let address_k = Address_key None
+  let timestamp_k = Timestamp_key None
+  let bytes_k = Bytes_key None
+  (* let timestamp_k = Timestamp_key None *)
+
+  let unit = Unit_t None
+  let bytes = Bytes_t None
+  let nat = Nat_t None
+  let tez = Mutez_t None
+  let int = Int_t None
+  let big_map k v = Big_map_t (k, v, None)
+  let signature = Signature_t None
+  let operation = Operation_t None
+  let bool = Bool_t None
+  let mutez = Mutez_t None
+  let string = String_t None
+  let key = Key_t None
+  let list a = List_t (a, None)
+  let set a = Set_t (a, None)
+  let address = Address_t None
+  let option a = Option_t ((a, None), None, None)
+  let contract a = Contract_t (a, None)
+  let lambda a b = Lambda_t (a, b, None)
+  let timestamp = Timestamp_t None
+  let map a b = Map_t (a, b, None)
+  let pair a b = Pair_t ((a, None, None), (b, None, None), None)
+  let union a b = Union_t ((a, None), (b, None), None)
+
   let comparable_type_base : type_base -> ex_comparable_ty result = fun tb ->
-    let open Contract_types in
     let return x = ok @@ Ex_comparable_ty x in
     match tb with
     | Base_unit -> fail (not_comparable "unit")
@@ -42,7 +76,6 @@ module Ty = struct
     | T_contract _ -> fail (not_comparable "contract")
 
   let base_type : type_base -> ex_ty result = fun b ->
-    let open Contract_types in
     let return x = ok @@ Ex_ty x in
     match b with
     | Base_unit -> return unit
@@ -63,57 +96,56 @@ module Ty = struct
     | T_pair (t, t') -> (
         type_ t >>? fun (Ex_ty t) ->
         type_ t' >>? fun (Ex_ty t') ->
-        ok @@ Ex_ty (Contract_types.pair t t')
+        ok @@ Ex_ty (pair t t')
       )
     | T_or (t, t') -> (
         type_ t >>? fun (Ex_ty t) ->
         type_ t' >>? fun (Ex_ty t') ->
-        ok @@ Ex_ty (Contract_types.union t t')
+        ok @@ Ex_ty (union t t')
       )
     | T_function (arg, ret) ->
         let%bind (Ex_ty arg) = type_ arg in
         let%bind (Ex_ty ret) = type_ ret in
-        ok @@ Ex_ty (Contract_types.lambda arg ret)
+        ok @@ Ex_ty (lambda arg ret)
     | T_deep_closure (c, arg, ret) ->
         let%bind (Ex_ty capture) = environment_representation c in
         let%bind (Ex_ty arg) = type_ arg in
         let%bind (Ex_ty ret) = type_ ret in
-        ok @@ Ex_ty Contract_types.(pair (lambda (pair arg capture) ret) capture)
+        ok @@ Ex_ty (pair (lambda (pair arg capture) ret) capture)
     | T_map (k, v) ->
         let%bind (Ex_comparable_ty k') = comparable_type k in
         let%bind (Ex_ty v') = type_ v in
-        ok @@ Ex_ty Contract_types.(map k' v')
+        ok @@ Ex_ty (map k' v')
     | T_list t ->
         let%bind (Ex_ty t') = type_ t in
-        ok @@ Ex_ty Contract_types.(list t')
+        ok @@ Ex_ty (list t')
     | T_set t -> (
         let%bind (Ex_comparable_ty t') = comparable_type t in
-        ok @@ Ex_ty Contract_types.(set t')
+        ok @@ Ex_ty (set t')
       )
     | T_option t ->
         let%bind (Ex_ty t') = type_ t in
-        ok @@ Ex_ty Contract_types.(option t')
+        ok @@ Ex_ty (option t')
     | T_contract t ->
         let%bind (Ex_ty t') = type_ t in
-        ok @@ Ex_ty Contract_types.(contract t')
+        ok @@ Ex_ty (contract t')
 
   and environment_representation = function
-    | [] -> ok @@ Ex_ty Contract_types.unit
+    | [] -> ok @@ Ex_ty unit
     | [a] -> type_ @@ snd a
     | a::b ->
         let%bind (Ex_ty a) = type_ @@ snd a in
         let%bind (Ex_ty b) = environment_representation b in
-        ok @@ Ex_ty (Contract_types.pair a b)
+        ok @@ Ex_ty (pair a b)
 
-  and environment : environment -> Meta_michelson.Stack.ex_stack_ty result = fun env ->
+  and environment : environment -> ex_stack_ty result = fun env ->
-    let open Meta_michelson in
     let%bind lst =
       bind_map_list type_
       @@ List.map snd env in
-    let aux (Stack.Ex_stack_ty st) (Ex_ty cur) =
+    let aux (Ex_stack_ty st) (Ex_ty cur) =
-      Stack.Ex_stack_ty (Stack.stack cur st)
+      Ex_stack_ty (Item_t (cur,  st, None))
     in
-    ok @@ List.fold_right' aux (Ex_stack_ty Stack.nil) lst
+    ok @@ List.fold_right' aux (Ex_stack_ty Empty_t) lst
 
 end
 

src/compiler/dune

@@ -3,13 +3,13 @@
   (public_name ligo.compiler)
   (libraries
     simple-utils
+    proto-alpha-utils
     tezos-utils
-    meta_michelson
     mini_c
     operators
   )
   (preprocess
-    (pps simple-utils.ppx_let_generalized)
+    (pps ppx_let)
   )
   (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Tezos_utils ))
 )

src/compiler/uncompiler.ml

@@ -1,6 +1,8 @@
 open Mini_c.Types
-open Memory_proto_alpha
+open Proto_alpha_utils.Memory_proto_alpha
+open X
 open Proto_alpha_utils.Trace
+open Protocol
 open Script_typed_ir
 open Script_ir_translator
 

src/dune

@@ -6,11 +6,10 @@
     simple-utils
     tezos-utils
     tezos-micheline
-    meta_michelson
     main
   )
   (preprocess
-    (pps simple-utils.ppx_let_generalized)
+    (pps ppx_let)
   )
 )
 
@@ -29,4 +28,4 @@
   (name manual-test)
   (action (run test/manual_test.exe))
   (deps (glob_files contracts/*))  
-)
+)

src/main/dune

@@ -15,7 +15,7 @@
     compiler
   )
   (preprocess
-    (pps simple-utils.ppx_let_generalized)
+    (pps ppx_let)
   )
   (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Tezos_utils ))
 )

src/main/run_mini_c.ml

@@ -2,7 +2,8 @@ open Proto_alpha_utils
 open Trace
 open Mini_c
 open! Compiler.Program
-open Memory_proto_alpha.Script_ir_translator
+open Memory_proto_alpha.Protocol.Script_ir_translator
+open Memory_proto_alpha.X
 
 let run_aux ?options (program:compiled_program) (input_michelson:Michelson.t) : ex_typed_value result =
   let Compiler.Program.{input;output;body} : compiled_program = program in
@@ -15,8 +16,8 @@ let run_aux ?options (program:compiled_program) (input_michelson:Michelson.t) :
   let%bind descr =
     Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@
     Memory_proto_alpha.parse_michelson body
-      (Stack.(input_ty @: nil)) (Stack.(output_ty @: nil)) in
+      (Item_t (input_ty, Empty_t, None)) (Item_t (output_ty, Empty_t, None)) in
-  let open! Memory_proto_alpha.Script_interpreter in
+  let open! Memory_proto_alpha.Protocol.Script_interpreter in
   let%bind (Item(output, Empty)) =
     Trace.trace_tzresult_lwt (simple_error "error of execution") @@
     Memory_proto_alpha.interpret ?options descr (Item(input, Empty)) in

src/main/run_source.ml

@@ -259,7 +259,7 @@ let run_contract ?amount source_filename entry_point storage input syntax =
     parsify_expression syntax input in
   let options =
     let open Proto_alpha_utils.Memory_proto_alpha in
-    let amount = Option.bind (fun amount -> Alpha_context.Tez.of_string amount) amount in
+    let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
     (make_options ?amount ()) in
   Run_simplified.run_simplityped ~options typed entry_point (Ast_simplified.e_pair storage_simpl input_simpl)
 
@@ -271,7 +271,7 @@ let run_function ?amount source_filename entry_point parameter syntax =
     parsify_expression syntax parameter in
   let options =
     let open Proto_alpha_utils.Memory_proto_alpha in
-    let amount = Option.bind (fun amount -> Alpha_context.Tez.of_string amount) amount in
+    let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
     (make_options ?amount ()) in
   Run_simplified.run_simplityped ~options typed entry_point parameter'
 
@@ -281,6 +281,6 @@ let evaluate_value ?amount source_filename entry_point syntax =
     type_file syntax source_filename in
   let options =
     let open Proto_alpha_utils.Memory_proto_alpha in
-    let amount = Option.bind (fun amount -> Alpha_context.Tez.of_string amount) amount in
+    let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
     (make_options ?amount ()) in
   Run_simplified.evaluate_simplityped ~options typed entry_point

src/meta_michelson/alpha_wrap.ml

@@ -1,30 +0,0 @@
-open Proto_alpha_utils.Error_monad
-
-let dummy_environment = force_lwt ~msg:"getting dummy env" @@ Misc.init_environment ()
-
-let tc = dummy_environment.tezos_context
-
-module Proto_alpha = Proto_alpha_utils.Memory_proto_alpha
-open Proto_alpha
-open Alpha_context
-open Alpha_environment
-
-let pack ty v = fst @@ force_lwt_alpha ~msg:"packing" @@ Script_ir_translator.pack_data tc ty v
-let unpack_opt (type a) : a Script_typed_ir.ty -> MBytes.t -> a option = fun ty bytes ->
-  force_lwt ~msg:"unpacking : parse" (
-    if Compare.Int.(MBytes.length bytes >= 1) &&
-       Compare.Int.(MBytes.get_uint8 bytes 0 = 0x05) then
-      let bytes = MBytes.sub bytes 1 (MBytes.length bytes - 1) in
-      match Data_encoding.Binary.of_bytes Script.expr_encoding bytes with
-      | None -> return None
-      | Some expr ->
-        Script_ir_translator.parse_data tc ty (Micheline.root expr) >>=?? fun x -> return (Some (fst x))
-    else
-      return None
-  )
-
-let unpack ty a = match unpack_opt ty a with
-  | None -> raise @@ Failure "unpacking : of_bytes"
-  | Some x -> x
-
-let blake2b b = Alpha_environment.Raw_hashes.blake2b b

src/meta_michelson/contract.ml

@@ -1,317 +0,0 @@
-open Misc
-
-open Proto_alpha_utils.Error_monad
-open Memory_proto_alpha
-open Alpha_context
-
-open Script_ir_translator
-open Script_typed_ir
-
-module Option = Simple_utils.Option
-module Cast = Proto_alpha_utils.Cast
-
-type ('param, 'storage) toplevel = {
-  param_type : 'param ty ;
-  storage_type : 'storage ty ;
-  code : ('param * 'storage, packed_internal_operation list * 'storage) lambda
-}
-
-type ex_toplevel =
-    Ex_toplevel : ('a, 'b) toplevel -> ex_toplevel
-
-let get_toplevel ?environment toplevel_path claimed_storage_type claimed_parameter_type =
-  let toplevel_str = Streams.read_file toplevel_path in
-  contextualize ?environment ~msg:"toplevel" @@ fun {tezos_context = context ; _ } ->
-  let toplevel_expr = Cast.tl_of_string toplevel_str in
-  let (param_ty_node, storage_ty_node, code_field) =
-    force_ok_alpha ~msg:"parsing toplevel" @@
-    parse_toplevel toplevel_expr in
-  let (Ex_ty param_type, _) =
-    force_ok_alpha ~msg:"parse arg ty" @@
-    Script_ir_translator.parse_ty context ~allow_big_map:false ~allow_operation:false param_ty_node in
-  let (Ex_ty storage_type, _) =
-    force_ok_alpha ~msg:"parse storage ty" @@
-    parse_storage_ty context storage_ty_node in
-  let _ = force_ok_alpha ~msg:"storage eq" @@ Script_ir_translator.ty_eq context storage_type claimed_storage_type in
-  let _ = force_ok_alpha ~msg:"param eq" @@ Script_ir_translator.ty_eq context param_type claimed_parameter_type in
-  let param_type_full = Pair_t ((claimed_parameter_type, None, None),
-                                (claimed_storage_type, None, None), None) in
-  let ret_type_full =
-    Pair_t ((List_t (Operation_t None, None), None, None),
-            (claimed_storage_type, None, None), None) in
-  parse_returning (Toplevel { storage_type = claimed_storage_type ; param_type = claimed_parameter_type })
-    context (param_type_full, None) ret_type_full code_field >>=?? fun (code, _) ->
-  Error_monad.return {
-    param_type = claimed_parameter_type;
-    storage_type = claimed_storage_type;
-    code ;
-  }
-
-let make_toplevel code storage_type param_type =
-  { param_type ; storage_type ; code }
-
-module type ENVIRONMENT = sig
-  val identities : identity list
-  val tezos_context : t
-end
-
-type ex_typed_stack = Ex_typed_stack : ('a stack_ty * 'a Script_interpreter.stack) -> ex_typed_stack
-
-open Error_monad
-
-module Step (Env: ENVIRONMENT) = struct
-  open Env
-
-  type config = {
-    source : Contract.t option ;
-    payer : Contract.t option ;
-    self : Contract.t option ;
-    visitor : (Script_interpreter.ex_descr_stack -> unit) option ;
-    timestamp : Script_timestamp.t option ;
-    debug_visitor : (ex_typed_stack -> unit) option ;
-    amount : Tez.t option ;
-  }
-
-  let no_config = {
-    source = None ;
-    payer = None ;
-    self = None ;
-    visitor = None ;
-    debug_visitor = None ;
-    timestamp = None ;
-    amount = None ;
-  }
-
-  let of_param base param = match param with
-    | None -> base
-    | Some _ as x -> x
-
-  let make_config ?base_config ?source ?payer ?self ?visitor ?debug_visitor ?timestamp ?amount () =
-    let base_config = Option.unopt ~default:no_config base_config in {
-      source = Option.bind_eager_or source base_config.source ;
-      payer = Option.bind_eager_or payer base_config.payer ;
-      self = Option.bind_eager_or self base_config.self ;
-      visitor = Option.bind_eager_or visitor base_config.visitor ;
-      debug_visitor = Option.bind_eager_or debug_visitor base_config.debug_visitor ;
-      timestamp = Option.bind_eager_or timestamp base_config.timestamp ;
-      amount = Option.bind_eager_or amount base_config.amount ;
-    }
-
-  open Error_monad
-
-  let debug_visitor ?f () =
-    let open Script_interpreter in
-    let aux (Ex_descr_stack (descr, stack)) =
-      (match (descr.instr, descr.bef) with
-       | Nop, Item_t (String_t _, stack_ty, _) -> (
-           let (Item (s, stack)) = stack in
-           if s = "_debug"
-           then (
-             match f with
-             | None -> Format.printf "debug: %s\n%!" @@ Cast.stack_to_string stack_ty stack
-             | Some f -> f (Ex_typed_stack(stack_ty, stack))
-           ) else ()
-         )
-       | _ -> ()) ;
-      () in
-    aux
-
-  let step_lwt ?(config=no_config) (stack:'a Script_interpreter.stack) (code:('a, 'b) descr) =
-    let source = Option.unopt
-        ~default:(List.nth identities 0).implicit_contract config.source in
-    let payer = Option.unopt
-        ~default:(List.nth identities 1).implicit_contract config.payer in
-    let self = Option.unopt
-        ~default:(List.nth identities 2).implicit_contract config.self in
-    let amount = Option.unopt ~default:(Tez.one) config.amount in
-    let visitor =
-      let default = debug_visitor ?f:config.debug_visitor () in
-      Option.unopt ~default config.visitor in
-    let tezos_context = match config.timestamp with
-      | None -> tezos_context
-      | Some s -> Alpha_context.Script_timestamp.set_now tezos_context s in
-    Script_interpreter.step tezos_context ~source ~payer ~self ~visitor amount code stack >>=?? fun (stack, _) ->
-    return stack
-
-  let step_1_2 ?config (a:'a) (descr:('a * end_of_stack, 'b * ('c * end_of_stack)) descr) =
-    let open Script_interpreter in
-    step_lwt ?config (Item(a, Empty)) descr >>=? fun (Item(b, Item(c, Empty))) ->
-    return (b, c)
-
-  let step_3_1 ?config (a:'a) (b:'b) (c:'c)
-      (descr:('a * ('b * ('c * end_of_stack)), 'd * end_of_stack) descr) =
-    let open Script_interpreter in
-    step_lwt ?config (Item(a, Item(b, Item(c, Empty)))) descr >>=? fun (Item(d, Empty)) ->
-    return d
-
-  let step_2_1 ?config (a:'a) (b:'b) (descr:('a * ('b * end_of_stack), 'c * end_of_stack) descr) =
-    let open Script_interpreter in
-    step_lwt ?config (Item(a, Item(b, Empty))) descr >>=? fun (Item(c, Empty)) ->
-    return c
-
-  let step_1_1 ?config (a:'a) (descr:('a * end_of_stack, 'b * end_of_stack) descr) =
-    let open Script_interpreter in
-    step_lwt ?config (Item(a, Empty)) descr >>=? fun (Item(b, Empty)) ->
-    return b
-
-  let step_value ?config (a:'a) (descr:('a * end_of_stack, 'a * end_of_stack) descr) =
-    step_1_1 ?config a descr
-
-  let step ?config stack code =
-    force_lwt ~msg:"running a step" @@ step_lwt ?config stack code
-
-end
-
-let run_lwt_full ?source ?payer ?self toplevel storage param {identities ; tezos_context = context} =
-  let { code ; _ } : (_, _) toplevel = toplevel in
-
-  let source = Option.unopt
-      ~default:(List.nth identities 0).implicit_contract source in
-  let payer = Option.unopt
-      ~default:(List.nth identities 1).implicit_contract payer in
-  let self = Option.unopt
-      ~default:(List.nth identities 2).implicit_contract self in
-  let amount = Tez.one in
-
-  Script_interpreter.interp context ~source ~payer ~self amount code (param, storage)
-  >>=?? fun ((ops, storage), new_ctxt) ->
-  let gas = Alpha_context.Gas.consumed ~since:context ~until:new_ctxt in
-  return (storage, ops, gas)
-
-let run_lwt ?source ?payer ?self toplevel storage param env =
-  run_lwt_full ?source ?payer ?self toplevel storage param env >>=? fun (storage, _ops, _gas) ->
-  return storage
-
-let run ?environment toplevel storage param =
-  contextualize ?environment ~msg:"run toplevel" @@ run_lwt toplevel storage param
-
-let run_node ?environment toplevel storage_node param_node =
-  contextualize ?environment ~msg:"run toplevel" @@ fun {tezos_context = context ; _} ->
-  let {param_type ; storage_type ; _ } = toplevel in
-  parse_data context param_type param_node >>=?? fun (param, _) ->
-  parse_data context storage_type storage_node >>=?? fun (storage, _) ->
-  let storage = run toplevel storage param in
-  unparse_data context Readable storage_type storage >>=?? fun (storage_node, _) ->
-  return storage_node
-
-let run_str toplevel storage_str param_str =
-  let param_node = Cast.node_of_string param_str in
-  let storage_node = Cast.node_of_string storage_str in
-  run_node toplevel storage_node param_node
-
-type input = {
-  toplevel_path : string ;
-  storage : string ;
-  parameter : string
-}
-
-let parse_json json_str : input =
-  let json = force_ok_str ~msg:"main_contract: invalid json" @@ Tezos_utils.Data_encoding.Json.from_string json_str in
-  let json = match json with
-    | `O json ->  json
-    | _ -> raise @@ Failure "main_contract: not recorD"
-  in
-  let open Json in
-  let toplevel_path = force_string ~msg:"main_contract, top_level" @@ List.assoc "top_level" json in
-  let parameter = force_string ~msg:"main_contract, param" @@ List.assoc "param" json in
-  let storage = force_string ~msg:"main_contract, storage" @@ List.assoc "storage" json in
-  { toplevel_path ; storage ; parameter }
-
-let generate_json (storage_node:Script.node) : string =
-  let storage_expr = Tezos_micheline.Micheline.strip_locations storage_node in
-  let json = Data_encoding.Json.construct Script.expr_encoding storage_expr in
-  Format.fprintf Format.str_formatter "%a" Data_encoding.Json.pp json ;
-  Format.flush_str_formatter ()
-
-module Types = struct
-  open Script_typed_ir
-
-  let union a b = Union_t ((a, None), (b, None), None)
-  let assert_union = function
-    | Union_t ((a, _), (b, _), _) -> (a, b)
-    | _ -> assert false
-
-  let pair a b = Pair_t ((a, None, None), (b, None, None), None)
-  let assert_pair = function
-    | Pair_t ((a, _, _), ((b, _, _)), _) -> (a, b)
-    | _ -> assert false
-  let assert_pair_ex ?(msg="assert pair") (Ex_ty ty) = match ty with
-    | Pair_t ((a, _, _), ((b, _, _)), _) -> (Ex_ty a, Ex_ty b)
-    | _ -> raise (Failure msg)
-
-  let unit = Unit_t None
-
-  let bytes = Bytes_t None
-  let bytes_k = Bytes_key None
-
-  let nat = Nat_t None
-  let tez = Mutez_t None
-  let int = Int_t None
-  let nat_k = Nat_key None
-  let tez_k = Mutez_key None
-  let int_k = Int_key None
-
-  let big_map k v = Big_map_t (k, v, None)
-
-  let signature = Signature_t None
-  let operation = Operation_t None
-
-  let bool = Bool_t None
-
-  let mutez = Mutez_t None
-
-  let string = String_t None
-  let string_k = String_key None
-  let address_k = Address_key None
-
-  let key = Key_t None
-
-  let list a = List_t (a, None)
-  let set a = Set_t (a, None)
-  let assert_list = function
-    | List_t (a, _) -> a
-    | _ -> assert false
-
-  let option a = Option_t ((a, None), None, None)
-  let contract a = Contract_t (a, None)
-  let assert_option = function
-    | Option_t ((a, _), _, _) -> a
-    | _ -> assert false
-
-  let address = Address_t None
-
-  let lambda a b = Lambda_t (a, b, None)
-  let assert_lambda = function
-    | Lambda_t (a, b, _) -> (a, b)
-    | _ -> assert false
-  type ex_lambda = Ex_lambda : (_, _) lambda ty -> ex_lambda
-  let is_lambda : type a . a ty -> ex_lambda option = function
-    | Lambda_t (_, _, _) as x -> Some (Ex_lambda x)
-    | _ -> None
-
-  let timestamp = Timestamp_t None
-  let timestamp_k = Timestamp_key None
-
-  let map a b = Map_t (a, b, None)
-
-  let assert_type (_:'a ty) (_:'a) = ()
-end
-
-module Values = struct
-  let empty_map t = empty_map t
-
-  let empty_big_map key_type comparable_key_ty value_type : ('a, 'b) big_map = {
-    key_type ; value_type ; diff = empty_map comparable_key_ty ;
-  }
-
-  let int n = Script_int.of_int n
-
-  let nat n = Script_int.abs @@ Script_int.of_int n
-  let nat_to_int n = Option.unopt_exn @@ Script_int.to_int n
-
-  let tez n = Option.unopt_exn @@ Tez.of_mutez @@ Int64.of_int n
-
-  let left a = L a
-
-  let right b = R b
-end

src/meta_michelson/dune

@@ -1,11 +0,0 @@
-(library
- (name meta_michelson)
- (public_name ligo.meta_michelson)
- (libraries
-   simple-utils
-   tezos-utils
-   proto-alpha-utils
-   michelson-parser
-   tezos-micheline
- )
-)

src/meta_michelson/json.ml

@@ -1,7 +0,0 @@
-let force_record ~msg json = match json with
-  | `O json -> json
-  | _ -> raise @@ Failure ("not json record : " ^ msg)
-
-let force_string ~msg json = match json with
-  | `String str -> str
-  | _ -> raise @@ Failure ("not json str : " ^ msg)

src/meta_michelson/meta_michelson.ml

@@ -1,12 +0,0 @@
-module Run = struct
-  open Contract
-  let run_lwt_full = run_lwt_full
-  let run_lwt = run_lwt
-  let run_str = run_str
-  let run_node = run_node
-  let run = run
-end
-module Stack = Michelson_wrap.Stack
-module Values = Contract.Values
-module Types = Contract.Types
-

src/meta_michelson/michelson_wrap.ml

@@ -1,514 +0,0 @@
-open Proto_alpha_utils.Memory_proto_alpha
-module AC = Alpha_context
-
-module Types = Contract.Types
-module Option = Simple_utils.Option
-module MBytes = Alpha_environment.MBytes
-
-module Stack = struct
-  open Script_typed_ir
-
-  let descr bef aft instr =
-    {
-      loc = 0 ;
-      bef ; aft ; instr
-    }
-
-  type nonrec 'a ty = 'a ty
-  type 'a t = 'a stack_ty
-  type nonrec ('a, 'b) descr = ('a, 'b) descr
-  type ('a, 'b) code = ('a t) -> ('a, 'b) descr
-
-  type ex_stack_ty = Ex_stack_ty : 'a t -> ex_stack_ty
-  type ex_descr = Ex_descr : ('a, 'b) descr -> ex_descr
-  type ex_code = Ex_code : ('a, 'b) code -> ex_code
-
-  let stack ?annot a b = Item_t (a, b, annot)
-  let unstack (item: (('a * 'rest) stack_ty)) : ('a ty * 'rest stack_ty) =
-    let Item_t (hd, tl, _) = item in
-    (hd, tl)
-
-  let nil = Empty_t
-  let head x = fst @@ unstack x
-  let tail x = snd @@ unstack x
-
-  let seq a b bef =
-    let a_descr = a bef in
-    let b_descr = b a_descr.aft in
-    let aft = b_descr.aft in
-    descr bef aft @@ Seq (a_descr, b_descr)
-
-  let (@>) (stack : 'b t) (code : ('a, 'b) code) = code stack
-  let (@|) = seq
-  let (@:) = stack
-
-  let (!:) : ('a, 'b) descr -> ('a, 'b) code = fun d _ -> d
-
-  let (<.) (stack:'a t) (code: ('a, 'b) code): ('a, 'b) descr = code stack
-
-  let (<::) : ('a, 'b) descr -> ('b, 'c) descr -> ('a, 'c) descr = fun ab bc ->
-    descr ab.bef bc.aft @@ Seq(ab, bc)
-
-  let (<:) (ab_descr:('a, 'b) descr) (code:('b, 'c) code) : ('a, 'c) descr =
-    let bc_descr = code ab_descr.aft in
-    ab_descr <:: bc_descr
-
-end
-
-open Stack
-
-type nat = AC.Script_int.n AC.Script_int.num
-type int_num = AC.Script_int.z AC.Script_int.num
-type bytes = MBytes.t
-type address = AC.Contract.t Script_typed_ir.ty
-type mutez = AC.Tez.t Script_typed_ir.ty
-
-
-module Stack_ops = struct
-  open Script_typed_ir
-  let dup : ('a * 'rest, 'a * ('a * 'rest)) code = fun bef ->
-    let Item_t (ty, rest, _) = bef in
-    descr bef (Item_t (ty, Item_t (ty, rest, None), None)) Dup
-
-  let drop : ('a * 'rest, 'rest) code = fun bef ->
-    let aft = snd @@ unstack bef in
-    descr bef aft Drop
-
-  let swap (bef : (('a * ('b * 'c)) stack_ty)) =
-    let Item_t (a, Item_t (b, rest, _), _) = bef in
-    descr bef (Item_t (b, (Item_t (a, rest, None)), None)) Swap
-
-  let dip code (bef : ('ty * 'rest) stack_ty) =
-    let Item_t (ty, rest, _) = bef in
-    let applied = code rest in
-    let aft = Item_t (ty, applied.aft, None) in
-    descr bef aft (Dip (code rest))
-
-  let noop : ('r, 'r) code = fun bef ->
-    descr bef bef Nop
-
-  let exec : (_, _) code = fun bef ->
-    let lambda = head @@ tail bef in
-    let (_, ret) = Types.assert_lambda lambda in
-    let aft = ret @: (tail @@ tail bef) in
-    descr bef aft Exec
-
-  let fail aft : ('a * 'r, 'b) code = fun bef ->
-    let head = fst @@ unstack bef in
-    descr bef aft (Failwith head)
-
-  let push_string str (bef : 'rest stack_ty) : (_, (string * 'rest)) descr =
-    let aft = Item_t (Types.string, bef, None) in
-    descr bef aft (Const (str))
-
-  let push_none (a:'a ty) : ('rest, 'a option * 'rest) code = fun r ->
-    let aft = stack (Types.option a) r in
-    descr r aft (Const None)
-
-  let push_unit : ('rest, unit * 'rest) code = fun r ->
-    let aft = stack Types.unit r in
-    descr r aft (Const ())
-
-  let push_nat n (bef : 'rest stack_ty) : (_, (nat * 'rest)) descr =
-    let aft = Item_t (Types.nat, bef, None) in
-    descr bef aft (Const (Contract.Values.nat n))
-
-  let push_int n (bef : 'rest stack_ty) : (_, (int_num * 'rest)) descr =
-    let aft = Types.int @: bef in
-    descr bef aft (Const (Contract.Values.int n))
-
-  let push_tez n (bef : 'rest stack_ty) : (_, (AC.Tez.tez * 'rest)) descr =
-    let aft = Types.mutez @: bef in
-    descr bef aft (Const (Contract.Values.tez n))
-
-  let push_bool b : ('s, bool * 's) code = fun bef ->
-    let aft = stack Types.bool bef in
-    descr bef aft (Const b)
-
-  let push_generic ty v : ('s, _ * 's) code = fun bef ->
-    let aft = stack ty bef in
-    descr bef aft (Const v)
-
-  let failstring str aft =
-    push_string str @| fail aft
-
-end
-
-module Stack_shortcuts = struct
-  open Stack_ops
-
-  let diip c x = dip (dip c) x
-  let diiip c x = dip (diip c) x
-  let diiiip c x = dip (diiip c) x
-
-  let bubble_1 = swap
-  let bubble_down_1 = swap
-
-  let bubble_2 : ('a * ('b * ('c * 'r)), 'c * ('a * ('b * 'r))) code = fun bef ->
-    bef <. dip swap <: swap
-  let bubble_down_2 : ('a * ('b * ('c * 'r)), ('b * ('c * ('a * 'r)))) code = fun bef ->
-    bef <. swap <: dip swap
-
-  let bubble_3 : ('a * ('b * ('c * ('d * 'r))), 'd * ('a * ('b * ('c * 'r)))) code = fun bef ->
-    bef <. diip swap <: dip swap <: swap
-
-  let keep_1 : type r s . ('a * r, s) code -> ('a * r, 'a * s) code = fun code bef ->
-    bef <. dup <: dip code
-
-  let save_1_1 : type r . ('a * r, 'b * r) code -> ('a * r, 'b * ('a * r)) code = fun code s ->
-    s <. keep_1 code <: swap
-
-  let keep_2 : type r s . ('a * ('b * r), s) code -> ('a * ('b * r), ('a * ('b * s))) code = fun code bef ->
-    (dup @| dip (swap @| dup @| dip (swap @| code))) bef
-
-  let keep_2_1 : type r s . ('a * ('b * r), s) code -> ('a * ('b * r), 'b * s) code = fun code bef ->
-    (dip dup @| swap @| dip code) bef
-
-  let relativize_1_1 : ('a * unit, 'b * unit) descr -> ('a * 'r, 'b * 'r) code = fun d s ->
-    let aft = head d.aft @: tail s in
-    descr s aft d.instr
-
-end
-
-module Pair_ops = struct
-  let car (bef : (('a * 'b) * 'rest) Stack.t) =
-    let (pair, rest) = unstack bef in
-    let (a, _) = Contract.Types.assert_pair pair in
-    descr bef (stack a rest) Car
-
-  let cdr (bef : (('a * 'b) * 'rest) Stack.t) =
-    let (pair, rest) = unstack bef in
-    let (_, b) = Contract.Types.assert_pair pair in
-    descr bef (stack b rest) Cdr
-
-  let pair (bef : ('a * ('b * 'rest)) Stack.t) =
-    let (a, rest) = unstack bef in
-    let (b, rest) = unstack rest in
-    let aft = (Types.pair a b) @: rest in
-    descr bef aft Cons_pair
-
-  open Stack_ops
-  let carcdr s = s <. car <: Stack_ops.dip cdr
-
-  let cdrcar s = s <. cdr <: dip car
-
-  let cdrcdr s = s <. cdr <: dip cdr
-
-  let carcar s = s <. car <: dip car
-
-  let cdar s = s <. cdr <: car
-
-  let unpair s = s <. dup <: car <: dip cdr
-end
-
-module Option_ops = struct
-  open Script_typed_ir
-
-  let cons bef =
-    let (hd, tl) = unstack bef in
-    descr bef (stack (Contract.Types.option hd) tl) Cons_some
-
-  let cond ?target none_branch some_branch : ('a option * 'r, 'b) code = fun bef ->
-    let (a_opt, base) = unstack bef in
-    let a = Types.assert_option a_opt in
-    let target = Option.unopt ~default:(none_branch base).aft target in
-    descr bef target (If_none (none_branch base, some_branch (stack a base)))
-
-  let force_some ?msg : ('a option * 'r, 'a * 'r) code = fun s ->
-    let (a_opt, base) = unstack s in
-    let a = Types.assert_option a_opt in
-    let target = a @: base in
-    cond ~target
-      (Stack_ops.failstring ("force_some : " ^ Option.unopt ~default:"" msg) target)
-      Stack_ops.noop s
-end
-
-module Union_ops = struct
-  open Script_typed_ir
-
-  let left (b:'b ty) : ('a * 'r, ('a, 'b) union * 'r) code = fun bef ->
-    let (a, base) = unstack bef in
-    let aft = Types.union a b @: base in
-    descr bef aft Left
-
-  let right (a:'a ty) : ('b * 'r, ('a, 'b) union * 'r) code = fun bef ->
-    let (b, base) = unstack bef in
-    let aft = Types.union a b @: base in
-    descr bef aft Right
-
-
-  let loop ?after (code: ('a * 'r, ('a, 'b) union * 'r) code): (('a, 'b) union * 'r, 'b * 'r) code = fun bef ->
-    let (union, base) = unstack bef in
-    let (a, b) = Types.assert_union union in
-    let code_stack = a @: base in
-    let aft = Option.unopt ~default:(b @: base) after in
-    descr bef aft (Loop_left (code code_stack))
-
-end
-
-module Arithmetic = struct
-  let neq : (int_num * 'r, bool *'r) code = fun bef ->
-    let aft = stack Types.bool @@ snd @@ unstack bef in
-    descr bef aft Neq
-
-  let neg : (int_num * 'r, int_num *'r) code = fun bef ->
-    let aft = stack Types.int @@ snd @@ unstack bef in
-    descr bef aft Neg_int
-
-  let abs : (int_num * 'r, nat *'r) code = fun bef ->
-    let aft = stack Types.nat @@ snd @@ unstack bef in
-    descr bef aft Abs_int
-
-  let int : (nat * 'r, int_num*'r) code = fun bef ->
-    let aft = stack Types.int @@ snd @@ unstack bef in
-    descr bef aft Int_nat
-
-  let nat_opt : (int_num * 'r, nat option * 'r) code = fun bef ->
-    let aft = stack Types.(option nat) @@ tail bef in
-    descr bef aft Is_nat
-
-  let nat_neq = fun s -> (int @| neq) s
-
-  let add_natnat (bef : (nat * (nat * 'rest)) Stack.t) =
-    let (nat, rest) = unstack bef in
-    let rest = tail rest in
-    let aft = stack nat rest in
-    descr bef aft Add_natnat
-
-  let add_intint (bef : (int_num * (int_num * 'rest)) Stack.t) =
-    let (nat, rest) = unstack bef in
-    let rest = tail rest in
-    let aft = stack nat rest in
-    descr bef aft Add_intint
-
-  let add_teztez : (AC.Tez.tez * (AC.Tez.tez * 'rest), _) code = fun bef ->
-    let aft = tail bef in
-    descr bef aft Add_tez
-
-  let mul_natnat (bef : (nat * (nat * 'rest)) Stack.t) =
-    let nat = head bef in
-    let rest = tail @@ tail bef in
-    let aft = stack nat rest in
-    descr bef aft Mul_natnat
-
-  let mul_intint (bef : (int_num * (int_num * 'rest)) Stack.t) =
-    let nat = head bef in
-    let rest = tail @@ tail bef in
-    let aft = stack nat rest in
-    descr bef aft Mul_intint
-
-  let sub_intint : (int_num * (int_num * 'r), int_num * 'r) code = fun bef ->
-    let aft = tail bef in
-    descr bef aft Sub_int
-
-  let sub_natnat : (nat * (nat * 'r), int_num * 'r) code =
-    fun bef -> bef <. int <: Stack_ops.dip int <: sub_intint
-
-  let ediv : (nat * (nat * 'r), (nat * nat) option * 'r) code = fun s ->
-    let (n, base) = unstack @@ snd @@ unstack s in
-    let aft = Types.option (Types.pair n n) @: base in
-    descr s aft Ediv_natnat
-
-  let ediv_tez = fun s ->
-    let aft = Types.(option @@ pair (head s) (head s)) @: tail @@ tail s in
-    descr s aft Ediv_teznat
-
-  open Option_ops
-  let force_ediv x = x <. ediv <: force_some
-  let force_ediv_tez x = (ediv_tez @| force_some) x
-
-  open Pair_ops
-  let div x = x <. force_ediv <: car
-
-  open Stack_ops
-  let div_n n s = s <. push_nat n <: swap <: div
-  let add_n n s = s <. push_nat n <: swap <: add_natnat
-  let add_teztez_n n s = s <. push_tez n <: swap <: add_teztez
-  let sub_n n s = s <. push_nat n <: swap <: sub_natnat
-
-  let force_nat s = s <. nat_opt <: force_some ~msg:"force nat"
-end
-
-module Boolean = struct
-  let bool_and (type r) : (bool * (bool * r), bool * r) code = fun bef ->
-    let aft = Types.bool @: tail @@ tail bef in
-    descr bef aft And
-
-  let bool_or (type r) : (bool * (bool * r), bool * r) code = fun bef ->
-    let aft = Types.bool @: tail @@ tail bef in
-    descr bef aft Or
-
-  open Script_typed_ir
-  let cond ?target true_branch false_branch : (bool * 'r, 's) code = fun bef ->
-    let base = tail bef in
-    let aft = Option.unopt ~default:((true_branch base).aft) target in
-    descr bef aft (If (true_branch base, false_branch base))
-
-  let loop (code : ('s, bool * 's) code) : ((bool * 's), 's) code = fun bef ->
-    let aft = tail bef in
-    descr bef aft @@ Loop (code aft)
-
-end
-
-module Comparison_ops = struct
-  let cmp c_ty : _ code = fun bef ->
-    let aft = stack Contract.Types.int @@ tail @@ tail @@ bef in
-    descr bef aft (Compare c_ty)
-
-  let cmp_bytes = fun x -> cmp (Bytes_key None) x
-
-  let eq : (int_num * 'r, bool *'r) code = fun bef ->
-    let aft = stack Contract.Types.bool @@ snd @@ unstack bef in
-    descr bef aft Eq
-
-  open Arithmetic
-  let eq_n n s = s <. sub_n n <: eq
-
-  let ge : (int_num * 'r, bool * 'r) code = fun bef ->
-    let base = tail bef in
-    let aft = stack Types.bool base in
-    descr bef aft Ge
-
-  let gt : (int_num * 'r, bool * 'r) code = fun bef ->
-    let base = tail bef in
-    let aft = stack Types.bool base in
-    descr bef aft Gt
-
-  let lt : (int_num * 'r, bool * 'r) code = fun bef ->
-    let base = tail bef in
-    let aft = stack Types.bool base in
-    descr bef aft Lt
-
-  let gt_nat s = s <. int <: gt
-
-  open Stack_ops
-  let assert_positive_nat s = s <. dup <: gt_nat <: Boolean.cond noop (failstring "positive" s)
-
-  let cmp_ge_nat : (nat * (nat * 'r), bool * 'r) code = fun bef ->
-    bef <. sub_natnat <: ge
-
-  let cmp_ge_timestamp : (AC.Script_timestamp.t * (AC.Script_timestamp.t * 'r), bool * 'r) code = fun bef ->
-    bef <. cmp Types.timestamp_k <: ge
-
-  let assert_cmp_ge_nat : (nat * (nat * 'r), 'r) code = fun bef ->
-    bef <. cmp_ge_nat <: Boolean.cond noop (failstring "assert cmp ge nat" (tail @@ tail bef))
-
-  let assert_cmp_ge_timestamp : (AC.Script_timestamp.t * (AC.Script_timestamp.t * 'r), 'r) code = fun bef ->
-    bef <. cmp_ge_timestamp <: Boolean.cond noop (failstring "assert cmp ge timestamp" (tail @@ tail bef))
-end
-
-
-module Bytes = struct
-
-  open Script_typed_ir
-
-  let pack (ty:'a ty) : ('a * 'r, bytes * 'r) code = fun bef ->
-    let aft = stack Types.bytes @@ tail bef in
-    descr bef aft (Pack ty)
-
-  let unpack_opt : type a . a ty -> (bytes * 'r, a option * 'r) code = fun ty bef ->
-    let aft = stack (Types.option ty) (tail bef) in
-    descr bef aft (Unpack ty)
-
-  let unpack ty s = s <. unpack_opt ty <: Option_ops.force_some
-
-  let concat : (MBytes.t * (MBytes.t * 'rest), MBytes.t * 'rest) code = fun bef ->
-    let aft = tail bef in
-    descr bef aft Concat_bytes_pair
-
-  let sha256 : (MBytes.t * 'rest, MBytes.t * 'rest) code = fun bef ->
-    descr bef bef Sha256
-
-  let blake2b : (MBytes.t * 'rest, MBytes.t * 'rest) code = fun bef ->
-    descr bef bef Blake2b
-end
-
-
-module Map = struct
-  open Script_typed_ir
-
-  type ('a, 'b) t = ('a, 'b) map
-
-  let empty c_ty = Script_ir_translator.empty_map c_ty
-  let set (type a b) m (k:a) (v:b) = Script_ir_translator.map_update k (Some v) m
-
-  module Ops = struct
-    let update (bef : (('a * ('b option * (('a, 'b) map * ('rest)))) Stack.t)) : (_, ('a, 'b) map * 'rest) descr =
-      let Item_t (_, Item_t (_, Item_t (map, rest, _), _), _) = bef in
-      let aft = Item_t (map, rest, None) in
-      descr bef aft Map_update
-
-    let get : ?a:('a ty) -> 'b ty -> ('a * (('a, 'b) map * 'r), 'b option * 'r) code = fun ?a b bef ->
-      let _ = a in
-      let base = snd @@ unstack @@ snd @@ unstack bef in
-      let aft = stack (Types.option b) base in
-      descr bef aft Map_get
-
-    let big_get : 'a ty -> 'b ty -> ('a * (('a, 'b) big_map * 'r), 'b option * 'r) code = fun _a b bef ->
-      let base = snd @@ unstack @@ snd @@ unstack bef in
-      let aft = stack (Types.option b) base in
-      descr bef aft Big_map_get
-
-    let big_update : ('a * ('b option * (('a, 'b) big_map * 'r)), ('a, 'b) big_map * 'r) code = fun bef ->
-      let base = tail @@ tail bef in
-      descr bef base Big_map_update
-  end
-end
-
-module List_ops = struct
-  let nil ele bef =
-    let aft = stack (Types.list ele) bef in
-    descr bef aft Nil
-
-  let cons bef =
-    let aft = tail bef in
-    descr bef aft Cons_list
-
-  let cond ~target cons_branch nil_branch bef =
-    let (lst, aft) = unstack bef in
-    let a = Types.assert_list lst in
-    let cons_descr = cons_branch (a @: Types.list a @: aft) in
-    let nil_descr = nil_branch aft in
-    descr bef target (If_cons (cons_descr, nil_descr))
-
-  let list_iter : type a r . (a * r, r) code -> (a list * r, r) code = fun code bef ->
-    let (a_lst, aft) = unstack bef in
-    let a = Types.assert_list a_lst in
-    descr bef aft (List_iter (code (a @: aft)))
-
-end
-
-module Tez = struct
-
-  let amount : ('r, AC.Tez.t * 'r) code = fun bef ->
-    let aft = Types.mutez @: bef in
-    descr bef aft Amount
-
-  open Bytes
-
-  let tez_nat s = s <. pack Types.mutez <: unpack Types.nat
-  let amount_nat s = s <. amount <: pack Types.mutez <: unpack Types.nat
-end
-
-module Misc = struct
-
-  open Stack_ops
-  open Stack_shortcuts
-  open Comparison_ops
-  let min_nat : (nat * (nat * 'r), nat * 'r) code = fun s ->
-    s <.
-    keep_2 cmp_ge_nat <: bubble_2 <:
-    Boolean.cond drop (dip drop)
-
-  let debug ~msg () s = s <. push_string msg <: push_string "_debug" <: noop <: drop <: drop
-
-  let debug_msg msg = debug ~msg ()
-
-  let now : ('r, AC.Script_timestamp.t * 'r) code = fun bef ->
-    let aft = stack Types.timestamp bef in
-    descr bef aft Now
-
-end
-
-
-

src/meta_michelson/misc.ml

@@ -1,302 +0,0 @@
-module Signature = Tezos_base.TzPervasives.Signature
-open Proto_alpha_utils.Memory_proto_alpha
-module Data_encoding = Alpha_environment.Data_encoding
-module MBytes = Alpha_environment.MBytes
-module Error_monad = Proto_alpha_utils.Error_monad
-open Error_monad
-
-module Context_init = struct
-
-  type account = {
-      pkh : Signature.Public_key_hash.t ;
-      pk :  Signature.Public_key.t ;
-      sk :  Signature.Secret_key.t ;
-    }
-
-  let generate_accounts n : (account * Tez_repr.t) list =
-    let amount = Tez_repr.of_mutez_exn 4_000_000_000_000L in
-    List.map (fun _ ->
-        let (pkh, pk, sk) = Signature.generate_key () in
-        let account = { pkh ; pk ; sk } in
-        account, amount)
-      (Simple_utils.List.range n)
-
-  let make_shell
-        ~level ~predecessor ~timestamp ~fitness ~operations_hash =
-    Tezos_base.Block_header.{
-        level ;
-        predecessor ;
-        timestamp ;
-        fitness ;
-        operations_hash ;
-        (* We don't care of the following values, only the shell validates them. *)
-        proto_level = 0 ;
-        validation_passes = 0 ;
-        context = Alpha_environment.Context_hash.zero ;
-    }
-
-  let default_proof_of_work_nonce =
-    MBytes.create Alpha_context.Constants.proof_of_work_nonce_size
-
-  let protocol_param_key = [ "protocol_parameters" ]
-
-  let check_constants_consistency constants =
-    let open Constants_repr in
-    let open Error_monad in
-    let { blocks_per_cycle ; blocks_per_commitment ;
-          blocks_per_roll_snapshot ; _ } = constants in
-    Error_monad.unless (blocks_per_commitment <= blocks_per_cycle)
-      (fun () -> failwith "Inconsistent constants : blocks per commitment must be \
-                           less than blocks per cycle") >>=? fun () ->
-    Error_monad.unless (blocks_per_cycle >= blocks_per_roll_snapshot)
-      (fun () -> failwith "Inconsistent constants : blocks per cycle \
-                           must be superior than blocks per roll snapshot") >>=?
-      return
-
-
-  let initial_context
-        constants
-        header
-        commitments
-        initial_accounts
-        security_deposit_ramp_up_cycles
-        no_reward_cycles
-    =
-    let open Tezos_base.TzPervasives.Error_monad in
-    let bootstrap_accounts =
-      List.map (fun ({ pk ; pkh ; _ }, amount) ->
-          let open! Parameters_repr in
-          { public_key_hash = pkh ; public_key = Some pk ; amount }
-        ) initial_accounts
-    in
-    let json =
-      Data_encoding.Json.construct
-        Parameters_repr.encoding
-        Parameters_repr.{
-          bootstrap_accounts ;
-          bootstrap_contracts = [] ;
-          commitments ;
-          constants ;
-          security_deposit_ramp_up_cycles ;
-          no_reward_cycles ;
-      }
-    in
-    let proto_params =
-      Data_encoding.Binary.to_bytes_exn Data_encoding.json json
-    in
-    Tezos_protocol_environment_memory.Context.(
-      set empty ["version"] (MBytes.of_string "genesis")
-    ) >>= fun ctxt ->
-    Tezos_protocol_environment_memory.Context.(
-      set ctxt protocol_param_key proto_params
-    ) >>= fun ctxt ->
-    Main.init ctxt header
-    >|= Alpha_environment.wrap_error >>=? fun { context; _ } ->
-    return context
-
-  let genesis
-        ?(preserved_cycles = Constants_repr.default.preserved_cycles)
-        ?(blocks_per_cycle = Constants_repr.default.blocks_per_cycle)
-        ?(blocks_per_commitment = Constants_repr.default.blocks_per_commitment)
-        ?(blocks_per_roll_snapshot = Constants_repr.default.blocks_per_roll_snapshot)
-        ?(blocks_per_voting_period = Constants_repr.default.blocks_per_voting_period)
-        ?(time_between_blocks = Constants_repr.default.time_between_blocks)
-        ?(endorsers_per_block = Constants_repr.default.endorsers_per_block)
-        ?(hard_gas_limit_per_operation = Constants_repr.default.hard_gas_limit_per_operation)
-        ?(hard_gas_limit_per_block = Constants_repr.default.hard_gas_limit_per_block)
-        ?(proof_of_work_threshold = Int64.(neg one))
-        ?(tokens_per_roll = Constants_repr.default.tokens_per_roll)
-        ?(michelson_maximum_type_size = Constants_repr.default.michelson_maximum_type_size)
-        ?(seed_nonce_revelation_tip = Constants_repr.default.seed_nonce_revelation_tip)
-        ?(origination_size = Constants_repr.default.origination_size)
-        ?(block_security_deposit = Constants_repr.default.block_security_deposit)
-        ?(endorsement_security_deposit = Constants_repr.default.endorsement_security_deposit)
-        ?(block_reward = Constants_repr.default.block_reward)
-        ?(endorsement_reward = Constants_repr.default.endorsement_reward)
-        ?(cost_per_byte = Constants_repr.default.cost_per_byte)
-        ?(hard_storage_limit_per_operation = Constants_repr.default.hard_storage_limit_per_operation)
-        ?(commitments = [])
-        ?(security_deposit_ramp_up_cycles = None)
-        ?(no_reward_cycles = None)
-        (initial_accounts : (account * Tez_repr.t) list)
-    =
-    if initial_accounts = [] then
-      Pervasives.failwith "Must have one account with a roll to bake";
-
-    (* Check there is at least one roll *)
-    let open Tezos_base.TzPervasives.Error_monad in
-    begin try
-        let (>>?=) x y = match x with
-          | Ok(a) -> y a
-          | Error(b) -> fail @@ List.hd b in
-        fold_left_s (fun acc (_, amount) ->
-            Alpha_environment.wrap_error @@
-              Tez_repr.(+?) acc amount >>?= fun acc ->
-                                            if acc >= tokens_per_roll then
-                                              raise Exit
-                                            else return acc
-          ) Tez_repr.zero initial_accounts >>=? fun _ ->
-      failwith "Insufficient tokens in initial accounts to create one roll"
-    with Exit -> return ()
-    end >>=? fun () ->
-
-    let constants : Constants_repr.parametric = {
-        preserved_cycles ;
-        blocks_per_cycle ;
-        blocks_per_commitment ;
-        blocks_per_roll_snapshot ;
-        blocks_per_voting_period ;
-        time_between_blocks ;
-        endorsers_per_block ;
-        hard_gas_limit_per_operation ;
-        hard_gas_limit_per_block ;
-        proof_of_work_threshold ;
-        tokens_per_roll ;
-        michelson_maximum_type_size ;
-        seed_nonce_revelation_tip ;
-        origination_size ;
-        block_security_deposit ;
-        endorsement_security_deposit ;
-        block_reward ;
-        endorsement_reward ;
-        cost_per_byte ;
-        hard_storage_limit_per_operation ;
-      } in
-    check_constants_consistency constants >>=? fun () ->
-
-    let hash =
-      Alpha_environment.Block_hash.of_b58check_exn "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU"
-    in
-    let shell = make_shell
-                  ~level:0l
-                  ~predecessor:hash
-                  ~timestamp:Tezos_utils.Time.epoch
-                  ~fitness: (Fitness_repr.from_int64 0L)
-                  ~operations_hash: Alpha_environment.Operation_list_list_hash.zero in
-    initial_context
-      constants
-      shell
-      commitments
-      initial_accounts
-      security_deposit_ramp_up_cycles
-      no_reward_cycles
-    >>=? fun context ->
-    return (context, shell, hash)
-
-  let init
-        ?(slow=false)
-        ?preserved_cycles
-        ?endorsers_per_block
-        ?commitments
-        n =
-    let open Error_monad in
-    let accounts = generate_accounts n in
-    let contracts = List.map (fun (a, _) ->
-                        Alpha_context.Contract.implicit_contract (a.pkh)) accounts in
-    begin
-      if slow then
-        genesis
-          ?preserved_cycles
-          ?endorsers_per_block
-          ?commitments
-          accounts
-      else
-        genesis
-          ?preserved_cycles
-          ~blocks_per_cycle:32l
-          ~blocks_per_commitment:4l
-          ~blocks_per_roll_snapshot:8l
-          ~blocks_per_voting_period:(Int32.mul 32l 8l)
-          ?endorsers_per_block
-          ?commitments
-          accounts
-    end >>=? fun ctxt ->
-    return (ctxt, accounts, contracts)
-
-  let contents
-        ?(proof_of_work_nonce = default_proof_of_work_nonce)
-        ?(priority = 0) ?seed_nonce_hash () =
-    Alpha_context.Block_header.({
-      priority ;
-      proof_of_work_nonce ;
-      seed_nonce_hash ;
-    })
-
-
-  let begin_construction ?(priority=0) ~timestamp ~(header:Alpha_context.Block_header.shell_header) ~hash ctxt =
-    let contents = contents ~priority () in
-    let protocol_data =
-      let open! Alpha_context.Block_header in {
-        contents ;
-        signature = Signature.zero ;
-      } in
-    let header = {
-        Alpha_context.Block_header.shell = {
-          predecessor = hash ;
-          proto_level = header.proto_level ;
-          validation_passes = header.validation_passes ;
-          fitness = header.fitness ;
-          timestamp ;
-          level = header.level ;
-          context = Alpha_environment.Context_hash.zero ;
-          operations_hash = Alpha_environment.Operation_list_list_hash.zero ;
-        } ;
-        protocol_data = {
-            contents ;
-            signature = Signature.zero ;
-          } ;
-      } in
-    Main.begin_construction
-      ~chain_id: Alpha_environment.Chain_id.zero
-      ~predecessor_context: ctxt
-      ~predecessor_timestamp: header.shell.timestamp
-      ~predecessor_fitness: header.shell.fitness
-      ~predecessor_level: header.shell.level
-      ~predecessor:hash
-      ~timestamp
-      ~protocol_data
-      () >>= fun x -> Lwt.return @@ Alpha_environment.wrap_error x >>=? fun state ->
-    return state.ctxt
-
-  let main n =
-    init n >>=? fun ((ctxt, header, hash), accounts, contracts) ->
-    let timestamp = Tezos_base.Time.now () in
-    begin_construction ~timestamp ~header ~hash ctxt >>=? fun ctxt ->
-    return (ctxt, accounts, contracts)
-
-end
-
-type identity = {
-  public_key_hash : Signature.public_key_hash;
-  public_key : Signature.public_key;
-  secret_key : Signature.secret_key;
-  implicit_contract : Alpha_context.Contract.t;
-}
-
-type environment = {
-  tezos_context : Alpha_context.t ;
-  identities : identity list ;
-}
-
-let init_environment () =
-  Context_init.main 10 >>=? fun (tezos_context, accounts, contracts) ->
-  let accounts = List.map fst accounts in
-  let tezos_context = Alpha_context.Gas.set_limit tezos_context @@ Z.of_int 350000 in
-  let identities =
-    List.map (fun ((a:Context_init.account), c) -> {
-          public_key = a.pk ;
-          public_key_hash = a.pkh ;
-          secret_key = a.sk ;
-          implicit_contract = c ;
-        }) @@
-    List.combine accounts contracts in
-  return {tezos_context ; identities}
-
-let contextualize ~msg ?environment f =
-  let lwt =
-    let environment = match environment with
-      | None -> init_environment ()
-      | Some x -> return x in
-    environment >>=? f
-  in
-  force_ok ~msg @@ Lwt_main.run lwt

src/meta_michelson/streams.ml

@@ -1,18 +0,0 @@
-let read_file f =
-  let ic = open_in f in
-  let n = in_channel_length ic in
-  let s = Bytes.create n in
-  really_input ic s 0 n;
-  close_in ic;
-  Bytes.to_string s
-
-let read_lines filename = 
-  let lines = ref [] in
-  let chan = open_in filename in
-  try
-    while true; do
-      lines := input_line chan :: !lines
-    done; !lines
-  with End_of_file ->
-    close_in chan;
-    List.rev !lines

src/mini_c/dune

@@ -4,10 +4,9 @@
   (libraries
     simple-utils
     tezos-utils
-    meta_michelson
   )
   (preprocess
-    (pps simple-utils.ppx_let_generalized)
+    (pps ppx_let)
   )
   (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils ))
 )

src/mini_c/types.ml

@@ -51,7 +51,7 @@ type value =
   | D_set of value list
   (* | `Macro of anon_macro ... The future. *)
   | D_function of anon_function
-  | D_operation of Memory_proto_alpha.Alpha_context.packed_internal_operation
+  | D_operation of Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation
 
 and selector = var_name list
 

src/operators/dune

@@ -8,7 +8,7 @@
     mini_c
   )
   (preprocess
-    (pps simple-utils.ppx_let_generalized)
+    (pps ppx_let)
   )
   (flags (:standard -open Simple_utils ))
 )

src/parser/camligo/dune

@@ -10,7 +10,7 @@
   (flags (:standard -w +1..62-4-9-44-40-42-48@39@33 -open Simple_utils -open Tezos_utils ))
   (preprocess
     (pps
-      simple-utils.ppx_let_generalized
+      ppx_let
       ppx_deriving.std
     )
   )

src/parser/dune

@@ -10,7 +10,7 @@
     parser_ligodity
   )
   (preprocess
-    (pps simple-utils.ppx_let_generalized)
+    (pps ppx_let)
   )
   (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Parser_shared ))
 )

src/parser/pascaligo/.gitlab-ci.yml

@@ -1,21 +0,0 @@
-before_script:
-  - apt-get update -qq
-  - apt-get -y -qq install libhidapi-dev libcap-dev bubblewrap
-  - wget https://github.com/ocaml/opam/releases/download/2.0.1/opam-2.0.1-x86_64-linux -O opam-2.0.1-x86_64-linux
-  - cp opam-2.0.1-x86_64-linux /usr/local/bin/opam
-  - chmod +x /usr/local/bin/opam
-  - export PATH="/usr/local/bin${PATH:+:}${PATH:-}"
-  - echo "$PATH"
-  - printf '' | opam init
-  - eval $(opam config env)
-  - opam repository add tezos-opam-repository https://gitlab.com/ligolang/tezos-opam-repository.git
-  - eval $(opam config env)
-  - opam --version
-  - printf '' | ocaml
-
-default-job:
-  script:
-    - opam install -y --working-dir .
-  artifacts:
-    paths:
-      - Parser.exe

src/simplify/dune

@@ -10,7 +10,7 @@
   (modules ligodity pascaligo simplify)
   (preprocess
     (pps
-      simple-utils.ppx_let_generalized
+      ppx_let
     )
   )
   (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils ))

src/test/coase_tests.ml

@@ -75,13 +75,13 @@ let (first_owner , first_contract) =
   let open Proto_alpha_utils.Memory_proto_alpha in
   let id = List.nth dummy_environment.identities 0 in
   let kt = id.implicit_contract in
-  Alpha_context.Contract.to_b58check kt , kt
+  Protocol.Alpha_context.Contract.to_b58check kt , kt
 
 let second_owner =
   let open Proto_alpha_utils.Memory_proto_alpha in
   let id = List.nth dummy_environment.identities 1 in
   let kt = id.implicit_contract in
-  Alpha_context.Contract.to_b58check kt
+  Protocol.Alpha_context.Contract.to_b58check kt
 
 let basic a b cards next_id =
   let card_patterns = List.map card_pattern_ez [
@@ -113,13 +113,13 @@ let buy () =
     let%bind () =
       let%bind amount =
         trace_option (simple_error "getting amount for run") @@
-        Memory_proto_alpha.Alpha_context.Tez.of_mutez @@ Int64.of_int 10000000000 in
+        Memory_proto_alpha.Protocol.Alpha_context.Tez.of_mutez @@ Int64.of_int 10000000000 in
       let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~amount () in
       expect_eq_n_pos_small ~options program "buy_single" make_input make_expected in
     let%bind () =
       let%bind amount =
         trace_option (simple_error "getting amount for run") @@
-        Memory_proto_alpha.Alpha_context.Tez.of_mutez @@ Int64.of_int 0 in
+        Memory_proto_alpha.Protocol.Alpha_context.Tez.of_mutez @@ Int64.of_int 0 in
       let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~amount () in
       trace_strong (simple_error "could buy without money") @@
       Assert.assert_fail
@@ -152,13 +152,13 @@ let dispatch_buy () =
     let%bind () =
       let%bind amount =
         trace_option (simple_error "getting amount for run") @@
-        Memory_proto_alpha.Alpha_context.Tez.of_mutez @@ Int64.of_int 10000000000 in
+        Memory_proto_alpha.Protocol.Alpha_context.Tez.of_mutez @@ Int64.of_int 10000000000 in
       let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~amount () in
       expect_eq_n_pos_small ~options program "main" make_input make_expected in
     let%bind () =
       let%bind amount =
         trace_option (simple_error "getting amount for run") @@
-        Memory_proto_alpha.Alpha_context.Tez.of_mutez @@ Int64.of_int 0 in
+        Memory_proto_alpha.Protocol.Alpha_context.Tez.of_mutez @@ Int64.of_int 0 in
       let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~amount () in
       trace_strong (simple_error "could buy without money") @@
       Assert.assert_fail
@@ -190,7 +190,7 @@ let transfer () =
       e_pair ops storage
     in
     let%bind () =
-      let amount = Memory_proto_alpha.Alpha_context.Tez.zero in
+      let amount = Memory_proto_alpha.Protocol.Alpha_context.Tez.zero in
       let payer = first_contract in
       let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~amount ~payer () in
       expect_eq_n_strict_pos_small ~options program "transfer_single" make_input make_expected in
@@ -220,7 +220,7 @@ let sell () =
       Ast_simplified.Misc.assert_value_eq (expected_storage , storage)
     in
     let%bind () =
-      let amount = Memory_proto_alpha.Alpha_context.Tez.zero in
+      let amount = Memory_proto_alpha.Protocol.Alpha_context.Tez.zero in
       let payer = first_contract in
       let options = Proto_alpha_utils.Memory_proto_alpha.make_options ~amount ~payer () in
       expect_n_strict_pos_small ~options program "sell_single" make_input make_expecter in

src/test/dune

@@ -6,7 +6,7 @@
     alcotest
   )
   (preprocess
-    (pps simple-utils.ppx_let_generalized)
+    (pps ppx_let)
   )
   (flags (:standard -w +1..62-4-9-44-40-42-48@39@33 -open Simple_utils ))
 )

src/transpiler/dune

@@ -9,7 +9,7 @@
     operators
   )
   (preprocess
-    (pps simple-utils.ppx_let_generalized)
+    (pps ppx_let)
   )
   (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils ))
 )

src/typer/dune

@@ -9,7 +9,7 @@
     operators
   )
   (preprocess
-    (pps simple-utils.ppx_let_generalized)
+    (pps ppx_let)
   )
   (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils ))
 )

vendors/ligo-utils/memory-proto-alpha/dune-project

@@ -0,0 +1,2 @@
+(lang dune 1.11)
+(name tezos-memory-proto-alpha)

vendors/ligo-utils/memory-proto-alpha/memory_proto_alpha.ml

@@ -1,8 +1,9 @@
 module Name = struct let name = "alpha" end
-module Alpha_environment = Tezos_protocol_environment_memory.MakeV1(Name)()
+module Alpha_environment = Tezos_protocol_alpha.Protocol.Environment
+
 
 type alpha_error = Alpha_environment.Error_monad.error
 type 'a alpha_tzresult = 'a Alpha_environment.Error_monad.tzresult
 module Alpha_error_monad = Alpha_environment.Error_monad
-module Proto = Tezos_protocol_alpha.Functor.Make(Alpha_environment)
+module Proto = Tezos_protocol_alpha
 include Proto

vendors/ligo-utils/proto-alpha-utils/cast.ml

@@ -4,6 +4,7 @@ open Tezos_micheline
 let env = Error_monad.force_lwt ~msg:"Cast:init environment" @@ Init_proto_alpha.init_environment ()
 
 open Memory_proto_alpha
+open Protocol
 open Alpha_context
 
 exception Expr_from_string
@@ -44,6 +45,196 @@ let node_to_string (node:_ Micheline.node) =
 
 open Script_ir_translator
 
+type ex_typed_value =
+  Ex_typed_value : ('a Script_typed_ir.ty * 'a) -> ex_typed_value
+
+include struct
+  open Script_typed_ir
+  open Protocol.Environment.Error_monad
+  module Unparse_costs = Michelson_v1_gas.Cost_of.Unparse
+  open Micheline
+  open Michelson_v1_primitives
+  open Protocol.Environment
+
+  let rec unparse_data_generic
+          : type a. context -> ?mapper:(ex_typed_value -> Script.node option tzresult Lwt.t) ->
+                 unparsing_mode -> a ty -> a -> (Script.node * context) tzresult Lwt.t
+    = fun ctxt ?(mapper = fun _ -> return None) mode ty a ->
+    Lwt.return (Gas.consume ctxt Unparse_costs.cycle) >>=? fun ctxt ->
+    mapper (Ex_typed_value (ty, a)) >>=? function
+    | Some x -> return (x, ctxt)
+    | None -> (
+      match ty, a with
+      | Unit_t _, () ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.unit) >>=? fun ctxt ->
+         return (Prim (-1, D_Unit, [], []), ctxt)
+      | Int_t _, v ->
+         Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt ->
+         return (Int (-1, Script_int.to_zint v), ctxt)
+      | Nat_t _, v ->
+         Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt ->
+         return (Int (-1, Script_int.to_zint v), ctxt)
+      | String_t _, s ->
+         Lwt.return (Gas.consume ctxt (Unparse_costs.string s)) >>=? fun ctxt ->
+         return (String (-1, s), ctxt)
+      | Bytes_t _, s ->
+         Lwt.return (Gas.consume ctxt (Unparse_costs.bytes s)) >>=? fun ctxt ->
+         return (Bytes (-1, s), ctxt)
+      | Bool_t _, true ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt ->
+         return (Prim (-1, D_True, [], []), ctxt)
+      | Bool_t _, false ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt ->
+         return (Prim (-1, D_False, [], []), ctxt)
+      | Timestamp_t _, t ->
+         Lwt.return (Gas.consume ctxt (Unparse_costs.timestamp t)) >>=? fun ctxt ->
+         begin
+           match mode with
+           | Optimized -> return (Int (-1, Script_timestamp.to_zint t), ctxt)
+           | Readable ->
+              match Script_timestamp.to_notation t with
+              | None -> return (Int (-1, Script_timestamp.to_zint t), ctxt)
+              | Some s -> return (String (-1, s), ctxt)
+         end
+      | Address_t _, c  ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt ->
+         begin
+           match mode with
+           | Optimized ->
+              let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in
+              return (Bytes (-1, bytes), ctxt)
+           | Readable -> return (String (-1, Contract.to_b58check c), ctxt)
+         end
+      | Contract_t _, (_, c)  ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt ->
+         begin
+           match mode with
+           | Optimized ->
+              let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in
+              return (Bytes (-1, bytes), ctxt)
+           | Readable -> return (String (-1, Contract.to_b58check c), ctxt)
+         end
+      | Signature_t _, s ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.signature) >>=? fun ctxt ->
+         begin
+           match mode with
+           | Optimized ->
+              let bytes = Data_encoding.Binary.to_bytes_exn Signature.encoding s in
+              return (Bytes (-1, bytes), ctxt)
+           | Readable ->
+              return (String (-1, Signature.to_b58check s), ctxt)
+         end
+      | Mutez_t _, v ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.tez) >>=? fun ctxt ->
+         return (Int (-1, Z.of_int64 (Tez.to_mutez v)), ctxt)
+      | Key_t _, k ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.key) >>=? fun ctxt ->
+         begin
+           match mode with
+           | Optimized ->
+              let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding k in
+              return (Bytes (-1, bytes), ctxt)
+           | Readable ->
+              return (String (-1, Signature.Public_key.to_b58check k), ctxt)
+         end
+      | Key_hash_t _, k ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.key_hash) >>=? fun ctxt ->
+         begin
+           match mode with
+           | Optimized ->
+              let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key_hash.encoding k in
+              return (Bytes (-1, bytes), ctxt)
+           | Readable ->
+              return (String (-1, Signature.Public_key_hash.to_b58check k), ctxt)
+         end
+      | Operation_t _, op ->
+         let bytes = Data_encoding.Binary.to_bytes_exn Alpha_context.Operation.internal_operation_encoding op in
+         Lwt.return (Gas.consume ctxt (Unparse_costs.operation bytes)) >>=? fun ctxt ->
+         return (Bytes (-1, bytes), ctxt)
+      | Pair_t ((tl, _, _), (tr, _, _), _), (l, r) ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.pair) >>=? fun ctxt ->
+         unparse_data_generic ~mapper ctxt mode tl l >>=? fun (l, ctxt) ->
+         unparse_data_generic ~mapper ctxt mode tr r >>=? fun (r, ctxt) ->
+         return (Prim (-1, D_Pair, [ l; r ], []), ctxt)
+      | Union_t ((tl, _), _, _), L l ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt ->
+         unparse_data_generic ~mapper ctxt mode tl l >>=? fun (l, ctxt) ->
+         return (Prim (-1, D_Left, [ l ], []), ctxt)
+      | Union_t (_, (tr, _), _), R r ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt ->
+         unparse_data_generic ~mapper ctxt mode tr r >>=? fun (r, ctxt) ->
+         return (Prim (-1, D_Right, [ r ], []), ctxt)
+      | Option_t ((t, _), _, _), Some v ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.some) >>=? fun ctxt ->
+         unparse_data_generic ~mapper ctxt mode t v >>=? fun (v, ctxt) ->
+         return (Prim (-1, D_Some, [ v ], []), ctxt)
+      | Option_t _, None ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.none) >>=? fun ctxt ->
+         return (Prim (-1, D_None, [], []), ctxt)
+      | List_t (t, _), items ->
+         fold_left_s
+           (fun (l, ctxt) element ->
+             Lwt.return (Gas.consume ctxt Unparse_costs.list_element) >>=? fun ctxt ->
+             unparse_data_generic ~mapper ctxt mode t element >>=? fun (unparsed, ctxt) ->
+             return (unparsed :: l, ctxt))
+           ([], ctxt)
+           items >>=? fun (items, ctxt) ->
+         return (Micheline.Seq (-1, List.rev items), ctxt)
+      | Set_t (t, _), set ->
+         let t = ty_of_comparable_ty t in
+         fold_left_s
+           (fun (l, ctxt) item ->
+             Lwt.return (Gas.consume ctxt Unparse_costs.set_element) >>=? fun ctxt ->
+             unparse_data_generic ~mapper ctxt mode t item >>=? fun (item, ctxt) ->
+             return (item :: l, ctxt))
+           ([], ctxt)
+           (set_fold (fun e acc -> e :: acc) set []) >>=? fun (items, ctxt) ->
+         return (Micheline.Seq (-1, items), ctxt)
+      | Map_t (kt, vt, _), map ->
+         let kt = ty_of_comparable_ty kt in
+         fold_left_s
+           (fun (l, ctxt) (k, v) ->
+             Lwt.return (Gas.consume ctxt Unparse_costs.map_element) >>=? fun ctxt ->
+             unparse_data_generic ~mapper ctxt mode kt k >>=? fun (key, ctxt) ->
+             unparse_data_generic ~mapper ctxt mode vt v >>=? fun (value, ctxt) ->
+             return (Prim (-1, D_Elt, [ key ; value ], []) :: l, ctxt))
+           ([], ctxt)
+           (map_fold (fun k v acc -> (k, v) :: acc) map []) >>=? fun (items, ctxt) ->
+         return (Micheline.Seq (-1, items), ctxt)
+      | Big_map_t (_kt, _kv, _), _map ->
+         return (Micheline.Seq (-1, []), ctxt)
+      | Lambda_t _, Lam (_, original_code) ->
+         unparse_code_generic ~mapper ctxt mode (root original_code)
+    )
+
+  and unparse_code_generic ctxt ?mapper mode = function
+    | Prim (loc, I_PUSH, [ ty ; data ], annot) ->
+       Lwt.return (parse_ty ctxt ~allow_big_map:false ~allow_operation:false ty) >>=? fun (Ex_ty t, ctxt) ->
+       parse_data ctxt t data >>=? fun (data, ctxt) ->
+       unparse_data_generic ?mapper ctxt mode t data >>=? fun (data, ctxt) ->
+       Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 2 annot)) >>=? fun ctxt ->
+       return (Prim (loc, I_PUSH, [ ty ; data ], annot), ctxt)
+    | Seq (loc, items) ->
+       fold_left_s
+         (fun (l, ctxt) item ->
+           unparse_code_generic ?mapper ctxt mode item >>=? fun (item, ctxt) ->
+           return (item :: l, ctxt))
+         ([], ctxt) items >>=? fun (items, ctxt) ->
+       Lwt.return (Gas.consume ctxt (Unparse_costs.seq_cost (List.length items))) >>=? fun ctxt ->
+       return (Micheline.Seq (loc, List.rev items), ctxt)
+    | Prim (loc, prim, items, annot) ->
+       fold_left_s
+         (fun (l, ctxt) item ->
+           unparse_code_generic ?mapper ctxt mode item >>=? fun (item, ctxt) ->
+           return (item :: l, ctxt))
+         ([], ctxt) items >>=? fun (items, ctxt) ->
+       Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 3 annot)) >>=? fun ctxt ->
+       return (Prim (loc, prim, List.rev items, annot), ctxt)
+    | Int _ | String _ | Bytes _ as atom -> return (atom, ctxt)
+
+
+end
+
 let rec mapper (Ex_typed_value (ty, a)) =
   let open Alpha_environment.Error_monad in
   let open Script_typed_ir in
@@ -67,7 +258,7 @@ let rec mapper (Ex_typed_value (ty, a)) =
 
 and data_to_node (Ex_typed_value (ty, data)) =
   let tc = env.tezos_context in
-  let node_lwt = Script_ir_translator.unparse_data tc ~mapper Readable ty data in
+  let node_lwt = unparse_data_generic tc ~mapper Readable ty data in
   let node = fst @@ Error_monad.force_lwt_alpha ~msg:"data to string" node_lwt in
   node
 
@@ -125,7 +316,7 @@ let descr_to_node x =
     | Car -> prim I_CAR
     | Cdr -> prim I_CDR
     | Cons_pair -> prim I_PAIR
-    | Nop -> prim I_NOP
+    | Nop -> Micheline.Seq (0, [prim I_UNIT ; prim I_DROP])
     | Seq (a, b) -> Micheline.Seq (0, List.map f [Ex_descr a ; Ex_descr b])
     | Const v -> (
         let (Item_t (ty, _, _)) = descr.aft in

vendors/ligo-utils/proto-alpha-utils/dune

@@ -4,6 +4,7 @@
   (libraries
     tezos-error-monad
     tezos-stdlib-unix
+    tezos-protocol-alpha-parameters
     tezos-memory-proto-alpha
     simple-utils
     tezos-utils

vendors/ligo-utils/proto-alpha-utils/init_proto_alpha.ml

@@ -4,7 +4,7 @@ module Data_encoding = Alpha_environment.Data_encoding
 module MBytes = Alpha_environment.MBytes
 module Error_monad = X_error_monad
 open Error_monad
-
+open Protocol
 
 
 module Context_init = struct
@@ -85,10 +85,10 @@ module Context_init = struct
     let proto_params =
       Data_encoding.Binary.to_bytes_exn Data_encoding.json json
     in
-    Tezos_protocol_environment_memory.Context.(
+    Tezos_protocol_environment.Context.(
-      set empty ["version"] (MBytes.of_string "genesis")
+      set Memory_context.empty ["version"] (MBytes.of_string "genesis")
     ) >>= fun ctxt ->
-    Tezos_protocol_environment_memory.Context.(
+    Tezos_protocol_environment.Context.(
       set ctxt protocol_param_key proto_params
     ) >>= fun ctxt ->
     Main.init ctxt header
@@ -141,7 +141,7 @@ module Context_init = struct
       with Exit -> return ()
     end >>=? fun () ->
 
-    let constants : Constants_repr.parametric = {
+    let constants : Constants_repr.parametric = Tezos_protocol_alpha_parameters.Default_parameters.({
         preserved_cycles ;
         blocks_per_cycle ;
         blocks_per_commitment ;
@@ -162,7 +162,8 @@ module Context_init = struct
         endorsement_reward ;
         cost_per_byte ;
         hard_storage_limit_per_operation ;
-      } in
+        test_chain_duration = constants_mainnet.test_chain_duration ;
+      }) in
     check_constants_consistency constants >>=? fun () ->
 
     let hash =
@@ -171,7 +172,7 @@ module Context_init = struct
     let shell = make_shell
                   ~level:0l
                   ~predecessor:hash
-                  ~timestamp:Tezos_base.TzPervasives.Time.epoch
+                  ~timestamp:Tezos_base.TzPervasives.Time.Protocol.epoch
                   ~fitness: (Fitness_repr.from_int64 0L)
                   ~operations_hash: Alpha_environment.Operation_list_list_hash.zero in
     initial_context
@@ -246,7 +247,7 @@ module Context_init = struct
 
   let main n =
     init n >>=? fun ((ctxt, header, hash), accounts, contracts) ->
-    let timestamp = Tezos_base.Time.now () in
+    let timestamp = Environment.Time.of_seconds @@ Int64.of_float @@ Unix.time () in
     begin_construction ~timestamp ~header ~hash ctxt >>=? fun ctxt ->
     return (ctxt, accounts, contracts)
 

vendors/ligo-utils/proto-alpha-utils/proto-alpha-utils.opam

@@ -39,6 +39,7 @@ depends: [
   "tezos-data-encoding"
   "tezos-protocol-environment"
   "tezos-protocol-alpha"
+  "tezos-protocol-alpha-parameters"
   "michelson-parser"
   "simple-utils"
   "tezos-utils"

vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml

@@ -4,15 +4,940 @@ include Memory_proto_alpha
 let init_environment = Init_proto_alpha.init_environment
 let dummy_environment = Init_proto_alpha.dummy_environment
 
-open X_error_monad
+
+open Protocol
 open Script_typed_ir
 open Script_ir_translator
 open Script_interpreter
 
+module X = struct
+  open Alpha_context
+  open Script_tc_errors
+  open Alpha_environment.Error_monad
+let rec stack_ty_eq
+  : type ta tb. context -> int -> ta stack_ty -> tb stack_ty ->
+    ((ta stack_ty, tb stack_ty) eq * context) tzresult
+  = fun ctxt lvl ta tb ->
+    match ta, tb with
+    | Item_t (tva, ra, _), Item_t (tvb, rb, _) ->
+        ty_eq ctxt tva tvb |>
+        record_trace (Bad_stack_item lvl) >>? fun (Eq, ctxt) ->
+        stack_ty_eq ctxt (lvl + 1) ra rb >>? fun (Eq, ctxt) ->
+        (Ok (Eq, ctxt) : ((ta stack_ty, tb stack_ty) eq * context) tzresult)
+    | Empty_t, Empty_t -> Ok (Eq, ctxt)
+    | _, _ -> error Bad_stack_length
+
+  open Script_typed_ir
+  open Protocol.Environment.Error_monad
+  module Unparse_costs = Michelson_v1_gas.Cost_of.Unparse
+  open Tezos_micheline.Micheline
+  open Michelson_v1_primitives
+  open Protocol.Environment
+
+  type ex_typed_value =
+    Ex_typed_value : ('a Script_typed_ir.ty * 'a) -> ex_typed_value
+
+
+  let rec unparse_data_generic
+          : type a. context -> ?mapper:(ex_typed_value -> Script.node option tzresult Lwt.t) ->
+                 unparsing_mode -> a ty -> a -> (Script.node * context) tzresult Lwt.t
+    = fun ctxt ?(mapper = fun _ -> return None) mode ty a ->
+    Lwt.return (Gas.consume ctxt Unparse_costs.cycle) >>=? fun ctxt ->
+    mapper (Ex_typed_value (ty, a)) >>=? function
+    | Some x -> return (x, ctxt)
+    | None -> (
+      match ty, a with
+      | Unit_t _, () ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.unit) >>=? fun ctxt ->
+         return (Prim (-1, D_Unit, [], []), ctxt)
+      | Int_t _, v ->
+         Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt ->
+         return (Int (-1, Script_int.to_zint v), ctxt)
+      | Nat_t _, v ->
+         Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt ->
+         return (Int (-1, Script_int.to_zint v), ctxt)
+      | String_t _, s ->
+         Lwt.return (Gas.consume ctxt (Unparse_costs.string s)) >>=? fun ctxt ->
+         return (String (-1, s), ctxt)
+      | Bytes_t _, s ->
+         Lwt.return (Gas.consume ctxt (Unparse_costs.bytes s)) >>=? fun ctxt ->
+         return (Bytes (-1, s), ctxt)
+      | Bool_t _, true ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt ->
+         return (Prim (-1, D_True, [], []), ctxt)
+      | Bool_t _, false ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt ->
+         return (Prim (-1, D_False, [], []), ctxt)
+      | Timestamp_t _, t ->
+         Lwt.return (Gas.consume ctxt (Unparse_costs.timestamp t)) >>=? fun ctxt ->
+         begin
+           match mode with
+           | Optimized -> return (Int (-1, Script_timestamp.to_zint t), ctxt)
+           | Readable ->
+              match Script_timestamp.to_notation t with
+              | None -> return (Int (-1, Script_timestamp.to_zint t), ctxt)
+              | Some s -> return (String (-1, s), ctxt)
+         end
+      | Address_t _, c  ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt ->
+         begin
+           match mode with
+           | Optimized ->
+              let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in
+              return (Bytes (-1, bytes), ctxt)
+           | Readable -> return (String (-1, Contract.to_b58check c), ctxt)
+         end
+      | Contract_t _, (_, c)  ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt ->
+         begin
+           match mode with
+           | Optimized ->
+              let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in
+              return (Bytes (-1, bytes), ctxt)
+           | Readable -> return (String (-1, Contract.to_b58check c), ctxt)
+         end
+      | Signature_t _, s ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.signature) >>=? fun ctxt ->
+         begin
+           match mode with
+           | Optimized ->
+              let bytes = Data_encoding.Binary.to_bytes_exn Signature.encoding s in
+              return (Bytes (-1, bytes), ctxt)
+           | Readable ->
+              return (String (-1, Signature.to_b58check s), ctxt)
+         end
+      | Mutez_t _, v ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.tez) >>=? fun ctxt ->
+         return (Int (-1, Z.of_int64 (Tez.to_mutez v)), ctxt)
+      | Key_t _, k ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.key) >>=? fun ctxt ->
+         begin
+           match mode with
+           | Optimized ->
+              let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding k in
+              return (Bytes (-1, bytes), ctxt)
+           | Readable ->
+              return (String (-1, Signature.Public_key.to_b58check k), ctxt)
+         end
+      | Key_hash_t _, k ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.key_hash) >>=? fun ctxt ->
+         begin
+           match mode with
+           | Optimized ->
+              let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key_hash.encoding k in
+              return (Bytes (-1, bytes), ctxt)
+           | Readable ->
+              return (String (-1, Signature.Public_key_hash.to_b58check k), ctxt)
+         end
+      | Operation_t _, op ->
+         let bytes = Data_encoding.Binary.to_bytes_exn Alpha_context.Operation.internal_operation_encoding op in
+         Lwt.return (Gas.consume ctxt (Unparse_costs.operation bytes)) >>=? fun ctxt ->
+         return (Bytes (-1, bytes), ctxt)
+      | Pair_t ((tl, _, _), (tr, _, _), _), (l, r) ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.pair) >>=? fun ctxt ->
+         unparse_data_generic ~mapper ctxt mode tl l >>=? fun (l, ctxt) ->
+         unparse_data_generic ~mapper ctxt mode tr r >>=? fun (r, ctxt) ->
+         return (Prim (-1, D_Pair, [ l; r ], []), ctxt)
+      | Union_t ((tl, _), _, _), L l ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt ->
+         unparse_data_generic ~mapper ctxt mode tl l >>=? fun (l, ctxt) ->
+         return (Prim (-1, D_Left, [ l ], []), ctxt)
+      | Union_t (_, (tr, _), _), R r ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt ->
+         unparse_data_generic ~mapper ctxt mode tr r >>=? fun (r, ctxt) ->
+         return (Prim (-1, D_Right, [ r ], []), ctxt)
+      | Option_t ((t, _), _, _), Some v ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.some) >>=? fun ctxt ->
+         unparse_data_generic ~mapper ctxt mode t v >>=? fun (v, ctxt) ->
+         return (Prim (-1, D_Some, [ v ], []), ctxt)
+      | Option_t _, None ->
+         Lwt.return (Gas.consume ctxt Unparse_costs.none) >>=? fun ctxt ->
+         return (Prim (-1, D_None, [], []), ctxt)
+      | List_t (t, _), items ->
+         fold_left_s
+           (fun (l, ctxt) element ->
+             Lwt.return (Gas.consume ctxt Unparse_costs.list_element) >>=? fun ctxt ->
+             unparse_data_generic ~mapper ctxt mode t element >>=? fun (unparsed, ctxt) ->
+             return (unparsed :: l, ctxt))
+           ([], ctxt)
+           items >>=? fun (items, ctxt) ->
+         return (Micheline.Seq (-1, List.rev items), ctxt)
+      | Set_t (t, _), set ->
+         let t = ty_of_comparable_ty t in
+         fold_left_s
+           (fun (l, ctxt) item ->
+             Lwt.return (Gas.consume ctxt Unparse_costs.set_element) >>=? fun ctxt ->
+             unparse_data_generic ~mapper ctxt mode t item >>=? fun (item, ctxt) ->
+             return (item :: l, ctxt))
+           ([], ctxt)
+           (set_fold (fun e acc -> e :: acc) set []) >>=? fun (items, ctxt) ->
+         return (Micheline.Seq (-1, items), ctxt)
+      | Map_t (kt, vt, _), map ->
+         let kt = ty_of_comparable_ty kt in
+         fold_left_s
+           (fun (l, ctxt) (k, v) ->
+             Lwt.return (Gas.consume ctxt Unparse_costs.map_element) >>=? fun ctxt ->
+             unparse_data_generic ~mapper ctxt mode kt k >>=? fun (key, ctxt) ->
+             unparse_data_generic ~mapper ctxt mode vt v >>=? fun (value, ctxt) ->
+             return (Prim (-1, D_Elt, [ key ; value ], []) :: l, ctxt))
+           ([], ctxt)
+           (map_fold (fun k v acc -> (k, v) :: acc) map []) >>=? fun (items, ctxt) ->
+         return (Micheline.Seq (-1, items), ctxt)
+      | Big_map_t (_kt, _kv, _), _map ->
+         return (Micheline.Seq (-1, []), ctxt)
+      | Lambda_t _, Lam (_, original_code) ->
+         unparse_code_generic ~mapper ctxt mode (root original_code)
+    )
+
+  and unparse_code_generic ctxt ?mapper mode = function
+    | Prim (loc, I_PUSH, [ ty ; data ], annot) ->
+       Lwt.return (parse_ty ctxt ~allow_big_map:false ~allow_operation:false ty) >>=? fun (Ex_ty t, ctxt) ->
+       parse_data ctxt t data >>=? fun (data, ctxt) ->
+       unparse_data_generic ?mapper ctxt mode t data >>=? fun (data, ctxt) ->
+       Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 2 annot)) >>=? fun ctxt ->
+       return (Prim (loc, I_PUSH, [ ty ; data ], annot), ctxt)
+    | Seq (loc, items) ->
+       fold_left_s
+         (fun (l, ctxt) item ->
+           unparse_code_generic ?mapper ctxt mode item >>=? fun (item, ctxt) ->
+           return (item :: l, ctxt))
+         ([], ctxt) items >>=? fun (items, ctxt) ->
+       Lwt.return (Gas.consume ctxt (Unparse_costs.seq_cost (List.length items))) >>=? fun ctxt ->
+       return (Micheline.Seq (loc, List.rev items), ctxt)
+    | Prim (loc, prim, items, annot) ->
+       fold_left_s
+         (fun (l, ctxt) item ->
+           unparse_code_generic ?mapper ctxt mode item >>=? fun (item, ctxt) ->
+           return (item :: l, ctxt))
+         ([], ctxt) items >>=? fun (items, ctxt) ->
+       Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 3 annot)) >>=? fun ctxt ->
+       return (Prim (loc, prim, List.rev items, annot), ctxt)
+    | Int _ | String _ | Bytes _ as atom -> return (atom, ctxt)
+
+module Interp_costs = Michelson_v1_gas.Cost_of
+type ex_descr_stack = Ex_descr_stack : (('a, 'b) descr * 'a stack) -> ex_descr_stack
+
+let unparse_stack ctxt (stack, stack_ty) =
+  (* We drop the gas limit as this function is only used for debugging/errors. *)
+  let ctxt = Gas.set_unlimited ctxt in
+  let rec unparse_stack
+    : type a. a stack * a stack_ty -> (Script.expr * string option) list tzresult Lwt.t
+    = function
+      | Empty, Empty_t -> return_nil
+      | Item (v, rest), Item_t (ty, rest_ty, annot) ->
+          unparse_data ctxt Readable ty v >>=? fun (data, _ctxt) ->
+          unparse_stack (rest, rest_ty) >>=? fun rest ->
+          let annot = match Script_ir_annot.unparse_var_annot annot with
+            | [] -> None
+            | [ a ] -> Some a
+            | _ -> assert false in
+          let data = Micheline.strip_locations data in
+          return ((data, annot) :: rest) in
+  unparse_stack (stack, stack_ty)
+
+let rec step
+  : type b a.
+    (?log: execution_trace ref ->
+     context ->
+     source: Contract.t ->
+     self: Contract.t ->
+     payer: Contract.t ->
+     ?visitor: (ex_descr_stack -> unit) ->
+     Tez.t ->
+     (b, a) descr -> b stack ->
+     (a stack * context) tzresult Lwt.t) =
+  fun ?log ctxt ~source ~self ~payer ?visitor amount ({ instr ; loc ; _ } as descr) stack ->
+    Lwt.return (Gas.consume ctxt Interp_costs.cycle) >>=? fun ctxt ->
+    (match visitor with
+     | Some visitor -> visitor @@ Ex_descr_stack(descr, stack)
+     | None -> ()) ;
+    let step_same ctxt = step ?log ctxt ~source ~self ~payer ?visitor amount in
+    let logged_return : type a b.
+      (b, a) descr ->
+      a stack * context ->
+      (a stack * context) tzresult Lwt.t =
+      fun descr (ret, ctxt) ->
+        match log with
+        | None -> return (ret, ctxt)
+        | Some log ->
+            trace
+              Cannot_serialize_log
+              (unparse_stack ctxt (ret, descr.aft)) >>=? fun stack ->
+            log := (descr.loc, Gas.level ctxt, stack) :: !log ;
+            return (ret, ctxt) in
+    let get_log (log : execution_trace ref option) =
+      Option.map ~f:(fun l -> List.rev !l) log in
+    let consume_gas_terop : type ret arg1 arg2 arg3 rest.
+      (_ * (_ * (_ * rest)), ret * rest) descr ->
+      ((arg1 -> arg2 -> arg3 -> ret) * arg1 * arg2 * arg3) ->
+      (arg1 -> arg2 -> arg3 -> Gas.cost) ->
+      rest stack ->
+      ((ret * rest) stack * context) tzresult Lwt.t =
+      fun descr (op, x1, x2, x3) cost_func rest ->
+        Lwt.return (Gas.consume ctxt (cost_func x1 x2 x3)) >>=? fun ctxt ->
+        logged_return descr (Item (op x1 x2 x3, rest), ctxt) in
+    let consume_gas_binop : type ret arg1 arg2 rest.
+      (_ * (_ * rest), ret * rest) descr ->
+      ((arg1 -> arg2 -> ret) * arg1 * arg2) ->
+      (arg1 -> arg2 -> Gas.cost) ->
+      rest stack ->
+      context ->
+      ((ret * rest) stack * context) tzresult Lwt.t =
+      fun descr (op, x1, x2) cost_func rest ctxt ->
+        Lwt.return (Gas.consume ctxt (cost_func x1 x2)) >>=? fun ctxt ->
+        logged_return descr (Item (op x1 x2, rest), ctxt) in
+    let consume_gas_unop : type ret arg rest.
+      (_ * rest, ret * rest) descr ->
+      ((arg -> ret) * arg) ->
+      (arg -> Gas.cost) ->
+      rest stack ->
+      context ->
+      ((ret * rest) stack * context) tzresult Lwt.t =
+      fun descr (op, arg) cost_func rest ctxt ->
+        Lwt.return (Gas.consume ctxt (cost_func arg)) >>=? fun ctxt ->
+        logged_return descr (Item (op arg, rest), ctxt) in
+    let consume_gaz_comparison :
+      type t rest.
+      (t * (t * rest), Script_int.z Script_int.num * rest) descr ->
+      (t -> t -> int) ->
+      (t -> t -> Gas.cost) ->
+      t -> t ->
+      rest stack ->
+      ((Script_int.z Script_int.num * rest) stack * context) tzresult Lwt.t =
+      fun descr op cost x1 x2 rest ->
+        Lwt.return (Gas.consume ctxt (cost x1 x2)) >>=? fun ctxt ->
+        logged_return descr (Item (Script_int.of_int @@ op x1 x2, rest), ctxt) in
+    let logged_return :
+      a stack * context ->
+      (a stack * context) tzresult Lwt.t =
+      logged_return descr in
+    match instr, stack with
+    (* stack ops *)
+    | Drop, Item (_, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.stack_op) >>=? fun ctxt ->
+        logged_return (rest, ctxt)
+    | Dup, Item (v, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.stack_op) >>=? fun ctxt ->
+        logged_return (Item (v, Item (v, rest)), ctxt)
+    | Swap, Item (vi, Item (vo, rest)) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.stack_op) >>=? fun ctxt ->
+        logged_return (Item (vo, Item (vi, rest)), ctxt)
+    | Const v, rest ->
+        Lwt.return (Gas.consume ctxt Interp_costs.push) >>=? fun ctxt ->
+        logged_return (Item (v, rest), ctxt)
+    (* options *)
+    | Cons_some, Item (v, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.wrap) >>=? fun ctxt ->
+        logged_return (Item (Some v, rest), ctxt)
+    | Cons_none _, rest ->
+        Lwt.return (Gas.consume ctxt Interp_costs.variant_no_data) >>=? fun ctxt ->
+        logged_return (Item (None, rest), ctxt)
+    | If_none (bt, _), Item (None, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
+        step_same ctxt bt rest
+    | If_none (_, bf), Item (Some v, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
+        step_same ctxt bf (Item (v, rest))
+    (* pairs *)
+    | Cons_pair, Item (a, Item (b, rest)) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.pair) >>=? fun ctxt ->
+        logged_return (Item ((a, b), rest), ctxt)
+    | Car, Item ((a, _), rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.pair_access) >>=? fun ctxt ->
+        logged_return (Item (a, rest), ctxt)
+    | Cdr, Item ((_, b), rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.pair_access) >>=? fun ctxt ->
+        logged_return (Item (b, rest), ctxt)
+    (* unions *)
+    | Left, Item (v, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.wrap) >>=? fun ctxt ->
+        logged_return (Item (L v, rest), ctxt)
+    | Right, Item (v, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.wrap) >>=? fun ctxt ->
+        logged_return (Item (R v, rest), ctxt)
+    | If_left (bt, _), Item (L v, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
+        step_same ctxt bt (Item (v, rest))
+    | If_left (_, bf), Item (R v, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
+        step_same ctxt bf (Item (v, rest))
+    (* lists *)
+    | Cons_list, Item (hd, Item (tl, rest)) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.cons) >>=? fun ctxt ->
+        logged_return (Item (hd :: tl, rest), ctxt)
+    | Nil, rest ->
+        Lwt.return (Gas.consume ctxt Interp_costs.variant_no_data) >>=? fun ctxt ->
+        logged_return (Item ([], rest), ctxt)
+    | If_cons (_, bf), Item ([], rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
+        step_same ctxt bf rest
+    | If_cons (bt, _), Item (hd :: tl, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
+        step_same ctxt bt (Item (hd, Item (tl, rest)))
+    | List_map body, Item (l, rest) ->
+        let rec loop rest ctxt l acc =
+          Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
+          match l with
+          | [] -> return (Item (List.rev acc, rest), ctxt)
+          | hd :: tl ->
+              step_same ctxt body (Item (hd, rest))
+              >>=? fun (Item (hd, rest), ctxt) ->
+              loop rest ctxt tl (hd :: acc)
+        in loop rest ctxt l [] >>=? fun (res, ctxt) ->
+        logged_return (res, ctxt)
+    | List_size, Item (list, rest) ->
+        Lwt.return
+          (List.fold_left
+             (fun acc _ ->
+                acc >>? fun (size, ctxt) ->
+                Gas.consume ctxt Interp_costs.list_size >>? fun ctxt ->
+                ok (size + 1 (* FIXME: overflow *), ctxt))
+             (ok (0, ctxt)) list) >>=? fun (len, ctxt) ->
+        logged_return (Item (Script_int.(abs (of_int len)), rest), ctxt)
+    | List_iter body, Item (l, init) ->
+        let rec loop ctxt l stack =
+          Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
+          match l with
+          | [] -> return (stack, ctxt)
+          | hd :: tl ->
+              step_same ctxt body (Item (hd, stack))
+              >>=? fun (stack, ctxt) ->
+              loop ctxt tl stack
+        in loop ctxt l init >>=? fun (res, ctxt) ->
+        logged_return (res, ctxt)
+    (* sets *)
+    | Empty_set t, rest ->
+        Lwt.return (Gas.consume ctxt Interp_costs.empty_set) >>=? fun ctxt ->
+        logged_return (Item (empty_set t, rest), ctxt)
+    | Set_iter body, Item (set, init) ->
+        Lwt.return (Gas.consume ctxt (Interp_costs.set_to_list set)) >>=? fun ctxt ->
+        let l = List.rev (set_fold (fun e acc -> e :: acc) set []) in
+        let rec loop ctxt l stack =
+          Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
+          match l with
+          | [] -> return (stack, ctxt)
+          | hd :: tl ->
+              step_same ctxt body (Item (hd, stack))
+              >>=? fun (stack, ctxt) ->
+              loop ctxt tl stack
+        in loop ctxt l init >>=? fun (res, ctxt) ->
+        logged_return (res, ctxt)
+    | Set_mem, Item (v, Item (set, rest)) ->
+        consume_gas_binop descr (set_mem, v, set) Interp_costs.set_mem rest ctxt
+    | Set_update, Item (v, Item (presence, Item (set, rest))) ->
+        consume_gas_terop descr (set_update, v, presence, set) Interp_costs.set_update rest
+    | Set_size, Item (set, rest) ->
+        consume_gas_unop descr (set_size, set) (fun _ -> Interp_costs.set_size) rest ctxt
+    (* maps *)
+    | Empty_map (t, _), rest ->
+        Lwt.return (Gas.consume ctxt Interp_costs.empty_map) >>=? fun ctxt ->
+        logged_return (Item (empty_map t, rest), ctxt)
+    | Map_map body, Item (map, rest) ->
+        Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map)) >>=? fun ctxt ->
+        let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
+        let rec loop rest ctxt l acc =
+          Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
+          match l with
+          | [] -> return (acc, ctxt)
+          | (k, _) as hd :: tl ->
+              step_same ctxt body (Item (hd, rest))
+              >>=? fun (Item (hd, rest), ctxt) ->
+              loop rest ctxt tl (map_update k (Some hd) acc)
+        in loop rest ctxt l (empty_map (map_key_ty map)) >>=? fun (res, ctxt) ->
+        logged_return (Item (res, rest), ctxt)
+    | Map_iter body, Item (map, init) ->
+        Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map)) >>=? fun ctxt ->
+        let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
+        let rec loop ctxt l stack =
+          Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
+          match l with
+          | [] -> return (stack, ctxt)
+          | hd :: tl ->
+              step_same ctxt body (Item (hd, stack))
+              >>=? fun (stack, ctxt) ->
+              loop ctxt tl stack
+        in loop ctxt l init >>=? fun (res, ctxt) ->
+        logged_return (res, ctxt)
+    | Map_mem, Item (v, Item (map, rest)) ->
+        consume_gas_binop descr (map_mem, v, map) Interp_costs.map_mem rest ctxt
+    | Map_get, Item (v, Item (map, rest)) ->
+        consume_gas_binop descr (map_get, v, map) Interp_costs.map_get rest ctxt
+    | Map_update, Item (k, Item (v, Item (map, rest))) ->
+        consume_gas_terop descr (map_update, k, v, map) Interp_costs.map_update rest
+    | Map_size, Item (map, rest) ->
+        consume_gas_unop descr (map_size, map) (fun _ -> Interp_costs.map_size) rest ctxt
+    (* Big map operations *)
+    | Big_map_mem, Item (key, Item (map, rest)) ->
+        Lwt.return (Gas.consume ctxt (Interp_costs.big_map_mem key map)) >>=? fun ctxt ->
+        Script_ir_translator.big_map_mem ctxt self key map >>=? fun (res, ctxt) ->
+        logged_return (Item (res, rest), ctxt)
+    | Big_map_get, Item (key, Item (map, rest)) ->
+        Lwt.return (Gas.consume ctxt (Interp_costs.big_map_get key map)) >>=? fun ctxt ->
+        Script_ir_translator.big_map_get ctxt self key map >>=? fun (res, ctxt) ->
+        logged_return (Item (res, rest), ctxt)
+    | Big_map_update, Item (key, Item (maybe_value, Item (map, rest))) ->
+        consume_gas_terop descr
+          (Script_ir_translator.big_map_update, key, maybe_value, map)
+          Interp_costs.big_map_update rest
+    (* timestamp operations *)
+    | Add_seconds_to_timestamp, Item (n, Item (t, rest)) ->
+        consume_gas_binop descr
+          (Script_timestamp.add_delta, t, n)
+          Interp_costs.add_timestamp rest ctxt
+    | Add_timestamp_to_seconds, Item (t, Item (n, rest)) ->
+        consume_gas_binop descr (Script_timestamp.add_delta, t, n)
+          Interp_costs.add_timestamp rest ctxt
+    | Sub_timestamp_seconds, Item (t, Item (s, rest)) ->
+        consume_gas_binop descr (Script_timestamp.sub_delta, t, s)
+          Interp_costs.sub_timestamp rest ctxt
+    | Diff_timestamps, Item (t1, Item (t2, rest)) ->
+        consume_gas_binop descr (Script_timestamp.diff, t1, t2)
+          Interp_costs.diff_timestamps rest ctxt
+    (* string operations *)
+    | Concat_string_pair, Item (x, Item (y, rest)) ->
+        Lwt.return (Gas.consume ctxt (Interp_costs.concat_string [x; y])) >>=? fun ctxt ->
+        let s = String.concat "" [x; y] in
+        logged_return (Item (s, rest), ctxt)
+    | Concat_string, Item (ss, rest) ->
+        Lwt.return (Gas.consume ctxt (Interp_costs.concat_string ss)) >>=? fun ctxt ->
+        let s = String.concat "" ss in
+        logged_return (Item (s, rest), ctxt)
+    | Slice_string, Item (offset, Item (length, Item (s, rest))) ->
+        let s_length = Z.of_int (String.length s) in
+        let offset = Script_int.to_zint offset in
+        let length = Script_int.to_zint length in
+        if Compare.Z.(offset < s_length && Z.add offset length <= s_length) then
+          Lwt.return (Gas.consume ctxt (Interp_costs.slice_string (Z.to_int length))) >>=? fun ctxt ->
+          logged_return (Item (Some (String.sub s (Z.to_int offset) (Z.to_int length)), rest), ctxt)
+        else
+          Lwt.return (Gas.consume ctxt (Interp_costs.slice_string 0)) >>=? fun ctxt ->
+          logged_return (Item (None, rest), ctxt)
+    | String_size, Item (s, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.push) >>=? fun ctxt ->
+        logged_return (Item (Script_int.(abs (of_int (String.length s))), rest), ctxt)
+    (* bytes operations *)
+    | Concat_bytes_pair, Item (x, Item (y, rest)) ->
+        Lwt.return (Gas.consume ctxt (Interp_costs.concat_bytes [x; y])) >>=? fun ctxt ->
+        let s = MBytes.concat "" [x; y] in
+        logged_return (Item (s, rest), ctxt)
+    | Concat_bytes, Item (ss, rest) ->
+        Lwt.return (Gas.consume ctxt (Interp_costs.concat_bytes ss)) >>=? fun ctxt ->
+        let s = MBytes.concat "" ss in
+        logged_return (Item (s, rest), ctxt)
+    | Slice_bytes, Item (offset, Item (length, Item (s, rest))) ->
+        let s_length = Z.of_int (MBytes.length s) in
+        let offset = Script_int.to_zint offset in
+        let length = Script_int.to_zint length in
+        if Compare.Z.(offset < s_length && Z.add offset length <= s_length) then
+          Lwt.return (Gas.consume ctxt (Interp_costs.slice_string (Z.to_int length))) >>=? fun ctxt ->
+          logged_return (Item (Some (MBytes.sub s (Z.to_int offset) (Z.to_int length)), rest), ctxt)
+        else
+          Lwt.return (Gas.consume ctxt (Interp_costs.slice_string 0)) >>=? fun ctxt ->
+          logged_return (Item (None, rest), ctxt)
+    | Bytes_size, Item (s, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.push) >>=? fun ctxt ->
+        logged_return (Item (Script_int.(abs (of_int (MBytes.length s))), rest), ctxt)
+    (* currency operations *)
+    | Add_tez, Item (x, Item (y, rest)) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.int64_op) >>=? fun ctxt ->
+        Lwt.return Tez.(x +? y) >>=? fun res ->
+        logged_return (Item (res, rest), ctxt)
+    | Sub_tez, Item (x, Item (y, rest)) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.int64_op) >>=? fun ctxt ->
+        Lwt.return Tez.(x -? y) >>=? fun res ->
+        logged_return (Item (res, rest), ctxt)
+    | Mul_teznat, Item (x, Item (y, rest)) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.int64_op) >>=? fun ctxt ->
+        Lwt.return (Gas.consume ctxt Interp_costs.z_to_int64) >>=? fun ctxt ->
+        begin
+          match Script_int.to_int64 y with
+          | None -> fail (Overflow (loc, get_log log))
+          | Some y ->
+              Lwt.return Tez.(x *? y) >>=? fun res ->
+              logged_return (Item (res, rest), ctxt)
+        end
+    | Mul_nattez, Item (y, Item (x, rest)) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.int64_op) >>=? fun ctxt ->
+        Lwt.return (Gas.consume ctxt Interp_costs.z_to_int64) >>=? fun ctxt ->
+        begin
+          match Script_int.to_int64 y with
+          | None -> fail (Overflow (loc, get_log log))
+          | Some y ->
+              Lwt.return Tez.(x *? y) >>=? fun res ->
+              logged_return (Item (res, rest), ctxt)
+        end
+    (* boolean operations *)
+    | Or, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr ((||), x, y) Interp_costs.bool_binop rest ctxt
+    | And, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr ((&&), x, y) Interp_costs.bool_binop rest ctxt
+    | Xor, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Compare.Bool.(<>), x, y) Interp_costs.bool_binop rest ctxt
+    | Not, Item (x, rest) ->
+        consume_gas_unop descr (not, x) Interp_costs.bool_unop rest ctxt
+    (* integer operations *)
+    | Is_nat, Item (x, rest) ->
+        consume_gas_unop descr (Script_int.is_nat, x) Interp_costs.abs rest ctxt
+    | Abs_int, Item (x, rest) ->
+        consume_gas_unop descr (Script_int.abs, x) Interp_costs.abs rest ctxt
+    | Int_nat, Item (x, rest) ->
+        consume_gas_unop descr (Script_int.int, x) Interp_costs.int rest ctxt
+    | Neg_int, Item (x, rest) ->
+        consume_gas_unop descr (Script_int.neg, x) Interp_costs.neg rest ctxt
+    | Neg_nat, Item (x, rest) ->
+        consume_gas_unop descr (Script_int.neg, x) Interp_costs.neg rest ctxt
+    | Add_intint, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt
+    | Add_intnat, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt
+    | Add_natint, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt
+    | Add_natnat, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Script_int.add_n, x, y) Interp_costs.add rest ctxt
+    | Sub_int, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Script_int.sub, x, y) Interp_costs.sub rest ctxt
+    | Mul_intint, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt
+    | Mul_intnat, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt
+    | Mul_natint, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt
+    | Mul_natnat, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Script_int.mul_n, x, y) Interp_costs.mul rest ctxt
+    | Ediv_teznat, Item (x, Item (y, rest)) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.int64_to_z) >>=? fun ctxt ->
+        let x = Script_int.of_int64 (Tez.to_mutez x) in
+        consume_gas_binop descr
+          ((fun x y ->
+              match Script_int.ediv x y with
+              | None -> None
+              | Some (q, r) ->
+                  match Script_int.to_int64 q,
+                        Script_int.to_int64 r with
+                  | Some q, Some r ->
+                      begin
+                        match Tez.of_mutez q, Tez.of_mutez r with
+                        | Some q, Some r -> Some (q,r)
+                        (* Cannot overflow *)
+                        | _ -> assert false
+                      end
+                  (* Cannot overflow *)
+                  | _ -> assert false),
+           x, y)
+          Interp_costs.div
+          rest
+          ctxt
+    | Ediv_tez, Item (x, Item (y, rest)) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.int64_to_z) >>=? fun ctxt ->
+        Lwt.return (Gas.consume ctxt Interp_costs.int64_to_z) >>=? fun ctxt ->
+        let x = Script_int.abs (Script_int.of_int64 (Tez.to_mutez x)) in
+        let y = Script_int.abs (Script_int.of_int64 (Tez.to_mutez y)) in
+        consume_gas_binop descr
+          ((fun x y -> match Script_int.ediv_n x y with
+              | None -> None
+              | Some (q, r) ->
+                  match Script_int.to_int64 r with
+                  | None -> assert false (* Cannot overflow *)
+                  | Some r ->
+                      match Tez.of_mutez r with
+                      | None -> assert false (* Cannot overflow *)
+                      | Some r -> Some (q, r)),
+           x, y)
+          Interp_costs.div
+          rest
+          ctxt
+    | Ediv_intint, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Script_int.ediv, x, y) Interp_costs.div rest ctxt
+    | Ediv_intnat, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Script_int.ediv, x, y) Interp_costs.div rest ctxt
+    | Ediv_natint, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Script_int.ediv, x, y) Interp_costs.div rest ctxt
+    | Ediv_natnat, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Script_int.ediv_n, x, y) Interp_costs.div rest ctxt
+    | Lsl_nat, Item (x, Item (y, rest)) ->
+        Lwt.return (Gas.consume ctxt (Interp_costs.shift_left x y)) >>=? fun ctxt ->
+        begin
+          match Script_int.shift_left_n x y with
+          | None -> fail (Overflow (loc, get_log log))
+          | Some x -> logged_return (Item (x, rest), ctxt)
+        end
+    | Lsr_nat, Item (x, Item (y, rest)) ->
+        Lwt.return (Gas.consume ctxt (Interp_costs.shift_right x y)) >>=? fun ctxt ->
+        begin
+          match Script_int.shift_right_n x y with
+          | None -> fail (Overflow (loc, get_log log))
+          | Some r -> logged_return (Item (r, rest), ctxt)
+        end
+    | Or_nat, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Script_int.logor, x, y) Interp_costs.logor rest ctxt
+    | And_nat, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Script_int.logand, x, y) Interp_costs.logand rest ctxt
+    | And_int_nat, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Script_int.logand, x, y) Interp_costs.logand rest ctxt
+    | Xor_nat, Item (x, Item (y, rest)) ->
+        consume_gas_binop descr (Script_int.logxor, x, y) Interp_costs.logxor rest ctxt
+    | Not_int, Item (x, rest) ->
+        consume_gas_unop descr (Script_int.lognot, x) Interp_costs.lognot rest ctxt
+    | Not_nat, Item (x, rest) ->
+        consume_gas_unop descr (Script_int.lognot, x) Interp_costs.lognot rest ctxt
+    (* control *)
+    | Seq (hd, tl), stack ->
+        step_same ctxt hd stack >>=? fun (trans, ctxt) ->
+        step_same ctxt tl trans
+    | If (bt, _), Item (true, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
+        step_same ctxt bt rest
+    | If (_, bf), Item (false, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->
+        step_same ctxt bf rest
+    | Loop body, Item (true, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
+        step_same ctxt body rest >>=? fun (trans, ctxt) ->
+        step_same ctxt descr trans
+    | Loop _, Item (false, rest) ->
+        logged_return (rest, ctxt)
+    | Loop_left body, Item (L v, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
+        step_same ctxt body (Item (v, rest)) >>=? fun (trans, ctxt) ->
+        step_same ctxt descr trans
+    | Loop_left _, Item (R v, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->
+        logged_return (Item (v, rest), ctxt)
+    | Dip b, Item (ign, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.stack_op) >>=? fun ctxt ->
+        step_same ctxt b rest >>=? fun (res, ctxt) ->
+        logged_return (Item (ign, res), ctxt)
+    | Exec, Item (arg, Item (lam, rest)) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.exec) >>=? fun ctxt ->
+        interp ?log ctxt ~source ~payer ~self amount lam arg >>=? fun (res, ctxt) ->
+        logged_return (Item (res, rest), ctxt)
+    | Lambda lam, rest ->
+        Lwt.return (Gas.consume ctxt Interp_costs.push) >>=? fun ctxt ->
+        logged_return (Item (lam, rest), ctxt)
+    | Failwith tv, Item (v, _) ->
+        trace Cannot_serialize_failure
+          (unparse_data ctxt Optimized tv v) >>=? fun (v, _ctxt) ->
+        let v = Micheline.strip_locations v in
+        fail (Reject (loc, v, get_log log))
+    | Nop, stack ->
+        logged_return (stack, ctxt)
+    (* comparison *)
+    | Compare (Bool_key _), Item (a, Item (b, rest)) ->
+        consume_gaz_comparison descr Compare.Bool.compare Interp_costs.compare_bool a b rest
+    | Compare (String_key _), Item (a, Item (b, rest)) ->
+        consume_gaz_comparison descr Compare.String.compare Interp_costs.compare_string a b rest
+    | Compare (Bytes_key _), Item (a, Item (b, rest)) ->
+        consume_gaz_comparison descr MBytes.compare Interp_costs.compare_bytes a b rest
+    | Compare (Mutez_key _), Item (a, Item (b, rest)) ->
+        consume_gaz_comparison descr Tez.compare Interp_costs.compare_tez a b rest
+    | Compare (Int_key _), Item (a, Item (b, rest)) ->
+        consume_gaz_comparison descr Script_int.compare Interp_costs.compare_int a b rest
+    | Compare (Nat_key _), Item (a, Item (b, rest)) ->
+        consume_gaz_comparison descr Script_int.compare Interp_costs.compare_nat a b rest
+    | Compare (Key_hash_key _), Item (a, Item (b, rest)) ->
+        consume_gaz_comparison descr Signature.Public_key_hash.compare
+          Interp_costs.compare_key_hash a b rest
+    | Compare (Timestamp_key _), Item (a, Item (b, rest)) ->
+        consume_gaz_comparison descr Script_timestamp.compare Interp_costs.compare_timestamp a b rest
+    | Compare (Address_key _), Item (a, Item (b, rest)) ->
+        consume_gaz_comparison descr Contract.compare Interp_costs.compare_address a b rest
+    (* comparators *)
+    | Eq, Item (cmpres, rest) ->
+        let cmpres = Script_int.compare cmpres Script_int.zero in
+        let cmpres = Compare.Int.(cmpres = 0) in
+        Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->
+        logged_return (Item (cmpres, rest), ctxt)
+    | Neq, Item (cmpres, rest) ->
+        let cmpres = Script_int.compare cmpres Script_int.zero in
+        let cmpres = Compare.Int.(cmpres <> 0) in
+        Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->
+        logged_return (Item (cmpres, rest), ctxt)
+    | Lt, Item (cmpres, rest) ->
+        let cmpres = Script_int.compare cmpres Script_int.zero in
+        let cmpres = Compare.Int.(cmpres < 0) in
+        Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->
+        logged_return (Item (cmpres, rest), ctxt)
+    | Le, Item (cmpres, rest) ->
+        let cmpres = Script_int.compare cmpres Script_int.zero in
+        let cmpres = Compare.Int.(cmpres <= 0) in
+        Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->
+        logged_return (Item (cmpres, rest), ctxt)
+    | Gt, Item (cmpres, rest) ->
+        let cmpres = Script_int.compare cmpres Script_int.zero in
+        let cmpres = Compare.Int.(cmpres > 0) in
+        Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->
+        logged_return (Item (cmpres, rest), ctxt)
+    | Ge, Item (cmpres, rest) ->
+        let cmpres = Script_int.compare cmpres Script_int.zero in
+        let cmpres = Compare.Int.(cmpres >= 0) in
+        Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->
+        logged_return (Item (cmpres, rest), ctxt)
+    (* packing *)
+    | Pack t, Item (value, rest) ->
+        Script_ir_translator.pack_data ctxt t value >>=? fun (bytes, ctxt) ->
+        logged_return (Item (bytes, rest), ctxt)
+    | Unpack t, Item (bytes, rest) ->
+        Lwt.return (Gas.check_enough ctxt (Script.serialized_cost bytes)) >>=? fun () ->
+        if Compare.Int.(MBytes.length bytes >= 1) &&
+           Compare.Int.(MBytes.get_uint8 bytes 0 = 0x05) then
+          let bytes = MBytes.sub bytes 1 (MBytes.length bytes - 1) in
+          match Data_encoding.Binary.of_bytes Script.expr_encoding bytes with
+          | None ->
+              Lwt.return (Gas.consume ctxt (Interp_costs.unpack_failed bytes)) >>=? fun ctxt ->
+              logged_return (Item (None, rest), ctxt)
+          | Some expr ->
+              Lwt.return (Gas.consume ctxt (Script.deserialized_cost expr)) >>=? fun ctxt ->
+              parse_data ctxt t (Micheline.root expr) >>= function
+              | Ok (value, ctxt) ->
+                  logged_return (Item (Some value, rest), ctxt)
+              | Error _ignored ->
+                  Lwt.return (Gas.consume ctxt (Interp_costs.unpack_failed bytes)) >>=? fun ctxt ->
+                  logged_return (Item (None, rest), ctxt)
+        else
+          logged_return (Item (None, rest), ctxt)
+    (* protocol *)
+    | Address, Item ((_, contract), rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.address) >>=? fun ctxt ->
+        logged_return (Item (contract, rest), ctxt)
+    | Contract t, Item (contract, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.contract) >>=? fun ctxt ->
+        Script_ir_translator.parse_contract_for_script ctxt loc t contract >>=? fun (ctxt, maybe_contract) ->
+        logged_return (Item (maybe_contract, rest), ctxt)
+    | Transfer_tokens,
+      Item (p, Item (amount, Item ((tp, destination), rest))) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.transfer) >>=? fun ctxt ->
+        unparse_data ctxt Optimized tp p >>=? fun (p, ctxt) ->
+        let operation =
+          Transaction
+            { amount ; destination ;
+              parameters = Some (Script.lazy_expr (Micheline.strip_locations p)) } in
+        Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->
+        logged_return (Item (Internal_operation { source = self ; operation ; nonce }, rest), ctxt)
+    | Create_account,
+      Item (manager, Item (delegate, Item (delegatable, Item (credit, rest)))) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.create_account) >>=? fun ctxt ->
+        Contract.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) ->
+        let operation =
+          Origination
+            { credit ; manager ; delegate ; preorigination = Some contract ;
+              delegatable ; script = None ; spendable = true } in
+        Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->
+        logged_return (Item (Internal_operation { source = self ; operation ; nonce },
+                             Item (contract, rest)), ctxt)
+    | Implicit_account, Item (key, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.implicit_account) >>=? fun ctxt ->
+        let contract = Contract.implicit_contract key in
+        logged_return (Item ((Unit_t None, contract), rest), ctxt)
+    | Create_contract (storage_type, param_type, Lam (_, code)),
+      Item (manager, Item
+              (delegate, Item
+                 (spendable, Item
+                    (delegatable, Item
+                       (credit, Item
+                          (init, rest)))))) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.create_contract) >>=? fun ctxt ->
+        unparse_ty ctxt param_type >>=? fun (unparsed_param_type, ctxt) ->
+        unparse_ty ctxt storage_type >>=? fun (unparsed_storage_type, ctxt) ->
+        let code =
+          Micheline.strip_locations
+            (Seq (0, [ Prim (0, K_parameter, [ unparsed_param_type ], []) ;
+                       Prim (0, K_storage, [ unparsed_storage_type ], []) ;
+                       Prim (0, K_code, [ Micheline.root code ], []) ])) in
+        unparse_data ctxt Optimized storage_type init >>=? fun (storage, ctxt) ->
+        let storage = Micheline.strip_locations storage in
+        Contract.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) ->
+        let operation =
+          Origination
+            { credit ; manager ; delegate ; preorigination = Some contract ;
+              delegatable ; spendable ;
+              script = Some { code = Script.lazy_expr code ;
+                              storage = Script.lazy_expr storage } } in
+        Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->
+        logged_return
+          (Item (Internal_operation { source = self ; operation ; nonce },
+                 Item (contract, rest)), ctxt)
+    | Set_delegate,
+      Item (delegate, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.create_account) >>=? fun ctxt ->
+        let operation = Delegation delegate in
+        Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->
+        logged_return (Item (Internal_operation { source = self ; operation ; nonce }, rest), ctxt)
+    | Balance, rest ->
+        Lwt.return (Gas.consume ctxt Interp_costs.balance) >>=? fun ctxt ->
+        Contract.get_balance ctxt self >>=? fun balance ->
+        logged_return (Item (balance, rest), ctxt)
+    | Now, rest ->
+        Lwt.return (Gas.consume ctxt Interp_costs.now) >>=? fun ctxt ->
+        let now = Script_timestamp.now ctxt in
+        logged_return (Item (now, rest), ctxt)
+    | Check_signature, Item (key, Item (signature, Item (message, rest))) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.check_signature) >>=? fun ctxt ->
+        let res = Signature.check key signature message in
+        logged_return (Item (res, rest), ctxt)
+    | Hash_key, Item (key, rest) ->
+        Lwt.return (Gas.consume ctxt Interp_costs.hash_key) >>=? fun ctxt ->
+        logged_return (Item (Signature.Public_key.hash key, rest), ctxt)
+    | Blake2b, Item (bytes, rest) ->
+        Lwt.return (Gas.consume ctxt (Interp_costs.hash bytes 32)) >>=? fun ctxt ->
+        let hash = Raw_hashes.blake2b bytes in
+        logged_return (Item (hash, rest), ctxt)
+    | Sha256, Item (bytes, rest) ->
+        Lwt.return (Gas.consume ctxt (Interp_costs.hash bytes 32)) >>=? fun ctxt ->
+        let hash = Raw_hashes.sha256 bytes in
+        logged_return (Item (hash, rest), ctxt)
+    | Sha512, Item (bytes, rest) ->
+        Lwt.return (Gas.consume ctxt (Interp_costs.hash bytes 64)) >>=? fun ctxt ->
+        let hash = Raw_hashes.sha512 bytes in
+        logged_return (Item (hash, rest), ctxt)
+    | Steps_to_quota, rest ->
+        Lwt.return (Gas.consume ctxt Interp_costs.steps_to_quota) >>=? fun ctxt ->
+        let steps = match Gas.level ctxt with
+          | Limited { remaining } -> remaining
+          | Unaccounted -> Z.of_string "99999999" in
+        logged_return (Item (Script_int.(abs (of_zint steps)), rest), ctxt)
+    | Source, rest ->
+        Lwt.return (Gas.consume ctxt Interp_costs.source) >>=? fun ctxt ->
+        logged_return (Item (payer, rest), ctxt)
+    | Sender, rest ->
+        Lwt.return (Gas.consume ctxt Interp_costs.source) >>=? fun ctxt ->
+        logged_return (Item (source, rest), ctxt)
+    | Self t, rest ->
+        Lwt.return (Gas.consume ctxt Interp_costs.self) >>=? fun ctxt ->
+        logged_return (Item ((t,self), rest), ctxt)
+    | Amount, rest ->
+        Lwt.return (Gas.consume ctxt Interp_costs.amount) >>=? fun ctxt ->
+        logged_return (Item (amount, rest), ctxt)
+
+and interp
+  : type p r.
+    (?log: execution_trace ref ->
+     context ->
+     source: Contract.t -> payer:Contract.t -> self: Contract.t -> Tez.t ->
+     (p, r) lambda -> p ->
+     (r * context) tzresult Lwt.t)
+  = fun ?log ctxt ~source ~payer ~self amount (Lam (code, _)) arg ->
+    let stack = (Item (arg, Empty)) in
+    begin match log with
+      | None -> return_unit
+      | Some log ->
+          trace Cannot_serialize_log
+            (unparse_stack ctxt (stack, code.bef)) >>=? fun stack ->
+          log := (code.loc, Gas.level ctxt, stack) :: !log ;
+          return_unit
+    end >>=? fun () ->
+    step ctxt ~source ~payer ~self amount code stack >>=? fun (Item (ret, Empty), ctxt) ->
+    return (ret, ctxt)
+
+
+
+end
+
+open X_error_monad
+
 let stack_ty_eq (type a b)
     ?(tezos_context = dummy_environment.tezos_context)
     (a:a stack_ty) (b:b stack_ty) =
-  alpha_wrap (Script_ir_translator.stack_ty_eq tezos_context 0 a b) >>? fun (Eq, _) ->
+  alpha_wrap (X.stack_ty_eq tezos_context 0 a b) >>? fun (Eq, _) ->
   ok Eq
 
 let ty_eq (type a b)
@@ -37,7 +962,7 @@ let parse_michelson (type aft)
   match j with
   | Typed descr -> (
       Lwt.return (
-        alpha_wrap (Script_ir_translator.stack_ty_eq tezos_context 0 descr.aft aft) >>? fun (Eq, _) ->
+        alpha_wrap (X.stack_ty_eq tezos_context 0 descr.aft aft) >>? fun (Eq, _) ->
         let descr : (_, aft) Script_typed_ir.descr = {descr with aft} in
         Ok descr
       )
@@ -59,7 +984,7 @@ let parse_michelson_fail (type aft)
   match j with
   | Typed descr -> (
       Lwt.return (
-        alpha_wrap (Script_ir_translator.stack_ty_eq tezos_context 0 descr.aft aft) >>? fun (Eq, _) ->
+        alpha_wrap (X.stack_ty_eq tezos_context 0 descr.aft aft) >>? fun (Eq, _) ->
         let descr : (_, aft) Script_typed_ir.descr = {descr with aft} in
         Ok descr
       )
@@ -87,7 +1012,7 @@ let parse_michelson_ty
 let unparse_michelson_data
     ?(tezos_context = dummy_environment.tezos_context)
     ?mapper ty value : Michelson.t tzresult Lwt.t =
-  Script_ir_translator.unparse_data tezos_context ?mapper
+  X.unparse_data_generic tezos_context ?mapper
     Readable ty value >>=?? fun (michelson, _) ->
   return michelson
 
@@ -129,5 +1054,5 @@ let interpret ?(options = default_options) ?visitor (instr:('a, 'b) descr) (bef:
     payer ;
     amount ;
   } = options in
-  Script_interpreter.step tezos_context ~source ~self ~payer ?visitor amount instr bef >>=??
+  X.step tezos_context ~source ~self ~payer ?visitor amount instr bef >>=??
   fun (stack, _) -> return stack

vendors/ligo-utils/simple-utils/dune

@@ -1,11 +1,12 @@
 (library
   (name simple_utils)
   (public_name simple-utils)
-  (preprocess
-    (pps simple-utils.ppx_let_generalized))
   (libraries
     yojson
     unix
     str
   )
+  (preprocess
+    (pps ppx_let)
+  )
 )

vendors/ligo-utils/simple-utils/simple-utils.opam

@@ -10,36 +10,8 @@ bug-reports: "https://gitlab.com/ligolang/ligo-utils/issues"
 depends: [
   "dune"
   "base"
-  "base"
+  "yojson"
-  "bigstring"
+  "ppx_let"
-  "calendar"
-  "cohttp-lwt-unix"
-  "cstruct"
-  "ezjsonm"
-  "hex"
-  "hidapi"
-  "ipaddr"
-  "irmin"
-  "js_of_ocaml"
-  "lwt"
-  "lwt_log"
-  "mtime"
-  "ocplib-endian"
-  "ocp-ocamlres"
-  "re"
-  "rresult"
-  "stdio"
-  "uri"
-  "uutf"
-  "zarith"
-  "ocplib-json-typed"
-  "ocplib-json-typed-bson"
-  "tezos-crypto"
-  "tezos-stdlib-unix"
-  "tezos-data-encoding"
-  "tezos-protocol-environment"
-  "tezos-protocol-alpha"
-  "michelson-parser"
   # from ppx_let:
   "ocaml" {>= "4.04.2" & < "4.08.0"}
   "dune"   {build & >= "1.5.1"}

vendors/ligo-utils/tezos-protocol-alpha-parameters/.ocamlformat

@@ -0,0 +1,11 @@
+wrap-fun-args=false
+let-binding-spacing=compact
+field-space=loose
+break-separators=after-and-docked
+sequence-style=separator
+doc-comments=before
+margin=80
+module-item-spacing=sparse
+parens-tuple=always
+parens-tuple-patterns=always
+break-string-literals=newlines-and-wrap

vendors/ligo-utils/tezos-protocol-alpha-parameters/default_parameters.ml

@@ -0,0 +1,146 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+open Protocol
+
+let constants_mainnet =
+  Constants_repr.
+    {
+      preserved_cycles = 5;
+      blocks_per_cycle = 4096l;
+      blocks_per_commitment = 32l;
+      blocks_per_roll_snapshot = 256l;
+      blocks_per_voting_period = 32768l;
+      time_between_blocks = List.map Period_repr.of_seconds_exn [60L; 75L];
+      endorsers_per_block = 32;
+      hard_gas_limit_per_operation = Z.of_int 800_000;
+      hard_gas_limit_per_block = Z.of_int 8_000_000;
+      proof_of_work_threshold = Int64.(sub (shift_left 1L 46) 1L);
+      tokens_per_roll = Tez_repr.(mul_exn one 8_000);
+      michelson_maximum_type_size = 1000;
+      seed_nonce_revelation_tip =
+        (match Tez_repr.(one /? 8L) with Ok c -> c | Error _ -> assert false);
+      origination_size = 257;
+      block_security_deposit = Tez_repr.(mul_exn one 512);
+      endorsement_security_deposit = Tez_repr.(mul_exn one 64);
+      block_reward = Tez_repr.(mul_exn one 16);
+      endorsement_reward = Tez_repr.(mul_exn one 2);
+      hard_storage_limit_per_operation = Z.of_int 60_000;
+      cost_per_byte = Tez_repr.of_mutez_exn 1_000L;
+      test_chain_duration = Int64.mul 32768L 60L;
+    }
+
+let constants_sandbox =
+  Constants_repr.
+    {
+      constants_mainnet with
+      preserved_cycles = 2;
+      blocks_per_cycle = 8l;
+      blocks_per_commitment = 4l;
+      blocks_per_roll_snapshot = 4l;
+      blocks_per_voting_period = 64l;
+      time_between_blocks = List.map Period_repr.of_seconds_exn [1L; 0L];
+      proof_of_work_threshold = Int64.of_int (-1);
+    }
+
+let constants_test =
+  Constants_repr.
+    {
+      constants_mainnet with
+      blocks_per_cycle = 128l;
+      blocks_per_commitment = 4l;
+      blocks_per_roll_snapshot = 32l;
+      blocks_per_voting_period = 256l;
+      time_between_blocks = List.map Period_repr.of_seconds_exn [1L; 0L];
+      proof_of_work_threshold = Int64.of_int (-1);
+    }
+
+let bootstrap_accounts_strings =
+  [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav";
+    "edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9";
+    "edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV";
+    "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU";
+    "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n" ]
+
+let boostrap_balance = Tez_repr.of_mutez_exn 4_000_000_000_000L
+
+let bootstrap_accounts =
+  List.map
+    (fun s ->
+      let public_key = Signature.Public_key.of_b58check_exn s in
+      let public_key_hash = Signature.Public_key.hash public_key in
+      Parameters_repr.
+        {
+          public_key_hash;
+          public_key = Some public_key;
+          amount = boostrap_balance;
+        })
+    bootstrap_accounts_strings
+
+(* TODO this could be generated from OCaml together with the faucet
+   for now these are harcoded values in the tests *)
+let commitments =
+  let json_result =
+    Data_encoding.Json.from_string
+      {json|
+  [
+    [ "btz1bRL4X5BWo2Fj4EsBdUwexXqgTf75uf1qa", "23932454669343" ],
+    [ "btz1SxjV1syBgftgKy721czKi3arVkVwYUFSv", "72954577464032" ],
+    [ "btz1LtoNCjiW23txBTenALaf5H6NKF1L3c1gw", "217487035428348" ],
+    [ "btz1SUd3mMhEBcWudrn8u361MVAec4WYCcFoy", "4092742372031" ],
+    [ "btz1MvBXf4orko1tsGmzkjLbpYSgnwUjEe81r", "17590039016550" ],
+    [ "btz1LoDZ3zsjgG3k3cqTpUMc9bsXbchu9qMXT", "26322312350555" ],
+    [ "btz1RMfq456hFV5AeDiZcQuZhoMv2dMpb9hpP", "244951387881443" ],
+    [ "btz1Y9roTh4A7PsMBkp8AgdVFrqUDNaBE59y1", "80065050465525" ],
+    [ "btz1Q1N2ePwhVw5ED3aaRVek6EBzYs1GDkSVD", "3569618927693" ],
+    [ "btz1VFFVsVMYHd5WfaDTAt92BeQYGK8Ri4eLy", "9034781424478" ]
+  ]|json}
+  in
+  match json_result with
+  | Error err ->
+      raise (Failure err)
+  | Ok json ->
+      Data_encoding.Json.destruct
+        (Data_encoding.list Commitment_repr.encoding)
+        json
+
+let make_bootstrap_account (pkh, pk, amount) =
+  Parameters_repr.{public_key_hash = pkh; public_key = Some pk; amount}
+
+let parameters_of_constants ?(bootstrap_accounts = bootstrap_accounts)
+    ?(bootstrap_contracts = []) ?(with_commitments = false) constants =
+  let commitments = if with_commitments then commitments else [] in
+  Parameters_repr.
+    {
+      bootstrap_accounts;
+      bootstrap_contracts;
+      commitments;
+      constants;
+      security_deposit_ramp_up_cycles = None;
+      no_reward_cycles = None;
+    }
+
+let json_of_parameters parameters =
+  Data_encoding.Json.construct Parameters_repr.encoding parameters

vendors/ligo-utils/tezos-protocol-alpha-parameters/default_parameters.mli

@@ -23,28 +23,23 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-open Alpha_context
+open Protocol
 
-val may_start_new_voting_cycle:
+val constants_mainnet : Constants_repr.parametric
-  context -> context tzresult Lwt.t
 
-type error +=
+val constants_sandbox : Constants_repr.parametric
-  | Unexpected_proposal
-  | Unauthorized_proposal
-  | Too_many_proposals
-  | Empty_proposal
 
-val record_proposals:
+val constants_test : Constants_repr.parametric
-  context ->
-  public_key_hash -> Protocol_hash.t list ->
-  context tzresult Lwt.t
 
-type error +=
+val make_bootstrap_account :
-  | Invalid_proposal
+  Signature.public_key_hash * Signature.public_key * Tez_repr.t ->
-  | Unexpected_ballot
+  Parameters_repr.bootstrap_account
-  | Unauthorized_ballot
 
-val record_ballot:
+val parameters_of_constants :
-  context ->
+  ?bootstrap_accounts:Parameters_repr.bootstrap_account list ->
-  public_key_hash -> Protocol_hash.t -> Vote.ballot ->
+  ?bootstrap_contracts:Parameters_repr.bootstrap_contract list ->
-  context tzresult Lwt.t
+  ?with_commitments:bool ->
+  Constants_repr.parametric ->
+  Parameters_repr.t
+
+val json_of_parameters : Parameters_repr.t -> Data_encoding.json

vendors/ligo-utils/tezos-protocol-alpha-parameters/dune

@@ -0,0 +1,44 @@
+(library
+ (name tezos_protocol_alpha_parameters)
+ (public_name tezos-protocol-alpha-parameters)
+ (modules :standard \ gen)
+ (libraries tezos-base
+            tezos-protocol-environment
+            tezos-protocol-alpha)
+ (flags (:standard -open Tezos_base__TzPervasives
+                   -open Tezos_protocol_alpha
+                   -linkall))
+)
+
+(executable
+ (name gen)
+ (libraries tezos-base
+            tezos-protocol-alpha-parameters)
+ (modules gen)
+ (flags (:standard -open Tezos_base__TzPervasives
+                   -open Tezos_protocol_alpha_parameters
+                   -linkall)))
+
+(rule
+ (targets sandbox-parameters.json)
+ (deps gen.exe)
+ (action (run %{deps} --sandbox)))
+
+(rule
+ (targets test-parameters.json)
+ (deps gen.exe)
+ (action (run %{deps} --test)))
+
+(rule
+ (targets mainnet-parameters.json)
+ (deps gen.exe)
+ (action (run %{deps} --mainnet)))
+
+(install
+ (section lib)
+ (files sandbox-parameters.json test-parameters.json mainnet-parameters.json))
+
+(alias
+ (name runtest_lint)
+ (deps (glob_files *.ml{,i}))
+ (action (run %{lib:tezos-tooling:lint.sh} %{deps})))

vendors/ligo-utils/tezos-protocol-alpha-parameters/dune-project

@@ -0,0 +1,2 @@
+(lang dune 1.10)
+(name tezos-protocol-alpha-parameters)

vendors/ligo-utils/tezos-protocol-alpha-parameters/gen.ml

@@ -23,29 +23,39 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-module Set : Set.S with type elt = string
+(* Prints the json encoding of the parametric constants of protocol alpha.
-module Map : Map.S with type key = string
+   $ dune utop src/proto_alpha/lib_protocol/test/helpers/ constants.ml
+*)
 
-(** Splits a string on slashes, grouping multiple slashes, and
+let () =
-    ignoring slashes at the beginning and end of string. *)
+  let print_usage_and_fail s =
-val split_path: string -> string list
+    Printf.eprintf "Usage: %s [ --sandbox | --test | --mainnet ]" Sys.argv.(0) ;
-
+    raise (Invalid_argument s)
-(** Splits a string on a delimier character, grouping multiple
+  in
-    delimiters, and ignoring delimiters at the beginning and end of
+  let dump parameters file =
-    string, if [limit] is passed, stops after [limit] split(s). *)
+    let str =
-val split: char -> ?dup:bool -> ?limit: int -> string -> string list
+      Data_encoding.Json.to_string
-
+        (Default_parameters.json_of_parameters parameters)
-(** [true] if input has prefix **)
+    in
-val has_prefix: prefix:string -> string -> bool
+    let fd = open_out file in
-
+    output_string fd str ; close_out fd
-(** Some (input with [prefix] removed), if string has [prefix], else [None] **)
+  in
-val remove_prefix: prefix:string -> string -> string option
+  if Array.length Sys.argv < 2 then print_usage_and_fail ""
-
+  else
-(** Length of common prefix of input strings *)
+    match Sys.argv.(1) with
-val common_prefix: string -> string -> int
+    | "--sandbox" ->
-
+        dump
-(** Test whether a string contains a given character *)
+          Default_parameters.(parameters_of_constants constants_sandbox)
-val mem_char: string -> char -> bool
+          "sandbox-parameters.json"
-
+    | "--test" ->
-(** Functional iteration over the characters of a string from first to last *)
+        dump
-val fold_left : ('a -> char -> 'a) -> 'a -> string -> 'a
+          Default_parameters.(
+            parameters_of_constants ~with_commitments:true constants_sandbox)
+          "test-parameters.json"
+    | "--mainnet" ->
+        dump
+          Default_parameters.(
+            parameters_of_constants ~with_commitments:true constants_mainnet)
+          "mainnet-parameters.json"
+    | s ->
+        print_usage_and_fail s

vendors/ligo-utils/tezos-protocol-alpha-parameters/tezos-protocol-alpha-parameters.opam

@@ -1,4 +1,5 @@
 opam-version: "2.0"
+version: "dev"
 maintainer: "contact@tezos.com"
 authors: [ "Tezos devteam" ]
 homepage: "https://www.tezos.com/"
@@ -6,15 +7,15 @@ bug-reports: "https://gitlab.com/tezos/tezos/issues"
 dev-repo: "git+https://gitlab.com/tezos/tezos.git"
 license: "MIT"
 depends: [
+  "tezos-tooling" { with-test }
   "ocamlfind" { build }
-  "dune" { build & >= "1.0.1" }
+  "dune" { build & >= "1.7" }
   "tezos-base"
   "tezos-protocol-environment"
   "tezos-protocol-alpha"
-  "tezos-shell-services"
-  "tezos-client-base"
-  "tezos-signer-backends"
 ]
 build: [
-  [ "dune" "build" "-p" name "-j" jobs ]
+  ["dune" "build" "-p" name "-j" jobs]
+  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
 ]
+synopsis: "Tezos/Protocol: parameters"

vendors/ligo-utils/tezos-protocol-alpha/.ocamlformat

@@ -0,0 +1,11 @@
+wrap-fun-args=false
+let-binding-spacing=compact
+field-space=loose
+break-separators=after-and-docked
+sequence-style=separator
+doc-comments=before
+margin=80
+module-item-spacing=sparse
+parens-tuple=always
+parens-tuple-patterns=always
+break-string-literals=newlines-and-wrap

vendors/ligo-utils/tezos-protocol-alpha/.ocamlformat-ignore

@@ -0,0 +1,120 @@
+alpha_context.ml
+alpha_context.mli
+alpha_services.ml
+alpha_services.mli
+amendment.ml
+amendment.mli
+apply.ml
+apply_results.ml
+apply_results.mli
+baking.ml
+baking.mli
+blinded_public_key_hash.ml
+blinded_public_key_hash.mli
+block_header_repr.ml
+block_header_repr.mli
+bootstrap_storage.ml
+bootstrap_storage.mli
+commitment_repr.ml
+commitment_repr.mli
+commitment_storage.ml
+commitment_storage.mli
+constants_repr.ml
+constants_services.ml
+constants_services.mli
+constants_storage.ml
+contract_hash.ml
+contract_repr.ml
+contract_repr.mli
+contract_services.ml
+contract_services.mli
+contract_storage.ml
+contract_storage.mli
+cycle_repr.ml
+cycle_repr.mli
+delegate_services.ml
+delegate_services.mli
+delegate_storage.ml
+delegate_storage.mli
+fees_storage.ml
+fees_storage.mli
+fitness_repr.ml
+fitness_storage.ml
+gas_limit_repr.ml
+gas_limit_repr.mli
+helpers_services.ml
+helpers_services.mli
+init_storage.ml
+level_repr.ml
+level_repr.mli
+level_storage.ml
+level_storage.mli
+main.ml
+main.mli
+manager_repr.ml
+manager_repr.mli
+michelson_v1_gas.ml
+michelson_v1_gas.mli
+michelson_v1_primitives.ml
+michelson_v1_primitives.mli
+misc.ml
+misc.mli
+nonce_hash.ml
+nonce_storage.ml
+nonce_storage.mli
+operation_repr.ml
+operation_repr.mli
+parameters_repr.ml
+parameters_repr.mli
+period_repr.ml
+period_repr.mli
+qty_repr.ml
+raw_context.ml
+raw_context.mli
+raw_level_repr.ml
+raw_level_repr.mli
+roll_repr.ml
+roll_repr.mli
+roll_storage.ml
+roll_storage.mli
+script_expr_hash.ml
+script_interpreter.ml
+script_interpreter.mli
+script_int_repr.ml
+script_int_repr.mli
+script_ir_annot.ml
+script_ir_annot.mli
+script_ir_translator.ml
+script_ir_translator.mli
+script_repr.ml
+script_repr.mli
+script_tc_errors.ml
+script_tc_errors_registration.ml
+script_timestamp_repr.ml
+script_timestamp_repr.mli
+script_typed_ir.ml
+seed_repr.ml
+seed_repr.mli
+seed_storage.ml
+seed_storage.mli
+services_registration.ml
+state_hash.ml
+storage_description.ml
+storage_description.mli
+storage_functors.ml
+storage_functors.mli
+storage.ml
+storage.mli
+storage_sigs.ml
+tez_repr.ml
+tez_repr.mli
+time_repr.ml
+time_repr.mli
+vote_repr.ml
+vote_repr.mli
+vote_storage.ml
+vote_storage.mli
+voting_period_repr.ml
+voting_period_repr.mli
+voting_services.ml
+voting_services.mli

vendors/ligo-utils/tezos-protocol-alpha/alpha_context.ml

@@ -65,13 +65,6 @@ module Script_timestamp = struct
     Raw_context.current_timestamp ctxt
     |> Timestamp.to_seconds
     |> of_int64
-
-  let set_now ctxt timestamp =
-    timestamp
-    |> to_zint
-    |> Z.to_int64
-    |> Time.of_seconds
-    |> (Raw_context.set_current_timestamp ctxt)
 end
 module Script = struct
   include Michelson_v1_primitives

vendors/ligo-utils/tezos-protocol-alpha/alpha_context.mli

@@ -178,14 +178,13 @@ module Script_timestamp : sig
   val add_delta: t -> z num -> t
   val sub_delta: t -> z num -> t
   val now: context -> t
-  val set_now: context -> t -> context
   val to_zint: t -> Z.t
   val of_zint: Z.t -> t
 end
 
 module Script : sig
 
-  type prim = Micheline.Michelson_primitives.prim =
+  type prim = Michelson_v1_primitives.prim =
     | K_parameter
     | K_storage
     | K_code
@@ -249,7 +248,6 @@ module Script : sig
     | I_NEQ
     | I_NIL
     | I_NONE
-    | I_NOP
     | I_NOT
     | I_NOW
     | I_OR
@@ -300,7 +298,6 @@ module Script : sig
     | T_operation
     | T_address
 
-
   type location = Micheline.canonical_location
 
   type annot = Micheline.annot
@@ -382,6 +379,7 @@ module Constants : sig
     endorsement_reward: Tez.t ;
     cost_per_byte: Tez.t ;
     hard_storage_limit_per_operation: Z.t ;
+    test_chain_duration: int64;
   }
   val parametric_encoding: parametric Data_encoding.t
   val parametric: context -> parametric
@@ -405,6 +403,7 @@ module Constants : sig
   val origination_size: context -> int
   val block_security_deposit: context -> Tez.t
   val endorsement_security_deposit: context -> Tez.t
+  val test_chain_duration: context -> int64
 
   (** All constants: fixed and parametric *)
   type t = {
@@ -1119,7 +1118,8 @@ end
 
 val prepare_first_block:
   Context.t ->
-  typecheck:(context -> Script.t -> context tzresult Lwt.t) ->
+  typecheck:(context -> Script.t ->
+             ((Script.t * Contract.big_map_diff option) * context) tzresult Lwt.t) ->
   level:Int32.t ->
   timestamp:Time.t ->
   fitness:Fitness.t ->

vendors/ligo-utils/tezos-protocol-alpha/amendment.ml

@@ -25,8 +25,8 @@
 
 open Alpha_context
 
-let () = ()
+(** Returns the proposal submitted by the most delegates.
-
+    Returns None in case of a tie or if there are no proposals. *)
 let select_winning_proposal proposals =
   let merge proposal vote winners =
     match winners with
@@ -43,28 +43,43 @@ let select_winning_proposal proposals =
   | Some ([proposal], _) -> Some proposal
   | Some _ -> None (* in case of a tie, lets do nothing. *)
 
+(** A proposal is approved if it has supermajority and the participation reaches
+    the current quorum.
+    Supermajority means the yays are more 8/10 of casted votes.
+    The participation is the ratio of all received votes, including passes, with
+    respect to the number of possible votes. The quorum starts at 80% and at
+    each vote is updated using the last expected quorum and the current
+    participation with the following weights:
+    newQ = oldQ * 8/10 + participation * 2/10 *)
 let check_approval_and_update_quorum ctxt =
   Vote.get_ballots ctxt >>=? fun ballots ->
   Vote.listing_size ctxt >>=? fun maximum_vote ->
   Vote.get_current_quorum ctxt >>=? fun expected_quorum ->
-  (* FIXME check overflow ??? *)
+  (* Note overflows: considering a maximum of 8e8 tokens, with roll size as
-  let casted_vote = Int32.add ballots.yay ballots.nay in
+     small as 1e3, there is a maximum of 8e5 rolls and thus votes.
-  let actual_vote = Int32.add casted_vote ballots.pass in
+     In 'participation' an Int64 is used because in the worst case 'all_votes is
-  let actual_quorum =
+     8e5 and after the multiplication is 8e9, making it potentially overflow a
-    Int32.div (Int32.mul actual_vote 100_00l) maximum_vote in
+     signed Int32 which is 2e9. *)
-  let supermajority = Int32.div (Int32.mul 8l casted_vote) 10l in
+  let casted_votes = Int32.add ballots.yay ballots.nay in
+  let all_votes = Int32.add casted_votes ballots.pass in
+  let supermajority = Int32.div (Int32.mul 8l casted_votes) 10l in
+  let participation = (* in centile of percentage *)
+    Int64.to_int32
+      (Int64.div
+         (Int64.mul (Int64.of_int32 all_votes) 100_00L)
+         (Int64.of_int32 maximum_vote)) in
+  let outcome = Compare.Int32.(participation >= expected_quorum &&
+                               ballots.yay >= supermajority) in
   let updated_quorum =
-    Int32.div
+    Int32.div (Int32.add (Int32.mul 8l expected_quorum) (Int32.mul 2l participation)) 10l in
-      (Int32.add (Int32.mul 8l expected_quorum)
-         (Int32.mul 2l actual_quorum))
-      10l in
   Vote.set_current_quorum ctxt updated_quorum >>=? fun ctxt ->
-  return
+  return (ctxt, outcome)
-    (ctxt,
-     Compare.Int32.(actual_quorum >= expected_quorum
-                    && ballots.yay >= supermajority))
 
-let start_new_voting_cycle ctxt =
+(** Implements the state machine of the amendment procedure.
+    Note that [freeze_listings], that computes the vote weight of each delegate,
+    is run at the beginning of each voting period.
+*)
+let start_new_voting_period ctxt =
   Vote.get_current_period_kind ctxt >>=? function
   | Proposal -> begin
       Vote.get_proposals ctxt >>=? fun proposals ->
@@ -86,7 +101,7 @@ let start_new_voting_cycle ctxt =
       Vote.clear_listings ctxt >>=? fun ctxt ->
       if approved then
         let expiration = (* in two days maximum... *)
-          Time.add (Timestamp.current ctxt) (Int64.mul 48L 3600L) in
+          Time.add (Timestamp.current ctxt) (Constants.test_chain_duration ctxt) in
         Vote.get_current_proposal ctxt >>=? fun proposal ->
         fork_test_chain ctxt proposal expiration >>= fun ctxt ->
         Vote.set_current_period_kind ctxt Testing >>=? fun ctxt ->
@@ -212,7 +227,7 @@ let rec longer_than l n =
 let record_proposals ctxt delegate proposals =
   begin match proposals with
     | [] -> fail Empty_proposal
-    | _ :: _ -> return ()
+    | _ :: _ -> return_unit
   end >>=? fun () ->
   Vote.get_current_period_kind ctxt >>=? function
   | Proposal ->
@@ -252,9 +267,9 @@ let last_of_a_voting_period ctxt l =
   Compare.Int32.(Int32.succ l.Level.voting_period_position =
                  Constants.blocks_per_voting_period ctxt )
 
-let may_start_new_voting_cycle ctxt =
+let may_start_new_voting_period ctxt =
   let level = Level.current ctxt in
   if last_of_a_voting_period ctxt level then
-    start_new_voting_cycle ctxt
+    start_new_voting_period ctxt
   else
     return ctxt

vendors/ligo-utils/tezos-protocol-alpha/amendment.mli

@@ -0,0 +1,79 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(**
+   Only delegates with at least one roll take part in the amendment procedure.
+   It works as follows:
+   - Proposal period: delegates can submit protocol amendment proposals using
+     the proposal operation. At the end of a proposal period, the proposal with
+     most supporters is selected and we move to a testing_vote period.
+     If there are no proposals, or a tie between proposals, a new proposal
+     period starts.
+   - Testing_vote period: delegates can cast votes to test or not the winning
+     proposal using the ballot operation.
+     At the end of a testing_vote period if participation reaches the quorum
+     and the proposal has a supermajority in favor, we proceed to a testing
+     period. Otherwise we go back to a proposal period.
+     In any case, if there is enough participation the quorum is updated.
+   - Testing period: a test chain is forked for the lengh of the period.
+     At the end of a testing period we move to a promotion_vote period.
+   - Promotion_vote period: delegates can cast votes to promote or not the
+     tested proposal using the ballot operation.
+     At the end of a promotion_vote period if participation reaches the quorum
+     and the tested proposal has a supermajority in favor, it is activated as
+     the new protocol. Otherwise we go back to a proposal period.
+     In any case, if there is enough participation the quorum is updated.
+*)
+
+open Alpha_context
+
+(** If at the end of a voting period, moves to the next one following
+    the state machine of the amendment procedure. *)
+val may_start_new_voting_period:
+  context -> context tzresult Lwt.t
+
+type error +=
+  | Unexpected_proposal
+  | Unauthorized_proposal
+  | Too_many_proposals
+  | Empty_proposal
+
+(** Records a list of proposals for a delegate.
+    @raise Unexpected_proposal if [ctxt] is not in a proposal period.
+    @raise Unauthorized_proposal if [delegate] is not in the listing. *)
+val record_proposals:
+  context ->
+  public_key_hash -> Protocol_hash.t list ->
+  context tzresult Lwt.t
+
+type error +=
+  | Invalid_proposal
+  | Unexpected_ballot
+  | Unauthorized_ballot
+
+val record_ballot:
+  context ->
+  public_key_hash -> Protocol_hash.t -> Vote.ballot ->
+  context tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/apply.ml

@@ -33,6 +33,8 @@ type error += Duplicate_endorsement of Signature.Public_key_hash.t (* `Branch *)
 type error += Invalid_endorsement_level
 type error += Invalid_commitment of { expected: bool }
 type error += Internal_operation_replay of packed_internal_operation
+type error += Cannot_originate_spendable_smart_contract (* `Permanent *)
+type error += Cannot_originate_non_spendable_account (* `Permanent *)
 
 type error += Invalid_double_endorsement_evidence (* `Permanent *)
 type error += Inconsistent_double_endorsement_evidence
@@ -133,6 +135,30 @@ let () =
     Operation.internal_operation_encoding
     (function Internal_operation_replay op -> Some op | _ -> None)
     (fun op -> Internal_operation_replay op) ;
+  register_error_kind
+    `Permanent
+    ~id:"cannot_originate_non_spendable_account"
+    ~title:"Cannot originate non spendable account"
+    ~description:"An origination was attempted \
+                  that would create a non spendable, non scripted contract"
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "It is not possible anymore to originate \
+                            a non scripted contract that is not spendable.")
+    Data_encoding.empty
+    (function Cannot_originate_non_spendable_account -> Some () | _ -> None)
+    (fun () -> Cannot_originate_non_spendable_account) ;
+  register_error_kind
+    `Permanent
+    ~id:"cannot_originate_spendable_smart_contract"
+    ~title:"Cannot originate spendable smart contract"
+    ~description:"An origination was attempted \
+                  that would create a spendable scripted contract"
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "It is not possible anymore to originate \
+                            a scripted contract that is spendable.")
+    Data_encoding.empty
+    (function Cannot_originate_spendable_smart_contract -> Some () | _ -> None)
+    (fun () -> Cannot_originate_spendable_smart_contract) ;
   register_error_kind
     `Permanent
     ~id:"block.invalid_double_endorsement_evidence"
@@ -460,15 +486,22 @@ let apply_manager_operation_content :
     | Origination { manager ; delegate ; script ; preorigination ;
                     spendable ; delegatable ; credit } ->
         begin match script with
-          | None -> return (None, ctxt)
+          | None ->
+              if spendable then
+                return (None, ctxt)
+              else
+                fail Cannot_originate_non_spendable_account
           | Some script ->
-              Script.force_decode ctxt script.storage >>=? fun (unparsed_storage, ctxt) -> (* see [note] *)
+              if spendable then
-              Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_storage)) >>=? fun ctxt ->
+                fail Cannot_originate_spendable_smart_contract
-              Script.force_decode ctxt script.code >>=? fun (unparsed_code, ctxt) -> (* see [note] *)
+              else
-              Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_code)) >>=? fun ctxt ->
+                Script.force_decode ctxt script.storage >>=? fun (unparsed_storage, ctxt) -> (* see [note] *)
-              Script_ir_translator.parse_script ctxt script >>=? fun (_, ctxt) ->
+                Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_storage)) >>=? fun ctxt ->
-              Script_ir_translator.erase_big_map_initialization ctxt Optimized script >>=? fun (script, big_map_diff, ctxt) ->
+                Script.force_decode ctxt script.code >>=? fun (unparsed_code, ctxt) -> (* see [note] *)
-              return (Some (script, big_map_diff), ctxt)
+                Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_code)) >>=? fun ctxt ->
+                Script_ir_translator.parse_script ctxt script >>=? fun (ex_script, ctxt) ->
+                Script_ir_translator.big_map_initialization ctxt Optimized ex_script >>=? fun (big_map_diff, ctxt) ->
+                return (Some (script, big_map_diff), ctxt)
         end >>=? fun (script, ctxt) ->
         spend ctxt source credit >>=? fun ctxt ->
         begin match preorigination with
@@ -1020,7 +1053,7 @@ let finalize_application ctxt protocol_data delegate =
   (* end of cycle *)
   may_snapshot_roll ctxt >>=? fun ctxt ->
   may_start_new_cycle ctxt >>=? fun (ctxt, balance_updates, deactivated) ->
-  Amendment.may_start_new_voting_cycle ctxt >>=? fun ctxt ->
+  Amendment.may_start_new_voting_period ctxt >>=? fun ctxt ->
   let cycle = (Level.current ctxt).cycle in
   let balance_updates =
     Delegate.(cleanup_balance_updates