From c7a7f0065a0700a55a0678819e30a7aa00ac5628 Mon Sep 17 00:00:00 2001 From: Galfour Date: Sat, 30 Mar 2019 22:06:05 +0000 Subject: [PATCH] mend --- src/lib_utils/x_tezos_micheline.ml | 2 +- src/ligo/ast_simplified.ml | 2 +- src/ligo/contracts/map.ligo | 2 ++ src/ligo/simplify.ml | 21 +++++++++++++++++---- src/ligo/test/integration_tests.ml | 9 +++++++++ src/ligo/typer.ml | 7 ++++++- 6 files changed, 36 insertions(+), 7 deletions(-) diff --git a/src/lib_utils/x_tezos_micheline.ml b/src/lib_utils/x_tezos_micheline.ml index 8e4c74fca..468306784 100644 --- a/src/lib_utils/x_tezos_micheline.ml +++ b/src/lib_utils/x_tezos_micheline.ml @@ -43,7 +43,7 @@ module Michelson = struct let i_if a b = prim ~children:[a;b] I_IF let i_if_none a b = prim ~children:[a;b] I_IF_NONE let i_failwith = prim I_FAILWITH - let i_assert_some = i_if_none (seq []) (seq [i_push_unit ; i_failwith]) + let i_assert_some = i_if_none (seq [i_failwith]) (seq []) let dip code : michelson = prim ~children:[seq [code]] I_DIP let i_unpair = seq [i_dup ; i_car ; dip i_cdr] diff --git a/src/ligo/ast_simplified.ml b/src/ligo/ast_simplified.ml index 3d5cbe2ef..716a27c4d 100644 --- a/src/ligo/ast_simplified.ml +++ b/src/ligo/ast_simplified.ml @@ -134,7 +134,7 @@ module PP = struct let rec expression ppf (e:expression) = match e with | Literal l -> literal ppf l | Variable name -> fprintf ppf "%s" name - | Application (f, arg) -> fprintf ppf "(%a) (%a)" annotated_expression f annotated_expression arg + | Application (f, arg) -> fprintf ppf "(%a)@(%a)" annotated_expression f annotated_expression arg | Constructor (name, ae) -> fprintf ppf "%s(%a)" name annotated_expression ae | Constant (name, lst) -> fprintf ppf "%s(%a)" name (list_sep annotated_expression) lst | Tuple lst -> fprintf ppf "tuple[%a]" (list_sep annotated_expression) lst diff --git a/src/ligo/contracts/map.ligo b/src/ligo/contracts/map.ligo index 0d779e0f9..2bc9af8a6 100644 --- a/src/ligo/contracts/map.ligo +++ b/src/ligo/contracts/map.ligo @@ -1,5 +1,7 @@ type foobar is map(int, int) +function gf (const m : foobar) : int is begin skip end with get_force(23, m) + const fb : foobar = map 23 -> 0 ; 42 -> 0 ; diff --git a/src/ligo/simplify.ml b/src/ligo/simplify.ml index c37b7ceff..4fe56b2f9 100644 --- a/src/ligo/simplify.ml +++ b/src/ligo/simplify.ml @@ -74,6 +74,10 @@ and simpl_list_type_expression (lst:Raw.type_expr list) : type_expression result let%bind lst = bind_list @@ List.map simpl_type_expression lst in ok @@ Type_tuple lst +let constants = [ + ("get_force", 2) ; +] + let rec simpl_expression (t:Raw.expr) : ae result = let return x = ok @@ ae x in let simpl_projection = fun (p:Raw.projection) -> @@ -95,12 +99,21 @@ let rec simpl_expression (t:Raw.expr) : ae result = if c.value = "unit" then ok @@ ae @@ Literal Unit else ok @@ ae @@ Variable c.value - | ECall x -> + | ECall x -> ( let (name, args) = x.value in let f = name.value in - let%bind arg = simpl_list_expression - @@ npseq_to_list args.value.inside in - ok @@ ae @@ Application (ae @@ Variable f, arg) + let args' = npseq_to_list args.value.inside in + match List.assoc_opt f constants with + | None -> + let%bind arg = simpl_list_expression args' in + ok @@ ae @@ Application (ae @@ Variable f, arg) + | Some arity -> + let%bind _arity = + trace (simple_error "wrong arity for constants") @@ + Assert.assert_equal_int arity (List.length args') in + let%bind lst = bind_map_list simpl_expression args' in + ok @@ ae @@ Constant (f, lst) + ) | EPar x -> simpl_expression x.value.inside | EUnit _ -> ok @@ ae @@ Literal Unit | EBytes x -> ok @@ ae @@ Literal (Bytes (Bytes.of_string @@ fst x.value)) diff --git a/src/ligo/test/integration_tests.ml b/src/ligo/test/integration_tests.ml index 6904d1031..2bf8f2f76 100644 --- a/src/ligo/test/integration_tests.ml +++ b/src/ligo/test/integration_tests.ml @@ -176,6 +176,15 @@ let map () : unit result = let lst' = List.map (fun (x, y) -> a_int x, a_int y) lst in a_map lst' make_t_int make_t_int in + let%bind _get_force = trace (simple_error "get_force") @@ + let aux n = + let input = ez [(23, n) ; (42, 4)] in + let%bind result = easy_run_typed "gf" program input in + let expect = AST_Typed.Combinators.(a_int n) in + AST_Typed.assert_value_eq (expect, result) + in + bind_map_list aux [0 ; 42 ; 51 ; 421 ; -3] + in let%bind _foobar = trace (simple_error "foobar") @@ let%bind result = easy_evaluate_typed "fb" program in let expect = ez [(23, 0) ; (42, 0)] in diff --git a/src/ligo/typer.ml b/src/ligo/typer.ml index d1994102d..376a82715 100644 --- a/src/ligo/typer.ml +++ b/src/ligo/typer.ml @@ -406,7 +406,12 @@ and type_constant (name:string) (lst:O.type_value list) (tv_opt:O.type_value opt ) | "NONE", _ -> simple_fail "bad number of params to NONE" | "SOME", [s] -> ok ("SOME", make_t_option s) - | "SOME", _ -> simple_fail "bad number of params to NONE" + | "SOME", _ -> simple_fail "bad number of params to SOME" + | "get_force", [i_ty;m_ty] -> + let%bind (src, dst) = get_t_map m_ty in + let%bind _ = O.assert_type_value_eq (src, i_ty) in + ok ("GET_FORCE", dst) + | "get_force", _ -> simple_fail "bad number of params to get_force" | name, _ -> fail @@ unrecognized_constant name let untype_type_value (t:O.type_value) : (I.type_expression) result =