From 8f6f4398dd6186428d7bbb52ba005691848d2d4d Mon Sep 17 00:00:00 2001
From: Tom Jack <tom@tomjack.co>
Date: Wed, 4 Mar 2020 12:03:58 -0600
Subject: [PATCH 1/6] Add working example of Crypto.check

---
 src/test/contracts/check_signature.mligo | 22 ++++++++++++++++++++++
 src/test/integration_tests.ml            |  1 +
 2 files changed, 23 insertions(+)

diff --git a/src/test/contracts/check_signature.mligo b/src/test/contracts/check_signature.mligo
index ecd56eb4b..5af7022c0 100644
--- a/src/test/contracts/check_signature.mligo
+++ b/src/test/contracts/check_signature.mligo
@@ -1,2 +1,24 @@
 let check_signature (pk, signed, msg: key * signature * bytes) : bool =
   Crypto.check pk signed msg
+
+(*
+$ tezos-client gen keys testsign
+
+$ tezos-client show address testsign -S
+Hash: tz1RffmtWjy435AXZuWwLWG6UaJ66ERmgviA
+Public Key: edpktz4xg6csJnJ5vcmMb2H37sWXyBDcoAp3XrBvjRaTSQ1zmZTeRQ
+Secret Key: unencrypted:edsk34mH9qhMdVWtbammJfYkUoQfwW6Rw5K6rbGW1ajppy3LPNbiJA
+
+$ tezos-client hash data '"hello"' of type string
+Raw packed data: 0x05010000000568656c6c6f
+...
+
+$ tezos-client sign bytes 0x05010000000568656c6c6f for testsign
+Signature: edsigtnzKd51CDomKVMFBoU8SzFZgNqRkYUaQH4DLUg8Lsimz98DFB82uiHAkdvx29DDqHxPf1noQ8noWpKMZoxTCsfprrbs4Xo
+*)
+
+let example : bool =
+  Crypto.check
+    ("edpktz4xg6csJnJ5vcmMb2H37sWXyBDcoAp3XrBvjRaTSQ1zmZTeRQ" : key)
+    ("edsigtnzKd51CDomKVMFBoU8SzFZgNqRkYUaQH4DLUg8Lsimz98DFB82uiHAkdvx29DDqHxPf1noQ8noWpKMZoxTCsfprrbs4Xo" : signature)
+    0x05010000000568656c6c6f
diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml
index b8270e005..7f9369190 100644
--- a/src/test/integration_tests.ml
+++ b/src/test/integration_tests.ml
@@ -2090,6 +2090,7 @@ let check_signature_mligo () : unit result =
                             e_bytes_string "hello world"] in
   let make_expected = e_bool true in
   let%bind () = expect_eq program "check_signature" make_input make_expected in
+  let%bind () = expect_eq_evaluate program "example" (e_bool true) in
   ok ()
 
 let check_signature_religo () : unit result =

From e436a0a08a73797d9d09aa80e08bca782fd28dec Mon Sep 17 00:00:00 2001
From: Pierre-Emmanuel Wulfman <pierre.emmanuel.wulfman@gmail.com>
Date: Tue, 18 Feb 2020 16:55:20 +0100
Subject: [PATCH 2/6] removes loops

---
 src/passes/3-self_ast_simplified/helpers.ml | 14 ----------
 src/passes/4-typer-new/typer.ml             | 14 ----------
 src/passes/4-typer-new/typer.ml.old         | 23 ---------------
 src/passes/4-typer-old/typer.ml             | 31 ---------------------
 src/passes/5-self_ast_typed/helpers.ml      | 16 +----------
 src/passes/6-interpreter/interpreter.ml     |  2 +-
 src/passes/6-transpiler/transpiler.ml       |  5 ----
 src/stages/ast_simplified/PP.ml             |  2 --
 src/stages/ast_simplified/combinators.ml    |  1 -
 src/stages/ast_simplified/combinators.mli   |  1 -
 src/stages/ast_simplified/misc.ml           |  2 +-
 src/stages/ast_simplified/types.ml          |  3 --
 src/stages/ast_typed/PP.ml                  |  2 --
 src/stages/ast_typed/misc.ml                |  3 +-
 src/stages/ast_typed/misc_smart.ml          |  3 --
 src/stages/ast_typed/types.ml               | 23 +++++----------
 src/stages/typesystem/misc.ml               |  4 ---
 17 files changed, 11 insertions(+), 138 deletions(-)

diff --git a/src/passes/3-self_ast_simplified/helpers.ml b/src/passes/3-self_ast_simplified/helpers.ml
index 40520a0f4..40de7371b 100644
--- a/src/passes/3-self_ast_simplified/helpers.ml
+++ b/src/passes/3-self_ast_simplified/helpers.ml
@@ -19,10 +19,6 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
   | E_look_up ab ->
       let%bind res = bind_fold_pair self init' ab in
       ok res
-  | E_loop {condition;body} ->
-      let ab = (condition,body) in 
-      let%bind res = bind_fold_pair self init' ab in
-      ok res
   | E_application {expr1;expr2} -> (
       let ab = (expr1,expr2) in
       let%bind res = bind_fold_pair self init' ab in
@@ -116,11 +112,6 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
       let%bind ab' = bind_map_pair self ab in
       return @@ E_look_up ab'
     )
