balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge

Browse Source
This commit is contained in:
Sander Spies 2020-03-10 12:55:51 +01:00
commit bcb77c6305
25 changed files with 148 additions and 152 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/bin/expect_tests/contract_tests.ml
View File

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

25
src/passes/3-self_ast_simplified/entrypoints_lenght_limit.ml Normal file
View File

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

56
src/passes/3-self_ast_simplified/helpers.ml
View File

@ -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
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
@ -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
| 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
@ -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'})

15
src/passes/3-self_ast_simplified/self_ast_simplified.ml
View File

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

14
src/passes/4-typer-new/typer.ml
View File

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

23
src/passes/4-typer-new/typer.ml.old
View File

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

31
src/passes/4-typer-old/typer.ml
View File

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

16
src/passes/5-self_ast_typed/helpers.ml
View File

@ -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")
| [] -> simple_fail ("Entrypoint '"^main_fname^"' does not exist")

2
src/passes/6-interpreter/interpreter.ml
View File

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

5
src/passes/6-transpiler/transpiler.ml
View File

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

2
src/stages/ast_simplified/PP.ml
View File

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

1
src/stages/ast_simplified/combinators.ml
View File

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

1
src/stages/ast_simplified/combinators.mli
View File

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

2
src/stages/ast_simplified/misc.ml
View File

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

3
src/stages/ast_simplified/types.ml
View File

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

2
src/stages/ast_typed/PP.ml
View File

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

3
src/stages/ast_typed/misc.ml
View File

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

3
src/stages/ast_typed/misc_smart.ml
View File

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

23
src/stages/ast_typed/types.ml
View File

@ -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 = {

2
src/stages/common/helpers.ml
View File

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

9
src/stages/common/helpers.mli
View File

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

4
src/stages/typesystem/misc.ml
View File

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

22
src/test/contracts/check_signature.mligo
View File

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

18
src/test/contracts/negative/long_sum_type_names.ligo Normal file
View File

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

1
src/test/integration_tests.ml
View File

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