From bb37e04340a001524215b38e029d9d1ac5f96829 Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Mon, 30 Apr 2018 18:15:10 +0200
Subject: [PATCH] Michelson: add estimated memory cost of an expression

---
 .../lib_protocol/src/script_repr.ml           | 31 +++++++++++++++++++
 .../lib_protocol/src/script_repr.mli          |  2 ++
 2 files changed, 33 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/src/script_repr.ml b/src/proto_alpha/lib_protocol/src/script_repr.ml
index b719e044d..9ca409fdc 100644
--- a/src/proto_alpha/lib_protocol/src/script_repr.ml
+++ b/src/proto_alpha/lib_protocol/src/script_repr.ml
@@ -63,3 +63,34 @@ let encoding =
     (obj2
        (req "code" lazy_expr_encoding)
        (req "storage" lazy_expr_encoding))
+
+let rec node_size node =
+  let open Micheline in
+  match node with
+  | Int (_, n) -> (1, 1 + (Z.numbits n + 63) / 64)
+  | String (_, s) -> (1, 1 + (String.length s + 7) / 8)
+  | Prim (_, _, args, annot) ->
+      List.fold_left
+        (fun (blocks, words) node ->
+           let (nblocks, nwords) = node_size node in
+           (blocks + 1 + nblocks, words + 2 + nwords))
+        (match annot with
+         | None -> (1, 2)
+         | Some annot -> (1, 4 + (String.length annot + 7) / 8))
+        args
+  | Seq (_, args, annot) ->
+      List.fold_left
+        (fun (blocks, words) node ->
+           let (nblocks, nwords) = node_size node in
+           (blocks + 1 + nblocks, words + 2 + nwords))
+        (match annot with
+         | None -> (1, 2)
+         | Some annot -> (1, 3 + (String.length annot + 7) / 8))
+        args
+
+let expr_size expr =
+  node_size (Micheline.root expr)
+
+let expr_cost expr =
+  let blocks, words = expr_size expr in
+  Gas_limit_repr.(((Compare.Int.max 0 (blocks - 1)) *@ alloc_cost 0) +@ alloc_cost words)
diff --git a/src/proto_alpha/lib_protocol/src/script_repr.mli b/src/proto_alpha/lib_protocol/src/script_repr.mli
index 5a23f1e79..96a3660b0 100644
--- a/src/proto_alpha/lib_protocol/src/script_repr.mli
+++ b/src/proto_alpha/lib_protocol/src/script_repr.mli
@@ -32,3 +32,5 @@ val lazy_expr : expr -> lazy_expr
 type t = { code : lazy_expr ; storage : lazy_expr }
 
 val encoding : t Data_encoding.encoding
+
+val expr_cost : expr -> Gas_limit_repr.cost