-  | E_loop {condition;body} -> (
-      let ab = (condition,body) in
-      let%bind (a,b) = bind_map_pair self ab in
-      return @@ E_loop {condition = a; body = b}
-    )
   | E_ascription ascr -> (
       let%bind e' = self ascr.anno_expr in
       return @@ E_ascription {ascr with anno_expr=e'}
@@ -237,11 +228,6 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
       let%bind (res, ab') = bind_fold_map_pair self init' ab in
       ok (res, return @@ E_look_up ab')
     )
-  | E_loop {condition;body} -> (
-      let ab = (condition,body) in
-      let%bind (res,(a,b)) = bind_fold_map_pair self init' ab in
-      ok (res, return @@ E_loop {condition = a; body = b})
-    )
   | E_ascription ascr -> (
       let%bind (res,e') = self init' ascr.anno_expr in
       ok (res, return @@ E_ascription {ascr with anno_expr=e'})
diff --git a/src/passes/4-typer-new/typer.ml b/src/passes/4-typer-new/typer.ml
index 7c0b045be..0ca9f8ef8 100644
--- a/src/passes/4-typer-new/typer.ml
+++ b/src/passes/4-typer-new/typer.ml
@@ -159,14 +159,6 @@ module Errors = struct
     ] in
     error ~data title message ()
 
-  let not_supported_yet_untranspile (message : string) (ae : O.expression) () =
-    let title = (thunk "not supported yet") in
-    let message () = message in
-    let data = [
-      ("expression" , fun () -> Format.asprintf "%a"  O.PP.expression ae)
-    ] in
-    error ~data title message ()
-
 end
 
 open Errors
@@ -734,11 +726,6 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_expression -
    *       tv_opt in
    *     return (O.E_matching (ex', m')) tv
    *   ) *)
-  | E_loop {condition; body} ->
-    let%bind (expr' , state') = type_expression e state condition in
-    let%bind (body' , state'') = type_expression e state' body in
-    let wrapped = Wrap.loop expr'.type_expression body'.type_expression in
-    return_wrapped (O.E_loop {condition=expr';body=body'}) state'' wrapped
   | E_let_in {let_binder ; rhs ; let_result; inline} ->
     let%bind rhs_tv_opt = bind_map_option (evaluate_type e) (snd let_binder) in
     (* TODO: the binder annotation should just be an annotation node *)
@@ -1100,7 +1087,6 @@ let rec untype_expression (e:O.expression) : (I.expression) result =
   (* | E_failwith ae ->
    *   let%bind ae' = untype_expression ae in
    *   return (e_failwith ae') *)
-  | E_loop _ -> fail @@ not_supported_yet_untranspile "not possible to untranspile statements yet" e
   | E_let_in {let_binder; rhs;let_result; inline} ->
     let%bind tv = untype_type_value rhs.type_expression in
     let%bind rhs = untype_expression rhs in
diff --git a/src/passes/4-typer-new/typer.ml.old b/src/passes/4-typer-new/typer.ml.old
index a302301e0..db842716a 100644
--- a/src/passes/4-typer-new/typer.ml.old
+++ b/src/passes/4-typer-new/typer.ml.old
@@ -675,28 +675,6 @@ and type_expression : environment -> ?tv_opt:O.type_expression -> I.expression -
                       a'.location) @@
       Ast_typed.assert_type_expression_eq (t_unit () , a'_type_annot) in
     return (O.E_sequence (a' , b')) (get_type_annotation b')
-  | E_loop (expr , body) ->
-    let%bind expr' = type_expression e expr in
-    let%bind body' = type_expression e body in
-    let t_expr' = get_type_annotation expr' in
-    let%bind () =
-      trace_strong (type_error
-                      ~msg:"while condition isn't of type bool"
-                      ~expected:(O.t_bool ())
-                      ~actual:t_expr'
-                      ~expression:expr
-                      expr'.location) @@
-      Ast_typed.assert_type_expression_eq (t_bool () , t_expr') in
-    let t_body' = get_type_annotation body' in
-    let%bind () =
-      trace_strong (type_error
-                     ~msg:"while body isn't of unit type"
-                     ~expected:(O.t_unit ())
-                     ~actual:t_body'
-                     ~expression:body
-                     body'.location) @@
-      Ast_typed.assert_type_expression_eq (t_unit () , t_body') in
-    return (O.E_loop (expr' , body')) (t_unit ())
   | E_assign (name , path , expr) ->
     let%bind typed_name =
       let%bind ele = Environment.get_trace name e in
@@ -834,7 +812,6 @@ let rec untype_expression (e:O.annotated_expression) : (I.expression) result =
       let%bind ae' = untype_expression ae in
       return (e_failwith ae')
   | E_sequence _
-  | E_loop _
   | E_assign _ -> fail @@ not_supported_yet_untranspile "not possible to untranspile statements yet" e.expression
   | E_let_in {binder;rhs;result} ->
       let%bind tv = untype_type_expression rhs.type_annotation in
diff --git a/src/passes/4-typer-old/typer.ml b/src/passes/4-typer-old/typer.ml
index 2e13a76ab..eec5d3a49 100644
--- a/src/passes/4-typer-old/typer.ml
+++ b/src/passes/4-typer-old/typer.ml
@@ -205,14 +205,6 @@ module Errors = struct
     ] in
     error ~data title message ()
 
-  let not_supported_yet_untranspile (message : string) (ae : O.expression) () =
-    let title = (thunk "not suported yet") in
-    let message () = message in
-    let data = [
-      ("expression" , fun () -> Format.asprintf "%a"  O.PP.expression ae)
-    ] in
-    error ~data title message ()
-
 end
 open Errors
 
@@ -774,28 +766,6 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
         tv_opt in
       return (O.E_matching {matchee=ex'; cases=m'}) tv
     )
-  | E_loop {condition; body} ->
-    let%bind expr' = type_expression' e condition in
-    let%bind body' = type_expression' e body in
-    let t_expr' = get_type_expression expr' in
-    let%bind () =
-      trace_strong (type_error
-                      ~msg:"while condition isn't of type bool"
-                      ~expected:(O.t_bool ())
-                      ~actual:t_expr'
-                      ~expression:condition
-                      expr'.location) @@
-      Ast_typed.assert_type_expression_eq (t_bool () , t_expr') in
-    let t_body' = get_type_expression body' in
-    let%bind () =
-      trace_strong (type_error
-                     ~msg:"while body isn't of unit type"
-                     ~expected:(O.t_unit ())
-                     ~actual:t_body'
-                     ~expression:body
-                     body'.location) @@
-      Ast_typed.assert_type_expression_eq (t_unit () , t_body') in
-    return (O.E_loop {condition=expr'; body=body'}) (t_unit ())
   | E_let_in {let_binder ; rhs ; let_result; inline} ->
     let%bind rhs_tv_opt = bind_map_option (evaluate_type e) (snd let_binder) in
     let%bind rhs = type_expression' ?tv_opt:rhs_tv_opt e rhs in
@@ -909,7 +879,6 @@ let rec untype_expression (e:O.expression) : (I.expression) result =
       let%bind ae' = untype_expression matchee in
       let%bind m' = untype_matching untype_expression cases in
       return (e_matching ae' m')
-  | E_loop _-> fail @@ not_supported_yet_untranspile "not possible to untranspile statements yet" e
   | E_let_in {let_binder;rhs;let_result; inline} ->
       let%bind tv = untype_type_expression rhs.type_expression in
       let%bind rhs = untype_expression rhs in
diff --git a/src/passes/5-self_ast_typed/helpers.ml b/src/passes/5-self_ast_typed/helpers.ml
index f7d38302a..153093b06 100644
--- a/src/passes/5-self_ast_typed/helpers.ml
+++ b/src/passes/5-self_ast_typed/helpers.ml
@@ -19,10 +19,6 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
   | E_look_up ab ->
       let%bind res = bind_fold_pair self init' ab in
       ok res
-  | E_loop {condition;body} ->
-      let ab = (condition,body) in 
-      let%bind res = bind_fold_pair self init' ab in
-      ok res
   | E_application {expr1;expr2} -> (
       let ab = (expr1,expr2) in
       let%bind res = bind_fold_pair self init' ab in
@@ -116,11 +112,6 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
       let%bind ab' = bind_map_pair self ab in
       return @@ E_look_up ab'
     )
-  | E_loop {condition;body} -> (
-      let ab = (condition,body) in
-      let%bind (a,b) = bind_map_pair self ab in
-      return @@ E_loop {condition = a; body = b}
-    )
   | E_matching {matchee=e;cases} -> (
       let%bind e' = self e in
       let%bind cases' = map_cases f cases in
@@ -232,11 +223,6 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
       let%bind (res, ab') = bind_fold_map_pair self init' ab in
       ok (res, return @@ E_look_up ab')
     )
-  | E_loop {condition;body} -> (
-      let ab = (condition,body) in
-      let%bind (res,(a,b)) = bind_fold_map_pair self init' ab in
-      ok (res, return @@ E_loop {condition = a; body = b})
-    )
   | E_matching {matchee=e;cases} -> (
       let%bind (res, e') = self init' e in
       let%bind (res,cases') = fold_map_cases f res cases in
@@ -391,4 +377,4 @@ let fetch_contract_type : string -> program -> contract_type result = fun main_f
       )
     | _ -> fail @@ Errors.bad_contract_io main_fname e
   )
-  | [] -> simple_fail ("Entrypoint '"^main_fname^"' does not exist")
\ No newline at end of file
+  | [] -> simple_fail ("Entrypoint '"^main_fname^"' does not exist")
diff --git a/src/passes/6-interpreter/interpreter.ml b/src/passes/6-interpreter/interpreter.ml
index 5b44d5b11..ed9f6d6d3 100644
--- a/src/passes/6-interpreter/interpreter.ml
+++ b/src/passes/6-interpreter/interpreter.ml
@@ -371,7 +371,7 @@ and eval : Ast_typed.expression -> env -> value result
       | _ -> simple_fail "not yet supported case"
         (* ((ctor,name),body) *)
     )
-    | E_look_up _ | E_loop _ ->
+    | E_look_up _ ->
       let serr = Format.asprintf "Unsupported construct :\n %a\n" Ast_typed.PP.expression term in
       simple_fail serr
 
diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml
index 1a4569f75..8911b76fa 100644
--- a/src/passes/6-transpiler/transpiler.ml
+++ b/src/passes/6-transpiler/transpiler.ml
@@ -431,11 +431,6 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
       let%bind (ds', i') = bind_map_pair f dsi in
       return @@ E_constant {cons_name=C_MAP_FIND_OPT;arguments=[i' ; ds']}
     )
-  | E_loop {condition; body} -> (
-      let%bind expr' = transpile_annotated_expression condition in
-      let%bind body' = transpile_annotated_expression body in
-      return @@ E_while (expr' , body')
-    )
   | E_matching {matchee=expr; cases=m} -> (
       let%bind expr' = transpile_annotated_expression expr in
       match m with
diff --git a/src/stages/ast_simplified/PP.ml b/src/stages/ast_simplified/PP.ml
index 80311a012..f5c2283b0 100644
--- a/src/stages/ast_simplified/PP.ml
+++ b/src/stages/ast_simplified/PP.ml
@@ -48,8 +48,6 @@ let rec expression ppf (e : expression) =
   | E_matching {matchee; cases; _} ->
       fprintf ppf "match %a with %a" expression matchee (matching expression)
         cases
-  | E_loop l ->
-      fprintf ppf "while %a do %a" expression l.condition expression l.body
   | E_let_in { let_binder ; mut; rhs ; let_result; inline } ->    
     fprintf ppf "let %a%a = %a%a in %a" option_mut mut option_type_name let_binder expression rhs option_inline inline expression let_result
   | E_skip ->
diff --git a/src/stages/ast_simplified/combinators.ml b/src/stages/ast_simplified/combinators.ml
index 8de9f5b77..21c9ee183 100644
--- a/src/stages/ast_simplified/combinators.ml
+++ b/src/stages/ast_simplified/combinators.ml
@@ -122,7 +122,6 @@ let e_accessor ?loc a b = location_wrap ?loc @@ E_record_accessor {expr = a; lab
 let e_accessor_list ?loc a b  = List.fold_left (fun a b -> e_accessor ?loc a b) a b
 let e_variable ?loc v = location_wrap ?loc @@ E_variable v
 let e_skip ?loc () = location_wrap ?loc @@ E_skip
-let e_loop ?loc condition body = location_wrap ?loc @@ E_loop {condition; body}
 let e_let_in ?loc (binder, ascr) mut inline rhs let_result = 
   location_wrap ?loc @@ E_let_in { let_binder = (binder, ascr) ; mut; rhs ; let_result; inline }
 let e_annotation ?loc anno_expr ty = location_wrap ?loc @@ E_ascription {anno_expr; type_annotation = ty}
diff --git a/src/stages/ast_simplified/combinators.mli b/src/stages/ast_simplified/combinators.mli
index 9b18599be..37e32bb5f 100644
--- a/src/stages/ast_simplified/combinators.mli
+++ b/src/stages/ast_simplified/combinators.mli
@@ -83,7 +83,6 @@ val e_accessor : ?loc:Location.t -> expression -> string -> expression
 val e_accessor_list : ?loc:Location.t -> expression -> string list -> expression
 val e_variable : ?loc:Location.t -> expression_variable -> expression
 val e_skip : ?loc:Location.t -> unit -> expression
-val e_loop : ?loc:Location.t -> expression -> expression -> expression
 val e_sequence : ?loc:Location.t -> expression -> expression -> expression
 val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression
 val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> bool -> expression -> expression -> expression
diff --git a/src/stages/ast_simplified/misc.ml b/src/stages/ast_simplified/misc.ml
index 31cccf719..bb309048e 100644
--- a/src/stages/ast_simplified/misc.ml
+++ b/src/stages/ast_simplified/misc.ml
@@ -184,7 +184,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
   | (E_application _, _) | (E_let_in _, _)
   | (E_record_accessor _, _)
   | (E_look_up _, _) | (E_matching _, _)
-  | (E_loop _, _) | (E_skip, _) -> simple_fail "comparing not a value"
+  | (E_skip, _) -> simple_fail "comparing not a value"
 
 let is_value_eq (a , b) = to_bool @@ assert_value_eq (a , b)
 
diff --git a/src/stages/ast_simplified/types.ml b/src/stages/ast_simplified/types.ml
index 9c1b9eaa1..de0de0934 100644
--- a/src/stages/ast_simplified/types.ml
+++ b/src/stages/ast_simplified/types.ml
@@ -51,7 +51,6 @@ and expression_content =
   | E_set of expression list
   | E_look_up of (expression * expression)
   (* Advanced *)
-  | E_loop of loop
   | E_ascription of ascription
 
 and constant =
@@ -79,8 +78,6 @@ and accessor = {expr: expression; label: label}
 
 and update = {record: expression; path: label ; update: expression}
 
-and loop = {condition: expression; body: expression}
-
 and matching_expr = (expr,unit) matching_content
 and matching =
   { matchee: expression
diff --git a/src/stages/ast_typed/PP.ml b/src/stages/ast_typed/PP.ml
index 09d6a1734..a0f15514b 100644
--- a/src/stages/ast_typed/PP.ml
+++ b/src/stages/ast_typed/PP.ml
@@ -44,8 +44,6 @@ let rec expression ppf (e : expression) =
         expression result
   | E_matching {matchee; cases;} ->
       fprintf ppf "match %a with %a" expression matchee (matching expression) cases
-  | E_loop l ->
-      fprintf ppf "while %a do %a" expression l.condition expression l.body
   | E_let_in {let_binder; rhs; let_result; inline} ->
       fprintf ppf "let %a = %a%a in %a" expression_variable let_binder expression
         rhs option_inline inline expression let_result
diff --git a/src/stages/ast_typed/misc.ml b/src/stages/ast_typed/misc.ml
index ee404596a..9395c511a 100644
--- a/src/stages/ast_typed/misc.ml
+++ b/src/stages/ast_typed/misc.ml
@@ -216,7 +216,6 @@ module Free_variables = struct
     | (E_map m | E_big_map m) -> unions @@ List.map self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m
     | E_look_up (a , b) -> unions @@ List.map self [ a ; b ]
     | E_matching {matchee; cases;_} -> union (self matchee) (matching_expression b cases)
-    | E_loop {condition ; body} -> unions @@ List.map self [ condition ; body ]
     | E_let_in { let_binder; rhs; let_result; _} ->
       let b' = union (singleton let_binder) b in
       union
@@ -533,7 +532,7 @@ let rec assert_value_eq (a, b: (expression*expression)) : unit result =
   | (E_lambda _, _) | (E_let_in _, _)
   | (E_record_accessor _, _) | (E_record_update _,_)
   | (E_look_up _, _) | (E_matching _, _)
-  | (E_loop _, _)-> fail @@ error_uncomparable_values "can't compare sequences nor loops" a b
+  -> fail @@ error_uncomparable_values "can't compare sequences nor loops" a b
 
 let merge_annotation (a:type_expression option) (b:type_expression option) err : type_expression result =
   match a, b with
diff --git a/src/stages/ast_typed/misc_smart.ml b/src/stages/ast_typed/misc_smart.ml
index bf376f383..ebe25ace2 100644
--- a/src/stages/ast_typed/misc_smart.ml
+++ b/src/stages/ast_typed/misc_smart.ml
@@ -89,9 +89,6 @@ module Captured_variables = struct
       let%bind a' = self matchee in
       let%bind cs' = matching_expression b cases in
       ok @@ union a' cs'
-    | E_loop {condition; body} ->
-      let%bind lst' = bind_map_list self [ condition ; body ] in
-      ok @@ unions lst'
     | E_let_in li ->
       let b' = union (singleton li.let_binder) b in
       expression b' li.let_result
diff --git a/src/stages/ast_typed/types.ml b/src/stages/ast_typed/types.ml
index 8b9195d60..c20eef077 100644
--- a/src/stages/ast_typed/types.ml
+++ b/src/stages/ast_typed/types.ml
@@ -55,14 +55,10 @@ and expression_content =
   | E_list of expression list
   | E_set of expression list
   | E_look_up of (expression * expression)
-  (* Advanced *)
-  | E_loop of loop
-  (* | E_ascription of ascription *)
 
-and constant = {
-    cons_name: constant' ;
-    arguments: expression list ;
-  }
+and constant =
+  { cons_name: constant'
+  ; arguments: expression list }
 
 and application = {expr1: expression; expr2: expression}
 
@@ -96,15 +92,10 @@ and update = {
     update: expression ;
   }
 
-and loop = {
-    condition: expression ;
-    body: expression ;
-  }
-
-and matching_expr = (expression, type_expression) matching_content
-and matching = {
-    matchee: expression ;
-    cases: matching_expr ;
+and matching_expr = (expression,type_expression) matching_content
+and matching =
+  { matchee: expression
+  ; cases: matching_expr
   }
 
 and ascription = {
diff --git a/src/stages/typesystem/misc.ml b/src/stages/typesystem/misc.ml
index 011fef1b7..f6618dd43 100644
--- a/src/stages/typesystem/misc.ml
+++ b/src/stages/typesystem/misc.ml
@@ -212,10 +212,6 @@ module Substitution = struct
         let%bind matchee = s_expression ~substs matchee in
         let%bind cases = s_matching_expr ~substs cases in
         ok @@ T.E_matching {matchee;cases}
-      | T.E_loop  {condition;body} ->
-        let%bind condition = s_expression ~substs condition in
-        let%bind body = s_expression ~substs body in
-        ok @@ T.E_loop {condition;body}
 
     and s_expression : T.expression w = fun ~(substs:substs) { expression_content; type_expression; environment; location } ->
       let%bind expression_content = s_expression_content ~substs expression_content in

From bc7a4daa64fec6e6b7d0503145124a703a75ab03 Mon Sep 17 00:00:00 2001
From: Lesenechal Remi <lesenechal.remi@gmail.com>
Date: Fri, 21 Feb 2020 17:05:52 +0100
Subject: [PATCH 3/6] add 'mapi' equivalent for label and constructor maps

---
 src/stages/common/helpers.ml  | 2 ++
 src/stages/common/helpers.mli | 9 +++++++++
 2 files changed, 11 insertions(+)

diff --git a/src/stages/common/helpers.ml b/src/stages/common/helpers.ml
index d498a1712..5dba263b8 100644
--- a/src/stages/common/helpers.ml
+++ b/src/stages/common/helpers.ml
@@ -28,6 +28,8 @@ let bind_fold_lmap f init (lmap:_ LMap.t) =
 
 let bind_map_lmap f map = bind_lmap (LMap.map f map)
 let bind_map_cmap f map = bind_cmap (CMap.map f map)
+let bind_map_lmapi f map = bind_lmap (LMap.mapi f map)
+let bind_map_cmapi f map = bind_cmap (CMap.mapi f map)
 
 let range i j =
   let rec aux i j acc = if i >= j then acc else aux i (j-1) (j-1 :: acc) in
diff --git a/src/stages/common/helpers.mli b/src/stages/common/helpers.mli
index 69efa24eb..d5e388e36 100644
--- a/src/stages/common/helpers.mli
+++ b/src/stages/common/helpers.mli
@@ -19,3 +19,12 @@ val is_tuple_lmap : 'a Types.label_map -> bool
 val get_pair :
            'a Types.label_map ->
            (('a * 'a) * 'b list, unit -> Trace.error) result
+
+
+
+val bind_map_lmapi : 
+  (Types.label -> 'a -> ('b * 'c list, 'd) result) ->
+  'a Types.label_map -> ('b Types.label_map * 'c list, 'd) result
+val bind_map_cmapi : 
+  (Types.constructor' -> 'a -> ('b * 'c list, 'd) result) ->
+  'a Types.constructor_map -> ('b Types.constructor_map * 'c list, 'd) result

From 5a15feadc157f1f87a44408643069f46d33e02e0 Mon Sep 17 00:00:00 2001
From: Lesenechal Remi <lesenechal.remi@gmail.com>
Date: Fri, 21 Feb 2020 17:07:48 +0100
Subject: [PATCH 4/6] now map over type declarations

---
 .../entrypoints_lenght_limit.ml               | 25 +++++++
 src/passes/3-self_ast_simplified/helpers.ml   | 71 ++++++++++++++++---
 .../self_ast_simplified.ml                    | 15 ++--
 3 files changed, 99 insertions(+), 12 deletions(-)
 create mode 100644 src/passes/3-self_ast_simplified/entrypoints_lenght_limit.ml

diff --git a/src/passes/3-self_ast_simplified/entrypoints_lenght_limit.ml b/src/passes/3-self_ast_simplified/entrypoints_lenght_limit.ml
new file mode 100644
index 000000000..a64007b4a
--- /dev/null
+++ b/src/passes/3-self_ast_simplified/entrypoints_lenght_limit.ml
@@ -0,0 +1,25 @@
+open Ast_simplified
+open Trace
+open Stage_common.Helpers
+
+module Errors = struct
+  let bad_string_timestamp name () =
+    let title = thunk @@ Format.asprintf ("Too long constructor '%s'") name in
+    let message () = "names length is limited to 32 (tezos limitation)" in
+    error title message ()
+end
+open Errors
+
+let peephole_type_expression : type_expression -> type_expression result = fun e ->
+  let return type_content = ok { e with type_content } in
+  match e.type_content with
+  | T_sum cmap ->
+    let%bind _uu = bind_map_cmapi
+      (fun k _ ->
+        let (Constructor name) = k in
+        if (String.length name  >= 32) then fail @@ bad_string_timestamp name
+        else ok ()
+      )
+      cmap in
+    ok e
+  | e -> return e
diff --git a/src/passes/3-self_ast_simplified/helpers.ml b/src/passes/3-self_ast_simplified/helpers.ml
index 40520a0f4..f34f48514 100644
--- a/src/passes/3-self_ast_simplified/helpers.ml
+++ b/src/passes/3-self_ast_simplified/helpers.ml
@@ -90,8 +90,12 @@ and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
       ok res
     )
 
-type mapper = expression -> expression result
-let rec map_expression : mapper -> expression -> expression result = fun f e ->
+type exp_mapper = expression -> expression result
+type ty_exp_mapper = type_expression -> type_expression result
+type abs_mapper =
+  | Expression of exp_mapper
+  | Type_expression of ty_exp_mapper 
+let rec map_expression : exp_mapper -> expression -> expression result = fun f e ->
   let self = map_expression f in
   let%bind e' = f e in
   let return expression_content = ok { e' with expression_content } in
@@ -167,8 +171,54 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
     )
   | E_literal _ | E_variable _ | E_skip as e' -> return e'
 
+and map_type_expression : ty_exp_mapper -> type_expression -> type_expression result = fun f te ->
+  let self = map_type_expression f in
+  let%bind te' = f te in
+  let return type_content = ok { te' with type_content } in
+  match te'.type_content with
+  | T_sum temap ->
+    let%bind temap' = bind_map_cmap self temap in
+    return @@ (T_sum temap')
+  | T_record temap ->
+    let%bind temap' = bind_map_lmap self temap in
+    return @@ (T_record temap')
+  | T_arrow {type1 ; type2} ->
+    let%bind type1' = self type1 in
+    let%bind type2' = self type2 in
+    return @@ (T_arrow {type1=type1' ; type2=type2'})
+  | T_operator type_op ->
+    let%bind to' = map_type_operator f type_op in
+    return @@ (T_operator to')
+  | T_variable _ | T_constant _ -> ok te'
 
-and map_cases : mapper -> matching_expr -> matching_expr result = fun f m ->
+and map_type_operator : ty_exp_mapper -> type_operator -> type_operator result = fun f te ->
+  match te with
+  | TC_contract e ->
+    let%bind e' = map_type_expression f e in
+    ok @@ TC_contract e'
+  | TC_option e ->
+    let%bind e' = map_type_expression f e in
+    ok @@ TC_option e'
+  | TC_list e ->
+    let%bind e' = map_type_expression f e in
+    ok @@ TC_list e'
+  | TC_set e -> 
+    let%bind e' = map_type_expression f e in
+    ok @@ TC_set e'
+  | TC_map (a , b) ->
+    let%bind a' = map_type_expression f a in
+    let%bind b' = map_type_expression f b in
+    ok @@ TC_map (a' , b')
+  | TC_big_map (a , b) ->
+    let%bind a' = map_type_expression f a in
+    let%bind b' = map_type_expression f b in
+    ok @@ TC_big_map (a' , b')
+  | TC_arrow (a , b) -> 
+    let%bind a' = map_type_expression f a in
+    let%bind b' = map_type_expression f b in
+    ok @@ TC_arrow (a' , b')
+
+and map_cases : exp_mapper -> matching_expr -> matching_expr result = fun f m ->
   match m with
   | Match_bool { match_true ; match_false } -> (
       let%bind match_true = map_expression f match_true in
@@ -198,14 +248,19 @@ and map_cases : mapper -> matching_expr -> matching_expr result = fun f m ->
       ok @@ Match_variant (lst', ())
     )
 
-and map_program : mapper -> program -> program result = fun m p ->
+and map_program : abs_mapper -> program -> program result = fun m p ->
   let aux = fun (x : declaration) ->
-    match x with
-    | Declaration_constant (t , o , i, e) -> (
-        let%bind e' = map_expression m e in
+    match x,m with
+    | (Declaration_constant (t , o , i, e), Expression m') -> (
+        let%bind e' = map_expression m' e in
         ok (Declaration_constant (t , o , i, e'))
       )
-    | Declaration_type _ -> ok x
+    | (Declaration_type (tv,te), Type_expression m') -> (
+        let%bind te' = map_type_expression m' te in
+        ok (Declaration_type (tv, te'))
+      )
+    | decl,_ -> ok decl
+  (* | Declaration_type of (type_variable * type_expression) *)
   in
   bind_map_list (bind_map_location aux) p
 
diff --git a/src/passes/3-self_ast_simplified/self_ast_simplified.ml b/src/passes/3-self_ast_simplified/self_ast_simplified.ml
index 8f8eee099..a10968c0c 100644
--- a/src/passes/3-self_ast_simplified/self_ast_simplified.ml
+++ b/src/passes/3-self_ast_simplified/self_ast_simplified.ml
@@ -1,17 +1,24 @@
 open Trace
 
-let all = [
+let all_expression_mapper = [
   Tezos_type_annotation.peephole_expression ;
   None_variant.peephole_expression ;
   Literals.peephole_expression ;
 ]
+let all_type_expression_mapper = [
+  Entrypoints_lenght_limit.peephole_type_expression ;
+]
+
+let all_exp = List.map (fun el -> Helpers.Expression el) all_expression_mapper
+let all_ty = List.map (fun el -> Helpers.Type_expression el) all_type_expression_mapper
 
 let all_program =
-  let all_p = List.map Helpers.map_program all in
-  bind_chain all_p
+  let all_p = List.map Helpers.map_program all_exp in
+  let all_p2 = List.map Helpers.map_program all_ty in
+  bind_chain (List.append all_p all_p2)
 
 let all_expression =
-  let all_p = List.map Helpers.map_expression all in
+  let all_p = List.map Helpers.map_expression all_expression_mapper in
   bind_chain all_p
 
 let map_expression = Helpers.map_expression

From 503d8f771e3a7141047bc2d97c1156b513f3a0a5 Mon Sep 17 00:00:00 2001
From: Lesenechal Remi <lesenechal.remi@gmail.com>
Date: Fri, 21 Feb 2020 17:08:10 +0100
Subject: [PATCH 5/6] add tests for sum type names limit length

---
 src/bin/expect_tests/contract_tests.ml         | 13 +++++++++++++
 .../negative/long_sum_type_names.ligo          | 18 ++++++++++++++++++
 2 files changed, 31 insertions(+)
 create mode 100644 src/test/contracts/negative/long_sum_type_names.ligo

diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml
index 49b1563d7..cb7095651 100644
--- a/src/bin/expect_tests/contract_tests.ml
+++ b/src/bin/expect_tests/contract_tests.ml
@@ -1139,6 +1139,19 @@ let%expect_test _ =
       storage (pair (map %one key_hash nat) (big_map %two key_hash bool)) ;
       code { DUP ; CDR ; NIL operation ; PAIR ; DIP { DROP } } } |}]
 
+let%expect_test _ =
+  run_ligo_bad [ "compile-contract" ; bad_contract "long_sum_type_names.ligo" ; "main" ] ;
+  [%expect {|
+    ligo: Too long constructor 'Incrementttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt': names length is limited to 32 (tezos limitation)
+
+     If you're not sure how to fix this error, you can
+     do one of the following:
+
+    * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/
+    * Ask a question on our Discord: https://discord.gg/9rhYaEt
+    * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
+    * Check the changelog by running 'ligo changelog' |}]
+
 let%expect_test _ =
   run_ligo_good [ "dry-run" ; contract "super-counter.mligo" ; "main" ; "test_param" ; "test_storage" ] ;
   [%expect {|
diff --git a/src/test/contracts/negative/long_sum_type_names.ligo b/src/test/contracts/negative/long_sum_type_names.ligo
new file mode 100644
index 000000000..71c9a4efe
--- /dev/null
+++ b/src/test/contracts/negative/long_sum_type_names.ligo
@@ -0,0 +1,18 @@
+type action is
+| Incrementttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt of int
+// | Increment of int
+| Decrement of int
+
+function add (const a : int ; const b : int) : int is a + b
+
+function subtract (const a : int ; const b : int) : int is a - b
+
+function main (const p : action ; const s : int) : (list(operation) * int) is 
+  ((nil : list(operation)),
+    case p of
+    | Incrementttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt (n) -> add (s, n)
+    // | Increment(n) -> add (s, n)
+    | Decrement (n) -> subtract (s, n)
+    end)
+
+// incrementttttttttttttttttttttttt
\ No newline at end of file

From 66aca916bf2f50911c75f3f9279a2075f0b6c254 Mon Sep 17 00:00:00 2001
From: Lesenechal Remi <lesenechal.remi@gmail.com>
Date: Fri, 21 Feb 2020 17:18:51 +0100
Subject: [PATCH 6/6] mapping over type_operator types is useless

---
 src/bin/expect_tests/contract_tests.ml      |  4 +--
 src/passes/3-self_ast_simplified/helpers.ml | 31 +--------------------
 2 files changed, 3 insertions(+), 32 deletions(-)

diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml
index cb7095651..49d0d9ae1 100644
--- a/src/bin/expect_tests/contract_tests.ml
+++ b/src/bin/expect_tests/contract_tests.ml
@@ -1174,7 +1174,7 @@ let%expect_test _ =
 let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_toplevel.mligo" ; "main" ] ;
   [%expect {|
-ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P : ( nat * string ):Some(( nat * string ))) : None return let rhs#808 = #P in let p = rhs#808.0 in let s = rhs#808.1 in ( list[] : (TO_list(operation)) , store ) , NONE() : (TO_option(key_hash)) , 300000000mutez , \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"}
+ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P : ( nat * string ):Some(( nat * string ))) : None return let rhs#809 = #P in let p = rhs#809.0 in let s = rhs#809.1 in ( list[] : (TO_list(operation)) , store ) , NONE() : (TO_option(key_hash)) , 300000000mutez , \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"}
 
 
  If you're not sure how to fix this error, you can
@@ -1187,7 +1187,7 @@ ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8,
 
   run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_var.mligo" ; "main" ] ;
   [%expect {|
-ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P : ( nat * int ):Some(( nat * int ))) : None return let rhs#811 = #P in let p = rhs#811.0 in let s = rhs#811.1 in ( list[] : (TO_list(operation)) , a ) , NONE() : (TO_option(key_hash)) , 300000000mutez , 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"}
+ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P : ( nat * int ):Some(( nat * int ))) : None return let rhs#812 = #P in let p = rhs#812.0 in let s = rhs#812.1 in ( list[] : (TO_list(operation)) , a ) , NONE() : (TO_option(key_hash)) , 300000000mutez , 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"}
 
 
  If you're not sure how to fix this error, you can
diff --git a/src/passes/3-self_ast_simplified/helpers.ml b/src/passes/3-self_ast_simplified/helpers.ml
index f34f48514..76f884b6a 100644
--- a/src/passes/3-self_ast_simplified/helpers.ml
+++ b/src/passes/3-self_ast_simplified/helpers.ml
@@ -186,38 +186,9 @@ and map_type_expression : ty_exp_mapper -> type_expression -> type_expression re
     let%bind type1' = self type1 in
     let%bind type2' = self type2 in
     return @@ (T_arrow {type1=type1' ; type2=type2'})
-  | T_operator type_op ->
-    let%bind to' = map_type_operator f type_op in
-    return @@ (T_operator to')
+  | T_operator _
   | T_variable _ | T_constant _ -> ok te'
 
-and map_type_operator : ty_exp_mapper -> type_operator -> type_operator result = fun f te ->
-  match te with
-  | TC_contract e ->
-    let%bind e' = map_type_expression f e in
-    ok @@ TC_contract e'
-  | TC_option e ->
-    let%bind e' = map_type_expression f e in
-    ok @@ TC_option e'
-  | TC_list e ->
-    let%bind e' = map_type_expression f e in
-    ok @@ TC_list e'
-  | TC_set e -> 
-    let%bind e' = map_type_expression f e in
-    ok @@ TC_set e'
-  | TC_map (a , b) ->
-    let%bind a' = map_type_expression f a in
-    let%bind b' = map_type_expression f b in
-    ok @@ TC_map (a' , b')
-  | TC_big_map (a , b) ->
-    let%bind a' = map_type_expression f a in
-    let%bind b' = map_type_expression f b in
-    ok @@ TC_big_map (a' , b')
-  | TC_arrow (a , b) -> 
-    let%bind a' = map_type_expression f a in
-    let%bind b' = map_type_expression f b in
-    ok @@ TC_arrow (a' , b')
-
 and map_cases : exp_mapper -> matching_expr -> matching_expr result = fun f m ->
   match m with
   | Match_bool { match_true ; match_false } -> (