mend

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]

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

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 ;

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

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

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 =