From 8c37fe355d1d7915f6f1685256be2ae7ad4c0766 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Mon, 10 Jun 2019 21:39:43 +0200 Subject: [PATCH 01/51] test: contract for mligo version of the example on the website --- src/contracts/website2.mligo | 20 ++++++++++++++++++++ src/test/integration_tests.ml | 11 +++++++++++ 2 files changed, 31 insertions(+) create mode 100644 src/contracts/website2.mligo diff --git a/src/contracts/website2.mligo b/src/contracts/website2.mligo new file mode 100644 index 000000000..f972e9b47 --- /dev/null +++ b/src/contracts/website2.mligo @@ -0,0 +1,20 @@ +type storage = int + +(* variant defining pseudo multi-entrypoint actions *) + +type action = +| Increment of int +| Decrement of int + +let add (a: int) (b: int) : int = a + b + +let subtract (a: int) (b: int) : int = a - b + +(* real entrypoint that re-routes the flow based on the action provided *) + +let%entry main (p : action) storage = + let storage = + match p with + | Increment n -> add storage n + | Decrement n -> subtract storage n + in (([] : operation list), storage) diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 16a4c7d69..8ee57494d 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -825,6 +825,16 @@ let tez_mligo () : unit result = let%bind _ = expect_eq_evaluate program "add_more_tez" (e_mutez 111111000) in ok () +let website2_mligo () : unit result = + let%bind program = mtype_file "./contracts/website2.mligo" in + let make_input = fun n -> + let action = if n mod 2 = 0 then "Increment" else "Decrement" in + e_pair (e_constructor action (e_int n)) (e_int 42) in + let make_expected = fun n -> + let op = if n mod 2 = 0 then (+) else (-) in + e_pair (e_typed_list [] t_operation) (e_int (op 42 n)) in + expect_eq_n program "main" make_input make_expected + let main = test_suite "Integration (End to End)" [ test "type alias" type_alias ; test "function" function_ ; @@ -888,4 +898,5 @@ let main = test_suite "Integration (End to End)" [ test "tez (mligo)" tez_mligo ; test "website1 ligo" website1_ligo ; test "website2 ligo" website2_ligo ; + test "website2 (mligo)" website2_mligo ; ] From 606f7ca907331def3c5b7e322042e5c2a2b1a2ab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Tue, 11 Jun 2019 01:27:59 +0200 Subject: [PATCH 02/51] More tests, integration of some of the operators --- src/contracts/condition-annot.mligo | 5 +++++ src/contracts/condition-shadowing.mligo | 9 +++++++++ src/contracts/condition.mligo | 5 +++++ src/contracts/fibo.mligo | 12 ++++++++++++ src/passes/operators/operators.ml | 18 +++++++++++++++++ src/test/integration_tests.ml | 26 +++++++++++++++++++++++-- 6 files changed, 73 insertions(+), 2 deletions(-) create mode 100644 src/contracts/condition-annot.mligo create mode 100644 src/contracts/condition-shadowing.mligo create mode 100644 src/contracts/condition.mligo create mode 100644 src/contracts/fibo.mligo diff --git a/src/contracts/condition-annot.mligo b/src/contracts/condition-annot.mligo new file mode 100644 index 000000000..b5b87ef68 --- /dev/null +++ b/src/contracts/condition-annot.mligo @@ -0,0 +1,5 @@ +let%entry main (i : int) = + if (i = 2 : bool) then + (42 : int) + else + (0 : int) diff --git a/src/contracts/condition-shadowing.mligo b/src/contracts/condition-shadowing.mligo new file mode 100644 index 000000000..099b9fd7c --- /dev/null +++ b/src/contracts/condition-shadowing.mligo @@ -0,0 +1,9 @@ +(* TODO : make a test using mutation, not shadowing *) +let%entry main (i : int) = + let result = 0 in + if i = 2 then + let result = 42 in + result + else + let result = 0 in + result diff --git a/src/contracts/condition.mligo b/src/contracts/condition.mligo new file mode 100644 index 000000000..334ea46b0 --- /dev/null +++ b/src/contracts/condition.mligo @@ -0,0 +1,5 @@ +let%entry main (i : int) = + if i = 2 then + 42 + else + 0 diff --git a/src/contracts/fibo.mligo b/src/contracts/fibo.mligo new file mode 100644 index 000000000..ee7e2df12 --- /dev/null +++ b/src/contracts/fibo.mligo @@ -0,0 +1,12 @@ +type storage = unit + +(* not supported yet +let%entry main (p:unit) storage = + (fun x -> ()) () +*) + +let%entry main (p:unit) storage = + (fun (f : int -> int -> int) (x : int) (y : int) -> f y (x + y)) + (fun (x : int) (y : int) -> x + y) + 0 + 1 diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml index 15ed4928a..1842b620d 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/operators/operators.ml @@ -103,9 +103,20 @@ module Simplify = struct module Camligo = struct let constants = [ ("Bytes.pack" , "PACK") ; + + ("Map.remove" , "MAP_REMOVE") ; + ("Map.update" , "MAP_UPDATE") ; + ("Map.add" , "MAP_ADD") ; + ("Map.mem" , "MAP_MEM") ; + ("Map.find" , "MAP_FIND") ; + ("Map.fold" , "MAP_FOLD") ; + ("Map.map" , "MAP_MAP") ; + ("Crypto.hash" , "HASH") ; + ("Operation.transaction" , "CALL") ; ("Operation.get_contract" , "CONTRACT") ; + ("sender" , "SENDER") ; ("unit" , "UNIT") ; ("source" , "SOURCE") ; @@ -704,6 +715,13 @@ module Compiler = struct ("MAP_FIND_OPT" , simple_binary @@ prim I_GET) ; ("MAP_ADD" , simple_ternary @@ seq [dip (i_some) ; prim I_UPDATE]) ; ("MAP_UPDATE" , simple_ternary @@ prim I_UPDATE) ; + (* ("GET_CONTRACT" , simple_constant @@ prim I_CONTRACT) ; *) + (* ( "MAP_REMOVE" , simple_binary @@ seq [prim I_NONE TODO: + annotation ; prim I_UPDATE ]) ; *) + ( "MAP_MEM" , simple_binary @@ prim I_MEM) ; + (* ( "MAP_FOLD" , simple_ternary @@ prim TODO I_ITER?) ; *) + ( "MAP_MAP" , simple_binary @@ prim I_MAP) ; + (* ( "MAP_MAP_FOLD" , simple_ternary @@ prim TODO I_ITER?) ; *) + (* ( "MAP_ITER" , simple_binary @@ prim TODO I_ITER?) ; *) ("SIZE" , simple_unary @@ prim I_SIZE) ; ("FAILWITH" , simple_unary @@ prim I_FAILWITH) ; ("ASSERT_INFERRED" , simple_binary @@ i_if (seq [i_failwith]) (seq [i_drop ; i_push_unit])) ; diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 8ee57494d..0de2e619c 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -533,6 +533,20 @@ let condition () : unit result = let make_expected = fun n -> e_int (if n = 2 then 42 else 0) in expect_eq_n program "main" make_input make_expected +let condition_mligo () : unit result = + let%bind _ = + let aux file = + let%bind program = mtype_file file in + let make_input = e_int in + let make_expected = fun n -> e_int (if n = 2 then 42 else 0) in + expect_eq_n program "main" make_input make_expected in + bind_map_list aux [ + "./contracts/condition.mligo"; + "./contracts/condition-shadowing.mligo"; + "./contracts/condition-annot.mligo"; + ] in + ok () + let condition_simple () : unit result = let%bind program = type_file "./contracts/condition-simple.ligo" in let make_input = e_int in @@ -794,6 +808,12 @@ let lambda2_mligo () : unit result = let make_expected = (e_unit ()) in expect_eq program "main" make_input make_expected +let fibo_mligo () : unit result = + let%bind program = mtype_file "./contracts/fibo.mligo" in + let make_input = e_pair (e_unit ()) (e_unit ()) in + let make_expected = (e_int 42) in + expect_eq program "main" make_input make_expected + let website1_ligo () : unit result = let%bind program = type_file "./contracts/website1.ligo" in let make_input = fun n-> e_pair (e_int n) (e_int 42) in @@ -851,7 +871,8 @@ let main = test_suite "Integration (End to End)" [ test "tuple" tuple ; test "record" record ; test "condition simple" condition_simple ; - test "condition" condition ; + test "condition (ligo)" condition ; + test "condition (mligo)" condition_mligo ; test "shadow" shadow ; test "annotation" annotation ; test "multiple parameters" multiple_parameters ; @@ -893,9 +914,10 @@ let main = test_suite "Integration (End to End)" [ (* test "guess string mligo" guess_string_mligo ; WIP? *) test "lambda mligo" lambda_mligo ; test "lambda ligo" lambda_ligo ; - (* test "lambda2 mligo" lambda2_mligo ; *) test "tez (ligo)" tez_ligo ; test "tez (mligo)" tez_mligo ; + test "lambda2 mligo" lambda2_mligo ; + (* test "fibo (mligo)" fibo_mligo ; *) test "website1 ligo" website1_ligo ; test "website2 ligo" website2_ligo ; test "website2 (mligo)" website2_mligo ; From 0e5c9802ec8cf0d1be93bf33c5104896273de9c0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Wed, 12 Jun 2019 00:50:48 +0200 Subject: [PATCH 03/51] More tests with lambdas --- src/contracts/fibo.mligo | 6 +----- src/contracts/fibo2.mligo | 7 +++++++ src/contracts/fibo3.mligo | 7 +++++++ src/contracts/fibo4.mligo | 6 ++++++ src/test/integration_tests.ml | 3 +++ 5 files changed, 24 insertions(+), 5 deletions(-) create mode 100644 src/contracts/fibo2.mligo create mode 100644 src/contracts/fibo3.mligo create mode 100644 src/contracts/fibo4.mligo diff --git a/src/contracts/fibo.mligo b/src/contracts/fibo.mligo index ee7e2df12..efc437c30 100644 --- a/src/contracts/fibo.mligo +++ b/src/contracts/fibo.mligo @@ -1,12 +1,8 @@ type storage = unit -(* not supported yet -let%entry main (p:unit) storage = - (fun x -> ()) () -*) let%entry main (p:unit) storage = - (fun (f : int -> int -> int) (x : int) (y : int) -> f y (x + y)) + (fun (f : (int * int) -> int) (x : int) (y : int) -> f (y, x)) (fun (x : int) (y : int) -> x + y) 0 1 diff --git a/src/contracts/fibo2.mligo b/src/contracts/fibo2.mligo new file mode 100644 index 000000000..1daa72adb --- /dev/null +++ b/src/contracts/fibo2.mligo @@ -0,0 +1,7 @@ +type storage = unit + +let%entry main (p:unit) storage = + (fun (f : int -> int) (x : int) (y : int) -> (f y)) + (fun (x : int) -> x) + 0 + 1 diff --git a/src/contracts/fibo3.mligo b/src/contracts/fibo3.mligo new file mode 100644 index 000000000..ebce6b862 --- /dev/null +++ b/src/contracts/fibo3.mligo @@ -0,0 +1,7 @@ +type storage = unit + +let%entry main (p:unit) storage = + (fun (f : int -> int -> int) (x : int) (y : int) -> (f y) (x + y)) + (fun (x : int) (y : int) -> x + y) + 0 + 1 diff --git a/src/contracts/fibo4.mligo b/src/contracts/fibo4.mligo new file mode 100644 index 000000000..207d0c96c --- /dev/null +++ b/src/contracts/fibo4.mligo @@ -0,0 +1,6 @@ +type storage = unit + +let%entry main (p:unit) storage = + (fun (f : int -> int) (x : int) -> (f x)) + (fun (x : int) -> x) + 1 diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 0de2e619c..3b6273f7f 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -918,6 +918,9 @@ let main = test_suite "Integration (End to End)" [ test "tez (mligo)" tez_mligo ; test "lambda2 mligo" lambda2_mligo ; (* test "fibo (mligo)" fibo_mligo ; *) + (* test "fibo2 (mligo)" fibo2_mligo ; *) + (* test "fibo3 (mligo)" fibo3_mligo ; *) + (* test "fibo4 (mligo)" fibo4_mligo ; *) test "website1 ligo" website1_ligo ; test "website2 ligo" website2_ligo ; test "website2 (mligo)" website2_mligo ; From 23993a448889178ab4a9bcb02183aa9ac2389f42 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Fri, 18 Oct 2019 17:36:33 +0200 Subject: [PATCH 04/51] clean big_map tests --- src/test/contracts/big_map.ligo | 19 +++++-------------- 1 file changed, 5 insertions(+), 14 deletions(-) diff --git a/src/test/contracts/big_map.ligo b/src/test/contracts/big_map.ligo index 8fb705ab5..75d68b27d 100644 --- a/src/test/contracts/big_map.ligo +++ b/src/test/contracts/big_map.ligo @@ -1,30 +1,21 @@ type storage_ is big_map(int, int) * unit function main(const p : unit; const s : storage_) : list(operation) * storage_ is - var r : big_map(int, int) := s.0 ; var toto : option (int) := Some(0); block { - toto := r[23]; - r[2] := 444; - s.0 := r; + toto := s.0[23]; + s.0[2] := 444; } with ((nil: list(operation)), s) function set_ (var n : int ; var m : storage_) : storage_ is block { - var tmp : big_map(int,int) := m.0 ; - tmp[23] := n ; - m.0 := tmp ; + m.0[23] := n ; } with m function rm (var m : storage_) : storage_ is block { - var tmp : big_map(int,int) := m.0 ; - remove 42 from map tmp; - m.0 := tmp; + remove 42 from map m.0; } with m function gf (const m : storage_) : int is begin skip end with get_force(23, m.0) -function get (const m : storage_) : option(int) is - begin - skip - end with m.0[42] \ No newline at end of file +function get (const m : storage_) : option(int) is begin skip end with m.0[42] \ No newline at end of file From 5d040220c051e2cc64a3bc5cb8d1c6cb4f75ddc1 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Fri, 18 Oct 2019 17:52:26 +0200 Subject: [PATCH 05/51] WIP: add test --- src/test/contracts/big_map.ligo | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/src/test/contracts/big_map.ligo b/src/test/contracts/big_map.ligo index 75d68b27d..8afc707b4 100644 --- a/src/test/contracts/big_map.ligo +++ b/src/test/contracts/big_map.ligo @@ -18,4 +18,18 @@ function rm (var m : storage_) : storage_ is block { function gf (const m : storage_) : int is begin skip end with get_force(23, m.0) -function get (const m : storage_) : option(int) is begin skip end with m.0[42] \ No newline at end of file +function get (const m : storage_) : option(int) is begin skip end with m.0[42] + +function mutimaps (const m : storage_; const n : storage_) : storage_ is block +{ + var foo : big_map(int,int) := m.0 ; + foo[42] := 0 ; + n.0[42] := get_force(42, foo) ; +} with n + +const empty_big_map : big_map(int,int) = big_map end + +const map1 : big_map(int,int) = big_map + 23 -> 0 ; + 42 -> 0 ; +end \ No newline at end of file From cefac0d8e74868194e88f6d490230d5d0ec42e0c Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Mon, 21 Oct 2019 13:04:28 +0200 Subject: [PATCH 06/51] add big_map injection --- src/passes/1-parser/pascaligo/AST.ml | 2 ++ src/passes/1-parser/pascaligo/AST.mli | 1 + src/passes/1-parser/pascaligo/Parser.mly | 1 + src/passes/1-parser/pascaligo/ParserLog.ml | 3 ++- src/passes/2-simplify/pascaligo.ml | 14 +++++++++++++- 5 files changed, 19 insertions(+), 2 deletions(-) diff --git a/src/passes/1-parser/pascaligo/AST.ml b/src/passes/1-parser/pascaligo/AST.ml index 97eab1c20..985ae277e 100644 --- a/src/passes/1-parser/pascaligo/AST.ml +++ b/src/passes/1-parser/pascaligo/AST.ml @@ -490,6 +490,7 @@ and closing = and map_expr = MapLookUp of map_lookup reg | MapInj of binding reg injection reg +| BigMapInj of binding reg injection reg and map_lookup = { path : path; @@ -647,6 +648,7 @@ and tuple_expr_to_region {region; _} = region and map_expr_to_region = function MapLookUp {region; _} | MapInj {region; _} -> region +| BigMapInj {region; _} -> region and set_expr_to_region = function SetInj {region; _} diff --git a/src/passes/1-parser/pascaligo/AST.mli b/src/passes/1-parser/pascaligo/AST.mli index a41fb005f..cf8fa3321 100644 --- a/src/passes/1-parser/pascaligo/AST.mli +++ b/src/passes/1-parser/pascaligo/AST.mli @@ -481,6 +481,7 @@ and closing = and map_expr = MapLookUp of map_lookup reg | MapInj of binding reg injection reg +| BigMapInj of binding reg injection reg and map_lookup = { path : path; diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index 38b86357b..d3dc32568 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -877,6 +877,7 @@ set_expr: map_expr: map_lookup { MapLookUp $1 } | injection(Map,binding) { MapInj $1 } +| injection(BigMap,binding) { BigMapInj $1 } map_lookup: path brackets(expr) { diff --git a/src/passes/1-parser/pascaligo/ParserLog.ml b/src/passes/1-parser/pascaligo/ParserLog.ml index e09149bce..2f0fe6268 100644 --- a/src/passes/1-parser/pascaligo/ParserLog.ml +++ b/src/passes/1-parser/pascaligo/ParserLog.ml @@ -434,6 +434,7 @@ and print_case_clause_expr buffer {value; _} = and print_map_expr buffer = function MapLookUp {value; _} -> print_map_lookup buffer value | MapInj inj -> print_injection buffer "map" print_binding inj +| BigMapInj inj -> print_injection buffer "big_map" print_binding inj and print_set_expr buffer = function SetInj inj -> print_injection buffer "set" print_expr inj @@ -1445,7 +1446,7 @@ and pp_map_expr buffer ~pad = function MapLookUp {value; _} -> pp_node buffer ~pad "MapLookUp"; pp_map_lookup buffer ~pad value -| MapInj {value; _} -> +| MapInj {value; _} | BigMapInj {value; _} -> pp_node buffer ~pad "MapInj"; pp_injection pp_binding buffer ~pad value diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index d094f3819..3928d8b5f 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -399,7 +399,7 @@ let rec simpl_expression (t:Raw.expr) : expr result = let%bind cases = simpl_cases lst in return @@ e_matching ~loc e cases ) - | EMap (MapInj mi) -> ( + | EMap (MapInj mi) -> ( let (mi , loc) = r_split mi in let%bind lst = let lst = List.map get_value @@ pseq_to_list mi.elements in @@ -411,6 +411,18 @@ let rec simpl_expression (t:Raw.expr) : expr result = bind_map_list aux lst in return @@ e_map ~loc lst ) + | EMap (BigMapInj mi) -> ( + let (mi , loc) = r_split mi in + let%bind lst = + let lst = List.map get_value @@ pseq_to_list mi.elements in + let aux : Raw.binding -> (expression * expression) result = + fun b -> + let%bind src = simpl_expression b.source in + let%bind dst = simpl_expression b.image in + ok (src, dst) in + bind_map_list aux lst in + return @@ e_big_map ~loc lst + ) | EMap (MapLookUp lu) -> ( let (lu , loc) = r_split lu in let%bind path = match lu.path with From 2a2c708b548ccdaf4e359a05993ffdf3f651af6b Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 22 Oct 2019 11:55:03 +0200 Subject: [PATCH 07/51] adding Big_map.* operators for cameligo --- src/passes/3-self_ast_simplified/literals.ml | 28 ++++++++++++++++++++ src/passes/operators/operators.ml | 9 +++++++ 2 files changed, 37 insertions(+) diff --git a/src/passes/3-self_ast_simplified/literals.ml b/src/passes/3-self_ast_simplified/literals.ml index 5d7be25b6..154851601 100644 --- a/src/passes/3-self_ast_simplified/literals.ml +++ b/src/passes/3-self_ast_simplified/literals.ml @@ -4,6 +4,27 @@ open Trace let peephole_expression : expression -> expression result = fun e -> let return expression = ok { e with expression } in match e.expression with + | E_constant ("BIG_MAP_LITERAL" , lst) -> ( + let%bind elt = + trace_option (simple_error "big_map literal expects a single parameter") @@ + List.to_singleton lst + in + let%bind lst = + trace (simple_error "big_map literal expects a list as parameter") @@ + get_e_list elt.expression + in + let aux = fun (e : expression) -> + trace (simple_error "big_map literal expects a list of pairs as parameter") @@ + let%bind tpl = get_e_tuple e.expression in + let%bind (a , b) = + trace_option (simple_error "of pairs") @@ + List.to_pair tpl + in + ok (a , b) + in + let%bind pairs = bind_map_list aux lst in + return @@ E_big_map pairs + ) | E_constant ("MAP_LITERAL" , lst) -> ( let%bind elt = trace_option (simple_error "map literal expects a single parameter") @@ @@ -25,6 +46,13 @@ let peephole_expression : expression -> expression result = fun e -> let%bind pairs = bind_map_list aux lst in return @@ E_map pairs ) + | E_constant ("BIG_MAP_EMPTY" , lst) -> ( + let%bind () = + trace_strong (simple_error "BIG_MAP_EMPTY expects no parameter") @@ + Assert.assert_list_empty lst + in + return @@ E_big_map [] + ) | E_constant ("MAP_EMPTY" , lst) -> ( let%bind () = trace_strong (simple_error "MAP_EMPTY expects no parameter") @@ diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml index 65b55c18e..13510fedc 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/operators/operators.ml @@ -85,6 +85,7 @@ module Simplify = struct ("list_iter" , "LIST_ITER") ; ("list_fold" , "LIST_FOLD") ; ("list_map" , "LIST_MAP") ; + (*ici*) ("map_iter" , "MAP_ITER") ; ("map_map" , "MAP_MAP") ; ("map_fold" , "MAP_FOLD") ; @@ -167,6 +168,14 @@ module Simplify = struct ("Map.literal" , "MAP_LITERAL" ) ; ("Map.size" , "SIZE" ) ; + ("Big_map.find_opt" , "MAP_FIND_OPT") ; + ("Big_map.find" , "MAP_FIND") ; + ("Big_map.update" , "MAP_UPDATE") ; + ("Big_map.add" , "MAP_ADD") ; + ("Big_map.remove" , "MAP_REMOVE") ; + ("Big_map.literal" , "BIG_MAP_LITERAL" ) ; + ("Big_map.empty" , "BIG_MAP_EMPTY" ) ; + ("String.length", "SIZE") ; ("String.size", "SIZE") ; ("String.slice", "SLICE") ; From e6ee915f1e385329a7ef159d0e46318d60203bae Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 22 Oct 2019 11:55:36 +0200 Subject: [PATCH 08/51] updating tests (we don't need the big_map to be in a pair anymore) --- src/test/contracts/big_map.ligo | 31 ++++++++++++++++--------------- src/test/contracts/big_map.mligo | 25 +++++++++++++++++-------- src/test/integration_tests.ml | 2 +- 3 files changed, 34 insertions(+), 24 deletions(-) diff --git a/src/test/contracts/big_map.ligo b/src/test/contracts/big_map.ligo index 8afc707b4..3d504aa75 100644 --- a/src/test/contracts/big_map.ligo +++ b/src/test/contracts/big_map.ligo @@ -1,4 +1,5 @@ type storage_ is big_map(int, int) * unit +type foo is big_map(int, int) function main(const p : unit; const s : storage_) : list(operation) * storage_ is var toto : option (int) := Some(0); @@ -8,28 +9,28 @@ function main(const p : unit; const s : storage_) : list(operation) * storage_ i } with ((nil: list(operation)), s) -function set_ (var n : int ; var m : storage_) : storage_ is block { - m.0[23] := n ; +function set_ (var n : int ; var m : foo) : foo is block { + m[23] := n ; } with m -function rm (var m : storage_) : storage_ is block { - remove 42 from map m.0; +function rm (var m : foo) : foo is block { + remove 42 from map m; } with m -function gf (const m : storage_) : int is begin skip end with get_force(23, m.0) +function gf (const m : foo) : int is begin skip end with get_force(23, m) -function get (const m : storage_) : option(int) is begin skip end with m.0[42] - -function mutimaps (const m : storage_; const n : storage_) : storage_ is block -{ - var foo : big_map(int,int) := m.0 ; - foo[42] := 0 ; - n.0[42] := get_force(42, foo) ; -} with n +function get (const m : foo) : option(int) is begin skip end with m[42] const empty_big_map : big_map(int,int) = big_map end -const map1 : big_map(int,int) = big_map +const big_map1 : big_map(int,int) = big_map 23 -> 0 ; 42 -> 0 ; -end \ No newline at end of file +end + +function mutimaps (const m : foo ; const n : foo) : foo is block +{ + var bar : foo := m ; + bar[42] := 0 ; + n[42] := get_force(42, bar) ; +} with n \ No newline at end of file diff --git a/src/test/contracts/big_map.mligo b/src/test/contracts/big_map.mligo index d032fad8c..52a366fe6 100644 --- a/src/test/contracts/big_map.mligo +++ b/src/test/contracts/big_map.mligo @@ -1,12 +1,21 @@ -type storage_ = ((int, int) big_map * unit) +type foo = (int, int) big_map -let set_ (n : int) (m : storage_) : storage_ = - (Map.update 23 (Some(n)) m.(0), ()) +let set_ (n : int) (m : foo) : foo = Big_map.update 23 (Some(n)) m -let rm (m : storage_) : storage_ = - (Map.remove 42 m.(0), ()) +let rm (m : foo) : foo = Big_map.remove 42 m -let gf (m : storage_) : int = Map.find 23 m.(0) +let gf (m : foo) : int = Big_map.find 23 m -let get (m: storage_): int option = - Map.find_opt 42 m.(0) \ No newline at end of file +let get (m: foo): int option = Big_map.find_opt 42 m + +let empty_map : foo = Big_map.empty + +let map1 : foo = Big_map.literal + [ (23 , 0) ; (42, 0) ] + +let map1 : foo = Big_map.literal + [ (23 , 0) ; (42, 0) ] + +let mutimaps (m : foo) (n : foo) : foo = + let bar : foo = Big_map.update 42 (Some(0)) m in + Big_map.update 42 (get(bar)) n \ No newline at end of file diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 401f446ce..98af59a7f 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -522,7 +522,7 @@ let big_map_ type_f path : unit result = let ez lst = let open Ast_simplified.Combinators in let lst' = List.map (fun (x, y) -> e_int x, e_int y) lst in - e_pair (e_typed_big_map lst' t_int t_int) (e_unit ()) + (e_typed_big_map lst' t_int t_int) in let%bind () = let make_input = fun n -> ez [(23, n) ; (42, 4)] in From e2ea89cf87132e8a9680c98d441f9493a7b5948f Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Wed, 23 Oct 2019 09:37:51 -0500 Subject: [PATCH 09/51] Move tests, remove operators --- src/passes/operators/operators.ml | 18 ------------------ src/{ => test}/contracts/condition-annot.mligo | 0 .../contracts/condition-shadowing.mligo | 0 src/{ => test}/contracts/condition.mligo | 0 src/{ => test}/contracts/fibo.mligo | 0 src/{ => test}/contracts/fibo2.mligo | 0 src/{ => test}/contracts/fibo3.mligo | 0 src/{ => test}/contracts/fibo4.mligo | 0 src/{ => test}/contracts/for_fail.ligo | 0 src/{ => test}/contracts/incr_decr.mligo | 0 src/{ => test}/contracts/procedure.ligo | 0 src/{ => test}/contracts/website2.mligo | 0 12 files changed, 18 deletions(-) rename src/{ => test}/contracts/condition-annot.mligo (100%) rename src/{ => test}/contracts/condition-shadowing.mligo (100%) rename src/{ => test}/contracts/condition.mligo (100%) rename src/{ => test}/contracts/fibo.mligo (100%) rename src/{ => test}/contracts/fibo2.mligo (100%) rename src/{ => test}/contracts/fibo3.mligo (100%) rename src/{ => test}/contracts/fibo4.mligo (100%) rename src/{ => test}/contracts/for_fail.ligo (100%) rename src/{ => test}/contracts/incr_decr.mligo (100%) rename src/{ => test}/contracts/procedure.ligo (100%) rename src/{ => test}/contracts/website2.mligo (100%) diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml index 1842b620d..15ed4928a 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/operators/operators.ml @@ -103,20 +103,9 @@ module Simplify = struct module Camligo = struct let constants = [ ("Bytes.pack" , "PACK") ; - - ("Map.remove" , "MAP_REMOVE") ; - ("Map.update" , "MAP_UPDATE") ; - ("Map.add" , "MAP_ADD") ; - ("Map.mem" , "MAP_MEM") ; - ("Map.find" , "MAP_FIND") ; - ("Map.fold" , "MAP_FOLD") ; - ("Map.map" , "MAP_MAP") ; - ("Crypto.hash" , "HASH") ; - ("Operation.transaction" , "CALL") ; ("Operation.get_contract" , "CONTRACT") ; - ("sender" , "SENDER") ; ("unit" , "UNIT") ; ("source" , "SOURCE") ; @@ -715,13 +704,6 @@ module Compiler = struct ("MAP_FIND_OPT" , simple_binary @@ prim I_GET) ; ("MAP_ADD" , simple_ternary @@ seq [dip (i_some) ; prim I_UPDATE]) ; ("MAP_UPDATE" , simple_ternary @@ prim I_UPDATE) ; - (* ("GET_CONTRACT" , simple_constant @@ prim I_CONTRACT) ; *) - (* ( "MAP_REMOVE" , simple_binary @@ seq [prim I_NONE TODO: + annotation ; prim I_UPDATE ]) ; *) - ( "MAP_MEM" , simple_binary @@ prim I_MEM) ; - (* ( "MAP_FOLD" , simple_ternary @@ prim TODO I_ITER?) ; *) - ( "MAP_MAP" , simple_binary @@ prim I_MAP) ; - (* ( "MAP_MAP_FOLD" , simple_ternary @@ prim TODO I_ITER?) ; *) - (* ( "MAP_ITER" , simple_binary @@ prim TODO I_ITER?) ; *) ("SIZE" , simple_unary @@ prim I_SIZE) ; ("FAILWITH" , simple_unary @@ prim I_FAILWITH) ; ("ASSERT_INFERRED" , simple_binary @@ i_if (seq [i_failwith]) (seq [i_drop ; i_push_unit])) ; diff --git a/src/contracts/condition-annot.mligo b/src/test/contracts/condition-annot.mligo similarity index 100% rename from src/contracts/condition-annot.mligo rename to src/test/contracts/condition-annot.mligo diff --git a/src/contracts/condition-shadowing.mligo b/src/test/contracts/condition-shadowing.mligo similarity index 100% rename from src/contracts/condition-shadowing.mligo rename to src/test/contracts/condition-shadowing.mligo diff --git a/src/contracts/condition.mligo b/src/test/contracts/condition.mligo similarity index 100% rename from src/contracts/condition.mligo rename to src/test/contracts/condition.mligo diff --git a/src/contracts/fibo.mligo b/src/test/contracts/fibo.mligo similarity index 100% rename from src/contracts/fibo.mligo rename to src/test/contracts/fibo.mligo diff --git a/src/contracts/fibo2.mligo b/src/test/contracts/fibo2.mligo similarity index 100% rename from src/contracts/fibo2.mligo rename to src/test/contracts/fibo2.mligo diff --git a/src/contracts/fibo3.mligo b/src/test/contracts/fibo3.mligo similarity index 100% rename from src/contracts/fibo3.mligo rename to src/test/contracts/fibo3.mligo diff --git a/src/contracts/fibo4.mligo b/src/test/contracts/fibo4.mligo similarity index 100% rename from src/contracts/fibo4.mligo rename to src/test/contracts/fibo4.mligo diff --git a/src/contracts/for_fail.ligo b/src/test/contracts/for_fail.ligo similarity index 100% rename from src/contracts/for_fail.ligo rename to src/test/contracts/for_fail.ligo diff --git a/src/contracts/incr_decr.mligo b/src/test/contracts/incr_decr.mligo similarity index 100% rename from src/contracts/incr_decr.mligo rename to src/test/contracts/incr_decr.mligo diff --git a/src/contracts/procedure.ligo b/src/test/contracts/procedure.ligo similarity index 100% rename from src/contracts/procedure.ligo rename to src/test/contracts/procedure.ligo diff --git a/src/contracts/website2.mligo b/src/test/contracts/website2.mligo similarity index 100% rename from src/contracts/website2.mligo rename to src/test/contracts/website2.mligo From 4a9150f5601b95043707851c54e84f75c125ccf2 Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Thu, 24 Oct 2019 09:58:33 +0200 Subject: [PATCH 10/51] WIP: Fixing a regression (blocks in case clauses as intructions). --- src/passes/1-parser/pascaligo/AST.ml | 2 +- src/passes/1-parser/pascaligo/AST.mli | 2 +- src/passes/1-parser/pascaligo/Parser.mly | 2 +- src/passes/1-parser/pascaligo/ParserLog.ml | 10 +++++----- src/passes/2-simplify/pascaligo.ml | 19 ++++++++++++++----- 5 files changed, 22 insertions(+), 13 deletions(-) diff --git a/src/passes/1-parser/pascaligo/AST.ml b/src/passes/1-parser/pascaligo/AST.ml index 35726f15b..177d654df 100644 --- a/src/passes/1-parser/pascaligo/AST.ml +++ b/src/passes/1-parser/pascaligo/AST.ml @@ -284,7 +284,7 @@ and var_decl = { and instruction = Cond of conditional reg -| CaseInstr of instruction case reg +| CaseInstr of if_clause case reg | Assign of assignment reg | Loop of loop | ProcCall of fun_call diff --git a/src/passes/1-parser/pascaligo/AST.mli b/src/passes/1-parser/pascaligo/AST.mli index a682a9cd1..520674a4b 100644 --- a/src/passes/1-parser/pascaligo/AST.mli +++ b/src/passes/1-parser/pascaligo/AST.mli @@ -275,7 +275,7 @@ and var_decl = { and instruction = Cond of conditional reg -| CaseInstr of instruction case reg +| CaseInstr of if_clause case reg | Assign of assignment reg | Loop of loop | ProcCall of fun_call diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index 77abea723..d6ef4bdae 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -566,7 +566,7 @@ clause_block: ShortBlock {value; region} } case_instr: - case(instruction) { $1 instr_to_region } + case(if_clause) { $1 if_clause_to_region } case(rhs): Case expr Of option(VBAR) cases(rhs) End { diff --git a/src/passes/1-parser/pascaligo/ParserLog.ml b/src/passes/1-parser/pascaligo/ParserLog.ml index 3941cbb79..d47e0065e 100644 --- a/src/passes/1-parser/pascaligo/ParserLog.ml +++ b/src/passes/1-parser/pascaligo/ParserLog.ml @@ -295,7 +295,7 @@ and print_clause_block buffer = function print_terminator buffer terminator; print_token buffer rbrace "}" -and print_case_instr buffer (node : instruction case) = +and print_case_instr buffer (node : if_clause case) = let {kwd_case; expr; opening; lead_vbar; cases; closing} = node in print_token buffer kwd_case "case"; @@ -314,9 +314,9 @@ and print_cases_instr buffer {value; _} = and print_case_clause_instr buffer {value; _} = let {pattern; arrow; rhs} = value in - print_pattern buffer pattern; - print_token buffer arrow "->"; - print_instruction buffer rhs + print_pattern buffer pattern; + print_token buffer arrow "->"; + print_if_clause buffer rhs and print_assignment buffer {value; _} = let {lhs; assign; rhs} = value in @@ -921,7 +921,7 @@ and pp_instruction buffer ~pad:(_,pc as pad) = function pp_conditional buffer ~pad value | CaseInstr {value; _} -> pp_node buffer ~pad "CaseInstr"; - pp_case pp_instruction buffer ~pad value + pp_case pp_if_clause buffer ~pad value | Assign {value; _} -> pp_node buffer ~pad "Assign"; pp_assignment buffer ~pad value diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 742c22eb7..1821627a4 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -708,15 +708,24 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul let (c , loc) = r_split c in let%bind expr = simpl_expression c.expr in let%bind cases = - let aux (x : Raw.instruction Raw.case_clause Raw.reg) = - let%bind i = simpl_instruction x.value.rhs in - let%bind i = i None in - ok (x.value.pattern, i) in + let aux (x : Raw.if_clause Raw.case_clause Raw.reg) = + let%bind case_clause = + match x.value.rhs with + ClauseInstr i -> + simpl_single_instruction i + | ClauseBlock b -> + match b with + LongBlock {value; _} -> + simpl_block value + | ShortBlock {value; _} -> + simpl_statements @@ fst value.inside in + ok (x.value.pattern, case_clause None) in bind_list @@ List.map aux @@ npseq_to_list c.cases.value in let%bind m = simpl_cases cases in - return_statement @@ e_matching ~loc expr m + let%bind toto = ok @@ e_matching ~loc expr m in + return_statement @@ toto ) | RecordPatch r -> ( let r = r.value in From c0f4aaf0c7f61605dfe4d30390c4105a0c42608b Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Thu, 24 Oct 2019 10:29:41 +0200 Subject: [PATCH 11/51] Fixed the regression on case clauses (blocks were removed). --- src/passes/2-simplify/pascaligo.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 1821627a4..64816920c 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -718,14 +718,14 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul LongBlock {value; _} -> simpl_block value | ShortBlock {value; _} -> - simpl_statements @@ fst value.inside in - ok (x.value.pattern, case_clause None) in + simpl_statements @@ fst value.inside in + let%bind case_clause = case_clause None in + ok (x.value.pattern, case_clause) in bind_list @@ List.map aux @@ npseq_to_list c.cases.value in let%bind m = simpl_cases cases in - let%bind toto = ok @@ e_matching ~loc expr m in - return_statement @@ toto + return_statement @@ e_matching ~loc expr m ) | RecordPatch r -> ( let r = r.value in From f68e91466e77fee3dc3fe46e8251f2c8ce2451f6 Mon Sep 17 00:00:00 2001 From: Pierre-Emmanuel Wulfman Date: Thu, 24 Oct 2019 13:04:16 +0000 Subject: [PATCH 12/51] Make install script works on archlinux --- scripts/install_build_environment.sh | 84 +++++++++++++++++--------- scripts/install_native_dependencies.sh | 39 ++++++++---- scripts/setup_switch.sh | 2 +- 3 files changed, 84 insertions(+), 41 deletions(-) diff --git a/scripts/install_build_environment.sh b/scripts/install_build_environment.sh index 958f855b1..0dd33f068 100755 --- a/scripts/install_build_environment.sh +++ b/scripts/install_build_environment.sh @@ -18,50 +18,76 @@ then fi fi +echo "Installing dependencies.." +if [ -n "`uname -a | grep -i arch`" ] +then + sudo pacman -Sy --noconfirm \ + make \ + m4 \ + gcc \ + patch \ + bubblewrap \ + rsync \ + curl +fi + +if [ -n "`uname -a | grep -i ubuntu`" ] +then sudo apt-get install -y make \ m4 \ gcc \ patch \ bubblewrap \ rsync \ - curl \ + curl +fi if [ -n "`uname -a | grep -i ubuntu`" ] then + echo "ubuntu" sudo add-apt-repository -y ppa:avsm/ppa sudo apt-get update sudo apt-get install opam else - # I'm going to assume here that we're on x86_64, 32-bit users should be basically - # extinct at this point right? - curl -L https://github.com/ocaml/opam/releases/download/2.0.4/opam-2.0.4-x86_64-linux \ - --output opam_temp_version_2_0_4.bin - if [ "`openssl sha256 -r opam_temp_version_2_0_4.bin`" = "373e34f92f282273d482537f8103caad0d17b6f2699ff504bed77f474cb0c951 *opam_temp_version_2_0_4.bin" ] + if [ -n "`uname -a | grep -i arch`" ] then - # Stay paranoid, in case other checks fail don't want to overrwrite - # user's opam on accident - chmod +x opam_temp_version_2_0_4.bin # Set execute so we can get version - if [ -e /usr/local/bin/opam ] - then - opam_old_v=`/usr/local/bin/opam --version` - opam_new_v=`opam_temp_version_2_0_4.bin --version` - read -p "This will overrwrite the opam you have in /usr/local/bin (version $opam_old_v) with version $opam_new_v, do you actually want to do that? Type yes. (yes/n)" choice2 - else - choice2="yes" - fi - if [ $choice2 = "yes" ] - then - sudo mv opam_temp_version_2_0_4.bin /usr/local/bin/opam - else - rm opam_temp_version_2_0_4.bin - exit - fi + echo "arch" + sudo pacman -Sy --noconfirm opam else - echo "opam file hash doesn't match what was recorded at time of signature verification!" - echo "(If you actually get this message, you should probably file an issue)" - echo "https://gitlab.com/ligolang/ligo/issues" - exit 1 - fi + echo "unknown distro" + #I'm going to assume here that we're on x86_64, 32-bit users should be basically + #extinct at this point right? + curl -L https://github.com/ocaml/opam/releases/download/2.0.4/opam-2.0.4-x86_64-linux \ + --output opam_temp_version_2_0_4.bin + if [ "`openssl sha256 -r opam_temp_version_2_0_4.bin`" = "373e34f92f282273d482537f8103caad0d17b6f2699ff504bed77f474cb0c951 *opam_temp_version_2_0_4.bin" ] + then + # Stay paranoid, in case other checks fail don't want to overrwrite + # user's opam on accident + chmod +x opam_temp_version_2_0_4.bin # Set execute so we can get version + if [ -e /usr/local/bin/opam ] + then + opam_old_v=`/usr/local/bin/opam --version` + opam_new_v=`opam_temp_version_2_0_4.bin --version` + read -p "This will overrwrite the opam you have in /usr/local/bin (version $opam_old_v) with version $opam_new_v, do you actually want to do that? Type yes. (yes/n)" choice2 + else + choice2="yes" + fi + if [ $choice2 = "yes" ] + then + sudo mv opam_temp_version_2_0_4.bin /usr/local/bin/opam + else + rm opam_temp_version_2_0_4.bin + exit + fi + else + echo "opam file hash doesn't match what was recorded at time of signature verification!" + echo "(If you actually get this message, you should probably file an issue)" + echo "https://gitlab.com/ligolang/ligo/issues" + exit 1 + fi + fi fi opam init -a --bare + + diff --git a/scripts/install_native_dependencies.sh b/scripts/install_native_dependencies.sh index 6b06f51ad..46e354711 100755 --- a/scripts/install_native_dependencies.sh +++ b/scripts/install_native_dependencies.sh @@ -1,14 +1,31 @@ #!/bin/sh set -e +. /etc/os-release -apt-get update -qq -apt-get -y -qq install \ - libev-dev \ - perl \ - pkg-config \ - libgmp-dev \ - libhidapi-dev \ - m4 \ - libcap-dev \ - bubblewrap \ - rsync +if [ $ID = arch ] +then + pacman -Sy + sudo pacman -S --noconfirm \ + libevdev \ + perl \ + pkg-config \ + gmp \ + hidapi \ + m4 \ + libcap \ + bubblewrap \ + rsync + +else + apt-get update -qq + apt-get -y -qq install \ + libev-dev \ + perl \ + pkg-config \ + libgmp-dev \ + libhidapi-dev \ + m4 \ + libcap-dev \ + bubblewrap \ + rsync +fi diff --git a/scripts/setup_switch.sh b/scripts/setup_switch.sh index ed1e839b2..ee1179109 100755 --- a/scripts/setup_switch.sh +++ b/scripts/setup_switch.sh @@ -2,5 +2,5 @@ set -e set -x -printf '' | opam switch create . 4.07.1 # toto ocaml-base-compiler.4.06.1 +printf '' | opam switch create . ocaml-base-compiler.4.07.1 # toto ocaml-base-compiler.4.06.1 eval $(opam config env) From 34ac419b82bcbfbf9ab6351b394ea938e4a0e6ef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jev=20Bj=C3=B6rsell?= Date: Thu, 24 Oct 2019 14:30:10 -0700 Subject: [PATCH 13/51] Update website url to point to new ligo web ide --- gitlab-pages/website/pages/en/index.js | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gitlab-pages/website/pages/en/index.js b/gitlab-pages/website/pages/en/index.js index bd86da348..6fa3459de 100644 --- a/gitlab-pages/website/pages/en/index.js +++ b/gitlab-pages/website/pages/en/index.js @@ -190,7 +190,7 @@ class HomeSplash extends React.Component {

{siteConfig.tagline}

{siteConfig.taglineSub}

Try Online From ef05b47dc6c90337609d87083034e4fee60ce6ba Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Fri, 25 Oct 2019 11:27:55 -0500 Subject: [PATCH 14/51] Typecheck address argument to get_contract --- src/passes/operators/operators.ml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml index 8a24cbe1f..ab4527bdc 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/operators/operators.ml @@ -398,7 +398,10 @@ module Typer = struct let%bind () = assert_eq_1 op_lst (t_list (t_operation ()) ()) in ok @@ (t_pair (t_operation ()) (t_address ()) ()) - let get_contract = typer_1_opt "CONTRACT" @@ fun _ tv_opt -> + let get_contract = typer_1_opt "CONTRACT" @@ fun addr_tv tv_opt -> + if not (type_value_eq (addr_tv, t_address ())) + then fail @@ simple_error (Format.asprintf "get_contract expects an address, got %a" PP.type_value addr_tv) + else let%bind tv = trace_option (simple_error "get_contract needs a type annotation") tv_opt in let%bind tv' = From ea661247b6e536022bc62129a1ef22a62f523b02 Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Fri, 25 Oct 2019 16:12:54 -0700 Subject: [PATCH 15/51] Add bitwise operators to CameLIGO Right now they're defined as '.bor' and '.band' because of a glitch in CameLIGO's parser where 'X.Y' leads to a parse error if Y is a keyword or reserved word in CameLIGO. --- src/passes/operators/operators.ml | 4 ++++ src/test/contracts/bitwise_arithmetic.mligo | 10 ++++++++++ src/test/integration_tests.ml | 19 ++++++++++++++++++- 3 files changed, 32 insertions(+), 1 deletion(-) create mode 100644 src/test/contracts/bitwise_arithmetic.mligo diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml index b0b74fa9a..9ba53c1b5 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/operators/operators.ml @@ -177,6 +177,10 @@ module Simplify = struct ("Big_map.literal" , "BIG_MAP_LITERAL" ) ; ("Big_map.empty" , "BIG_MAP_EMPTY" ) ; + ("Bitwise.bor" , "OR") ; + ("Bitwise.band" , "AND") ; + ("Bitwise.xor" , "XOR") ; + ("String.length", "SIZE") ; ("String.size", "SIZE") ; ("String.slice", "SLICE") ; diff --git a/src/test/contracts/bitwise_arithmetic.mligo b/src/test/contracts/bitwise_arithmetic.mligo new file mode 100644 index 000000000..81671b800 --- /dev/null +++ b/src/test/contracts/bitwise_arithmetic.mligo @@ -0,0 +1,10 @@ +(* Test CameLIGO bitwise operators *) + +let or_op (n : nat) : nat = + Bitwise.bor n 4p + +let and_op (n : nat) : nat = + Bitwise.band n 7p + +let xor_op (n : nat) : nat = + Bitwise.xor n 7p diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 09e511322..ed60a0966 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -194,6 +194,22 @@ let bitwise_arithmetic () : unit result = let%bind () = expect_eq program "xor_op" (e_nat 7) (e_nat 0) in ok () +let bitwise_arithmetic_mligo () : unit result = + let%bind program = mtype_file "./contracts/bitwise_arithmetic.mligo" in + let%bind () = expect_eq program "or_op" (e_nat 7) (e_nat 7) in + let%bind () = expect_eq program "or_op" (e_nat 3) (e_nat 7) in + let%bind () = expect_eq program "or_op" (e_nat 2) (e_nat 6) in + let%bind () = expect_eq program "or_op" (e_nat 14) (e_nat 14) in + let%bind () = expect_eq program "or_op" (e_nat 10) (e_nat 14) in + let%bind () = expect_eq program "and_op" (e_nat 7) (e_nat 7) in + let%bind () = expect_eq program "and_op" (e_nat 3) (e_nat 3) in + let%bind () = expect_eq program "and_op" (e_nat 2) (e_nat 2) in + let%bind () = expect_eq program "and_op" (e_nat 14) (e_nat 6) in + let%bind () = expect_eq program "and_op" (e_nat 10) (e_nat 2) in + let%bind () = expect_eq program "xor_op" (e_nat 0) (e_nat 7) in + let%bind () = expect_eq program "xor_op" (e_nat 7) (e_nat 0) in + ok () + let string_arithmetic () : unit result = let%bind program = type_file "./contracts/string_arithmetic.ligo" in let%bind () = expect_eq program "concat_op" (e_string "foo") (e_string "foototo") in @@ -960,7 +976,8 @@ let main = test_suite "Integration (End to End)" [ test "multiple parameters" multiple_parameters ; test "bool" bool_expression ; test "arithmetic" arithmetic ; - test "bitiwse_arithmetic" bitwise_arithmetic ; + test "bitwise_arithmetic" bitwise_arithmetic ; + test "bitwise_arithmetic (mligo)" bitwise_arithmetic_mligo; test "string_arithmetic" string_arithmetic ; test "string_arithmetic (mligo)" string_arithmetic_mligo ; test "bytes_arithmetic" bytes_arithmetic ; From b3993d0db95f2ed6b47659862ae7f9e5eb53d06e Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Fri, 25 Oct 2019 17:24:12 -0700 Subject: [PATCH 16/51] Add failing negative operator --- src/test/contracts/arithmetic.mligo | 6 ++++++ src/test/integration_tests.ml | 10 ++++++++++ 2 files changed, 16 insertions(+) create mode 100644 src/test/contracts/arithmetic.mligo diff --git a/src/test/contracts/arithmetic.mligo b/src/test/contracts/arithmetic.mligo new file mode 100644 index 000000000..0e5f01587 --- /dev/null +++ b/src/test/contracts/arithmetic.mligo @@ -0,0 +1,6 @@ +// Test CameLIGO arithmetic operators + +let neg_op (n : int) : int = + -n + + diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 09e511322..7c800c63d 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -178,6 +178,15 @@ let arithmetic () : unit result = let%bind () = expect_eq_n_pos program "div_op" e_int (fun n -> e_int (n / 2)) in ok () +let arithmetic_mligo () : unit result = + let%bind program = mtype_file "./contracts/arithmetic.mligo" in + let%bind _ = + let aux (name , f) = expect_eq_n_int program name f in + bind_map_list aux [ + ("neg_op", fun n -> (-n)) ; + ] in + ok () + let bitwise_arithmetic () : unit result = let%bind program = type_file "./contracts/bitwise_arithmetic.ligo" in let%bind () = expect_eq program "or_op" (e_nat 7) (e_nat 7) in @@ -960,6 +969,7 @@ let main = test_suite "Integration (End to End)" [ test "multiple parameters" multiple_parameters ; test "bool" bool_expression ; test "arithmetic" arithmetic ; + test "arithmetic (mligo)" arithmetic_mligo ; test "bitiwse_arithmetic" bitwise_arithmetic ; test "string_arithmetic" string_arithmetic ; test "string_arithmetic (mligo)" string_arithmetic_mligo ; From 0191d8b0edc03527de8462bd6f6dfe71072a2f90 Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Sun, 27 Oct 2019 11:50:24 -0500 Subject: [PATCH 17/51] Replace "mtz" with "mutez" --- .../docs/language-basics/cheat-sheet.md | 7 +++-- gitlab-pages/docs/language-basics/types.md | 6 ++-- .../get-started/tezos-taco-shop-payout.md | 4 +-- .../tezos-taco-shop-smart-contract.md | 28 +++++++++---------- src/passes/1-parser/ligodity/AST.ml | 4 +-- src/passes/1-parser/ligodity/AST.mli | 2 +- src/passes/1-parser/ligodity/LexToken.mli | 4 +-- src/passes/1-parser/ligodity/LexToken.mll | 16 +++++------ src/passes/1-parser/ligodity/ParToken.mly | 2 +- src/passes/1-parser/ligodity/Parser.mly | 2 +- src/passes/1-parser/ligodity/ParserLog.ml | 4 +-- src/passes/1-parser/pascaligo/AST.ml | 4 +-- src/passes/1-parser/pascaligo/AST.mli | 2 +- .../1-parser/pascaligo/Doc/pascaligo.md | 10 +++---- .../1-parser/pascaligo/Doc/pascaligo_01.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_02.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_03.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_04.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_05.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_06.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_07.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_08.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_09.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_10.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_11.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_12.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_13.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_14.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_15.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_16.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_17.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_18.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_19.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_20.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_21.bnf | 2 +- .../1-parser/pascaligo/Doc/pascaligo_22.bnf | 2 +- src/passes/1-parser/pascaligo/LexToken.mli | 4 +-- src/passes/1-parser/pascaligo/LexToken.mll | 16 +++++------ src/passes/1-parser/pascaligo/ParToken.mly | 2 +- src/passes/1-parser/pascaligo/Parser.mly | 2 +- src/passes/1-parser/pascaligo/ParserLog.ml | 6 ++-- src/passes/1-parser/pascaligo/SParser.ml | 2 +- src/passes/1-parser/shared/Lexer.mli | 2 +- src/passes/1-parser/shared/Lexer.mll | 18 ++++++------ src/passes/2-simplify/ligodity.ml | 2 +- src/passes/2-simplify/pascaligo.ml | 2 +- src/stages/ast_simplified/PP.ml | 2 +- src/stages/ast_typed/PP.ml | 2 +- src/stages/mini_c/PP.ml | 2 +- src/test/contracts/tez.ligo | 22 +++++++-------- src/test/contracts/tez.mligo | 2 +- 51 files changed, 113 insertions(+), 112 deletions(-) diff --git a/gitlab-pages/docs/language-basics/cheat-sheet.md b/gitlab-pages/docs/language-basics/cheat-sheet.md index c754d039f..a93cd6efd 100644 --- a/gitlab-pages/docs/language-basics/cheat-sheet.md +++ b/gitlab-pages/docs/language-basics/cheat-sheet.md @@ -17,7 +17,7 @@ title: Cheat Sheet |Unit| `unit`| |Boolean|
const hasDriversLicense: bool = False;
const adult: bool = True;
| |Boolean Logic|
(not True) == False == (False and True) == (False or False)
| -|Mutez (micro tez)| `42mtz`, `7mtz` | +|Mutez (micro tez)| `42mutez`, `7mutez` | |Address | `"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"`, `"KT1JepfBfMSqkQyf9B1ndvURghGsSB8YCLMD"`| |Addition |`3 + 4`, `3n + 4n`| |Multiplication & Division| `3 * 4`, `3n * 4n`, `10 / 5`, `10n / 5n`| @@ -35,11 +35,12 @@ title: Cheat Sheet |Variants|
type action is
| Increment of int
| Decrement of int
| |Variant *(pattern)* matching|
const a: action = Increment(5);
case a of
| Increment(n) -> n + 1
| Decrement(n) -> n - 1
end
| |Records|
type person is record
  age: int ;
  name: string ;
end

const john : person = record
  age = 18;
  name = "John Doe";
end

const name: string = john.name;
| -|Maps|
type prices is map(nat, tez);

const prices : prices = map
  10n -> 60mtz;
  50n -> 30mtz;
  100n -> 10mtz;
end

const price: option(tez) = prices[50n];

prices[200n] := 5mtz;
| +|Maps|
type prices is map(nat, tez);

const prices : prices = map
  10n -> 60mutez;
  50n -> 30mutez;
  100n -> 10mutez;
end

const price: option(tez) = prices[50n];

prices[200n] := 5mutez;
| |Contracts & Accounts|
const destinationAddress : address = "tz1...";
const contract : contract(unit) = get_contract(destinationAddress);
| |Transactions|
const payment : operation = transaction(unit, amount, receiver);
| |Exception/Failure|`fail("Your descriptive error message for the user goes here.")`| + - \ No newline at end of file + diff --git a/gitlab-pages/docs/language-basics/types.md b/gitlab-pages/docs/language-basics/types.md index 957b6b6c8..501f77544 100644 --- a/gitlab-pages/docs/language-basics/types.md +++ b/gitlab-pages/docs/language-basics/types.md @@ -31,7 +31,7 @@ const dogBreed: animalBreed = "Saluki"; type accountBalances is map(address, tez); const ledger: accountBalances = map - ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) -> 10mtz + ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) -> 10mutez end ``` @@ -60,10 +60,10 @@ end type accountBalances is map(account, accountData); // pseudo-JSON representation of our map -// { "tz1...": {balance: 10mtz, numberOfTransactions: 5n} } +// { "tz1...": {balance: 10mutez, numberOfTransactions: 5n} } const ledger: accountBalances = map ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) -> record - balance = 10mtz; + balance = 10mutez; numberOfTransactions = 5n; end end diff --git a/gitlab-pages/docs/tutorials/get-started/tezos-taco-shop-payout.md b/gitlab-pages/docs/tutorials/get-started/tezos-taco-shop-payout.md index f0d70fe4a..ffc6e5687 100644 --- a/gitlab-pages/docs/tutorials/get-started/tezos-taco-shop-payout.md +++ b/gitlab-pages/docs/tutorials/get-started/tezos-taco-shop-payout.md @@ -134,11 +134,11 @@ To confirm that our contract is valid, we can dry run it. As a result we see a * ligo dry-run taco-shop.ligo --syntax pascaligo --amount 1 buy_taco 1n "map 1n -> record current_stock = 50n; - max_price = 50000000mtz; + max_price = 50000000mutez; end; 2n -> record current_stock = 20n; - max_price = 75000000mtz; + max_price = 75000000mutez; end; end" ``` diff --git a/gitlab-pages/docs/tutorials/get-started/tezos-taco-shop-smart-contract.md b/gitlab-pages/docs/tutorials/get-started/tezos-taco-shop-smart-contract.md index 8dadb49cd..59ea39198 100644 --- a/gitlab-pages/docs/tutorials/get-started/tezos-taco-shop-smart-contract.md +++ b/gitlab-pages/docs/tutorials/get-started/tezos-taco-shop-smart-contract.md @@ -28,8 +28,8 @@ Each taco kind, has its own `max_price` that it sells for, and a finite supply f |**kind** |id |**available_stock**| **max_price**| |---|---|---|---| -|el clásico | `1n` | `50n` | `50000000mtz` | -|especial del chef | `2n` | `20n` | `75000000mtz` | +|el clásico | `1n` | `50n` | `50000000mutez` | +|especial del chef | `2n` | `20n` | `75000000mutez` | ### Calculating the current purchase price @@ -42,16 +42,16 @@ current_purchase_price = max_price / available_stock #### El clásico |**available_stock**|**max_price**|**current_purchase_price**| |---|---|---| -| `50n` | `50000000mtz` | `1tz`| -| `20n` | `50000000mtz` | `2.5tz` | -| `5n` | `50000000mtz` | `10tz` | +| `50n` | `50000000mutez` | `1tz`| +| `20n` | `50000000mutez` | `2.5tz` | +| `5n` | `50000000mutez` | `10tz` | #### Especial del chef |**available_stock**|**max_price**|**current_purchase_price**| |---|---|---| -| `20n` | `75000000mtz` | `3.75tz` | -| `10n` | `75000000mtz` | `7.5tz`| -| `5n` | `75000000mtz` | `15tz` | +| `20n` | `75000000mutez` | `3.75tz` | +| `10n` | `75000000mutez` | `7.5tz`| +| `5n` | `75000000mutez` | `15tz` | --- @@ -161,11 +161,11 @@ When dry-running a contract, it's crucial to provide a correct initial storage v map 1n -> record current_stock = 50n; - max_price = 50000000mtz; + max_price = 50000000mutez; end; 2n -> record current_stock = 20n; - max_price = 75000000mtz; + max_price = 75000000mutez; end; end ``` @@ -177,11 +177,11 @@ end ligo dry-run taco-shop.ligo --syntax pascaligo main unit "map 1n -> record current_stock = 50n; - max_price = 50000000mtz; + max_price = 50000000mutez; end; 2n -> record current_stock = 20n; - max_price = 75000000mtz; + max_price = 75000000mutez; end; end" ``` @@ -298,11 +298,11 @@ In order to test the `amount` sent, we'll use the `--amount` option of `dry-run` ligo dry-run taco-shop.ligo --syntax pascaligo --amount 1 buy_taco 1n "map 1n -> record current_stock = 50n; - max_price = 50000000mtz; + max_price = 50000000mutez; end; 2n -> record current_stock = 20n; - max_price = 75000000mtz; + max_price = 75000000mutez; end; end" ``` diff --git a/src/passes/1-parser/ligodity/AST.ml b/src/passes/1-parser/ligodity/AST.ml index ae4729117..94c26b736 100644 --- a/src/passes/1-parser/ligodity/AST.ml +++ b/src/passes/1-parser/ligodity/AST.ml @@ -260,7 +260,7 @@ and arith_expr = | Neg of minus un_op reg | Int of (string * Z.t) reg | Nat of (string * Z.t) reg -| Mtz of (string * Z.t) reg +| Mutez of (string * Z.t) reg and logic_expr = BoolExpr of bool_expr @@ -391,7 +391,7 @@ let logic_expr_to_region = function let arith_expr_to_region = function Add {region;_} | Sub {region;_} | Mult {region;_} | Div {region;_} | Mod {region;_} | Neg {region;_} -| Int {region;_} | Mtz {region; _} +| Int {region;_} | Mutez {region; _} | Nat {region; _} -> region let string_expr_to_region = function diff --git a/src/passes/1-parser/ligodity/AST.mli b/src/passes/1-parser/ligodity/AST.mli index 3e4001536..39eed2441 100644 --- a/src/passes/1-parser/ligodity/AST.mli +++ b/src/passes/1-parser/ligodity/AST.mli @@ -265,7 +265,7 @@ and arith_expr = | Neg of minus un_op reg (* -e *) | Int of (string * Z.t) reg (* 12345 *) | Nat of (string * Z.t) reg (* 3p *) -| Mtz of (string * Z.t) reg (* 1.00tz 3tz *) +| Mutez of (string * Z.t) reg (* 1.00tz 3tz *) and logic_expr = BoolExpr of bool_expr diff --git a/src/passes/1-parser/ligodity/LexToken.mli b/src/passes/1-parser/ligodity/LexToken.mli index ea4f0a6ad..b58bcece1 100644 --- a/src/passes/1-parser/ligodity/LexToken.mli +++ b/src/passes/1-parser/ligodity/LexToken.mli @@ -82,7 +82,7 @@ type t = | Constr of string Region.reg | Int of (string * Z.t) Region.reg | Nat of (string * Z.t) Region.reg -| Mtz of (string * Z.t) Region.reg +| Mutez of (string * Z.t) Region.reg | Str of string Region.reg | Bytes of (string * Hex.t) Region.reg @@ -145,7 +145,7 @@ type sym_err = Invalid_symbol val mk_int : lexeme -> Region.t -> (token, int_err) result val mk_nat : lexeme -> Region.t -> (token, nat_err) result -val mk_mtz : lexeme -> Region.t -> (token, int_err) result +val mk_mutez : lexeme -> Region.t -> (token, int_err) result val mk_ident : lexeme -> Region.t -> (token, ident_err) result val mk_sym : lexeme -> Region.t -> (token, sym_err) result val mk_string : lexeme -> Region.t -> token diff --git a/src/passes/1-parser/ligodity/LexToken.mll b/src/passes/1-parser/ligodity/LexToken.mll index 2c437d15c..e286ff245 100644 --- a/src/passes/1-parser/ligodity/LexToken.mll +++ b/src/passes/1-parser/ligodity/LexToken.mll @@ -64,7 +64,7 @@ type t = | Constr of string Region.reg | Int of (string * Z.t) Region.reg | Nat of (string * Z.t) Region.reg -| Mtz of (string * Z.t) Region.reg +| Mutez of (string * Z.t) Region.reg | Str of string Region.reg | Bytes of (string * Hex.t) Region.reg @@ -141,8 +141,8 @@ let proj_token = function region, sprintf "Int (\"%s\", %s)" s (Z.to_string n) | Nat Region.{region; value = s,n} -> region, sprintf "Nat (\"%s\", %s)" s (Z.to_string n) - | Mtz Region.{region; value = s,n} -> - region, sprintf "Mtz (\"%s\", %s)" s (Z.to_string n) + | Mutez Region.{region; value = s,n} -> + region, sprintf "Mutez (\"%s\", %s)" s (Z.to_string n) | Str Region.{region; value} -> region, sprintf "Str %s" value | Bytes Region.{region; value = s,b} -> @@ -202,7 +202,7 @@ let to_lexeme = function | Constr id -> id.Region.value | Int i | Nat i - | Mtz i -> fst i.Region.value + | Mutez i -> fst i.Region.value | Str s -> s.Region.value | Bytes b -> fst b.Region.value | Begin _ -> "begin" @@ -396,14 +396,14 @@ let mk_nat lexeme region = else Ok (Nat Region.{region; value = lexeme, z}) ) -let mk_mtz lexeme region = +let mk_mutez lexeme region = let z = Str.(global_replace (regexp "_") "" lexeme) |> - Str.(global_replace (regexp "mtz") "") |> + Str.(global_replace (regexp "mutez") "") |> Z.of_string in - if Z.equal z Z.zero && lexeme <> "0mtz" + if Z.equal z Z.zero && lexeme <> "0mutez" then Error Non_canonical_zero - else Ok (Mtz Region.{region; value = lexeme, z}) + else Ok (Mutez Region.{region; value = lexeme, z}) let eof region = EOF region diff --git a/src/passes/1-parser/ligodity/ParToken.mly b/src/passes/1-parser/ligodity/ParToken.mly index 342f36953..b64d1ca3a 100644 --- a/src/passes/1-parser/ligodity/ParToken.mly +++ b/src/passes/1-parser/ligodity/ParToken.mly @@ -42,7 +42,7 @@ %token <(string * Z.t) Region.reg> Int %token <(string * Z.t) Region.reg> Nat -%token <(string * Z.t) Region.reg> Mtz +%token <(string * Z.t) Region.reg> Mutez (*%token And*) %token Begin diff --git a/src/passes/1-parser/ligodity/Parser.mly b/src/passes/1-parser/ligodity/Parser.mly index 0c8a5fbac..be1baced3 100644 --- a/src/passes/1-parser/ligodity/Parser.mly +++ b/src/passes/1-parser/ligodity/Parser.mly @@ -761,7 +761,7 @@ call_expr: core_expr: Int { EArith (Int $1) } -| Mtz { EArith (Mtz $1) } +| Mutez { EArith (Mutez $1) } | Nat { EArith (Nat $1) } | Ident | module_field { EVar $1 } | projection { EProj $1 } diff --git a/src/passes/1-parser/ligodity/ParserLog.ml b/src/passes/1-parser/ligodity/ParserLog.ml index 299b2a392..29c13e6ad 100644 --- a/src/passes/1-parser/ligodity/ParserLog.ml +++ b/src/passes/1-parser/ligodity/ParserLog.ml @@ -321,8 +321,8 @@ and print_arith_expr buffer = function | Int {region; value=lex,z} -> let line = sprintf "Int %s (%s)" lex (Z.to_string z) in print_token buffer region line -| Mtz {region; value=lex,z} -> - let line = sprintf "Mtz %s (%s)" lex (Z.to_string z) +| Mutez {region; value=lex,z} -> + let line = sprintf "Mutez %s (%s)" lex (Z.to_string z) in print_token buffer region line | Nat {region; value=lex,z} -> let line = sprintf "Nat %s (%s)" lex (Z.to_string z) diff --git a/src/passes/1-parser/pascaligo/AST.ml b/src/passes/1-parser/pascaligo/AST.ml index dad883dc1..14d2e02e1 100644 --- a/src/passes/1-parser/pascaligo/AST.ml +++ b/src/passes/1-parser/pascaligo/AST.ml @@ -547,7 +547,7 @@ and arith_expr = | Neg of minus un_op reg | Int of (Lexer.lexeme * Z.t) reg | Nat of (Lexer.lexeme * Z.t) reg -| Mtz of (Lexer.lexeme * Z.t) reg +| Mutez of (Lexer.lexeme * Z.t) reg and string_expr = Cat of cat bin_op reg @@ -689,7 +689,7 @@ and arith_expr_to_region = function | Neg {region; _} | Int {region; _} | Nat {region; _} -| Mtz {region; _} -> region +| Mutez {region; _} -> region and string_expr_to_region = function Cat {region; _} diff --git a/src/passes/1-parser/pascaligo/AST.mli b/src/passes/1-parser/pascaligo/AST.mli index e3509c1d7..418d422d3 100644 --- a/src/passes/1-parser/pascaligo/AST.mli +++ b/src/passes/1-parser/pascaligo/AST.mli @@ -538,7 +538,7 @@ and arith_expr = | Neg of minus un_op reg | Int of (Lexer.lexeme * Z.t) reg | Nat of (Lexer.lexeme * Z.t) reg -| Mtz of (Lexer.lexeme * Z.t) reg +| Mutez of (Lexer.lexeme * Z.t) reg and string_expr = Cat of cat bin_op reg diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo.md b/src/passes/1-parser/pascaligo/Doc/pascaligo.md index 8680138a8..5bb9044c3 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo.md +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo.md @@ -340,10 +340,10 @@ and the canonical form of zero is `0n`. * The last kind of native numerical type is `tez`, which is a unit of measure of the amounts (fees, accounts). Beware: the literals of the -type `tez` are annotated with the suffix `mtz`, which stands for -millionth of Tez, for instance, `0mtz` or `1200000mtz`. The same handy -use of underscores as in natural literals help in the writing, like -`1_200_000mtz`. +type `tez` are annotated with the suffix `mutez`, which stands for +millionth of Tez, for instance, `0mutez` or `1200000mutez`. The same +handy use of underscores as in natural literals help in the writing, +like `1_200_000mutez`. To see how numerical types can be used in expressions see the sections "Predefined operators" and "Predefined values". @@ -832,7 +832,7 @@ example, in verbose style: A value of that type could be record - goal = 10mtz; + goal = 10mutez; deadline = "..."; backers = map end; funded = False diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_01.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_01.bnf index d7c05f76d..169764eff 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_01.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_01.bnf @@ -331,7 +331,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | var | String | Bytes diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_02.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_02.bnf index a8fd7f688..7abf65aa1 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_02.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_02.bnf @@ -337,7 +337,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | var | String | Bytes diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_03.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_03.bnf index f7893cf6d..bc52b864d 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_03.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_03.bnf @@ -317,7 +317,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | String | Bytes diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_04.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_04.bnf index 5f344787a..dac66db62 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_04.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_04.bnf @@ -295,7 +295,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | String | Bytes diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_05.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_05.bnf index d88b74f78..9dd951d94 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_05.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_05.bnf @@ -289,7 +289,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | String | Bytes diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_06.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_06.bnf index f16a91dba..cd4c7751d 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_06.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_06.bnf @@ -292,7 +292,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | String | Bytes diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_07.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_07.bnf index a6d801368..d972db4ae 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_07.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_07.bnf @@ -279,7 +279,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | String | Bytes diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_08.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_08.bnf index f459f2193..5d3bbe886 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_08.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_08.bnf @@ -284,7 +284,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | String | Bytes diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_09.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_09.bnf index 0b15db3ac..1576befbc 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_09.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_09.bnf @@ -288,7 +288,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | String | Bytes diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_10.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_10.bnf index ae956b3c7..b167eb01a 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_10.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_10.bnf @@ -283,7 +283,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | String | Bytes diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_11.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_11.bnf index 569b16392..ede2ceacd 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_11.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_11.bnf @@ -281,7 +281,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | Ident (* var *) brackets(expr) (* lookup *) | Ident (* struct_name *) DOT nsepseq(selection,DOT) brackets(expr) (* lookup *) diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_12.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_12.bnf index 47c399337..bded0f013 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_12.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_12.bnf @@ -285,7 +285,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | Ident (* var *) brackets(expr) (* lookup *) | Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr)) diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_13.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_13.bnf index 7b8146e1c..52ac22ba0 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_13.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_13.bnf @@ -285,7 +285,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | Ident (* var *) brackets(expr) (* lookup *) | Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr)) diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_14.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_14.bnf index 4973e59b6..69a710b79 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_14.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_14.bnf @@ -285,7 +285,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | Ident (* var *) brackets(expr) (* lookup *) | Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr)) diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_15.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_15.bnf index 3f26f6494..b3713e285 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_15.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_15.bnf @@ -285,7 +285,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | Ident (* var *) brackets(expr) (* lookup *) | Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr)) diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_16.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_16.bnf index ab6844335..e50db4584 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_16.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_16.bnf @@ -285,7 +285,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | Ident (* var *) brackets(expr) (* lookup *) | Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr)) diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_17.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_17.bnf index 7a1f4c926..09cefcc77 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_17.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_17.bnf @@ -285,7 +285,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | Ident (* var *) brackets(expr) (* lookup *) | Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr)) diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_18.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_18.bnf index 6d7911a23..0cd754062 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_18.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_18.bnf @@ -285,7 +285,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | Ident (* var *) brackets(expr) (* lookup *) | Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr)) diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_19.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_19.bnf index 937290d18..8ca3db982 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_19.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_19.bnf @@ -285,7 +285,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | Ident (* var *) brackets(expr) (* lookup *) | Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr)) diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_20.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_20.bnf index 3afe57b98..cdb3cb15a 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_20.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_20.bnf @@ -270,7 +270,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident (* var *) | Ident (* var *) brackets(expr) (* lookup *) | Ident (* struct_name *) DOT nsepseq(selection,DOT) option(brackets(expr)) diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_21.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_21.bnf index d99ef835b..a9a825601 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_21.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_21.bnf @@ -291,7 +291,7 @@ unary_expr ::= core_expr ::= Int | Nat -| Mtz +| Mutez | Ident option(core_suffix) | String | Bytes diff --git a/src/passes/1-parser/pascaligo/Doc/pascaligo_22.bnf b/src/passes/1-parser/pascaligo/Doc/pascaligo_22.bnf index 6eb0e8dc1..93924bb5c 100644 --- a/src/passes/1-parser/pascaligo/Doc/pascaligo_22.bnf +++ b/src/passes/1-parser/pascaligo/Doc/pascaligo_22.bnf @@ -349,7 +349,7 @@ XXX core_expr ::= Int | Nat -| Mtz +| Mutez | Ident option(core_suffix) | String | Bytes diff --git a/src/passes/1-parser/pascaligo/LexToken.mli b/src/passes/1-parser/pascaligo/LexToken.mli index 1f94e166f..f569dc6a2 100644 --- a/src/passes/1-parser/pascaligo/LexToken.mli +++ b/src/passes/1-parser/pascaligo/LexToken.mli @@ -35,7 +35,7 @@ type t = | Bytes of (lexeme * Hex.t) Region.reg | Int of (lexeme * Z.t) Region.reg | Nat of (lexeme * Z.t) Region.reg -| Mtz of (lexeme * Z.t) Region.reg +| Mutez of (lexeme * Z.t) Region.reg | Ident of lexeme Region.reg | Constr of lexeme Region.reg @@ -145,7 +145,7 @@ type sym_err = Invalid_symbol val mk_int : lexeme -> Region.t -> (token, int_err) result val mk_nat : lexeme -> Region.t -> (token, nat_err) result -val mk_mtz : lexeme -> Region.t -> (token, int_err) result +val mk_mutez : lexeme -> Region.t -> (token, int_err) result val mk_ident : lexeme -> Region.t -> (token, ident_err) result val mk_sym : lexeme -> Region.t -> (token, sym_err) result val mk_string : lexeme -> Region.t -> token diff --git a/src/passes/1-parser/pascaligo/LexToken.mll b/src/passes/1-parser/pascaligo/LexToken.mll index c27abbb12..44922ee8c 100644 --- a/src/passes/1-parser/pascaligo/LexToken.mll +++ b/src/passes/1-parser/pascaligo/LexToken.mll @@ -33,7 +33,7 @@ type t = | Bytes of (lexeme * Hex.t) Region.reg | Int of (lexeme * Z.t) Region.reg | Nat of (lexeme * Z.t) Region.reg -| Mtz of (lexeme * Z.t) Region.reg +| Mutez of (lexeme * Z.t) Region.reg | Ident of lexeme Region.reg | Constr of lexeme Region.reg @@ -160,8 +160,8 @@ let proj_token = function | Nat Region.{region; value = s,n} -> region, sprintf "Nat (\"%s\", %s)" s (Z.to_string n) -| Mtz Region.{region; value = s,n} -> - region, sprintf "Mtz (\"%s\", %s)" s (Z.to_string n) +| Mutez Region.{region; value = s,n} -> + region, sprintf "Mutez (\"%s\", %s)" s (Z.to_string n) | Ident Region.{region; value} -> region, sprintf "Ident \"%s\"" value @@ -258,7 +258,7 @@ let to_lexeme = function | Bytes b -> fst b.Region.value | Int i | Nat i -| Mtz i -> fst i.Region.value +| Mutez i -> fst i.Region.value | Ident id | Constr id -> id.Region.value @@ -497,14 +497,14 @@ let mk_nat lexeme region = else Ok (Nat Region.{region; value = lexeme, z}) ) -let mk_mtz lexeme region = +let mk_mutez lexeme region = let z = Str.(global_replace (regexp "_") "" lexeme) |> - Str.(global_replace (regexp "mtz") "") |> + Str.(global_replace (regexp "mutez") "") |> Z.of_string in - if Z.equal z Z.zero && lexeme <> "0mtz" + if Z.equal z Z.zero && lexeme <> "0mutez" then Error Non_canonical_zero - else Ok (Mtz Region.{region; value = lexeme, z}) + else Ok (Mutez Region.{region; value = lexeme, z}) let eof region = EOF region diff --git a/src/passes/1-parser/pascaligo/ParToken.mly b/src/passes/1-parser/pascaligo/ParToken.mly index c236def9e..9d3d14e10 100644 --- a/src/passes/1-parser/pascaligo/ParToken.mly +++ b/src/passes/1-parser/pascaligo/ParToken.mly @@ -9,7 +9,7 @@ %token <(LexToken.lexeme * Hex.t) Region.reg> Bytes %token <(LexToken.lexeme * Z.t) Region.reg> Int %token <(LexToken.lexeme * Z.t) Region.reg> Nat -%token <(LexToken.lexeme * Z.t) Region.reg> Mtz +%token <(LexToken.lexeme * Z.t) Region.reg> Mutez %token Ident %token Constr diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index fb70ac8f8..a23fb5e9a 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -856,7 +856,7 @@ unary_expr: core_expr: Int { EArith (Int $1) } | Nat { EArith (Nat $1) } -| Mtz { EArith (Mtz $1) } +| Mutez { EArith (Mutez $1) } | var { EVar $1 } | String { EString (String $1) } | Bytes { EBytes $1 } diff --git a/src/passes/1-parser/pascaligo/ParserLog.ml b/src/passes/1-parser/pascaligo/ParserLog.ml index 6127b79d3..c6940bdee 100644 --- a/src/passes/1-parser/pascaligo/ParserLog.ml +++ b/src/passes/1-parser/pascaligo/ParserLog.ml @@ -527,7 +527,7 @@ and print_arith_expr buffer = function print_expr buffer arg | Int i | Nat i -| Mtz i -> print_int buffer i +| Mutez i -> print_int buffer i and print_string_expr buffer = function Cat {value = {arg1; op; arg2}; _} -> @@ -1391,8 +1391,8 @@ and pp_arith_expr buffer ~pad:(_,pc as pad) = function | Nat {value; _} -> pp_node buffer ~pad "Nat"; pp_int buffer ~pad value -| Mtz {value; _} -> - pp_node buffer ~pad "Mtz"; +| Mutez {value; _} -> + pp_node buffer ~pad "Mutez"; pp_int buffer ~pad value and pp_set_expr buffer ~pad:(_,pc as pad) = function diff --git a/src/passes/1-parser/pascaligo/SParser.ml b/src/passes/1-parser/pascaligo/SParser.ml index faa9780ed..70dc5166b 100644 --- a/src/passes/1-parser/pascaligo/SParser.ml +++ b/src/passes/1-parser/pascaligo/SParser.ml @@ -312,7 +312,7 @@ and unary_expr = parser and core_expr = parser [< 'Int _ >] -> () | [< 'Nat _ >] -> () -| [< 'Mtz _ >] -> () +| [< 'Mutez _ >] -> () | [< 'Ident _; _ = opt core_suffix >] -> () | [< 'String _ >] -> () | [< 'Bytes _ >] -> () diff --git a/src/passes/1-parser/shared/Lexer.mli b/src/passes/1-parser/shared/Lexer.mli index 8f56ac87e..cc0359998 100644 --- a/src/passes/1-parser/shared/Lexer.mli +++ b/src/passes/1-parser/shared/Lexer.mli @@ -70,7 +70,7 @@ module type TOKEN = val mk_int : lexeme -> Region.t -> (token, int_err) result val mk_nat : lexeme -> Region.t -> (token, nat_err) result - val mk_mtz : lexeme -> Region.t -> (token, int_err) result + val mk_mutez : lexeme -> Region.t -> (token, int_err) result val mk_ident : lexeme -> Region.t -> (token, ident_err) result val mk_sym : lexeme -> Region.t -> (token, sym_err) result val mk_string : lexeme -> Region.t -> token diff --git a/src/passes/1-parser/shared/Lexer.mll b/src/passes/1-parser/shared/Lexer.mll index 012d8b6b6..3f2ac2020 100644 --- a/src/passes/1-parser/shared/Lexer.mll +++ b/src/passes/1-parser/shared/Lexer.mll @@ -111,7 +111,7 @@ module type TOKEN = val mk_int : lexeme -> Region.t -> (token, int_err) result val mk_nat : lexeme -> Region.t -> (token, nat_err) result - val mk_mtz : lexeme -> Region.t -> (token, int_err) result + val mk_mutez : lexeme -> Region.t -> (token, int_err) result val mk_ident : lexeme -> Region.t -> (token, ident_err) result val mk_sym : lexeme -> Region.t -> (token, sym_err) result val mk_string : lexeme -> Region.t -> token @@ -436,9 +436,9 @@ module Make (Token: TOKEN) : (S with module Token = Token) = | Error Token.Invalid_natural -> fail region Invalid_natural - let mk_mtz state buffer = + let mk_mutez state buffer = let region, lexeme, state = sync state buffer in - match Token.mk_mtz lexeme region with + match Token.mk_mutez lexeme region with Ok token -> token, state | Error Token.Non_canonical_zero -> fail region Non_canonical_zero @@ -447,7 +447,7 @@ module Make (Token: TOKEN) : (S with module Token = Token) = let region, lexeme, state = sync state buffer in let lexeme = Str.string_before lexeme (String.index lexeme 't') in let lexeme = Z.mul (Z.of_int 1_000_000) (Z.of_string lexeme) in - match Token.mk_mtz (Z.to_string lexeme ^ "mtz") region with + match Token.mk_mutez (Z.to_string lexeme ^ "mutez") region with Ok token -> token, state | Error Token.Non_canonical_zero -> fail region Non_canonical_zero @@ -461,9 +461,9 @@ module Make (Token: TOKEN) : (S with module Token = Token) = let num = Z.of_string (integral ^ fractional) and den = Z.of_string ("1" ^ String.make (len-index-1) '0') and million = Q.of_string "1000000" in - let mtz = Q.make num den |> Q.mul million in - let should_be_1 = Q.den mtz in - if Z.equal Z.one should_be_1 then Some (Q.num mtz) else None + let mutez = Q.make num den |> Q.mul million in + let should_be_1 = Q.den mutez in + if Z.equal Z.one should_be_1 then Some (Q.num mutez) else None | exception Not_found -> assert false let mk_tz_decimal state buffer = @@ -471,7 +471,7 @@ module Make (Token: TOKEN) : (S with module Token = Token) = let lexeme = Str.string_before lexeme (String.index lexeme 't') in match format_tz lexeme with | Some tz -> ( - match Token.mk_mtz (Z.to_string tz ^ "mtz") region with + match Token.mk_mutez (Z.to_string tz ^ "mutez") region with Ok token -> token, state | Error Token.Non_canonical_zero -> @@ -559,7 +559,7 @@ and scan state = parse | bytes { (mk_bytes seq) state lexbuf |> enqueue } | natural 'n' { mk_nat state lexbuf |> enqueue } | natural 'p' { mk_nat state lexbuf |> enqueue } -| natural "mtz" { mk_mtz state lexbuf |> enqueue } +| natural "mutez" { mk_mutez state lexbuf |> enqueue } | natural "tz" { mk_tz state lexbuf |> enqueue } | decimal "tz" { mk_tz_decimal state lexbuf |> enqueue } | natural { mk_int state lexbuf |> enqueue } diff --git a/src/passes/2-simplify/ligodity.ml b/src/passes/2-simplify/ligodity.ml index 06928f754..9450f117c 100644 --- a/src/passes/2-simplify/ligodity.ml +++ b/src/passes/2-simplify/ligodity.ml @@ -420,7 +420,7 @@ let rec simpl_expression : let n = Z.to_int @@ snd @@ n in return @@ e_literal ~loc (Literal_nat n) ) - | EArith (Mtz n) -> ( + | EArith (Mutez n) -> ( let (n , loc) = r_split n in let n = Z.to_int @@ snd @@ n in return @@ e_literal ~loc (Literal_mutez n) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index d4924e359..d9fb6266d 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -348,7 +348,7 @@ let rec simpl_expression (t:Raw.expr) : expr result = let n = Z.to_int @@ snd @@ n in return @@ e_literal ~loc (Literal_nat n) ) - | EArith (Mtz n) -> ( + | EArith (Mutez n) -> ( let (n , loc) = r_split n in let n = Z.to_int @@ snd @@ n in return @@ e_literal ~loc (Literal_mutez n) diff --git a/src/stages/ast_simplified/PP.ml b/src/stages/ast_simplified/PP.ml index 19a802419..b99e7e62e 100644 --- a/src/stages/ast_simplified/PP.ml +++ b/src/stages/ast_simplified/PP.ml @@ -25,7 +25,7 @@ let literal ppf (l:literal) = match l with | Literal_int n -> fprintf ppf "%d" n | Literal_nat n -> fprintf ppf "+%d" n | Literal_timestamp n -> fprintf ppf "+%d" n - | Literal_mutez n -> fprintf ppf "%dmtz" n + | Literal_mutez n -> fprintf ppf "%dmutez" n | Literal_string s -> fprintf ppf "%S" s | Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b | Literal_address s -> fprintf ppf "@%S" s diff --git a/src/stages/ast_typed/PP.ml b/src/stages/ast_typed/PP.ml index fb8923ea9..f95720d8b 100644 --- a/src/stages/ast_typed/PP.ml +++ b/src/stages/ast_typed/PP.ml @@ -69,7 +69,7 @@ and literal ppf (l:literal) : unit = | Literal_int n -> fprintf ppf "%d" n | Literal_nat n -> fprintf ppf "+%d" n | Literal_timestamp n -> fprintf ppf "+%d" n - | Literal_mutez n -> fprintf ppf "%dmtz" n + | Literal_mutez n -> fprintf ppf "%dmutez" n | Literal_string s -> fprintf ppf "%s" s | Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b | Literal_address s -> fprintf ppf "@%s" s diff --git a/src/stages/mini_c/PP.ml b/src/stages/mini_c/PP.ml index 951aa2ae6..977c7b931 100644 --- a/src/stages/mini_c/PP.ml +++ b/src/stages/mini_c/PP.ml @@ -53,7 +53,7 @@ let rec value ppf : value -> unit = function | D_int n -> fprintf ppf "%d" n | D_nat n -> fprintf ppf "+%d" n | D_timestamp n -> fprintf ppf "+%d" n - | D_mutez n -> fprintf ppf "%dmtz" n + | D_mutez n -> fprintf ppf "%dmutez" n | D_unit -> fprintf ppf "unit" | D_string s -> fprintf ppf "\"%s\"" s | D_bytes x -> diff --git a/src/test/contracts/tez.ligo b/src/test/contracts/tez.ligo index cd76c47c7..31d5915cf 100644 --- a/src/test/contracts/tez.ligo +++ b/src/test/contracts/tez.ligo @@ -1,16 +1,16 @@ -const add_tez : tez = 21mtz + 0.000021tz; -const sub_tez : tez = 21mtz - 20mtz; +const add_tez : tez = 21mutez + 0.000021tz; +const sub_tez : tez = 21mutez - 20mutez; (* This is not enough. *) -const not_enough_tez : tez = 4611686018427387903mtz; +const not_enough_tez : tez = 4611686018427387903mutez; -const nat_mul_tez : tez = 1n * 100mtz; -const tez_mul_nat : tez = 100mtz * 10n; +const nat_mul_tez : tez = 1n * 100mutez; +const tez_mul_nat : tez = 100mutez * 10n; -const tez_div_tez1 : nat = 100mtz / 1mtz; -const tez_div_tez2 : nat = 100mtz / 90mtz; -const tez_div_tez3 : nat = 100mtz / 110mtz; +const tez_div_tez1 : nat = 100mutez / 1mutez; +const tez_div_tez2 : nat = 100mutez / 90mutez; +const tez_div_tez3 : nat = 100mutez / 110mutez; -const tez_mod_tez1 : tez = 100mtz mod 1mtz; -const tez_mod_tez2 : tez = 100mtz mod 90mtz; -const tez_mod_tez3 : tez = 100mtz mod 110mtz; +const tez_mod_tez1 : tez = 100mutez mod 1mutez; +const tez_mod_tez2 : tez = 100mutez mod 90mutez; +const tez_mod_tez3 : tez = 100mutez mod 110mutez; diff --git a/src/test/contracts/tez.mligo b/src/test/contracts/tez.mligo index 3f82198c5..557de9e2d 100644 --- a/src/test/contracts/tez.mligo +++ b/src/test/contracts/tez.mligo @@ -1,4 +1,4 @@ -let add_tez : tez = 21mtz + 0.000021tz +let add_tez : tez = 21mutez + 0.000021tz let sub_tez : tez = 0.000021tz - 0.000020tz let not_enough_tez : tez = 4611686018427.387903tz From cae0dfb1aa19e0fd92a1a8c73e6f610527cb3e06 Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Sun, 27 Oct 2019 12:05:34 -0700 Subject: [PATCH 18/51] Change names to the standard library names for the functions in OCaml --- src/passes/operators/operators.ml | 6 +++--- src/test/contracts/bitwise_arithmetic.mligo | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml index 9ba53c1b5..e1ebfc2e5 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/operators/operators.ml @@ -177,9 +177,9 @@ module Simplify = struct ("Big_map.literal" , "BIG_MAP_LITERAL" ) ; ("Big_map.empty" , "BIG_MAP_EMPTY" ) ; - ("Bitwise.bor" , "OR") ; - ("Bitwise.band" , "AND") ; - ("Bitwise.xor" , "XOR") ; + ("Bitwise.lor" , "OR") ; + ("Bitwise.land" , "AND") ; + ("Bitwise.lxor" , "XOR") ; ("String.length", "SIZE") ; ("String.size", "SIZE") ; diff --git a/src/test/contracts/bitwise_arithmetic.mligo b/src/test/contracts/bitwise_arithmetic.mligo index 81671b800..831592c70 100644 --- a/src/test/contracts/bitwise_arithmetic.mligo +++ b/src/test/contracts/bitwise_arithmetic.mligo @@ -1,10 +1,10 @@ (* Test CameLIGO bitwise operators *) let or_op (n : nat) : nat = - Bitwise.bor n 4p + Bitwise.lor n 4p let and_op (n : nat) : nat = - Bitwise.band n 7p + Bitwise.land n 7p let xor_op (n : nat) : nat = - Bitwise.xor n 7p + Bitwise.lxor n 7p From c7e4f3f651d6da571936ce5225bfba4a0b09eb5f Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Mon, 28 Oct 2019 09:18:16 -0700 Subject: [PATCH 19/51] Remove lxor, land, and lor from reserved words --- src/passes/1-parser/ligodity/LexToken.mll | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/passes/1-parser/ligodity/LexToken.mll b/src/passes/1-parser/ligodity/LexToken.mll index 2c437d15c..d47651845 100644 --- a/src/passes/1-parser/ligodity/LexToken.mll +++ b/src/passes/1-parser/ligodity/LexToken.mll @@ -280,12 +280,9 @@ let reserved = |> add "functor" |> add "inherit" |> add "initializer" - |> add "land" |> add "lazy" - |> add "lor" |> add "lsl" |> add "lsr" - |> add "lxor" |> add "method" |> add "module" |> add "mutable" From d8e44476baf1cc594fa7851c162dc2295181db52 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Fri, 11 Oct 2019 17:41:26 +0200 Subject: [PATCH 20/51] First version for ForInt loops --- src/passes/2-simplify/pascaligo.ml | 37 +++++++++++++++++++++++++++++- src/test/contracts/loop.ligo | 8 +++---- src/test/integration_tests.ml | 9 ++++++-- 3 files changed, 47 insertions(+), 7 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index d9fb6266d..08e88bdc7 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -667,7 +667,42 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul let%bind body = simpl_block l.block.value in let%bind body = body None in return_statement @@ e_loop cond body - | Loop (For (ForInt {region; _} | ForCollect {region ; _})) -> + | Loop (For (ForInt fi)) -> + (* cond part *) + let%bind _var = ok @@ e_variable fi.value.assign.value.name.value in + let%bind _value = simpl_expression fi.value.assign.value.expr in + let%bind _bound = simpl_expression fi.value.bound in + let%bind _comp = match fi.value.down with + | Some _ -> ok @@ e_annotation (e_constant "GE" [_var ; _bound]) t_bool + | None -> ok @@ e_annotation (e_constant "LE" [_var ; _bound]) t_bool + in + + (* body part *) + let%bind _body = simpl_block fi.value.block.value in + let%bind _body = _body None in + let%bind _step = match fi.value.step with + | Some (_,e) -> simpl_expression e + | None -> ok (e_int 1) in + let%bind _ctrl = match fi.value.down with + | Some _ -> + let%bind _addi = ok @@ e_constant "SUB" [ _var ; _step ] in + ok @@ e_assign fi.value.assign.value.name.value [] _addi + | None -> + let%bind _subi = ok @@ e_constant "ADD" [ _var ; _step ] in + ok @@ e_assign fi.value.assign.value.name.value [] _subi + in + let rec add_to_seq expr = match expr.expression with + | E_sequence (_,a) -> add_to_seq a + | _ -> e_sequence _body _ctrl in + let%bind _body' = ok @@ add_to_seq _body in + + let%bind _loop = ok @@ e_loop _comp _body' in + + let _ = Format.printf " -> %a\n" Ast_simplified.PP.expression _body' in + + return_statement @@ + e_let_in (fi.value.assign.value.name.value, Some t_int) _value _loop + | Loop (For (ForCollect {region ; _})) -> fail @@ unsupported_for_loops region | Cond c -> ( let (c , loc) = r_split c in diff --git a/src/test/contracts/loop.ligo b/src/test/contracts/loop.ligo index 03cc751a7..8fc4cd254 100644 --- a/src/test/contracts/loop.ligo +++ b/src/test/contracts/loop.ligo @@ -16,12 +16,12 @@ function while_sum (var n : nat) : nat is block { } } with r -(* function for_sum (var n : nat) : nat is block { - for i := 1 to 100 +function for_sum (var n : nat) : nat is block { + for i := 1 to 100 step 1 begin - n := n + 1; + n := n + 1n ; end } - with n *) + with n function dummy (const n : nat) : nat is block { while (False) block { skip } diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index ed60a0966..0644f1189 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -658,13 +658,18 @@ let loop () : unit result = let make_input = e_nat in let make_expected = fun n -> e_nat (n * (n + 1) / 2) in expect_eq_n_pos_mid program "while_sum" make_input make_expected +<<<<<<< HEAD in(* For loop is currently unsupported let%bind () = +======= + in + let%bind () = +>>>>>>> First version for ForInt loops let make_input = e_nat in - let make_expected = fun n -> e_nat (n * (n + 1) / 2) in + let make_expected = fun n -> e_nat (n + 100) in expect_eq_n_pos_mid program "for_sum" make_input make_expected - in *) + in ok () (* Don't know how to assert parse error happens in this test framework From b7961fc8ec17e1e54876c5c780d640ae4a01a49c Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Fri, 11 Oct 2019 17:47:04 +0200 Subject: [PATCH 21/51] cleaning --- src/passes/2-simplify/pascaligo.ml | 35 ++++++++++++++---------------- 1 file changed, 16 insertions(+), 19 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 08e88bdc7..3a438f68b 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -669,39 +669,36 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul return_statement @@ e_loop cond body | Loop (For (ForInt fi)) -> (* cond part *) - let%bind _var = ok @@ e_variable fi.value.assign.value.name.value in - let%bind _value = simpl_expression fi.value.assign.value.expr in - let%bind _bound = simpl_expression fi.value.bound in - let%bind _comp = match fi.value.down with - | Some _ -> ok @@ e_annotation (e_constant "GE" [_var ; _bound]) t_bool - | None -> ok @@ e_annotation (e_constant "LE" [_var ; _bound]) t_bool + let%bind var = ok @@ e_variable fi.value.assign.value.name.value in + let%bind value = simpl_expression fi.value.assign.value.expr in + let%bind bound = simpl_expression fi.value.bound in + let%bind comp = match fi.value.down with + | Some _ -> ok @@ e_annotation (e_constant "GE" [var ; bound]) t_bool + | None -> ok @@ e_annotation (e_constant "LE" [var ; bound]) t_bool in (* body part *) - let%bind _body = simpl_block fi.value.block.value in - let%bind _body = _body None in - let%bind _step = match fi.value.step with + let%bind body = simpl_block fi.value.block.value in + let%bind body = body None in + let%bind step = match fi.value.step with | Some (_,e) -> simpl_expression e | None -> ok (e_int 1) in - let%bind _ctrl = match fi.value.down with + let%bind ctrl = match fi.value.down with | Some _ -> - let%bind _addi = ok @@ e_constant "SUB" [ _var ; _step ] in + let%bind _addi = ok @@ e_constant "SUB" [ var ; step ] in ok @@ e_assign fi.value.assign.value.name.value [] _addi | None -> - let%bind _subi = ok @@ e_constant "ADD" [ _var ; _step ] in + let%bind _subi = ok @@ e_constant "ADD" [ var ; step ] in ok @@ e_assign fi.value.assign.value.name.value [] _subi in let rec add_to_seq expr = match expr.expression with | E_sequence (_,a) -> add_to_seq a - | _ -> e_sequence _body _ctrl in - let%bind _body' = ok @@ add_to_seq _body in - - let%bind _loop = ok @@ e_loop _comp _body' in - - let _ = Format.printf " -> %a\n" Ast_simplified.PP.expression _body' in + | _ -> e_sequence body ctrl in + let%bind body' = ok @@ add_to_seq body in + let%bind loop = ok @@ e_loop comp body' in return_statement @@ - e_let_in (fi.value.assign.value.name.value, Some t_int) _value _loop + e_let_in (fi.value.assign.value.name.value, Some t_int) value loop | Loop (For (ForCollect {region ; _})) -> fail @@ unsupported_for_loops region | Cond c -> ( From 3058a57c626fb90584fd45880220f396b3a1cdb5 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Fri, 11 Oct 2019 18:31:04 +0200 Subject: [PATCH 22/51] cleaning and better tests --- src/passes/2-simplify/pascaligo.ml | 64 +++++++++++++++--------------- src/test/contracts/loop.ligo | 32 ++++++++++++--- src/test/integration_tests.ml | 14 ++++++- 3 files changed, 72 insertions(+), 38 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 3a438f68b..f7b5b4211 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -668,37 +668,9 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul let%bind body = body None in return_statement @@ e_loop cond body | Loop (For (ForInt fi)) -> - (* cond part *) - let%bind var = ok @@ e_variable fi.value.assign.value.name.value in - let%bind value = simpl_expression fi.value.assign.value.expr in - let%bind bound = simpl_expression fi.value.bound in - let%bind comp = match fi.value.down with - | Some _ -> ok @@ e_annotation (e_constant "GE" [var ; bound]) t_bool - | None -> ok @@ e_annotation (e_constant "LE" [var ; bound]) t_bool - in - - (* body part *) - let%bind body = simpl_block fi.value.block.value in - let%bind body = body None in - let%bind step = match fi.value.step with - | Some (_,e) -> simpl_expression e - | None -> ok (e_int 1) in - let%bind ctrl = match fi.value.down with - | Some _ -> - let%bind _addi = ok @@ e_constant "SUB" [ var ; step ] in - ok @@ e_assign fi.value.assign.value.name.value [] _addi - | None -> - let%bind _subi = ok @@ e_constant "ADD" [ var ; step ] in - ok @@ e_assign fi.value.assign.value.name.value [] _subi - in - let rec add_to_seq expr = match expr.expression with - | E_sequence (_,a) -> add_to_seq a - | _ -> e_sequence body ctrl in - let%bind body' = ok @@ add_to_seq body in - let%bind loop = ok @@ e_loop comp body' in - - return_statement @@ - e_let_in (fi.value.assign.value.name.value, Some t_int) value loop + let%bind loop = simpl_for_int fi.value in + let%bind loop = loop None in + return_statement @@ loop | Loop (For (ForCollect {region ; _})) -> fail @@ unsupported_for_loops region | Cond c -> ( @@ -993,5 +965,35 @@ and simpl_statements : Raw.statements -> (_ -> expression result) result = and simpl_block : Raw.block -> (_ -> expression result) result = fun t -> simpl_statements t.statements +and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi -> + (* cond part *) + let%bind var = ok @@ e_variable fi.assign.value.name.value in + let%bind value = simpl_expression fi.assign.value.expr in + let%bind bound = simpl_expression fi.bound in + let%bind comp = match fi.down with + | Some _ -> ok @@ e_annotation (e_constant "GE" [var ; bound]) t_bool + | None -> ok @@ e_annotation (e_constant "LE" [var ; bound]) t_bool + in + (* body part *) + let%bind body = simpl_block fi.block.value in + let%bind body = body None in + let%bind step = match fi.step with + | Some (_,e) -> simpl_expression e + | None -> ok (e_int 1) in + let%bind ctrl = match fi.down with + | Some _ -> + let%bind _addi = ok @@ e_constant "SUB" [ var ; step ] in + ok @@ e_assign fi.assign.value.name.value [] _addi + | None -> + let%bind _subi = ok @@ e_constant "ADD" [ var ; step ] in + ok @@ e_assign fi.assign.value.name.value [] _subi + in + let rec add_to_seq expr = match expr.expression with + | E_sequence (_,a) -> add_to_seq a + | _ -> e_sequence body ctrl in + let%bind body' = ok @@ add_to_seq body in + let%bind loop = ok @@ e_loop comp body' in + return_statement @@ e_let_in (fi.assign.value.name.value, Some t_int) value loop + let simpl_program : Raw.ast -> program result = fun t -> bind_list @@ List.map simpl_declaration @@ nseq_to_list t.decl diff --git a/src/test/contracts/loop.ligo b/src/test/contracts/loop.ligo index 8fc4cd254..f3f0db33c 100644 --- a/src/test/contracts/loop.ligo +++ b/src/test/contracts/loop.ligo @@ -16,12 +16,34 @@ function while_sum (var n : nat) : nat is block { } } with r -function for_sum (var n : nat) : nat is block { - for i := 1 to 100 step 1 +function for_sum_up (var n : nat) : int is block { + var acc : int := 0 ; + for i := 1 to int(n) step 1 begin - n := n + 1n ; - end } - with n + acc := acc + i ; + end +} with acc + +function for_sum_down (var n : nat) : int is block { + var acc : int := 0 ; + for i := int(n) down to 1 step 1 + begin + acc := acc + i ; + end +} with acc + +function for_sum_step (var n : nat) : int is block { + var acc : int := 0 ; + var mystep : int := 2 ; + for i := 1 to int(n) step mystep + begin + acc := acc + i ; + end; + for i := 0 to int(n) step mystep + begin + acc := acc + i ; + end; +} with acc function dummy (const n : nat) : nat is block { while (False) block { skip } diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 0644f1189..d28f628b4 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -667,8 +667,18 @@ let loop () : unit result = let%bind () = >>>>>>> First version for ForInt loops let make_input = e_nat in - let make_expected = fun n -> e_nat (n + 100) in - expect_eq_n_pos_mid program "for_sum" make_input make_expected + let make_expected = fun n -> e_int (n * (n + 1) / 2) in + expect_eq_n_pos_mid program "for_sum_up" make_input make_expected + in + let%bind () = + let make_input = e_nat in + let make_expected = fun n -> e_int (n * (n + 1) / 2) in + expect_eq_n_pos_mid program "for_sum_down" make_input make_expected + in + let%bind () = + let make_input = e_nat in + let make_expected = fun n -> e_int (n * (n + 1) / 2) in + expect_eq_n_pos_mid program "for_sum_step" make_input make_expected in ok () From 1d3d57c7c57c37ff7283d762fab297a9b1936473 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 15 Oct 2019 13:14:00 +0200 Subject: [PATCH 23/51] not complete for collect tryout --- src/passes/2-simplify/pascaligo.ml | 23 +++++++++++++++++++---- src/test/contracts/loop.ligo | 8 ++++++++ src/test/integration_tests.ml | 5 +++++ 3 files changed, 32 insertions(+), 4 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index f7b5b4211..d1ffb5672 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -68,7 +68,7 @@ module Errors = struct ] in error ~data title message - let unsupported_for_loops region = + (* let unsupported_for_loops region = let title () = "bounded iterators" in let message () = Format.asprintf "only simple for loops are supported for now" in @@ -76,7 +76,7 @@ module Errors = struct ("loop_loc", fun () -> Format.asprintf "%a" Location.pp_lift @@ region) ] in - error ~data title message + error ~data title message *) let unsupported_non_var_pattern p = let title () = "pattern is not a variable" in @@ -671,8 +671,10 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul let%bind loop = simpl_for_int fi.value in let%bind loop = loop None in return_statement @@ loop - | Loop (For (ForCollect {region ; _})) -> - fail @@ unsupported_for_loops region + | Loop (For (ForCollect fc)) -> + let%bind loop = simpl_for_collect fc.value in + let%bind loop = loop None in + return_statement @@ loop | Cond c -> ( let (c , loc) = r_split c in let%bind expr = simpl_expression c.test in @@ -995,5 +997,18 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi -> let%bind loop = ok @@ e_loop comp body' in return_statement @@ e_let_in (fi.assign.value.name.value, Some t_int) value loop +and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc -> + let%bind col = simpl_expression fc.expr in + + let%bind body = simpl_block fc.block.value in + let%bind body = body None in + + let%bind invar = ok @@ e_variable fc.var.value in + let%bind letin = ok @@ e_let_in (fc.var.value, None) invar body in + let%bind lambda = ok @@ e_lambda fc.var.value None (Some t_unit) letin in + (* let%bind lambda = ok @@ e_lambda fc.var.value None (Some t_unit) body in *) + + return_statement @@ e_constant "SET_ITER" [col ; lambda] + let simpl_program : Raw.ast -> program result = fun t -> bind_list @@ List.map simpl_declaration @@ nseq_to_list t.decl diff --git a/src/test/contracts/loop.ligo b/src/test/contracts/loop.ligo index f3f0db33c..27af27a72 100644 --- a/src/test/contracts/loop.ligo +++ b/src/test/contracts/loop.ligo @@ -45,6 +45,14 @@ function for_sum_step (var n : nat) : int is block { end; } with acc +function for_collection (var n : set(int)) : int is block { + var acc : int := 0; + for i in n + begin + acc := acc + i ; + end; +} with acc + function dummy (const n : nat) : nat is block { while (False) block { skip } } with n diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index d28f628b4..f180ff7d5 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -680,6 +680,11 @@ let loop () : unit result = let make_expected = fun n -> e_int (n * (n + 1) / 2) in expect_eq_n_pos_mid program "for_sum_step" make_input make_expected in + let%bind () = + let make_input = fun _n -> e_set [e_int 1; e_int 2] in + let make_expected = fun _n -> e_int 3 in + expect_eq_n_pos_mid program "for_sum_step" make_input make_expected + in ok () (* Don't know how to assert parse error happens in this test framework From 536b5648c8a618fb426419584bf841bd42cfff62 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 15 Oct 2019 13:56:21 +0200 Subject: [PATCH 24/51] some cleaning --- src/passes/2-simplify/pascaligo.ml | 31 ++++++++++++++---------------- 1 file changed, 14 insertions(+), 17 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index d1ffb5672..148e8d314 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -969,12 +969,12 @@ and simpl_block : Raw.block -> (_ -> expression result) result = fun t -> and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi -> (* cond part *) - let%bind var = ok @@ e_variable fi.assign.value.name.value in + let var = e_variable fi.assign.value.name.value in let%bind value = simpl_expression fi.assign.value.expr in let%bind bound = simpl_expression fi.bound in - let%bind comp = match fi.down with - | Some _ -> ok @@ e_annotation (e_constant "GE" [var ; bound]) t_bool - | None -> ok @@ e_annotation (e_constant "LE" [var ; bound]) t_bool + let comp = match fi.down with + | Some _ -> e_annotation (e_constant "GE" [var ; bound]) t_bool + | None -> e_annotation (e_constant "LE" [var ; bound]) t_bool in (* body part *) let%bind body = simpl_block fi.block.value in @@ -982,32 +982,29 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi -> let%bind step = match fi.step with | Some (_,e) -> simpl_expression e | None -> ok (e_int 1) in - let%bind ctrl = match fi.down with + let ctrl = match fi.down with | Some _ -> - let%bind _addi = ok @@ e_constant "SUB" [ var ; step ] in - ok @@ e_assign fi.assign.value.name.value [] _addi + let _addi = e_constant "SUB" [ var ; step ] in + e_assign fi.assign.value.name.value [] _addi | None -> - let%bind _subi = ok @@ e_constant "ADD" [ var ; step ] in - ok @@ e_assign fi.assign.value.name.value [] _subi + let _subi = e_constant "ADD" [ var ; step ] in + e_assign fi.assign.value.name.value [] _subi in let rec add_to_seq expr = match expr.expression with | E_sequence (_,a) -> add_to_seq a | _ -> e_sequence body ctrl in - let%bind body' = ok @@ add_to_seq body in - let%bind loop = ok @@ e_loop comp body' in + let body' = add_to_seq body in + let loop = e_loop comp body' in return_statement @@ e_let_in (fi.assign.value.name.value, Some t_int) value loop and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc -> let%bind col = simpl_expression fc.expr in - let%bind body = simpl_block fc.block.value in let%bind body = body None in - - let%bind invar = ok @@ e_variable fc.var.value in - let%bind letin = ok @@ e_let_in (fc.var.value, None) invar body in - let%bind lambda = ok @@ e_lambda fc.var.value None (Some t_unit) letin in + let invar = e_variable fc.var.value in + let letin = e_let_in (fc.var.value, None) invar body in + let lambda = e_lambda fc.var.value None (Some t_unit) letin in (* let%bind lambda = ok @@ e_lambda fc.var.value None (Some t_unit) body in *) - return_statement @@ e_constant "SET_ITER" [col ; lambda] let simpl_program : Raw.ast -> program result = fun t -> From 730c130fb3bdca48d79e9dbd482ef54bf0df4f45 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 22 Oct 2019 12:12:19 +0200 Subject: [PATCH 25/51] merge step and down reemoval WIP WIP --- src/passes/2-simplify/pascaligo.ml | 52 +++++++++++++++------------ src/test/contracts/loop.ligo | 58 +++++++++++++++--------------- src/test/integration_tests.ml | 17 +-------- 3 files changed, 60 insertions(+), 67 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 148e8d314..d7443741a 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -972,24 +972,14 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi -> let var = e_variable fi.assign.value.name.value in let%bind value = simpl_expression fi.assign.value.expr in let%bind bound = simpl_expression fi.bound in - let comp = match fi.down with - | Some _ -> e_annotation (e_constant "GE" [var ; bound]) t_bool - | None -> e_annotation (e_constant "LE" [var ; bound]) t_bool + let comp = e_annotation (e_constant "LE" [var ; bound]) t_bool in (* body part *) let%bind body = simpl_block fi.block.value in let%bind body = body None in - let%bind step = match fi.step with - | Some (_,e) -> simpl_expression e - | None -> ok (e_int 1) in - let ctrl = match fi.down with - | Some _ -> - let _addi = e_constant "SUB" [ var ; step ] in - e_assign fi.assign.value.name.value [] _addi - | None -> - let _subi = e_constant "ADD" [ var ; step ] in - e_assign fi.assign.value.name.value [] _subi - in + let step = e_int 1 in + let ctrl = e_assign + fi.assign.value.name.value [] (e_constant "ADD" [ var ; step ]) in let rec add_to_seq expr = match expr.expression with | E_sequence (_,a) -> add_to_seq a | _ -> e_sequence body ctrl in @@ -998,14 +988,30 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi -> return_statement @@ e_let_in (fi.assign.value.name.value, Some t_int) value loop and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc -> - let%bind col = simpl_expression fc.expr in - let%bind body = simpl_block fc.block.value in - let%bind body = body None in - let invar = e_variable fc.var.value in - let letin = e_let_in (fc.var.value, None) invar body in - let lambda = e_lambda fc.var.value None (Some t_unit) letin in - (* let%bind lambda = ok @@ e_lambda fc.var.value None (Some t_unit) body in *) - return_statement @@ e_constant "SET_ITER" [col ; lambda] + let statements = npseq_to_list fc.block.value.statements in + (* building initial record *) + let aux (el : Raw.statement) : Raw.instruction option = match el with + | Raw.Instr (Assign _ as i) -> Some i + | _ -> None in + let assign_instrs = List.filter_map aux statements in + let%bind assign_instrs' = bind_map_list + (fun el -> + let%bind assign' = simpl_instruction el in + let%bind assign' = assign' None in + ok @@ assign') + assign_instrs in + let aux prev ass_exp = + match ass_exp.expression with + | E_variable name -> SMap.add name ass_exp prev + | _ -> prev in + let init_record = e_record (List.fold_left aux SMap.empty assign_instrs') in + (*later , init_record will be placed in a let_in *) + + (* replace assignments to variable to assignments to record *) + + + + return_statement @@ init_record let simpl_program : Raw.ast -> program result = fun t -> - bind_list @@ List.map simpl_declaration @@ nseq_to_list t.decl + bind_list @@ List.map simpl_declaration @@ nseq_to_list t.decl \ No newline at end of file diff --git a/src/test/contracts/loop.ligo b/src/test/contracts/loop.ligo index 27af27a72..2b7447942 100644 --- a/src/test/contracts/loop.ligo +++ b/src/test/contracts/loop.ligo @@ -16,42 +16,44 @@ function while_sum (var n : nat) : nat is block { } } with r -function for_sum_up (var n : nat) : int is block { +function for_sum (var n : nat) : int is block { var acc : int := 0 ; - for i := 1 to int(n) step 1 + for i := 1 to int(n) begin acc := acc + i ; end } with acc -function for_sum_down (var n : nat) : int is block { - var acc : int := 0 ; - for i := int(n) down to 1 step 1 - begin - acc := acc + i ; - end -} with acc -function for_sum_step (var n : nat) : int is block { - var acc : int := 0 ; - var mystep : int := 2 ; - for i := 1 to int(n) step mystep - begin - acc := acc + i ; - end; - for i := 0 to int(n) step mystep - begin - acc := acc + i ; - end; -} with acc +function lamby (var accu : (record st : string ; acc : int end) ; var i : int ) + : (record st : string ; acc : int end) is block { + accu.acc := accu.acc + i ; + accu.st := accu.st ^ "to" ; +} with accu -function for_collection (var n : set(int)) : int is block { - var acc : int := 0; - for i in n - begin - acc := acc + i ; - end; -} with acc +function for_collection (var nee : unit; var nuu : unit) : (int * string) is block { + var acc : int := 0 ; + var st : string := "to" ; + var mylist : list(int) := list 1 ; 1 ; 1 end ; + + var init_record : (record st : string; acc : int end ) := + record st = st; acc = acc; end; + var folded_record : (record st : string; acc : int end ) := + list_fold(mylist , init_record , lamby) ; +} with (folded_record.acc , folded_record.st) + +// function for_collection_ (var nee : unit; var nuu : unit) : (int * string) is block { +// var acc : int := 0 ; +// var st : string := "to" ; +// var mylist : list(int) := list 1 ; 1 ; 1 end ; + +// for x : int in list mylist +// begin +// acc := acc + x ; +// st := st^"to" ; +// end + +// } with acc function dummy (const n : nat) : nat is block { while (False) block { skip } diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index f180ff7d5..0088b0e31 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -668,22 +668,7 @@ let loop () : unit result = >>>>>>> First version for ForInt loops let make_input = e_nat in let make_expected = fun n -> e_int (n * (n + 1) / 2) in - expect_eq_n_pos_mid program "for_sum_up" make_input make_expected - in - let%bind () = - let make_input = e_nat in - let make_expected = fun n -> e_int (n * (n + 1) / 2) in - expect_eq_n_pos_mid program "for_sum_down" make_input make_expected - in - let%bind () = - let make_input = e_nat in - let make_expected = fun n -> e_int (n * (n + 1) / 2) in - expect_eq_n_pos_mid program "for_sum_step" make_input make_expected - in - let%bind () = - let make_input = fun _n -> e_set [e_int 1; e_int 2] in - let make_expected = fun _n -> e_int 3 in - expect_eq_n_pos_mid program "for_sum_step" make_input make_expected + expect_eq_n_pos_mid program "for_sum" make_input make_expected in ok () From 79de96136d3e24690061afc5feeef58ac7826d1b Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Sat, 26 Oct 2019 14:18:06 +0200 Subject: [PATCH 26/51] Collection for translation without type annotation on record --- src/passes/2-simplify/dune | 1 + src/passes/2-simplify/pascaligo.ml | 52 +++++++++++++++++-- .../self_ast_simplified.ml | 2 + src/test/contracts/loop.ligo | 27 ++++++---- 4 files changed, 68 insertions(+), 14 deletions(-) diff --git a/src/passes/2-simplify/dune b/src/passes/2-simplify/dune index 9649d13dc..e27b5139d 100644 --- a/src/passes/2-simplify/dune +++ b/src/passes/2-simplify/dune @@ -6,6 +6,7 @@ tezos-utils parser ast_simplified + self_ast_simplified operators) (modules ligodity pascaligo simplify) (preprocess diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index d7443741a..321c87cf5 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -1002,16 +1002,60 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun assign_instrs in let aux prev ass_exp = match ass_exp.expression with - | E_variable name -> SMap.add name ass_exp prev + | E_assign ( name , _ , _ ) -> + let expr' = e_variable name in + SMap.add name expr' prev | _ -> prev in + let captured_list = List.filter_map + (fun ass_exp -> match ass_exp.expression with + | E_assign ( name, _ , _ ) -> Some name + | _ -> None ) + assign_instrs' in let init_record = e_record (List.fold_left aux SMap.empty assign_instrs') in - (*later , init_record will be placed in a let_in *) - (* replace assignments to variable to assignments to record *) + (* replace assignments to X assignments to record *) + let%bind block' = simpl_block fc.block.value in + let%bind block' = block' None in + let replace_with_record exp = + match exp.expression with + | E_assign ( name , path , expr ) -> + let path' = ( match path with + | [] -> [Access_record name] + (* This will fail for deep tuple access, see LIGO-131 *) + | _ -> ((Access_record name)::path) ) in + ok @@ e_assign "_COMPILER_fold_record" path' expr + | E_variable name -> + if (List.mem name captured_list) then + ok @@ e_accessor (e_variable "_COMPILER_fold_record") [Access_record name] + else ok @@ exp + | _ -> ok @@ exp in + let%bind block'' = Self_ast_simplified.map_expression replace_with_record block' in + (* build the lambda*) + (* let%bind (elt_type' : type_expression) = simpl_type_expression fc.elt_type in *) + (* let%bind (record_type : type_expression) = ... in *) + (* Here it's not possible to know the type of the variable captures in the record ..*) + let lambda = e_lambda "_COMPILER_for_collect_lambda" None None block'' in + let%bind collect = simpl_expression fc.expr in + let fold = e_constant "LIST_FOLD" [collect ; init_record ; lambda] in + let final = e_let_in ("_COMPILER_init_record", None) init_record + @@ (e_let_in ("_COMPILER_folded_record", None) fold (e_skip ())) in - return_statement @@ init_record + (* build the sequence of assigments back to the original variables *) + let aux (prev : expression) (captured_varname : string) = + let access = e_accessor (e_variable "_COMPILER_folded_record") + [Access_record captured_varname] in + let assign = e_assign captured_varname [] access in + e_sequence prev assign in + + let ( final_sequence : expression ) = List.fold_left aux final captured_list in + + return_statement @@ final_sequence + +(** NODE TO AVOID THE DIRT: + have a E_unsimplified 'a which is then transformed in a self pass ?? +**) let simpl_program : Raw.ast -> program result = fun t -> bind_list @@ List.map simpl_declaration @@ nseq_to_list t.decl \ No newline at end of file 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 aa18b4a8c..b73113cdb 100644 --- a/src/passes/3-self_ast_simplified/self_ast_simplified.ml +++ b/src/passes/3-self_ast_simplified/self_ast_simplified.ml @@ -21,3 +21,5 @@ let all_program = let all_expression = let all_p = List.map Helpers.map_expression all in bind_chain all_p + +let map_expression = Helpers.map_expression diff --git a/src/test/contracts/loop.ligo b/src/test/contracts/loop.ligo index 2b7447942..6e5e709a8 100644 --- a/src/test/contracts/loop.ligo +++ b/src/test/contracts/loop.ligo @@ -40,20 +40,27 @@ function for_collection (var nee : unit; var nuu : unit) : (int * string) is blo record st = st; acc = acc; end; var folded_record : (record st : string; acc : int end ) := list_fold(mylist , init_record , lamby) ; + skip ; + st := folded_record.st ; + acc := folded_record.acc ; + } with (folded_record.acc , folded_record.st) -// function for_collection_ (var nee : unit; var nuu : unit) : (int * string) is block { -// var acc : int := 0 ; -// var st : string := "to" ; -// var mylist : list(int) := list 1 ; 1 ; 1 end ; +function for_collection_ (var nee : unit; var nuu : unit) : (int * string) is block { + var acc : int := 0 ; + var st : string := "to" ; + var toto : (string * string) := ("foo","bar") ; -// for x : int in list mylist -// begin -// acc := acc + x ; -// st := st^"to" ; -// end + var mylist : list(int) := list 1 ; 1 ; 1 end ; -// } with acc + for x : int in list mylist + begin + toto.1 := "r"; + acc := acc + x ; + st := st^"to" ; + end + +} with acc function dummy (const n : nat) : nat is block { while (False) block { skip } From db79b6b9da05e23d11585f075fa3479ead452b67 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Sat, 26 Oct 2019 14:27:29 +0200 Subject: [PATCH 27/51] select op_name from collection key word --- src/passes/2-simplify/pascaligo.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 321c87cf5..4aa92282e 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -1037,7 +1037,11 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun (* Here it's not possible to know the type of the variable captures in the record ..*) let lambda = e_lambda "_COMPILER_for_collect_lambda" None None block'' in let%bind collect = simpl_expression fc.expr in - let fold = e_constant "LIST_FOLD" [collect ; init_record ; lambda] in + let op_name = match fc.collection with + | Map _ -> "MAP_FOLD" + | Set _ -> "SET_FOLD" + | List _ -> "LIST_FOLD" in + let fold = e_constant op_name [collect ; init_record ; lambda] in let final = e_let_in ("_COMPILER_init_record", None) init_record @@ (e_let_in ("_COMPILER_folded_record", None) fold (e_skip ())) in From 70502f62cbd3773046243d17e3b610444e3a69c8 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Sat, 26 Oct 2019 22:07:42 +0200 Subject: [PATCH 28/51] fix the way lambda arguments are accessed --- src/passes/2-simplify/pascaligo.ml | 41 ++++++++++++++++++------------ 1 file changed, 25 insertions(+), 16 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 4aa92282e..c785ee780 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -1013,38 +1013,41 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun assign_instrs' in let init_record = e_record (List.fold_left aux SMap.empty assign_instrs') in - (* replace assignments to X assignments to record *) + (* replace assignments to X assignments to record in the for_collect + block which will become the body of the lambda *) let%bind block' = simpl_block fc.block.value in let%bind block' = block' None in - let replace_with_record exp = + let replace_with_record exp = match exp.expression with | E_assign ( name , path , expr ) -> let path' = ( match path with - | [] -> [Access_record name] + | [] -> [Access_tuple 0 ; Access_record name ] @ path (* This will fail for deep tuple access, see LIGO-131 *) - | _ -> ((Access_record name)::path) ) in - ok @@ e_assign "_COMPILER_fold_record" path' expr + | _ -> [Access_tuple 0 ; Access_record name ] @ path ) in + ok @@ e_assign "arguments" path' expr | E_variable name -> - if (List.mem name captured_list) then - ok @@ e_accessor (e_variable "_COMPILER_fold_record") [Access_record name] + if (name = fc.var.value ) then + ok @@ e_accessor (e_variable "arguments") [Access_tuple 1] + else if (List.mem name captured_list) then + let acc_arg = e_accessor (e_variable "arguments") [Access_tuple 0] in + ok @@ e_accessor (acc_arg) [Access_record name] else ok @@ exp | _ -> ok @@ exp in let%bind block'' = Self_ast_simplified.map_expression replace_with_record block' in + let rec add_return expr = match expr.expression with + | E_sequence (a,b) -> e_sequence a (add_return b) + | _ -> e_sequence expr (e_accessor (e_variable "arguments") [Access_tuple 0]) in + let block_with_return = add_return block'' in (* build the lambda*) - (* let%bind (elt_type' : type_expression) = simpl_type_expression fc.elt_type in *) - (* let%bind (record_type : type_expression) = ... in *) - (* Here it's not possible to know the type of the variable captures in the record ..*) - let lambda = e_lambda "_COMPILER_for_collect_lambda" None None block'' in + let lambda = e_lambda "_COMPILER_for_collect_lambda" None None block_with_return in let%bind collect = simpl_expression fc.expr in let op_name = match fc.collection with | Map _ -> "MAP_FOLD" | Set _ -> "SET_FOLD" | List _ -> "LIST_FOLD" in let fold = e_constant op_name [collect ; init_record ; lambda] in - - let final = e_let_in ("_COMPILER_init_record", None) init_record - @@ (e_let_in ("_COMPILER_folded_record", None) fold (e_skip ())) in + let folded_record = e_let_in ("_COMPILER_folded_record", None) fold (e_skip ()) in (* build the sequence of assigments back to the original variables *) let aux (prev : expression) (captured_varname : string) = @@ -1053,12 +1056,18 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun let assign = e_assign captured_varname [] access in e_sequence prev assign in - let ( final_sequence : expression ) = List.fold_left aux final captured_list in + let ( final_sequence : expression ) = List.fold_left aux folded_record captured_list in + let _ = Format.printf "___ GEN ____\n %a \n" Ast_simplified.PP.expression final_sequence in return_statement @@ final_sequence (** NODE TO AVOID THE DIRT: - have a E_unsimplified 'a which is then transformed in a self pass ?? + - have a E_unsimplified 'a which is then transformed in a self pass ?? + - need to forbid that ? + for i in somelist + begin + i := .. + end **) let simpl_program : Raw.ast -> program result = fun t -> From 91d92e048d427c3d5ba002ee8758455415f6ce8f Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Sat, 26 Oct 2019 22:15:28 +0200 Subject: [PATCH 29/51] special case for pascaligo generated LIST/SET/MAP_FOLD --- src/passes/4-typer/typer.ml | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/src/passes/4-typer/typer.ml b/src/passes/4-typer/typer.ml index 28258b9fb..8d6803534 100644 --- a/src/passes/4-typer/typer.ml +++ b/src/passes/4-typer/typer.ml @@ -615,6 +615,37 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a let output_type = body.type_annotation in return (E_lambda {binder = fst binder ; body}) (t_function input_type output_type ()) ) + | E_constant ( ("LIST_FOLD"|"MAP_FOLD"|"SET_FOLD") , + [ collect ; + init_record ; + ( { expression = (I.E_lambda { binder = (name, None) ; + input_type = None ; + output_type = None ; + result }) ; + location = _ }) as _lambda + ] ) -> + (* this special case is here force annotation of the lambda + generated by pascaligo's for_collect loop *) + let%bind lst' = bind_list @@ List.map (type_expression e) [collect ; init_record] in + let tv_lst = List.map get_type_annotation lst' in + let tv_col = List.nth tv_lst 0 in + let tv_out = List.nth tv_lst 1 in + let collect_inner_type = match tv_col.type_value' with + | O.T_constant ( ("list"|"set"|"map") , t) -> t + | _ -> failwith "impossible" in + let input_type = t_tuple (tv_out::collect_inner_type) () in + let output_type = Some tv_out in + + let e' = Environment.add_ez_binder name input_type e in + let%bind body = type_expression ?tv_opt:output_type e' result in + let output_type = body.type_annotation in + let%bind lambda' = ok @@ make_a_e (E_lambda {binder = name ; body}) (t_function input_type output_type ()) e in + + let%bind lst' = ok @@ lst'@[lambda'] in + let tv_lst = List.map get_type_annotation lst' in + let%bind (name', tv) = + type_constant name tv_lst tv_opt ae.location in + return (E_constant (name' , lst')) tv | E_constant (name, lst) -> let%bind lst' = bind_list @@ List.map (type_expression e) lst in let tv_lst = List.map get_type_annotation lst' in From 7f7f19854a15212547b59fced59ec7f96859b76d Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Sat, 26 Oct 2019 22:16:17 +0200 Subject: [PATCH 30/51] WIP : make test a bit easier --- src/test/contracts/loop.ligo | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/test/contracts/loop.ligo b/src/test/contracts/loop.ligo index 6e5e709a8..647735953 100644 --- a/src/test/contracts/loop.ligo +++ b/src/test/contracts/loop.ligo @@ -49,13 +49,13 @@ function for_collection (var nee : unit; var nuu : unit) : (int * string) is blo function for_collection_ (var nee : unit; var nuu : unit) : (int * string) is block { var acc : int := 0 ; var st : string := "to" ; - var toto : (string * string) := ("foo","bar") ; + // var toto : (string * string) := ("foo","bar") ; var mylist : list(int) := list 1 ; 1 ; 1 end ; for x : int in list mylist begin - toto.1 := "r"; + // toto.1 := "r"; acc := acc + x ; st := st^"to" ; end From 0cf747144106edacf81c02642ef91aa3de04e8d4 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Sat, 26 Oct 2019 22:59:17 +0200 Subject: [PATCH 31/51] prepend the body of the lambda with let_in's --- src/passes/2-simplify/pascaligo.ml | 39 +++++++++++++++++++++--------- 1 file changed, 27 insertions(+), 12 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index c785ee780..4b5a1b874 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -576,6 +576,7 @@ and simpl_fun_declaration : bind_fold_right_list aux result body in let expression : expression = e_lambda ~loc binder (Some input_type) (Some output_type) result in + (* let _toto = Format.printf "TAMERE %a \n" Ast_simplified.PP.expression expression in *) let type_annotation = Some (T_function (input_type, output_type)) in ok ((name , type_annotation) , expression) ) @@ -1017,30 +1018,45 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun block which will become the body of the lambda *) let%bind block' = simpl_block fc.block.value in let%bind block' = block' None in + let replace_with_record exp = match exp.expression with + (* replace asignement *) | E_assign ( name , path , expr ) -> let path' = ( match path with - | [] -> [Access_tuple 0 ; Access_record name ] @ path + | [] -> [Access_record name] (* This will fail for deep tuple access, see LIGO-131 *) - | _ -> [Access_tuple 0 ; Access_record name ] @ path ) in - ok @@ e_assign "arguments" path' expr + | _ -> ( (Access_record name) :: path ) + ) in + ok @@ e_assign "_COMPILER_acc" path' expr | E_variable name -> if (name = fc.var.value ) then - ok @@ e_accessor (e_variable "arguments") [Access_tuple 1] + (* replace reference to the collection element *) + ok @@ (e_variable "_COMPILER_collec_elt") else if (List.mem name captured_list) then - let acc_arg = e_accessor (e_variable "arguments") [Access_tuple 0] in - ok @@ e_accessor (acc_arg) [Access_record name] + (* replace reference fold accumulator *) + ok @@ e_accessor (e_variable "_COMPILER_acc") [Access_record name] else ok @@ exp | _ -> ok @@ exp in - let%bind block'' = Self_ast_simplified.map_expression replace_with_record block' in + let%bind block' = Self_ast_simplified.map_expression replace_with_record block' in + + (* append the return value *) let rec add_return expr = match expr.expression with | E_sequence (a,b) -> e_sequence a (add_return b) - | _ -> e_sequence expr (e_accessor (e_variable "arguments") [Access_tuple 0]) in - let block_with_return = add_return block'' in + | _ -> e_sequence expr (e_variable "_COMPILER_acc") in + let block' = add_return block' in + + (* prepend the body with let accumulator = argument.0 in let collec_elt = argument.1 in*) + let%bind elt_type = simpl_type_expression fc.elt_type in + let acc = e_accessor (e_variable "arguments") [Access_tuple 0] in + let collec_elt = e_accessor (e_variable "arguments") [Access_tuple 1] in + let args_let_in = e_let_in ("_COMPILER_acc", None) acc @@ + e_let_in ("_COMPILER_collec_elt", Some elt_type) collec_elt (e_skip ()) in + let block' = e_sequence args_let_in block' in + (* build the lambda*) - let lambda = e_lambda "_COMPILER_for_collect_lambda" None None block_with_return in + let lambda = e_lambda "_COMPILER_for_collect_lambda" None None block' in let%bind collect = simpl_expression fc.expr in let op_name = match fc.collection with | Map _ -> "MAP_FOLD" @@ -1049,7 +1065,7 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun let fold = e_constant op_name [collect ; init_record ; lambda] in let folded_record = e_let_in ("_COMPILER_folded_record", None) fold (e_skip ()) in - (* build the sequence of assigments back to the original variables *) + (* append assigments of fold result to the original captured variables *) let aux (prev : expression) (captured_varname : string) = let access = e_accessor (e_variable "_COMPILER_folded_record") [Access_record captured_varname] in @@ -1057,7 +1073,6 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun e_sequence prev assign in let ( final_sequence : expression ) = List.fold_left aux folded_record captured_list in - let _ = Format.printf "___ GEN ____\n %a \n" Ast_simplified.PP.expression final_sequence in return_statement @@ final_sequence From d651bfb3a3d6565b085e640eaf6611c589fe120b Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Sun, 27 Oct 2019 11:32:03 +0100 Subject: [PATCH 32/51] remove misplaced 'skip' --- src/passes/2-simplify/pascaligo.ml | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 4b5a1b874..f2ee15c73 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -576,7 +576,6 @@ and simpl_fun_declaration : bind_fold_right_list aux result body in let expression : expression = e_lambda ~loc binder (Some input_type) (Some output_type) result in - (* let _toto = Format.printf "TAMERE %a \n" Ast_simplified.PP.expression expression in *) let type_annotation = Some (T_function (input_type, output_type)) in ok ((name , type_annotation) , expression) ) @@ -1019,7 +1018,7 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun let%bind block' = simpl_block fc.block.value in let%bind block' = block' None in - let replace_with_record exp = + let replace exp = match exp.expression with (* replace asignement *) | E_assign ( name , path , expr ) -> @@ -1038,7 +1037,7 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun ok @@ e_accessor (e_variable "_COMPILER_acc") [Access_record name] else ok @@ exp | _ -> ok @@ exp in - let%bind block' = Self_ast_simplified.map_expression replace_with_record block' in + let%bind block' = Self_ast_simplified.map_expression replace block' in (* append the return value *) let rec add_return expr = match expr.expression with @@ -1050,12 +1049,11 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun let%bind elt_type = simpl_type_expression fc.elt_type in let acc = e_accessor (e_variable "arguments") [Access_tuple 0] in let collec_elt = e_accessor (e_variable "arguments") [Access_tuple 1] in - let args_let_in = e_let_in ("_COMPILER_acc", None) acc @@ - e_let_in ("_COMPILER_collec_elt", Some elt_type) collec_elt (e_skip ()) in - let block' = e_sequence args_let_in block' in + let block' = e_let_in ("_COMPILER_acc", None) acc @@ + e_let_in ("_COMPILER_collec_elt", Some elt_type) collec_elt (block') in - (* build the lambda*) + (* build the X_FOLD constant *) let lambda = e_lambda "_COMPILER_for_collect_lambda" None None block' in let%bind collect = simpl_expression fc.expr in let op_name = match fc.collection with @@ -1063,17 +1061,22 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun | Set _ -> "SET_FOLD" | List _ -> "LIST_FOLD" in let fold = e_constant op_name [collect ; init_record ; lambda] in - let folded_record = e_let_in ("_COMPILER_folded_record", None) fold (e_skip ()) in (* append assigments of fold result to the original captured variables *) - let aux (prev : expression) (captured_varname : string) = + let aux (prev : expression option) (captured_varname : string) = let access = e_accessor (e_variable "_COMPILER_folded_record") [Access_record captured_varname] in let assign = e_assign captured_varname [] access in - e_sequence prev assign in - - let ( final_sequence : expression ) = List.fold_left aux folded_record captured_list in + match prev with + | None -> Some assign + | Some p -> Some (e_sequence p assign) in + let ( reassign_sequence : expression option ) = List.fold_left aux None captured_list in + let final_sequence = match reassign_sequence with + (* None case means that no variables were captured *) + | None -> e_let_in ("_COMPILER_folded_record", None) fold (e_skip ()) + | Some seq -> e_let_in ("_COMPILER_folded_record", None) fold seq in + return_statement @@ final_sequence (** NODE TO AVOID THE DIRT: @@ -1083,6 +1086,7 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun begin i := .. end + - global definition of strings **) let simpl_program : Raw.ast -> program result = fun t -> From 164e88e818aa2ec477afaa90c8bb2a735022fe1b Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Sun, 27 Oct 2019 11:34:26 +0100 Subject: [PATCH 33/51] remove shadowing of lambda name over the constant name --- src/passes/4-typer/typer.ml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/passes/4-typer/typer.ml b/src/passes/4-typer/typer.ml index 8d6803534..7b3744d79 100644 --- a/src/passes/4-typer/typer.ml +++ b/src/passes/4-typer/typer.ml @@ -615,7 +615,7 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a let output_type = body.type_annotation in return (E_lambda {binder = fst binder ; body}) (t_function input_type output_type ()) ) - | E_constant ( ("LIST_FOLD"|"MAP_FOLD"|"SET_FOLD") , + | E_constant ( ("LIST_FOLD"|"MAP_FOLD"|"SET_FOLD") as opname , [ collect ; init_record ; ( { expression = (I.E_lambda { binder = (name, None) ; @@ -624,28 +624,28 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a result }) ; location = _ }) as _lambda ] ) -> - (* this special case is here force annotation of the lambda + (* this special case is here force annotation of the untyped lambda generated by pascaligo's for_collect loop *) let%bind lst' = bind_list @@ List.map (type_expression e) [collect ; init_record] in let tv_lst = List.map get_type_annotation lst' in let tv_col = List.nth tv_lst 0 in let tv_out = List.nth tv_lst 1 in let collect_inner_type = match tv_col.type_value' with - | O.T_constant ( ("list"|"set"|"map") , t) -> t + | O.T_constant ( ("list"|"set"|"map") , [t]) -> t | _ -> failwith "impossible" in - let input_type = t_tuple (tv_out::collect_inner_type) () in + let input_type = t_tuple (tv_out::[collect_inner_type]) () in let output_type = Some tv_out in - let e' = Environment.add_ez_binder name input_type e in + let e' = Environment.add_ez_binder "arguments" input_type e in let%bind body = type_expression ?tv_opt:output_type e' result in let output_type = body.type_annotation in let%bind lambda' = ok @@ make_a_e (E_lambda {binder = name ; body}) (t_function input_type output_type ()) e in let%bind lst' = ok @@ lst'@[lambda'] in let tv_lst = List.map get_type_annotation lst' in - let%bind (name', tv) = - type_constant name tv_lst tv_opt ae.location in - return (E_constant (name' , lst')) tv + let%bind (opname', tv) = + type_constant opname tv_lst tv_opt ae.location in + return (E_constant (opname' , lst')) tv | E_constant (name, lst) -> let%bind lst' = bind_list @@ List.map (type_expression e) lst in let tv_lst = List.map get_type_annotation lst' in From a3deccf352bcbb80ea32ef89ed6885c424b76919 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Sun, 27 Oct 2019 11:43:51 +0100 Subject: [PATCH 34/51] changing the name of the lambda to 'arguments' make its arguments available --- src/passes/2-simplify/pascaligo.ml | 2 +- src/passes/4-typer/typer.ml | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index f2ee15c73..066949450 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -1054,7 +1054,7 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun (* build the X_FOLD constant *) - let lambda = e_lambda "_COMPILER_for_collect_lambda" None None block' in + let lambda = e_lambda "arguments" None None block' in let%bind collect = simpl_expression fc.expr in let op_name = match fc.collection with | Map _ -> "MAP_FOLD" diff --git a/src/passes/4-typer/typer.ml b/src/passes/4-typer/typer.ml index 7b3744d79..73a8144e2 100644 --- a/src/passes/4-typer/typer.ml +++ b/src/passes/4-typer/typer.ml @@ -618,7 +618,7 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a | E_constant ( ("LIST_FOLD"|"MAP_FOLD"|"SET_FOLD") as opname , [ collect ; init_record ; - ( { expression = (I.E_lambda { binder = (name, None) ; + ( { expression = (I.E_lambda { binder = (lname, None) ; input_type = None ; output_type = None ; result }) ; @@ -636,10 +636,10 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a let input_type = t_tuple (tv_out::[collect_inner_type]) () in let output_type = Some tv_out in - let e' = Environment.add_ez_binder "arguments" input_type e in + let e' = Environment.add_ez_binder lname input_type e in let%bind body = type_expression ?tv_opt:output_type e' result in let output_type = body.type_annotation in - let%bind lambda' = ok @@ make_a_e (E_lambda {binder = name ; body}) (t_function input_type output_type ()) e in + let%bind lambda' = ok @@ make_a_e (E_lambda {binder = lname ; body}) (t_function input_type output_type ()) e in let%bind lst' = ok @@ lst'@[lambda'] in let tv_lst = List.map get_type_annotation lst' in From 7eed9b1856e6c0c9a6c46a45eaa17f051bc4367c Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Sun, 27 Oct 2019 11:47:17 +0100 Subject: [PATCH 35/51] test passing ! --- src/test/contracts/loop.ligo | 6 +++--- src/test/integration_tests.ml | 5 +++++ 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/src/test/contracts/loop.ligo b/src/test/contracts/loop.ligo index 647735953..d96753105 100644 --- a/src/test/contracts/loop.ligo +++ b/src/test/contracts/loop.ligo @@ -31,7 +31,7 @@ function lamby (var accu : (record st : string ; acc : int end) ; var i : int ) accu.st := accu.st ^ "to" ; } with accu -function for_collection (var nee : unit; var nuu : unit) : (int * string) is block { +function for_collection_ (var nee : unit; var nuu : unit) : (int * string) is block { var acc : int := 0 ; var st : string := "to" ; var mylist : list(int) := list 1 ; 1 ; 1 end ; @@ -46,7 +46,7 @@ function for_collection (var nee : unit; var nuu : unit) : (int * string) is blo } with (folded_record.acc , folded_record.st) -function for_collection_ (var nee : unit; var nuu : unit) : (int * string) is block { +function for_collection (var nee : unit) : (int * string) is block { var acc : int := 0 ; var st : string := "to" ; // var toto : (string * string) := ("foo","bar") ; @@ -60,7 +60,7 @@ function for_collection_ (var nee : unit; var nuu : unit) : (int * string) is bl st := st^"to" ; end -} with acc +} with (acc, st) function dummy (const n : nat) : nat is block { while (False) block { skip } diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 0088b0e31..992c21d4a 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -670,6 +670,11 @@ let loop () : unit result = let make_expected = fun n -> e_int (n * (n + 1) / 2) in expect_eq_n_pos_mid program "for_sum" make_input make_expected in + let%bind () = + let input = e_unit () in + let expected = e_pair (e_int 3) (e_string "totototo") in + expect_eq program "for_collection" input expected + in ok () (* Don't know how to assert parse error happens in this test framework From 5a77b08aa795fd23e63e2ba120f3b46bc84bcad2 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Sun, 27 Oct 2019 13:03:08 +0100 Subject: [PATCH 36/51] cleaning & documenting --- src/passes/2-simplify/pascaligo.ml | 85 +++++++++++------------------- src/passes/4-typer/typer.ml | 27 +++++----- 2 files changed, 43 insertions(+), 69 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 066949450..2a8218156 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -989,105 +989,80 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi -> and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc -> let statements = npseq_to_list fc.block.value.statements in - (* building initial record *) - let aux (el : Raw.statement) : Raw.instruction option = match el with + (* build initial record *) + let filter_assignments (el : Raw.statement) : Raw.instruction option = match el with | Raw.Instr (Assign _ as i) -> Some i | _ -> None in - let assign_instrs = List.filter_map aux statements in + let assign_instrs = List.filter_map filter_assignments statements in let%bind assign_instrs' = bind_map_list (fun el -> let%bind assign' = simpl_instruction el in let%bind assign' = assign' None in ok @@ assign') assign_instrs in - let aux prev ass_exp = - match ass_exp.expression with - | E_assign ( name , _ , _ ) -> - let expr' = e_variable name in - SMap.add name expr' prev - | _ -> prev in - let captured_list = List.filter_map + let captured_name_list = List.filter_map (fun ass_exp -> match ass_exp.expression with - | E_assign ( name, _ , _ ) -> Some name - | _ -> None ) + | E_assign ( name, _ , _ ) -> Some name | _ -> None ) assign_instrs' in - let init_record = e_record (List.fold_left aux SMap.empty assign_instrs') in - - (* replace assignments to X assignments to record in the for_collect - block which will become the body of the lambda *) - let%bind block' = simpl_block fc.block.value in - let%bind block' = block' None in - + let add_to_record (prev: expression type_name_map) (captured_name: string) = + SMap.add captured_name (e_variable captured_name) prev in + let init_record = e_record (List.fold_left add_to_record SMap.empty captured_name_list) in + (* replace references to the future lambda arguments in the for body *) + let%bind for_body = simpl_block fc.block.value in + let%bind for_body = for_body None in let replace exp = + (* TODO: map and set updated/remove must also be captured *) match exp.expression with - (* replace asignement *) | E_assign ( name , path , expr ) -> + (* replace references to fold accumulator as rhs *) let path' = ( match path with | [] -> [Access_record name] - (* This will fail for deep tuple access, see LIGO-131 *) + (* This might fail for deep tuple access, see LIGO-131 *) | _ -> ( (Access_record name) :: path ) ) in ok @@ e_assign "_COMPILER_acc" path' expr | E_variable name -> if (name = fc.var.value ) then - (* replace reference to the collection element *) + (* replace references to the collection element *) ok @@ (e_variable "_COMPILER_collec_elt") - else if (List.mem name captured_list) then - (* replace reference fold accumulator *) + else if (List.mem name captured_name_list) then + (* replace references to fold accumulator as lhs *) ok @@ e_accessor (e_variable "_COMPILER_acc") [Access_record name] else ok @@ exp | _ -> ok @@ exp in - let%bind block' = Self_ast_simplified.map_expression replace block' in - - (* append the return value *) - let rec add_return expr = match expr.expression with + let%bind for_body = Self_ast_simplified.map_expression replace for_body in + (* append the return value (the accumulator) to the for body *) + let rec add_return (expr : expression) = match expr.expression with | E_sequence (a,b) -> e_sequence a (add_return b) | _ -> e_sequence expr (e_variable "_COMPILER_acc") in - let block' = add_return block' in - - (* prepend the body with let accumulator = argument.0 in let collec_elt = argument.1 in*) + let for_body = add_return for_body in + (* prepend for body with args declaration (accumulator and collection element)*) let%bind elt_type = simpl_type_expression fc.elt_type in let acc = e_accessor (e_variable "arguments") [Access_tuple 0] in let collec_elt = e_accessor (e_variable "arguments") [Access_tuple 1] in - let block' = e_let_in ("_COMPILER_acc", None) acc @@ - e_let_in ("_COMPILER_collec_elt", Some elt_type) collec_elt (block') in - - + let for_body = e_let_in ("_COMPILER_acc", None) acc @@ + e_let_in ("_COMPILER_collec_elt", Some elt_type) collec_elt (for_body) in (* build the X_FOLD constant *) - let lambda = e_lambda "arguments" None None block' in let%bind collect = simpl_expression fc.expr in + let lambda = e_lambda "arguments" None None for_body in let op_name = match fc.collection with - | Map _ -> "MAP_FOLD" - | Set _ -> "SET_FOLD" - | List _ -> "LIST_FOLD" in + | Map _ -> "MAP_FOLD" | Set _ -> "SET_FOLD" | List _ -> "LIST_FOLD" in let fold = e_constant op_name [collect ; init_record ; lambda] in - - (* append assigments of fold result to the original captured variables *) - let aux (prev : expression option) (captured_varname : string) = + (* build sequence to re-assign fold result to the original captured variables *) + let assign_back (prev : expression option) (captured_varname : string) : expression option = let access = e_accessor (e_variable "_COMPILER_folded_record") [Access_record captured_varname] in let assign = e_assign captured_varname [] access in match prev with | None -> Some assign | Some p -> Some (e_sequence p assign) in - let ( reassign_sequence : expression option ) = List.fold_left aux None captured_list in - + let reassign_sequence = List.fold_left assign_back None captured_name_list in + (* attach the folded record to the re-assign sequence *) let final_sequence = match reassign_sequence with (* None case means that no variables were captured *) | None -> e_let_in ("_COMPILER_folded_record", None) fold (e_skip ()) | Some seq -> e_let_in ("_COMPILER_folded_record", None) fold seq in - return_statement @@ final_sequence -(** NODE TO AVOID THE DIRT: - - have a E_unsimplified 'a which is then transformed in a self pass ?? - - need to forbid that ? - for i in somelist - begin - i := .. - end - - global definition of strings -**) - let simpl_program : Raw.ast -> program result = fun t -> bind_list @@ List.map simpl_declaration @@ nseq_to_list t.decl \ No newline at end of file diff --git a/src/passes/4-typer/typer.ml b/src/passes/4-typer/typer.ml index 73a8144e2..832e7b04f 100644 --- a/src/passes/4-typer/typer.ml +++ b/src/passes/4-typer/typer.ml @@ -626,22 +626,21 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a ] ) -> (* this special case is here force annotation of the untyped lambda generated by pascaligo's for_collect loop *) - let%bind lst' = bind_list @@ List.map (type_expression e) [collect ; init_record] in - let tv_lst = List.map get_type_annotation lst' in - let tv_col = List.nth tv_lst 0 in - let tv_out = List.nth tv_lst 1 in - let collect_inner_type = match tv_col.type_value' with - | O.T_constant ( ("list"|"set"|"map") , [t]) -> t - | _ -> failwith "impossible" in - let input_type = t_tuple (tv_out::[collect_inner_type]) () in - let output_type = Some tv_out in - + let%bind (v_col , v_initr ) = bind_map_pair (type_expression e) (collect , init_record ) in + let tv_col = get_type_annotation v_col in (* this is the type of the collection *) + let tv_out = get_type_annotation v_initr in (* this is the output type of the lambda*) + let%bind col_inner_type = match tv_col.type_value' with + | O.T_constant ( ("list"|"set"|"map") , [t]) -> ok t + | _ -> + let wtype = Format.asprintf + "Loops over collections expect lists, sets or maps, type %a" O.PP.type_value tv_col in + fail @@ simple_error wtype in + let input_type = t_tuple (tv_out::[col_inner_type]) () in let e' = Environment.add_ez_binder lname input_type e in - let%bind body = type_expression ?tv_opt:output_type e' result in + let%bind body = type_expression ?tv_opt:(Some tv_out) e' result in let output_type = body.type_annotation in - let%bind lambda' = ok @@ make_a_e (E_lambda {binder = lname ; body}) (t_function input_type output_type ()) e in - - let%bind lst' = ok @@ lst'@[lambda'] in + let lambda' = make_a_e (E_lambda {binder = lname ; body}) (t_function input_type output_type ()) e in + let lst' = [v_col; v_initr ; lambda'] in let tv_lst = List.map get_type_annotation lst' in let%bind (opname', tv) = type_constant opname tv_lst tv_opt ae.location in From c7056d200dad536635bf7bf2c769f875d2238e04 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Sun, 27 Oct 2019 13:57:26 +0100 Subject: [PATCH 37/51] merging with dev --- src/test/integration_tests.ml | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 992c21d4a..dbd388cdd 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -658,14 +658,8 @@ let loop () : unit result = let make_input = e_nat in let make_expected = fun n -> e_nat (n * (n + 1) / 2) in expect_eq_n_pos_mid program "while_sum" make_input make_expected -<<<<<<< HEAD - in(* For loop is currently unsupported - - let%bind () = -======= in let%bind () = ->>>>>>> First version for ForInt loops let make_input = e_nat in let make_expected = fun n -> e_int (n * (n + 1) / 2) in expect_eq_n_pos_mid program "for_sum" make_input make_expected From b71309bfa2eb1c2230bc354ca32e3da16c7d6f38 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Sun, 27 Oct 2019 14:09:04 +0100 Subject: [PATCH 38/51] proper error message for deep accesses in loops of collection body --- src/passes/2-simplify/pascaligo.ml | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 2a8218156..4ae15d8dd 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -137,6 +137,17 @@ module Errors = struct ] in error ~data title message + let unsupported_deep_access_for_collection for_col = + let title () = "deep access in loop over collection" in + let message () = + Format.asprintf "currently, we do not support deep \ + accesses in loops over collection" in + let data = [ + ("pattern_loc", + fun () -> Format.asprintf "%a" Location.pp_lift @@ for_col.Region.region) + ] in + error ~data title message + (* Logging *) let simplifying_instruction t = @@ -1013,14 +1024,11 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun let replace exp = (* TODO: map and set updated/remove must also be captured *) match exp.expression with - | E_assign ( name , path , expr ) -> - (* replace references to fold accumulator as rhs *) - let path' = ( match path with - | [] -> [Access_record name] - (* This might fail for deep tuple access, see LIGO-131 *) - | _ -> ( (Access_record name) :: path ) - ) in - ok @@ e_assign "_COMPILER_acc" path' expr + (* replace references to fold accumulator as rhs *) + | E_assign ( name , path , expr ) -> ( match path with + | [] -> ok @@ e_assign "_COMPILER_acc" [Access_record name] expr + (* This fails for deep accesses, see LIGO-131 *) + | _ -> fail @@ unsupported_deep_access_for_collection fc.block ) | E_variable name -> if (name = fc.var.value ) then (* replace references to the collection element *) From 1a035f9713c970ac08c03e080d6a95240c176317 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Sun, 27 Oct 2019 14:12:42 +0100 Subject: [PATCH 39/51] tests for sets --- src/test/contracts/loop.ligo | 18 +++++++++++------- src/test/integration_tests.ml | 7 ++++++- 2 files changed, 17 insertions(+), 8 deletions(-) diff --git a/src/test/contracts/loop.ligo b/src/test/contracts/loop.ligo index d96753105..eaa429df7 100644 --- a/src/test/contracts/loop.ligo +++ b/src/test/contracts/loop.ligo @@ -35,7 +35,6 @@ function for_collection_ (var nee : unit; var nuu : unit) : (int * string) is bl var acc : int := 0 ; var st : string := "to" ; var mylist : list(int) := list 1 ; 1 ; 1 end ; - var init_record : (record st : string; acc : int end ) := record st = st; acc = acc; end; var folded_record : (record st : string; acc : int end ) := @@ -43,23 +42,28 @@ function for_collection_ (var nee : unit; var nuu : unit) : (int * string) is bl skip ; st := folded_record.st ; acc := folded_record.acc ; - } with (folded_record.acc , folded_record.st) -function for_collection (var nee : unit) : (int * string) is block { +function for_collection_list (var nee : unit) : (int * string) is block { var acc : int := 0 ; var st : string := "to" ; - // var toto : (string * string) := ("foo","bar") ; - var mylist : list(int) := list 1 ; 1 ; 1 end ; - for x : int in list mylist begin - // toto.1 := "r"; acc := acc + x ; st := st^"to" ; end +} with (acc, st) +function for_collection_set (var nee : unit) : (int * string) is block { + var acc : int := 0 ; + var st : string := "to" ; + var myset : set(int) := set 1 ; 2 ; 3 end ; + for x : int in set myset + begin + acc := acc + x ; + st := st^"to" ; + end } with (acc, st) function dummy (const n : nat) : nat is block { diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index dbd388cdd..3ed6d871e 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -667,7 +667,12 @@ let loop () : unit result = let%bind () = let input = e_unit () in let expected = e_pair (e_int 3) (e_string "totototo") in - expect_eq program "for_collection" input expected + expect_eq program "for_collection_list" input expected + in + let%bind () = + let input = e_unit () in + let expected = e_pair (e_int 6) (e_string "totototo") in + expect_eq program "for_collection_set" input expected in ok () From e16eac77a660e97e6a5518808fdbda415e440487 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Sun, 27 Oct 2019 16:42:11 +0100 Subject: [PATCH 40/51] fixes for loop on map. Untested because of issue with deep tuple access (LIGO-131 LIGO-134) An error message is in the simplifier --- src/passes/2-simplify/pascaligo.ml | 90 +++++++++++++++++++++--------- src/passes/4-typer/typer.ml | 8 +-- src/test/contracts/loop.ligo | 12 +++- 3 files changed, 80 insertions(+), 30 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 4ae15d8dd..66fe46481 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -68,16 +68,6 @@ module Errors = struct ] in error ~data title message - (* let unsupported_for_loops region = - let title () = "bounded iterators" in - let message () = - Format.asprintf "only simple for loops are supported for now" in - let data = [ - ("loop_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ region) - ] in - error ~data title message *) - let unsupported_non_var_pattern p = let title () = "pattern is not a variable" in let message () = @@ -148,6 +138,16 @@ module Errors = struct ] in error ~data title message + let unsupported_for_collect_map for_col = + let title () = "for loop over map" in + let message () = + Format.asprintf "for loops over map are not supported yet" in + let data = [ + ("loop_loc", + fun () -> Format.asprintf "%a" Location.pp_lift @@ for_col.Region.region) + ] in + error ~data title message + (* Logging *) let simplifying_instruction t = @@ -999,6 +999,7 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi -> return_statement @@ e_let_in (fi.assign.value.name.value, Some t_int) value loop and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc -> + match fc.collection with | Map _ -> fail @@ unsupported_for_collect_map fc.block | _ -> let statements = npseq_to_list fc.block.value.statements in (* build initial record *) let filter_assignments (el : Raw.statement) : Raw.instruction option = match el with @@ -1027,16 +1028,43 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun (* replace references to fold accumulator as rhs *) | E_assign ( name , path , expr ) -> ( match path with | [] -> ok @@ e_assign "_COMPILER_acc" [Access_record name] expr - (* This fails for deep accesses, see LIGO-131 *) - | _ -> fail @@ unsupported_deep_access_for_collection fc.block ) - | E_variable name -> - if (name = fc.var.value ) then - (* replace references to the collection element *) - ok @@ (e_variable "_COMPILER_collec_elt") - else if (List.mem name captured_name_list) then - (* replace references to fold accumulator as lhs *) - ok @@ e_accessor (e_variable "_COMPILER_acc") [Access_record name] - else ok @@ exp + (* This fails for deep accesses, see LIGO-131 LIGO-134 *) + | _ -> + (* ok @@ e_assign "_COMPILER_acc" ((Access_record name)::path) expr) *) + fail @@ unsupported_deep_access_for_collection fc.block ) + | E_variable name -> ( match fc.collection with + (* loop on map *) + | Map _ -> + let k' = e_variable "_COMPILER_collec_elt_k" in + let v' = e_variable "_COMPILER_collec_elt_v" in + ( match fc.bind_to with + | Some (_,v) -> + if ( name = fc.var.value ) then + ok @@ k' (* replace references to the the key *) + else if ( name = v.value ) then + ok @@ v' (* replace references to the the value *) + else if (List.mem name captured_name_list) then + (* replace references to fold accumulator as lhs *) + ok @@ e_accessor (e_variable "_COMPILER_acc") [Access_record name] + else ok @@ exp + | None -> + if ( name = fc.var.value ) then + ok @@ k' (* replace references to the key *) + else if (List.mem name captured_name_list) then + (* replace references to fold accumulator as lhs *) + ok @@ e_accessor (e_variable "_COMPILER_acc") [Access_record name] + else ok @@ exp + ) + (* loop on set or list *) + | (Set _ | List _) -> + if (name = fc.var.value ) then + (* replace references to the collection element *) + ok @@ (e_variable "_COMPILER_collec_elt") + else if (List.mem name captured_name_list) then + (* replace references to fold accumulator as lhs *) + ok @@ e_accessor (e_variable "_COMPILER_acc") [Access_record name] + else ok @@ exp + ) | _ -> ok @@ exp in let%bind for_body = Self_ast_simplified.map_expression replace for_body in (* append the return value (the accumulator) to the for body *) @@ -1044,12 +1072,24 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun | E_sequence (a,b) -> e_sequence a (add_return b) | _ -> e_sequence expr (e_variable "_COMPILER_acc") in let for_body = add_return for_body in - (* prepend for body with args declaration (accumulator and collection element)*) + (* prepend for body with args declaration (accumulator and collection elements *) let%bind elt_type = simpl_type_expression fc.elt_type in - let acc = e_accessor (e_variable "arguments") [Access_tuple 0] in - let collec_elt = e_accessor (e_variable "arguments") [Access_tuple 1] in - let for_body = e_let_in ("_COMPILER_acc", None) acc @@ - e_let_in ("_COMPILER_collec_elt", Some elt_type) collec_elt (for_body) in + let for_body = + let ( arg_access: Types.access_path -> expression ) = e_accessor (e_variable "arguments") in + ( match fc.collection with + | Map _ -> + let acc = arg_access [Access_tuple 0 ; Access_tuple 0] in + let collec_elt_v = arg_access [Access_tuple 1 ; Access_tuple 0] in + let collec_elt_k = arg_access [Access_tuple 1 ; Access_tuple 1] in + e_let_in ("_COMPILER_acc", None) acc @@ + e_let_in ("_COMPILER_collec_elt_k", None) collec_elt_v @@ + e_let_in ("_COMPILER_collec_elt_v", None) collec_elt_k (for_body) + | _ -> + let acc = arg_access [Access_tuple 0] in + let collec_elt = arg_access [Access_tuple 1] in + e_let_in ("_COMPILER_acc", None) acc @@ + e_let_in ("_COMPILER_collec_elt", Some elt_type) collec_elt (for_body) + ) in (* build the X_FOLD constant *) let%bind collect = simpl_expression fc.expr in let lambda = e_lambda "arguments" None None for_body in diff --git a/src/passes/4-typer/typer.ml b/src/passes/4-typer/typer.ml index 832e7b04f..99d8adf3c 100644 --- a/src/passes/4-typer/typer.ml +++ b/src/passes/4-typer/typer.ml @@ -629,13 +629,13 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a let%bind (v_col , v_initr ) = bind_map_pair (type_expression e) (collect , init_record ) in let tv_col = get_type_annotation v_col in (* this is the type of the collection *) let tv_out = get_type_annotation v_initr in (* this is the output type of the lambda*) - let%bind col_inner_type = match tv_col.type_value' with - | O.T_constant ( ("list"|"set"|"map") , [t]) -> ok t + let%bind input_type = match tv_col.type_value' with + | O.T_constant ( ("list"|"set") , t) -> ok @@ t_tuple (tv_out::t) () + | O.T_constant ( "map" , t) -> ok @@ t_tuple (tv_out::[(t_tuple t ())]) () | _ -> let wtype = Format.asprintf - "Loops over collections expect lists, sets or maps, type %a" O.PP.type_value tv_col in + "Loops over collections expect lists, sets or maps, got type %a" O.PP.type_value tv_col in fail @@ simple_error wtype in - let input_type = t_tuple (tv_out::[col_inner_type]) () in let e' = Environment.add_ez_binder lname input_type e in let%bind body = type_expression ?tv_opt:(Some tv_out) e' result in let output_type = body.type_annotation in diff --git a/src/test/contracts/loop.ligo b/src/test/contracts/loop.ligo index eaa429df7..f559c2816 100644 --- a/src/test/contracts/loop.ligo +++ b/src/test/contracts/loop.ligo @@ -39,7 +39,6 @@ function for_collection_ (var nee : unit; var nuu : unit) : (int * string) is bl record st = st; acc = acc; end; var folded_record : (record st : string; acc : int end ) := list_fold(mylist , init_record , lamby) ; - skip ; st := folded_record.st ; acc := folded_record.acc ; } with (folded_record.acc , folded_record.st) @@ -66,6 +65,17 @@ function for_collection_set (var nee : unit) : (int * string) is block { end } with (acc, st) +// function for_collection_map (var nee : unit) : (int * string) is block { +// var acc : int := 0 ; +// var st : string := "" ; +// var mymap : map(string,int) := map "one" -> 1 ; "two" -> 2 ; "three" -> 3 end ; +// for k -> v : (string * int) in map mymap +// begin +// acc := acc + v ; +// st := k^st ; +// end +// } with (acc, st) + function dummy (const n : nat) : nat is block { while (False) block { skip } } with n From 2ced2e784e3088b3983bdc7fa0516c3faedf744e Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Mon, 28 Oct 2019 18:40:53 +0100 Subject: [PATCH 41/51] add doc --- src/passes/2-simplify/pascaligo.ml | 143 ++++++++++++++++++++++------- 1 file changed, 112 insertions(+), 31 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 66fe46481..ec38004b3 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -998,13 +998,88 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi -> let loop = e_loop comp body' in return_statement @@ e_let_in (fi.assign.value.name.value, Some t_int) value loop +(** simpl_for_collect + For loops over collections, like + + ``` concrete syntax : + for x : int in set myset + begin + myint := myint + x ; + myst := myst ^ "to" ; + end + ``` + + are implemented using a MAP_FOLD, LIST_FOLD or SET_FOLD: + + ``` pseudo Ast_simplified + let #COMPILER#folded_record = list_fold( mylist , + record st = st; acc = acc; end; + lamby = fun arguments -> ( + let #COMPILER#acc = arguments.0 in + let #COMPILER#elt = arguments.1 in + #COMPILER#acc.myint := #COMPILER#acc.myint + #COMPILER#elt ; + #COMPILER#acc.myst := #COMPILER#acc.myst ^ "to" ; + #COMPILER#acc + ) + ) in + { + myst := #COMPILER#folded_record.myst ; + myint := #COMPILER#folded_record.myint ; + } + ``` + + We are performing the following steps: + 1) Filtering out of the body all the constructions that can't + alter the environment (assignements and map/set patches) + and simplifying only those. + + 2) Detect the free variables and build a list of their names + (myint and myst in the previous example) + + 3) Build the initial record (later passed as 2nd argument of + `MAP/SET/LIST_FOLD`) capturing the environment using the + free variables list of (2) + + 4) In the filtered body of (1), replace occurences: + - free variable of name X as rhs ==> accessor `#COMPILER#acc.X` + - free variable of name X as lhs ==> accessor `#COMPILER#acc.X` + And, in the case of a map: + - references to the iterated key ==> variable `#COMPILER#elt_key` + - references to the iterated value ==> variable `#COMPILER#elt_value` + in the case of a set/list: + - references to the iterated value ==> variable `#COMPILER#elt` + + 5) Append the return value to the body + + 6) Prepend the declaration of the lambda arguments to the body which + is a serie of `let .. in`'s + Note that the parameter of the lambda ̀arguments` is a tree of + tuple holding: + * In the case of `list` or ̀set`: + ( folding record , current list/set element ) as + ( #COMPILER#acc , #COMPILER#elt ) + * In the case of `map`: + ( folding record , current map key , current map value ) as + ( #COMPILER#acc , #COMPILER#elt_key , #COMPILER#elt_value ) + + 7) Build the lambda using the final body of (6) + + 8) Build a sequence of assignments for all the captured variables + to their new value, namely an access to the folded record + (#COMPILER#folded_record) + + 9) Attach the sequence of 8 to the ̀let .. in` declaration + of #COMPILER#folded_record + +**) and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc -> match fc.collection with | Map _ -> fail @@ unsupported_for_collect_map fc.block | _ -> let statements = npseq_to_list fc.block.value.statements in - (* build initial record *) - let filter_assignments (el : Raw.statement) : Raw.instruction option = match el with - | Raw.Instr (Assign _ as i) -> Some i - | _ -> None in + (* STEP 1 *) + let filter_assignments (el : Raw.statement) : Raw.instruction option = + match el with + | Raw.Instr (Assign _ as i) -> Some i + | _ -> None in let assign_instrs = List.filter_map filter_assignments statements in let%bind assign_instrs' = bind_map_list (fun el -> @@ -1012,31 +1087,37 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun let%bind assign' = assign' None in ok @@ assign') assign_instrs in + (* STEP 2 *) let captured_name_list = List.filter_map - (fun ass_exp -> match ass_exp.expression with - | E_assign ( name, _ , _ ) -> Some name | _ -> None ) + (fun ass_exp -> + match ass_exp.expression with + | E_assign ( name, _ , _ ) -> Some name + | _ -> None ) assign_instrs' in + (* STEP 3 *) let add_to_record (prev: expression type_name_map) (captured_name: string) = SMap.add captured_name (e_variable captured_name) prev in let init_record = e_record (List.fold_left add_to_record SMap.empty captured_name_list) in - (* replace references to the future lambda arguments in the for body *) + (* STEP 4 *) let%bind for_body = simpl_block fc.block.value in let%bind for_body = for_body None in let replace exp = (* TODO: map and set updated/remove must also be captured *) match exp.expression with (* replace references to fold accumulator as rhs *) - | E_assign ( name , path , expr ) -> ( match path with - | [] -> ok @@ e_assign "_COMPILER_acc" [Access_record name] expr + | E_assign ( name , path , expr ) -> ( + match path with + | [] -> ok @@ e_assign "#COMPILER#acc" [Access_record name] expr (* This fails for deep accesses, see LIGO-131 LIGO-134 *) | _ -> - (* ok @@ e_assign "_COMPILER_acc" ((Access_record name)::path) expr) *) + (* ok @@ e_assign "#COMPILER#acc" ((Access_record name)::path) expr) *) fail @@ unsupported_deep_access_for_collection fc.block ) - | E_variable name -> ( match fc.collection with + | E_variable name -> ( + match fc.collection with (* loop on map *) | Map _ -> - let k' = e_variable "_COMPILER_collec_elt_k" in - let v' = e_variable "_COMPILER_collec_elt_v" in + let k' = e_variable "#COMPILER#collec_elt_k" in + let v' = e_variable "#COMPILER#collec_elt_v" in ( match fc.bind_to with | Some (_,v) -> if ( name = fc.var.value ) then @@ -1045,34 +1126,34 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun ok @@ v' (* replace references to the the value *) else if (List.mem name captured_name_list) then (* replace references to fold accumulator as lhs *) - ok @@ e_accessor (e_variable "_COMPILER_acc") [Access_record name] + ok @@ e_accessor (e_variable "#COMPILER#acc") [Access_record name] else ok @@ exp | None -> if ( name = fc.var.value ) then ok @@ k' (* replace references to the key *) else if (List.mem name captured_name_list) then (* replace references to fold accumulator as lhs *) - ok @@ e_accessor (e_variable "_COMPILER_acc") [Access_record name] + ok @@ e_accessor (e_variable "#COMPILER#acc") [Access_record name] else ok @@ exp ) (* loop on set or list *) | (Set _ | List _) -> if (name = fc.var.value ) then (* replace references to the collection element *) - ok @@ (e_variable "_COMPILER_collec_elt") + ok @@ (e_variable "#COMPILER#collec_elt") else if (List.mem name captured_name_list) then (* replace references to fold accumulator as lhs *) - ok @@ e_accessor (e_variable "_COMPILER_acc") [Access_record name] + ok @@ e_accessor (e_variable "#COMPILER#acc") [Access_record name] else ok @@ exp ) | _ -> ok @@ exp in let%bind for_body = Self_ast_simplified.map_expression replace for_body in - (* append the return value (the accumulator) to the for body *) + (* STEP 5 *) let rec add_return (expr : expression) = match expr.expression with | E_sequence (a,b) -> e_sequence a (add_return b) - | _ -> e_sequence expr (e_variable "_COMPILER_acc") in + | _ -> e_sequence expr (e_variable "#COMPILER#acc") in let for_body = add_return for_body in - (* prepend for body with args declaration (accumulator and collection elements *) + (* STEP 6 *) let%bind elt_type = simpl_type_expression fc.elt_type in let for_body = let ( arg_access: Types.access_path -> expression ) = e_accessor (e_variable "arguments") in @@ -1081,35 +1162,35 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun let acc = arg_access [Access_tuple 0 ; Access_tuple 0] in let collec_elt_v = arg_access [Access_tuple 1 ; Access_tuple 0] in let collec_elt_k = arg_access [Access_tuple 1 ; Access_tuple 1] in - e_let_in ("_COMPILER_acc", None) acc @@ - e_let_in ("_COMPILER_collec_elt_k", None) collec_elt_v @@ - e_let_in ("_COMPILER_collec_elt_v", None) collec_elt_k (for_body) + e_let_in ("#COMPILER#acc", None) acc @@ + e_let_in ("#COMPILER#collec_elt_k", None) collec_elt_v @@ + e_let_in ("#COMPILER#collec_elt_v", None) collec_elt_k (for_body) | _ -> let acc = arg_access [Access_tuple 0] in let collec_elt = arg_access [Access_tuple 1] in - e_let_in ("_COMPILER_acc", None) acc @@ - e_let_in ("_COMPILER_collec_elt", Some elt_type) collec_elt (for_body) + e_let_in ("#COMPILER#acc", None) acc @@ + e_let_in ("#COMPILER#collec_elt", Some elt_type) collec_elt (for_body) ) in - (* build the X_FOLD constant *) + (* STEP 7 *) let%bind collect = simpl_expression fc.expr in let lambda = e_lambda "arguments" None None for_body in let op_name = match fc.collection with | Map _ -> "MAP_FOLD" | Set _ -> "SET_FOLD" | List _ -> "LIST_FOLD" in let fold = e_constant op_name [collect ; init_record ; lambda] in - (* build sequence to re-assign fold result to the original captured variables *) + (* STEP 8 *) let assign_back (prev : expression option) (captured_varname : string) : expression option = - let access = e_accessor (e_variable "_COMPILER_folded_record") + let access = e_accessor (e_variable "#COMPILER#folded_record") [Access_record captured_varname] in let assign = e_assign captured_varname [] access in match prev with | None -> Some assign | Some p -> Some (e_sequence p assign) in let reassign_sequence = List.fold_left assign_back None captured_name_list in - (* attach the folded record to the re-assign sequence *) + (* STEP 9 *) let final_sequence = match reassign_sequence with (* None case means that no variables were captured *) - | None -> e_let_in ("_COMPILER_folded_record", None) fold (e_skip ()) - | Some seq -> e_let_in ("_COMPILER_folded_record", None) fold seq in + | None -> e_let_in ("#COMPILER#folded_record", None) fold (e_skip ()) + | Some seq -> e_let_in ("#COMPILER#folded_record", None) fold seq in return_statement @@ final_sequence let simpl_program : Raw.ast -> program result = fun t -> From 37570c6a40351ea1e901e64a4a26bdc3f4b83a14 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Mon, 28 Oct 2019 18:43:55 +0100 Subject: [PATCH 42/51] clean test --- src/test/contracts/loop.ligo | 19 ------------------- 1 file changed, 19 deletions(-) diff --git a/src/test/contracts/loop.ligo b/src/test/contracts/loop.ligo index f559c2816..10137c07a 100644 --- a/src/test/contracts/loop.ligo +++ b/src/test/contracts/loop.ligo @@ -24,25 +24,6 @@ function for_sum (var n : nat) : int is block { end } with acc - -function lamby (var accu : (record st : string ; acc : int end) ; var i : int ) - : (record st : string ; acc : int end) is block { - accu.acc := accu.acc + i ; - accu.st := accu.st ^ "to" ; -} with accu - -function for_collection_ (var nee : unit; var nuu : unit) : (int * string) is block { - var acc : int := 0 ; - var st : string := "to" ; - var mylist : list(int) := list 1 ; 1 ; 1 end ; - var init_record : (record st : string; acc : int end ) := - record st = st; acc = acc; end; - var folded_record : (record st : string; acc : int end ) := - list_fold(mylist , init_record , lamby) ; - st := folded_record.st ; - acc := folded_record.acc ; -} with (folded_record.acc , folded_record.st) - function for_collection_list (var nee : unit) : (int * string) is block { var acc : int := 0 ; var st : string := "to" ; From e77f3e4903d050de10c554aed900ea39ca61d401 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Mon, 28 Oct 2019 18:53:40 +0100 Subject: [PATCH 43/51] empty for collection loop --- src/passes/2-simplify/pascaligo.ml | 2 +- src/test/contracts/loop.ligo | 21 +++++++++++++++++++++ src/test/integration_tests.ml | 5 +++++ 3 files changed, 27 insertions(+), 1 deletion(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index ec38004b3..a7314317d 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -1189,7 +1189,7 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun (* STEP 9 *) let final_sequence = match reassign_sequence with (* None case means that no variables were captured *) - | None -> e_let_in ("#COMPILER#folded_record", None) fold (e_skip ()) + | None -> e_skip () | Some seq -> e_let_in ("#COMPILER#folded_record", None) fold seq in return_statement @@ final_sequence diff --git a/src/test/contracts/loop.ligo b/src/test/contracts/loop.ligo index 10137c07a..7aaa4d7eb 100644 --- a/src/test/contracts/loop.ligo +++ b/src/test/contracts/loop.ligo @@ -46,6 +46,27 @@ function for_collection_set (var nee : unit) : (int * string) is block { end } with (acc, st) +// function for_collection_assignements_in_ifs (var nee : unit) : int is block { +// var acc : int := 0 ; +// var myset : set(int) := set 1 ; 2 ; 3 end ; +// for x : int in set myset +// begin +// if (x=1) then +// acc := acc + x ; +// else +// acc := acc + 10 ; +// end +// } with acc + +function for_collection_empty (var nee : unit) : int is block { + var acc : int := 0 ; + var myset : set(int) := set 1 ; 2 ; 3 end ; + for x : int in set myset + begin + skip ; + end +} with acc + // function for_collection_map (var nee : unit) : (int * string) is block { // var acc : int := 0 ; // var st : string := "" ; diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 3ed6d871e..26a1fcc63 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -674,6 +674,11 @@ let loop () : unit result = let expected = e_pair (e_int 6) (e_string "totototo") in expect_eq program "for_collection_set" input expected in + let%bind () = + let input = e_unit () in + let expected = (e_int 0) in + expect_eq program "for_collection_empty" input expected + in ok () (* Don't know how to assert parse error happens in this test framework From ba00db2b4cf3e2b9b3af22ed97deb0f2284262a2 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 29 Oct 2019 10:43:38 +0100 Subject: [PATCH 44/51] add self_ast_simplified fold_expression --- src/passes/3-self_ast_simplified/helpers.ml | 87 ++++++++++++++++++- .../self_ast_simplified.ml | 2 + 2 files changed, 88 insertions(+), 1 deletion(-) diff --git a/src/passes/3-self_ast_simplified/helpers.ml b/src/passes/3-self_ast_simplified/helpers.ml index 0793e8420..04b641f87 100644 --- a/src/passes/3-self_ast_simplified/helpers.ml +++ b/src/passes/3-self_ast_simplified/helpers.ml @@ -1,8 +1,93 @@ open Ast_simplified open Trace -type mapper = expression -> expression result +type 'a folder = 'a -> expression -> 'a result +let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f init e -> + let self = fold_expression f in + let%bind init' = f init e in + match e.expression with + | E_literal _ | E_variable _ | E_skip -> ok init' + | E_list lst | E_set lst | E_tuple lst | E_constant (_ , lst) -> ( + let%bind res' = bind_fold_list self init' lst in + ok res' + ) + | E_map lst | E_big_map lst -> ( + let%bind res' = bind_fold_list (bind_fold_pair self) init' lst in + ok res' + ) + | E_look_up ab | E_sequence ab | E_loop ab | E_application ab -> ( + let%bind res' = bind_fold_pair self init' ab in + ok res' + ) + | E_lambda { binder = _ ; input_type = _ ; output_type = _ ; result = e } + | E_annotation (e , _) | E_constructor (_ , e) -> ( + let%bind res' = self init' e in + ok res' + ) + | E_assign (_ , path , e) | E_accessor (e , path) -> ( + let%bind res' = fold_path f init' path in + let%bind res' = self res' e in + ok res' + ) + | E_matching (e , cases) -> ( + let%bind res = self init' e in + let%bind res = fold_cases f res cases in + ok res + ) + | E_record m -> ( + let aux init'' _ expr = + let%bind res' = fold_expression self init'' expr in + ok res' + in + let%bind res = bind_fold_smap aux (ok init') m in + ok res + ) + | E_let_in { binder = _ ; rhs ; result } -> ( + let%bind res = self init' rhs in + let%bind res = self res result in + ok res + ) +and fold_path : 'a folder -> 'a -> access_path -> 'a result = fun f init p -> bind_fold_list (fold_access f) init p + +and fold_access : 'a folder -> 'a -> access -> 'a result = fun f init a -> + match a with + | Access_map e -> ( + let%bind e' = fold_expression f init e in + ok e' + ) + | _ -> ok init + +and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m -> + match m with + | Match_bool { match_true ; match_false } -> ( + let%bind res = fold_expression f init match_true in + let%bind res = fold_expression f res match_false in + ok res + ) + | Match_list { match_nil ; match_cons = (_ , _ , cons) } -> ( + let%bind res = fold_expression f init match_nil in + let%bind res = fold_expression f res cons in + ok res + ) + | Match_option { match_none ; match_some = (_ , some) } -> ( + let%bind res = fold_expression f init match_none in + let%bind res = fold_expression f res some in + ok res + ) + | Match_tuple (_ , e) -> ( + let%bind res = fold_expression f init e in + ok res + ) + | Match_variant lst -> ( + let aux init' ((_ , _) , e) = + let%bind res' = fold_expression f init' e in + ok res' in + let%bind res = bind_fold_list aux init lst in + ok res + ) + +type mapper = expression -> expression result let rec map_expression : mapper -> expression -> expression result = fun f e -> let self = map_expression f in let%bind e' = f e in 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 b73113cdb..a1ce4b580 100644 --- a/src/passes/3-self_ast_simplified/self_ast_simplified.ml +++ b/src/passes/3-self_ast_simplified/self_ast_simplified.ml @@ -23,3 +23,5 @@ let all_expression = bind_chain all_p let map_expression = Helpers.map_expression + +let fold_expression = Helpers.fold_expression From e86c92bc3bb67a2e21935b8fbcd9a26696cd3ace Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 29 Oct 2019 11:41:59 +0100 Subject: [PATCH 45/51] improving simplifier --- src/passes/2-simplify/pascaligo.ml | 80 +++++++++++------------------- 1 file changed, 29 insertions(+), 51 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index a7314317d..c73fd67a3 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -1029,9 +1029,7 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi -> ``` We are performing the following steps: - 1) Filtering out of the body all the constructions that can't - alter the environment (assignements and map/set patches) - and simplifying only those. + 1) Simplifying the for body using ̀simpl_block` 2) Detect the free variables and build a list of their names (myint and myst in the previous example) @@ -1074,76 +1072,56 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi -> **) and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc -> match fc.collection with | Map _ -> fail @@ unsupported_for_collect_map fc.block | _ -> - let statements = npseq_to_list fc.block.value.statements in (* STEP 1 *) - let filter_assignments (el : Raw.statement) : Raw.instruction option = - match el with - | Raw.Instr (Assign _ as i) -> Some i - | _ -> None in - let assign_instrs = List.filter_map filter_assignments statements in - let%bind assign_instrs' = bind_map_list - (fun el -> - let%bind assign' = simpl_instruction el in - let%bind assign' = assign' None in - ok @@ assign') - assign_instrs in + let%bind for_body = simpl_block fc.block.value in + let%bind for_body = for_body None in (* STEP 2 *) - let captured_name_list = List.filter_map - (fun ass_exp -> + let%bind captured_name_list = Self_ast_simplified.fold_expression + (fun (prev : type_name list) (ass_exp : expression) -> match ass_exp.expression with - | E_assign ( name, _ , _ ) -> Some name - | _ -> None ) - assign_instrs' in + | E_assign ( name , _ , _ ) -> ok (name::prev) + | _ -> ok prev ) + [] + for_body in (* STEP 3 *) let add_to_record (prev: expression type_name_map) (captured_name: string) = SMap.add captured_name (e_variable captured_name) prev in let init_record = e_record (List.fold_left add_to_record SMap.empty captured_name_list) in (* STEP 4 *) - let%bind for_body = simpl_block fc.block.value in - let%bind for_body = for_body None in let replace exp = - (* TODO: map and set updated/remove must also be captured *) match exp.expression with (* replace references to fold accumulator as rhs *) | E_assign ( name , path , expr ) -> ( - match path with - | [] -> ok @@ e_assign "#COMPILER#acc" [Access_record name] expr - (* This fails for deep accesses, see LIGO-131 LIGO-134 *) - | _ -> - (* ok @@ e_assign "#COMPILER#acc" ((Access_record name)::path) expr) *) - fail @@ unsupported_deep_access_for_collection fc.block ) + match path with + | [] -> ok @@ e_assign "#COMPILER#acc" [Access_record name] expr + (* This fails for deep accesses, see LIGO-131 LIGO-134 *) + | _ -> + (* ok @@ e_assign "#COMPILER#acc" ((Access_record name)::path) expr) *) + fail @@ unsupported_deep_access_for_collection fc.block ) | E_variable name -> ( - match fc.collection with + if (List.mem name captured_name_list) then + (* replace references to fold accumulator as lhs *) + ok @@ e_accessor (e_variable "#COMPILER#acc") [Access_record name] + else match fc.collection with (* loop on map *) | Map _ -> let k' = e_variable "#COMPILER#collec_elt_k" in - let v' = e_variable "#COMPILER#collec_elt_v" in - ( match fc.bind_to with - | Some (_,v) -> - if ( name = fc.var.value ) then - ok @@ k' (* replace references to the the key *) - else if ( name = v.value ) then - ok @@ v' (* replace references to the the value *) - else if (List.mem name captured_name_list) then - (* replace references to fold accumulator as lhs *) - ok @@ e_accessor (e_variable "#COMPILER#acc") [Access_record name] - else ok @@ exp - | None -> - if ( name = fc.var.value ) then - ok @@ k' (* replace references to the key *) - else if (List.mem name captured_name_list) then - (* replace references to fold accumulator as lhs *) - ok @@ e_accessor (e_variable "#COMPILER#acc") [Access_record name] - else ok @@ exp + if ( name = fc.var.value ) then + ok @@ k' (* replace references to the the key *) + else ( + match fc.bind_to with + | Some (_,v) -> + let v' = e_variable "#COMPILER#collec_elt_v" in + if ( name = v.value ) then + ok @@ v' (* replace references to the the value *) + else ok @@ exp + | None -> ok @@ exp ) (* loop on set or list *) | (Set _ | List _) -> if (name = fc.var.value ) then (* replace references to the collection element *) ok @@ (e_variable "#COMPILER#collec_elt") - else if (List.mem name captured_name_list) then - (* replace references to fold accumulator as lhs *) - ok @@ e_accessor (e_variable "#COMPILER#acc") [Access_record name] else ok @@ exp ) | _ -> ok @@ exp in From c288f3c81e84767c133a7fe6bf3e80f18c8c289e Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 29 Oct 2019 11:56:21 +0100 Subject: [PATCH 46/51] simplify the simplifier and now find the free variables with a expression_fold --- src/passes/2-simplify/pascaligo.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index c73fd67a3..0200098ae 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -1132,7 +1132,6 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun | _ -> e_sequence expr (e_variable "#COMPILER#acc") in let for_body = add_return for_body in (* STEP 6 *) - let%bind elt_type = simpl_type_expression fc.elt_type in let for_body = let ( arg_access: Types.access_path -> expression ) = e_accessor (e_variable "arguments") in ( match fc.collection with @@ -1147,7 +1146,7 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun let acc = arg_access [Access_tuple 0] in let collec_elt = arg_access [Access_tuple 1] in e_let_in ("#COMPILER#acc", None) acc @@ - e_let_in ("#COMPILER#collec_elt", Some elt_type) collec_elt (for_body) + e_let_in ("#COMPILER#collec_elt", None) collec_elt (for_body) ) in (* STEP 7 *) let%bind collect = simpl_expression fc.expr in From fd901548af4f161977224f490aa16d6dccf3787b Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 29 Oct 2019 11:57:15 +0100 Subject: [PATCH 47/51] add more tests --- src/test/contracts/loop.ligo | 71 +++++++++++++++++++++++++++++------ src/test/integration_tests.ml | 45 +++++++++++++--------- 2 files changed, 88 insertions(+), 28 deletions(-) diff --git a/src/test/contracts/loop.ligo b/src/test/contracts/loop.ligo index 7aaa4d7eb..bbf887460 100644 --- a/src/test/contracts/loop.ligo +++ b/src/test/contracts/loop.ligo @@ -46,17 +46,66 @@ function for_collection_set (var nee : unit) : (int * string) is block { end } with (acc, st) -// function for_collection_assignements_in_ifs (var nee : unit) : int is block { -// var acc : int := 0 ; -// var myset : set(int) := set 1 ; 2 ; 3 end ; -// for x : int in set myset -// begin -// if (x=1) then -// acc := acc + x ; -// else -// acc := acc + 10 ; -// end -// } with acc +function for_collection_if_and_local_var (var nee : unit) : int is block { + var acc : int := 0 ; + const theone : int = 1 ; + var myset : set(int) := set 1 ; 2 ; 3 end ; + for x : int in set myset + begin + const thetwo : int = 2 ; + if (x=theone) then + acc := acc + x ; + else if (x=thetwo) then + acc := acc + thetwo ; + else + acc := acc + 10 ; + end +} with acc + +function for_collection_rhs_capture (var nee : unit) : int is block { + var acc : int := 0 ; + const mybigint : int = 1000 ; + var myset : set(int) := set 1 ; 2 ; 3 end ; + for x : int in set myset + begin + if (x=1) then + acc := acc + mybigint ; + else + acc := acc + 10 ; + end +} with acc + +function for_collection_proc_call (var nee : unit) : int is block { + var acc : int := 0 ; + var myset : set(int) := set 1 ; 2 ; 3 end ; + for x : int in set myset + begin + if (x=1) then + acc := acc + for_collection_rhs_capture(unit) ; + else + acc := acc + 10 ; + end +} with acc + +function for_collection_comp_with_acc (var nee : unit) : int is block { + var myint : int := 0 ; + var mylist : list(int) := list 1 ; 10 ; 15 end; + for x : int in list mylist + begin + if (x < myint) then skip ; + else myint := myint + 10 ; + end +} with myint + +function for_collection_with_patches (var nee : unit) : map(string,int) is block { + var myint : int := 12 ; + var mylist : list(string) := list "I" ; "am" ; "foo" end; + var mymap : map(string,int) := map end; + for x : string in list mylist + begin + patch mymap with map [ x -> myint ]; + end +} with mymap function for_collection_empty (var nee : unit) : int is block { var acc : int := 0 ; diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 26a1fcc63..734b28dba 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -647,38 +647,49 @@ let loop () : unit result = let%bind () = let make_input = e_nat in let make_expected = e_nat in - expect_eq_n_pos program "dummy" make_input make_expected - in + expect_eq_n_pos program "dummy" make_input make_expected in let%bind () = let make_input = e_nat in let make_expected = e_nat in - expect_eq_n_pos_mid program "counter" make_input make_expected - in + expect_eq_n_pos_mid program "counter" make_input make_expected in let%bind () = let make_input = e_nat in let make_expected = fun n -> e_nat (n * (n + 1) / 2) in - expect_eq_n_pos_mid program "while_sum" make_input make_expected - in + expect_eq_n_pos_mid program "while_sum" make_input make_expected in let%bind () = let make_input = e_nat in let make_expected = fun n -> e_int (n * (n + 1) / 2) in - expect_eq_n_pos_mid program "for_sum" make_input make_expected - in + expect_eq_n_pos_mid program "for_sum" make_input make_expected in + let input = e_unit () in let%bind () = - let input = e_unit () in let expected = e_pair (e_int 3) (e_string "totototo") in - expect_eq program "for_collection_list" input expected - in + expect_eq program "for_collection_list" input expected in let%bind () = - let input = e_unit () in let expected = e_pair (e_int 6) (e_string "totototo") in - expect_eq program "for_collection_set" input expected - in + expect_eq program "for_collection_set" input expected in let%bind () = - let input = e_unit () in let expected = (e_int 0) in - expect_eq program "for_collection_empty" input expected - in + expect_eq program "for_collection_empty" input expected in + let%bind () = + let expected = (e_int 13) in + expect_eq program "for_collection_if_and_local_var" input expected in + let%bind () = + let expected = (e_int 1020) in + expect_eq program "for_collection_rhs_capture" input expected in + let%bind () = + let expected = (e_int 1040) in + expect_eq program "for_collection_proc_call" input expected in + let%bind () = + let expected = (e_int 20) in + expect_eq program "for_collection_comp_with_acc" input expected in + let%bind () = + let ez lst = + let open Ast_simplified.Combinators in + let lst' = List.map (fun (x, y) -> e_string x, e_int y) lst in + e_typed_map lst' t_string t_int + in + let expected = ez [ ("I" , 12) ; ("am" , 12) ; ("foo" , 12) ] in + expect_eq program "for_collection_with_patches" input expected in ok () (* Don't know how to assert parse error happens in this test framework From 402d849cec742c408fe9ddbb7c3d3f3d38e94257 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 29 Oct 2019 15:43:00 +0100 Subject: [PATCH 48/51] use intermediary tuple access to get key and value for maps. add tests. --- src/passes/2-simplify/pascaligo.ml | 21 ++++++++------------- src/test/contracts/loop.ligo | 29 +++++++++++++++++++---------- src/test/integration_tests.ml | 6 ++++++ 3 files changed, 33 insertions(+), 23 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 0200098ae..54b2c2207 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -138,16 +138,6 @@ module Errors = struct ] in error ~data title message - let unsupported_for_collect_map for_col = - let title () = "for loop over map" in - let message () = - Format.asprintf "for loops over map are not supported yet" in - let data = [ - ("loop_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ for_col.Region.region) - ] in - error ~data title message - (* Logging *) let simplifying_instruction t = @@ -1071,7 +1061,6 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi -> **) and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc -> - match fc.collection with | Map _ -> fail @@ unsupported_for_collect_map fc.block | _ -> (* STEP 1 *) let%bind for_body = simpl_block fc.block.value in let%bind for_body = for_body None in @@ -1136,10 +1125,16 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun let ( arg_access: Types.access_path -> expression ) = e_accessor (e_variable "arguments") in ( match fc.collection with | Map _ -> - let acc = arg_access [Access_tuple 0 ; Access_tuple 0] in + (* let acc = arg_access [Access_tuple 0 ; Access_tuple 0] in let collec_elt_v = arg_access [Access_tuple 1 ; Access_tuple 0] in - let collec_elt_k = arg_access [Access_tuple 1 ; Access_tuple 1] in + let collec_elt_k = arg_access [Access_tuple 1 ; Access_tuple 1] in *) + (* The above should work, but not yet (see LIGO-131) *) + let temp_kv = arg_access [Access_tuple 1] in + let acc = arg_access [Access_tuple 0] in + let collec_elt_v = e_accessor (e_variable "#COMPILER#temp_kv") [Access_tuple 0] in + let collec_elt_k = e_accessor (e_variable "#COMPILER#temp_kv") [Access_tuple 1] in e_let_in ("#COMPILER#acc", None) acc @@ + e_let_in ("#COMPILER#temp_kv", None) temp_kv @@ e_let_in ("#COMPILER#collec_elt_k", None) collec_elt_v @@ e_let_in ("#COMPILER#collec_elt_v", None) collec_elt_k (for_body) | _ -> diff --git a/src/test/contracts/loop.ligo b/src/test/contracts/loop.ligo index bbf887460..b873853b7 100644 --- a/src/test/contracts/loop.ligo +++ b/src/test/contracts/loop.ligo @@ -116,16 +116,25 @@ function for_collection_empty (var nee : unit) : int is block { end } with acc -// function for_collection_map (var nee : unit) : (int * string) is block { -// var acc : int := 0 ; -// var st : string := "" ; -// var mymap : map(string,int) := map "one" -> 1 ; "two" -> 2 ; "three" -> 3 end ; -// for k -> v : (string * int) in map mymap -// begin -// acc := acc + v ; -// st := k^st ; -// end -// } with (acc, st) +function for_collection_map_kv (var nee : unit) : (int * string) is block { + var acc : int := 0 ; + var st : string := "" ; + var mymap : map(string,int) := map "1" -> 1 ; "2" -> 2 ; "3" -> 3 end ; + for k -> v : (string * int) in map mymap + begin + acc := acc + v ; + st := st^k ; + end +} with (acc, st) + +function for_collection_map_k (var nee : unit) : string is block { + var st : string := "" ; + var mymap : map(string,int) := map "1" -> 1 ; "2" -> 2 ; "3" -> 3 end ; + for k : string in map mymap + begin + st := st^k ; + end +} with st function dummy (const n : nat) : nat is block { while (False) block { skip } diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 734b28dba..8a644d1b2 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -667,6 +667,12 @@ let loop () : unit result = let%bind () = let expected = e_pair (e_int 6) (e_string "totototo") in expect_eq program "for_collection_set" input expected in + let%bind () = + let expected = e_pair (e_int 6) (e_string "123") in + expect_eq program "for_collection_map_kv" input expected in + let%bind () = + let expected = (e_string "123") in + expect_eq program "for_collection_map_k" input expected in let%bind () = let expected = (e_int 0) in expect_eq program "for_collection_empty" input expected in From a140e123949ea653a7d9d19cd0031bed31f497f7 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 29 Oct 2019 16:32:28 +0100 Subject: [PATCH 49/51] add test for nested for collection loops (not supported yet) --- src/passes/2-simplify/pascaligo.ml | 6 +++++- src/test/contracts/loop.ligo | 15 +++++++++++++++ src/test/integration_tests.ml | 3 +++ 3 files changed, 23 insertions(+), 1 deletion(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 54b2c2207..4dee47dec 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -1068,7 +1068,11 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun let%bind captured_name_list = Self_ast_simplified.fold_expression (fun (prev : type_name list) (ass_exp : expression) -> match ass_exp.expression with - | E_assign ( name , _ , _ ) -> ok (name::prev) + | E_assign ( name , _ , _ ) -> + if (String.contains name '#') then + ok prev + else + ok (name::prev) | _ -> ok prev ) [] for_body in diff --git a/src/test/contracts/loop.ligo b/src/test/contracts/loop.ligo index b873853b7..2f250cf18 100644 --- a/src/test/contracts/loop.ligo +++ b/src/test/contracts/loop.ligo @@ -136,6 +136,21 @@ function for_collection_map_k (var nee : unit) : string is block { end } with st +// function nested_for_collection (var nee : unit) : (int*string) is block { +// var myint : int := 0; +// var myst : string := ""; +// var mylist : list(int) := list 1 ; 2 ; 3 end ; +// for i : int in list mylist +// begin +// myint := myint + i ; +// var myset : set(string) := set "1" ; "2" ; "3" end ; +// for st : string in set myset +// begin +// myst := myst ^ st ; +// end +// end +// } with (myint,myst) + function dummy (const n : nat) : nat is block { while (False) block { skip } } with n diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 8a644d1b2..10f4d4d06 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -688,6 +688,9 @@ let loop () : unit result = let%bind () = let expected = (e_int 20) in expect_eq program "for_collection_comp_with_acc" input expected in + (* let%bind () = + let expected = e_pair (e_int 6) (e_string "123123123") in + expect_eq program "nested_for_collection" input expected in *) let%bind () = let ez lst = let open Ast_simplified.Combinators in From 102ffda7c31dfbe5760ff420f0434d609cf997fe Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Tue, 29 Oct 2019 09:28:20 -0700 Subject: [PATCH 50/51] Make negative operator test pass --- src/passes/2-simplify/ligodity.ml | 14 +------------- 1 file changed, 1 insertion(+), 13 deletions(-) diff --git a/src/passes/2-simplify/ligodity.ml b/src/passes/2-simplify/ligodity.ml index 06928f754..aa1afb2a5 100644 --- a/src/passes/2-simplify/ligodity.ml +++ b/src/passes/2-simplify/ligodity.ml @@ -49,17 +49,6 @@ module Errors = struct ] in error ~data title message - let unsupported_arith_op expr = - let title () = "arithmetic expressions" in - let message () = - Format.asprintf "this arithmetic operator is not supported yet" in - let expr_loc = Raw.expr_to_region expr in - let data = [ - ("expr_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ expr_loc) - ] in - error ~data title message - let untyped_fun_param var = let title () = "function parameter" in let message () = @@ -425,8 +414,7 @@ let rec simpl_expression : let n = Z.to_int @@ snd @@ n in return @@ e_literal ~loc (Literal_mutez n) ) - | EArith _ as e -> - fail @@ unsupported_arith_op e + | EArith (Neg e) -> simpl_unop "NEG" e | EString (String s) -> ( let (s , loc) = r_split s in let s' = From f0f4c683f289888f96a3ead38c19dee2a72c0c98 Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Tue, 29 Oct 2019 10:07:07 -0700 Subject: [PATCH 51/51] Add more complex negative operator test --- src/test/contracts/arithmetic.mligo | 5 +++++ src/test/integration_tests.ml | 1 + 2 files changed, 6 insertions(+) diff --git a/src/test/contracts/arithmetic.mligo b/src/test/contracts/arithmetic.mligo index 0e5f01587..3dd91648a 100644 --- a/src/test/contracts/arithmetic.mligo +++ b/src/test/contracts/arithmetic.mligo @@ -3,4 +3,9 @@ let neg_op (n : int) : int = -n +let foo (n : int) : int = n + 10 + +let neg_op_2 (b: int) : int = -(foo b) + + diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 7336ad676..6211532a7 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -184,6 +184,7 @@ let arithmetic_mligo () : unit result = let aux (name , f) = expect_eq_n_int program name f in bind_map_list aux [ ("neg_op", fun n -> (-n)) ; + ("neg_op_2", fun n -> -(n + 10)) ; ] in ok ()