Merge

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 {|
@@ -1161,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
@@ -1174,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

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

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
@@ -90,8 +86,12 @@ and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
       ok res
     )
 
-type mapper = expression -> expression result
+type exp_mapper = expression -> expression result
-let rec map_expression : mapper -> expression -> expression result = fun f e ->
+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
@@ -116,11 +116,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'}
@@ -167,8 +162,25 @@ 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 _
+  | T_variable _ | T_constant _ -> ok te'
 
-and map_cases : mapper -> matching_expr -> matching_expr result = fun f m ->
+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 +210,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
+    match x,m with
-    | Declaration_constant (t , o , i, e) -> (
+    | (Declaration_constant (t , o , i, e), Expression m') -> (
-        let%bind e' = map_expression m e in
+        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
 
@@ -237,11 +254,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'})

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
+  let all_p = List.map Helpers.map_program all_exp in
-  bind_chain all_p
+  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

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

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

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

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

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
 

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

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 ->

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}

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

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)
 

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

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

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

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

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 = {
+and constant =
-    cons_name: constant' ;
+  { cons_name: constant'
-    arguments: expression list ;
+  ; 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 = {
+and matching =
-    matchee: expression ;
+  { matchee: expression
-    cases: matching_expr ;
+  ; cases: matching_expr
   }
 
 and ascription = {

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

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

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

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

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

src/test/integration_tests.ml

@@ -2084,6 +2084,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 =